2 -- Copyright 2008 the Contributors, as shown in the revision logs.
3 -- Licensed under the Apache Public Source License 2.0 ("the License").
4 -- You may not use this file except in compliance with the License.
8 import Edu_Berkeley_Sbp_Haskell_SBP
11 import List(isSuffixOf,isPrefixOf)
13 -- FIXME: use pretty-printing when asked to for better display
17 instance ToHtml a => ToHtml [a] where
18 toHtml x = concatMap toHtml x
22 " h1, h2, h3, h4 { font-family: 'Trebuchet MS', arial, verdana, sans-serif; width: 100% }\n"++
23 " h1 { font-size: 20pt; border-top: black 1px solid; }\n"++
24 " h2 { font-size: 16pt; border-top: silver 1px solid; }\n"++
25 " h3 { font-size: 12pt; }\n"++
26 " TH, TD, P, LI, DIV, SPAN {\n"++
27 " font-family: verdana, arial, sans-serif;\n"++
28 " font-size: 12px; \n"++
29 " text-decoration:none; \n"++
31 " LI { margin-top: 5px; }\n"++
32 " body { color: #333333; }\n"++
33 " blockquote { font-style: italic; width: 100% }\n"++
34 " div.warn { border: 1px solid #f44; border-top: 5px solid #f44; background-color: #fbb; color: white; }\n"++
35 " td.warn { color: black; }\n"++
36 " div.announce { border: 1px solid green; background-color: #bfb; color: white; }\n"++
37 " td.announce { color: black; }\n"++
40 " border-top: 1px solid silver;\n"++
41 " font-size: 10px;\n"++
43 " table.blockquote { margin: 5px; border: 1px #e6ddcb solid; background-color: #fbf2e0; width: 100% }\n"++
44 " a:link { text-decoration: none; color: blue; border-bottom:1px dotted; }\n"++
45 " a:visited { text-decoration: none; color: purple; border-bottom:1px dotted; }\n"++
46 " a:active { text-decoration: none; color: red; border-bottom:1px solid; }\n"++
47 " a:hover { text-decoration: none; border-bottom:1px solid; }\n"++
48 " table.footer { border-top: silver solid 1px; }\n"++
49 " span.signature { color: #bbb; }\n"++
50 " .signature a:link { color: #aaf; }\n"++
51 " .signature a:visited { color: #faa; }\n"++
52 " .signature a:hover { color: blue; border-bottom: 1px solid blue; }\n"++
53 " span.highlight { background: yellow; color: black; padding: 3px }\n"++
55 " text-align: left;\n"++
56 " font-family: monospace;\n"++
57 " border-style: none;\n"++
58 " border-width: 2px 2px 2px 2px;\n"++
59 " border-color: #6666aa;\n"++
60 " color: #FFFFFF;\n"++
61 " background-color: #333333;\n"++
62 " margin-right: 25px;\n"++
63 " margin-left: 25px;\n"++
69 instance ToHtml Doc where
71 "<!-- This document was AUTOMATICALLY GENERATED from wix source -->\n"++
72 "<!-- it is probably not a wise idea to edit it directly -->\n\n"++
78 "<body>\n"++ -- tell jsmath we will escape stuff manually
80 -- FIXME: only put this in if math appears on the page
81 "<script> jsMath = { showFontWarnings: false } </script>\n"++
82 "<script src='/jsmath/easy/load.js'></script>\n"++
83 "<span id='tex2math_off'></span>\n"++
84 "<NOSCRIPT> <DIV STYLE='color:#CC0000; text-align:center'> <B>Warning: <A HREF='http://www.math.union.edu/locate/jsMath'>jsMath</A> requires JavaScript to process the mathematics on this page.<BR> If your browser supports JavaScript, be sure it is enabled.</B> </DIV> <HR> </NOSCRIPT>\n"++
86 "<center><table><tr><td width=600>\n"++
89 "<table width=100% class=footer><tr><td align=left>"++
90 "<img src='"++printIconBase64++"'></td>"++
91 "<td align=right><span class='signature'>rendered from "++
92 "<a href=http://www.megacz.com/software/wix>"++
93 "W<span style='vertical-align:-20%'>I</span>X</a></span></div></td></tr></table>\n"++
94 "</td></tr></table></center>\n"++
98 "data:image/png;base64,"
99 ++"iVBORw0KGgoAAAANSUhEUgAAABAAAAAVCAYAAABPPm7SAAAABmJLR0QA/wD/AP+gvaeTAAAA"
100 ++"CXBIWXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1wQPAx0rP5obpAAAAWJJREFUOMvdlKFvg0AU"
101 ++"xr8tVZ1cbU+04lUuwc2WypMX9AxiomoJ/RNYqmaaYKpb5kBys1UkWBCdKLqVs8zwFnrQmYol"
102 ++"+xLC8X55H/e+wAENhWGoPM/zT6eThQ4lSWJf5EEQuAAqAJXv+95vXCkVtpwZuq4bmM1pmlrM"
103 ++"LctKWzuwbTsBUNX3lph3Njfd6/WZ9vv9iHkYhsrkPa21zQ9aa9v3fRsAFovFK9cMPgIApdT7"
104 ++"eDz+RB1Y1XEBwEVe54ZbXKm/N7haNwCQ5zmtVqtnE0op49lspgFgPp+/dfF/EGIPAAaDgZBS"
105 ++"xgBwPB7vd7vdIwD0+/2v5ry8juNYmgY/P1GWZQ9sQER3XOcwD4fDkA2IqGiNwN8+ERVNY/Pt"
106 ++"RFQIIcozg+Vy+VKW5dDcMmuz2ThFURAATKfTj7MQ1+v1Ezc7jrMVQpTmocOjOY6znUwmRSvR"
107 ++"KIpknud0KfEoimSWZQ/N2jfhtb1AvGklDQAAAABJRU5ErkJggg=="
110 "data:image/png;base64,"
111 ++"iVBORw0KGgoAAAANSUhEUgAAABQAAAAREAYAAACN1FD9AAAABmJLR0QA/wD/AP+gvaeTAAAA"
112 ++"CXBIWXMAAABIAAAASABGyWs+AAAACXZwQWcAAAAUAAAAEQDeTN6UAAAD/ElEQVRIx8WUbUyV"
113 ++"ZRjHf+chxDi8yZcDa0mKh/wSuNE5eNYHZBiRwoespayEkdgx22hmjB1glTlenDYlMccAX1cb"
114 ++"CDFlg+aQ1JGEazGWpixdbbweDucctPF2PNxXX3pw00gL09+X59m1+77+v+d+nueCBRJ+ECAs"
115 ++"78dnAPp2nLEDtMdpPwMYZhfaf8GU1gLsixwdBRDRr7lRAHmxT0zs+UKAuKmhXgDfGleAYZVh"
116 ++"lXynC/Z1AYyeX+IFiLjw+MwWAxDQuBqgNVsX+iNta/nWcnV0vD+9Ir1CndDre68AfDH42PzW"
117 ++"2QDW79UFxkxh6WHp8o5a5lznXCfJ/nPX867nSYArO7AssEyOjOwE8GfGZwC84Pu3edrDLgzK"
118 ++"AFj06q7DAPt/1evBK4szizMlpXy4tqO2g/MHa9sm2ibwP23M78zvFE0rBAg4U24DqFpieAqA"
119 ++"6kd+cjuiAAqu6Sfn/n55/fJ6CZOc6YHpATmkNWgNWoOIZtSMmlFE1d9ae2utvDt21ZRiSpHV"
120 ++"+r43LwFkBT4ysehigKgDvxcC3P5QD5qxNtU11anj8hfhg+GD4YMixipjlbFK5pjyHok8Enn3"
121 ++"m7yyG2DAEdIFYLy9YMHDLoBjK/WA8fhkb7JXtcqMnJbT4tJFYlpiWmJaRKJio2KjYu8KSp9K"
122 ++"UAly2ZtpSbWkql/0PrsuAJR3/2cx65cA1qujRgBV6HpWy9fy5dydOz2JPYlqQO4hwZ/gT/CL"
123 ++"mB1mh9kh93Enq2tP1x7V4wo0pBnS5KehVwBmPjA7AcxtDy2mBQIYPmk/B/CDb26MxGw5teWU"
124 ++"+krmIdWaak21iiR2JHYkdsi83G7KtmRb1HG9b+PHAK2lJAEQ9EDBt88C5BybGyOLQgtCC8Su"
125 ++"gkesI1axzRd8Mvdk7slckeoN1RuqN8wvODsyVDNUIxaXP0SFKHlfz8l4GSDTfd+B6Tdh5QCh"
126 ++"hUUvAlR8o9eDI4qSipLkJcOEqdvUzaX5HmzSNGmaNMFN+037TTvgxInzb96QKTovOo/LRmuJ"
127 ++"r8QnFr3+2esAB/IX9wAEjd+3cfc+gD2euTFSv2zzss0SIdnTG6c3SqU8AFulrdJWKRJSElIS"
128 ++"UiLia/Y1+5r/YcNHM9tntku1e2KFZ4VHAvXcwnyAksY5MfNvAOYdQ+8BzHytL5warDtRd2I2"
129 ++"QjWNh46HqjR11LvGu0aVqUOei56LYlD7PRWeCmlWpe4p95R87h66Yb9hV+7+o71BvUHKoWyj"
130 ++"jlGHSlbPOTc5N6kkFTqybWSbeksxfHb4rGqd9Q3nDOdI5lRHTXtNu6rWc/vfAJjoXHoNYOl6"
131 ++"Q70CaFEpYwAZhof+m/5nvv0UoDFLW/UagCXuSQvdSzwAiTv/BGXg1AxNKyCeAAAAAElFTkSu"
135 "data:image/png;base64,"
136 ++"iVBORw0KGgoAAAANSUhEUgAAAA8AAAAOCAMAAADHVLbdAAAALHRFWHRDcmVhdGlvbiBUaW1l"
137 ++"AEZyaSAxOSBTZXAgMjAwMyAxODozOTozMiAtMDAwME2jAt8AAAAHdElNRQfTCRMRKABXeznM"
138 ++"AAAACXBIWXMAAAsSAAALEgHS3X78AAAABGdBTUEAALGPC/xhBQAAACRQTFRF////AAAA7+/v"
139 ++"3t7ezs7OtbW1ra2tlJSUnJycEBAQKSkphISEbGtEogAAAAF0Uk5TAEDm2GYAAABLSURBVHja"
140 ++"nY1BEsAgCAMDKm31//81qB3l6h4Y4mYQQNvAmXNv7W/gytcTRj6pppQHNWoW6JWS13Ix86yr"
141 ++"O7MEPkDWuWLPK/7hoYEOxksDsk8eppEAAAAASUVORK5CYII="
145 "data:image/png;base64,"
146 ++"iVBORw0KGgoAAAANSUhEUgAAABUAAAAOCAMAAAD32Kf8AAAALHRFWHRDcmVhdGlvbiBUaW1l"
147 ++"AEZyaSAxOSBTZXAgMjAwMyAxODo0MjowOSAtMDAwMBDwv7IAAAAHdElNRQfTCRMRKhqYL6I0"
148 ++"AAAACXBIWXMAAAsSAAALEgHS3X78AAAABGdBTUEAALGPC/xhBQAAADBQTFRF////AAAAhISE"
149 ++"9/fv9/f3////CAgI7+/v1tbOxsa9tbWtpaWclJSMlJSUe3t7a2trxDv8WgAAAAF0Uk5TAEDm"
150 ++"2GYAAABiSURBVHjabc9JEoAgDETRpNOKs/e/rSEYF8jfhHpQFAi6JHpHBg5VOdIj+KeXkgO9"
151 ++"tUj/Bldo3WdRnktt3fbjgoWKK5EKsunkyryCn86Oxsj/UZqKEkFmNF+mvieFdSK16wFr7QK5"
152 ++"tASqkwAAAABJRU5ErkJggg=="
155 "data:image/png;base64,"
156 ++"iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAMAAAAoLQ9TAAAAK3RFWHRDcmVhdGlvbiBUaW1l"
157 ++"AFRodSA2IE5vdiAyMDAzIDE1OjMwOjAwIC0wMDAwSwt8PwAAAAd0SU1FB9MLBg8fD1x8/t4A"
158 ++"AAAJcEhZcwAACxIAAAsSAdLdfvwAAAAEZ0FNQQAAsY8L/GEFAAAAQlBMVEX///9zc3Nra2uE"
159 ++"hITGxsaUlJScnJx7e3uMjIz////39/fv7+/n5+fe3t69vb1jY2OlpaXW1ta1tbVaWlqtra3O"
160 ++"zs5w48BYAAAAAXRSTlMAQObYZgAAAIdJREFUeNpNz1ESBBEMBNCRwSCJMOT+V10WW9vKz6uO"
161 ++"iusa0R137ShxjImwHsnSMCbEX6dPiIje+SUKC6hav8CbAQlZD/RmJ1Tdz6oTwETMfAByK0hT"
162 ++"1kgH7E1phFfjdvS2JlJpN8RAyEHMhgJgaexJTBPyA1JiGoD0BXgg2H8wcFs3/jDvPB+sOwir"
163 ++"+o6iKQAAAABJRU5ErkJggg=="
165 instance ToHtml Section where
166 toHtml (Section level header paragraphs) =
167 "\n<h"++(show (level+1))++">\n"++
169 "\n</h"++(show (level+1))++">\n"++
171 stag t body = "\n<"++t++">\n"++body++"\n</"++t++">\n"
172 tag t body = "<"++t++">"++body++"</"++t++">"
174 instance ToHtml Paragraph where
175 toHtml (Blockquote t) = "\n<table class=blockquote border=0 cellpadding=5px>\n"
176 ++"<tr><td valign=top><image src='"++quoteIconBase64++"'></td>\n"
177 ++"<td class=warn>\n"
179 ++"</td></tr></table>\n"
180 toHtml HR = stag "hr" []
181 toHtml (OL t) = stag "ol" $ concatMap (\x -> stag "li" $ concatMap toHtml x) t
182 toHtml (UL t) = stag "ul" $ concatMap (\x -> stag "li" $ concatMap toHtml x) t
183 toHtml (P t) = stag "p" $ toHtml t
186 link ref body = "<a href='"++(urlify ref)++"'>"++icon++body++"</a>"
189 icon = if ".pdf" `isSuffixOf` ref then "<img "++img++" src='"++pdfIconBase64++"'> "
190 else if "mailto:" `isPrefixOf` ref then "<img "++img++" src='"++emailIconBase64++"'> "
192 img = "style='vertical-align: text-bottom;' border=0 "
193 -- margin-bottom: -2px; padding-bottom: 2px; border-bottom: 1px blue solid;
195 instance ToHtml Text where
197 toHtml (Chars s) = toHtml s
199 -- directional quotes: see http://www.dwheeler.com/essays/quotes-in-html.html
200 toHtml (Quotes x) = "“"++(toHtml x)++"”"
201 toHtml (Verbatim x) = pre x
202 toHtml (Link t ref) = link (show ref) (toHtml t)
203 toHtml (Command "comment" y) = ""
204 toHtml (Command "url" y) = "<tt>"++(link (toHtml y) (toHtml y))++"</tt>"
205 toHtml (Command "WiX" y) = "W<span style='vertical-align:-20%'>I</span>X"
206 toHtml (Command "TeX" y) = "T<span style='vertical-align:-20%'>E</span>X"
207 -- u'1/2' : u'\u00BD',
208 -- u'1/4' : u'\u00BC',
209 -- u'3/4' : u'\u00BE',
210 -- u'1/3' : u'\u2153',
211 -- u'2/3' : u'\u2154',
212 -- u'1/5' : u'\u2155',
213 -- u'2/5' : u'\u2156',
214 -- u'3/5' : u'\u2157',
215 -- u'4/5' : u'\u2158',
216 -- u'1/6' : u'\u2159',
217 -- u'5/6' : u'\u215A',
218 -- u'1/8' : u'\u215B',
219 -- u'3/8' : u'\u215C',
220 -- u'5/8' : u'\u215D',
221 -- u'7/8' : u'\u215E',
223 toHtml (Styled Underline x) = tag "u" $ toHtml x
224 toHtml (Styled TT x) = tag "tt" $ toHtml x
225 toHtml (Styled Italic x) = tag "i" $ toHtml x
226 toHtml (Styled Strikethrough x) = tag "strike" $ toHtml x
227 toHtml (Styled Superscript x) = tag "sup" $ toHtml x
228 toHtml (Styled Subscript x) = tag "sub" $ toHtml x
229 toHtml (Styled Bold x) = tag "b" $ toHtml x
230 toHtml (Styled Highlight x) = "<span class=highlight>"++(toHtml x)++"</span>"
232 toHtml (Keyword x) = tag "tt" $ toHtml x
233 toHtml (SubPar x) = stag "p" $ concatMap toHtml x
235 toHtml (Command "red" y) = "<font color=red>"++(toHtml y)++"</font>"
236 toHtml (Command "orange" y) = "<font color=orange>"++(toHtml y)++"</font>"
237 toHtml (Command "green" y) = "<font color=green>"++(toHtml y)++"</font>"
238 toHtml (Command "sc" y) = "<sc>"++(toHtml y)++"</sc>"
239 toHtml (Command "image" y) = "<img src='"++(toHtml y)++"'/>"
240 toHtml (Command "imagec" y) = "<center><img src='"++(toHtml y)++"'/></center>"
241 toHtml (Command "image2" y) = "<img width=180px src='"++(toHtml y)++"'/>"
242 toHtml (Command "image3" y) = "<img width=200px src='"++(toHtml y)++"'/>"
243 toHtml (Command "image4" y) = "<center><img width=550px src='"++(toHtml y)++"'/></center>"
244 toHtml (Command "warn" y) = "\n<div class=warn>\n<table border=0 cellpadding=5px>\n"
245 ++"<tr><td valign=top><image src='"++warnIconBase64++"'></td>\n"
246 ++"<td class=warn>\n"
248 ++"</td></tr></table></div>\n"
249 toHtml (Command "announce" y) = "\n<div class=announce>\n<table border=0 cellpadding=5px>\n"
250 ++"<tr><td valign=top></td>\n"
251 ++"<td class=warn>\n"
253 ++"</td></tr></table></div>\n"
254 toHtml (Command "br" _) = "\n<br/>\n"
255 toHtml (Command "cent" _) = "½"
256 toHtml (Command "euro" _) = "€"
259 toHtml (Command "ordinal" x) | (last (toHtml x) == '1') = (toHtml x)++"<sup>"++"st"++"</sup>"
260 | (last (toHtml x) == '2') = (toHtml x)++"<sup>"++"nd"++"</sup>"
261 | (last (toHtml x) == '3') = (toHtml x)++"<sup>"++"rd"++"</sup>"
262 | otherwise = (toHtml x)++"<sup>"++"th"++"</sup>"
264 -- FIXME: use "unicode vulgar fractions" here
265 toHtml (Command "fraction" [n,d]) = "<sup>"++(toHtml n)++"</sup>"++"/"++"<sub>"++(toHtml d)++"</sub>"
266 toHtml (Command "rfc" x) = "<tt><a href=http://tools.ietf.org/html/rfc"++(toHtml x)++">RFC"++(toHtml x)++"</a></tt>"
268 -- FIXME: add div as well (for display-mode math)
269 toHtml (Math m) = "<span class=math>" ++ (toHtml m) ++ "</span>"
270 toHtml (Footnote x) = error $ "footnotes not supported"
272 toHtml (GlyphText Euro) = "€"
273 toHtml (GlyphText CircleR) = "¢"
274 toHtml (GlyphText CircleC) = "®"
275 toHtml (GlyphText TradeMark) = "™"
276 toHtml (GlyphText ServiceMark) = "™"
277 toHtml (GlyphText Emdash) = "—"
278 toHtml (GlyphText Ellipsis) = "…" -- &cdots;?
279 toHtml (GlyphText Cent) = "½"
280 toHtml (GlyphText Daggar) = "†"
281 toHtml (GlyphText DoubleDaggar) = "‡"
282 toHtml (GlyphText Clover) = "⌘"
283 toHtml (GlyphText Flat) = "⋖"
284 toHtml (GlyphText Natural) = "⋗"
285 toHtml (GlyphText Sharp) = "⋘"
286 toHtml (GlyphText CheckMark) = "✓"
287 toHtml (GlyphText XMark) = "✗"
288 toHtml (GlyphText LeftArrow) = "←"
289 toHtml (GlyphText RightArrow) = "→"
290 toHtml (GlyphText DoubleLeftArrow) = "&#;" -- FIXME
291 toHtml (GlyphText DoubleRightArrow) = "&#;" -- FIXME
292 toHtml (GlyphText DoubleLeftRightArrow) = "&#;" -- FIXME
293 toHtml (GlyphText LeftRightArrow) = "&#;" -- FIXME
294 toHtml (GlyphText Degree) = "&#;" -- FIXME
296 toHtml (Command ('k':'e':'y':'s':'t':'r':'o':'k':'e':':':k) _) =
305 toHtml (Command x y) = error $ "unsupported command "++(show x)
307 instance ToHtml String where
308 toHtml s = concatMap htmlEscapeChar s
310 htmlEscapeChar '<' = "<"
311 htmlEscapeChar '>' = ">"
312 htmlEscapeChar '&' = "&"
313 htmlEscapeChar '\'' = "'"
314 htmlEscapeChar '\"' = """
315 htmlEscapeChar c = [c]
317 pre x = "\n<div class=pre style='white-space:nowrap'>"++ (pre' x) ++ "\n</div>\n"
319 pre' (' ':b) = " "++(pre' b)
320 pre' ('\n':b) = "<br/>\n"++(pre' b)
321 pre' (a:b) = (htmlEscapeChar a)++(pre' b)