4 import Edu.Berkeley.Sbp.Haskell.SBP
7 import List(isSuffixOf,isPrefixOf)
9 -- FIXME: use pretty-printing when asked to for better display
13 instance ToHtml a => ToHtml [a] where
14 toHtml x = concatMap toHtml x
18 " h1, h2, h3, h4 { font-family: 'Trebuchet MS', arial, verdana, sans-serif; width: 100% }\n"++
19 " h1 { font-size: 20pt; border-top: black 1px solid; }\n"++
20 " h2 { font-size: 16pt; border-top: silver 1px solid; }\n"++
21 " h3 { font-size: 12pt; }\n"++
22 " TH, TD, P, LI, DIV, SPAN {\n"++
23 " font-family: verdana, arial, sans-serif;\n"++
24 " font-size: 12px; \n"++
25 " text-decoration:none; \n"++
27 " LI { margin-top: 5px; }\n"++
28 " body { color: #333333; }\n"++
29 " blockquote { font-style: italic; width: 100% }\n"++
30 " div.warn { border: 1px solid red; background-color: #fbb; color: white; }\n"++
31 " td.warn { color: black; }\n"++
32 " div.announce { border: 1px solid green; background-color: #bfb; color: white; }\n"++
33 " td.announce { color: black; }\n"++
36 " border-top: 1px solid silver;\n"++
37 " font-size: 10px;\n"++
39 " table.blockquote { margin: 5px; border: 1px #e6ddcb solid; background-color: #fbf2e0; width: 100% }\n"++
40 " a:link { text-decoration: none; color: blue; border-bottom:1px dotted; }\n"++
41 " a:visited { text-decoration: none; color: purple; border-bottom:1px dotted; }\n"++
42 " a:active { text-decoration: none; color: red; border-bottom:1px solid; }\n"++
43 " a:hover { text-decoration: none; border-bottom:1px solid; }\n"++
44 " table.footer { border-top: silver solid 1px; }\n"++
45 " span.signature { color: #bbb; }\n"++
46 " .signature a:link { color: #bbb; }\n"++
47 " .signature a:visited { color: #bbb; }\n"++
48 " .signature a:hover { color: blue; border-bottom: 1px solid blue; }\n"++
49 " span.highlight { background: yellow; color: black; padding: 3px }\n"++
51 " text-align: left;\n"++
52 " font-family: monospace;\n"++
53 " border-style: solid;\n"++
54 " border-width: 2px 2px 2px 2px;\n"++
55 " border-color: #6666aa;\n"++
56 " color: #FFFFFF;\n"++
57 " background-color: #000000;\n"++
58 " margin-right: 25px;\n"++
59 " margin-left: 25px;\n"++
65 instance ToHtml Doc where
67 "<!-- This document was AUTOMATICALLY GENERATED from wix source -->\n"++
68 "<!-- it is probably not a wise idea to edit it directly -->\n\n"++
74 "<body>\n"++ -- tell jsmath we will escape stuff manually
76 -- FIXME: only put this in if math appears on the page
77 "<script> jsMath = { showFontWarnings: false } </script>\n"++
78 "<script src='/jsmath/easy/load.js'></script>\n"++
79 "<span id='tex2math_off'></span>\n"++
80 "<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"++
82 "<center><table><tr><td width=600>\n"++
85 "<table width=100% class=footer><tr><td align=left>"++
86 "<img src=/images/print.icon.png></td>"++
87 "<td align=right><span class='signature'>rendered from "++
88 "<a href=http://www.megacz.com/software/wix>"++
89 "W<span style='vertical-align:-20%'>I</span>X</a></span></div></td></tr></table>\n"++
90 "</td></tr></table></center>\n"++
93 instance ToHtml Section where
94 toHtml (Section level header paragraphs) =
95 "\n<h"++(show (level+1))++">\n"++
97 "\n</h"++(show (level+1))++">\n"++
99 stag t body = "\n<"++t++">\n"++body++"\n</"++t++">\n"
100 tag t body = "<"++t++">"++body++"</"++t++">"
102 instance ToHtml Paragraph where
103 toHtml (Blockquote t) = "\n<table class=blockquote border=0 cellpadding=5px>\n"
104 ++"<tr><td valign=top><image src=/images/blockquote.png></td>\n"
105 ++"<td class=warn>\n"
107 ++"</td></tr></table>\n"
108 toHtml HR = stag "hr" []
109 toHtml (OL t) = stag "ol" $ concatMap (\x -> stag "li" $ concatMap toHtml x) t
110 toHtml (UL t) = stag "ul" $ concatMap (\x -> stag "li" $ concatMap toHtml x) t
111 toHtml (P t) = stag "p" $ toHtml t
114 link ref body = "<a href='"++ref++"'>"++icon++body++"</a>"
116 icon = if ".pdf" `isSuffixOf` ref then "<img "++img++" src=/images/pdf.icon.png> "
117 else if "mailto:" `isPrefixOf` ref then "<img "++img++" src=/images/email.icon.png> "
119 img = "style='vertical-align: text-bottom;' border=0 "
120 -- margin-bottom: -2px; padding-bottom: 2px; border-bottom: 1px blue solid;
122 instance ToHtml Text where
124 toHtml (Chars s) = toHtml s
126 -- directional quotes: see http://www.dwheeler.com/essays/quotes-in-html.html
127 toHtml (Quotes x) = "“"++(toHtml x)++"”"
128 toHtml (Verbatim x) = pre x
129 toHtml (Link t ref) = link (show ref) (toHtml t)
130 toHtml (Command "url" y) = "<tt>"++(link (toHtml y) (toHtml y))++"</tt>"
131 toHtml (Command "WiX" y) = "W<span style='vertical-align:-20%'>I</span>X"
132 toHtml (Command "TeX" y) = "T<span style='vertical-align:-20%'>E</span>X"
133 -- u'1/2' : u'\u00BD',
134 -- u'1/4' : u'\u00BC',
135 -- u'3/4' : u'\u00BE',
136 -- u'1/3' : u'\u2153',
137 -- u'2/3' : u'\u2154',
138 -- u'1/5' : u'\u2155',
139 -- u'2/5' : u'\u2156',
140 -- u'3/5' : u'\u2157',
141 -- u'4/5' : u'\u2158',
142 -- u'1/6' : u'\u2159',
143 -- u'5/6' : u'\u215A',
144 -- u'1/8' : u'\u215B',
145 -- u'3/8' : u'\u215C',
146 -- u'5/8' : u'\u215D',
147 -- u'7/8' : u'\u215E',
149 toHtml (Styled Underline x) = tag "u" $ toHtml x
150 toHtml (Styled TT x) = tag "tt" $ toHtml x
151 toHtml (Styled Italic x) = tag "i" $ toHtml x
152 toHtml (Styled Strikethrough x) = tag "strike" $ toHtml x
153 toHtml (Styled Superscript x) = tag "sup" $ toHtml x
154 toHtml (Styled Subscript x) = tag "sub" $ toHtml x
155 toHtml (Styled Bold x) = tag "b" $ toHtml x
156 toHtml (Styled Highlight x) = "<span class=highlight>"++(toHtml x)++"</span>"
158 toHtml (Keyword x) = tag "tt" $ toHtml x
159 toHtml (SubPar x) = stag "p" $ concatMap toHtml x
161 toHtml (Command "red" y) = "<font color=red>"++(toHtml y)++"</font>"
162 toHtml (Command "orange" y) = "<font color=orange>"++(toHtml y)++"</font>"
163 toHtml (Command "green" y) = "<font color=green>"++(toHtml y)++"</font>"
164 toHtml (Command "sc" y) = "<sc>"++(toHtml y)++"</sc>"
165 toHtml (Command "image" y) = "<img src='"++(toHtml y)++"'/>"
166 toHtml (Command "image3" y) = "<img width=200px src='"++(toHtml y)++"'/>"
167 toHtml (Command "image4" y) = "<center><img width=550px src='"++(toHtml y)++"'/></center>"
168 toHtml (Command "warn" y) = "\n<div class=warn>\n<table border=0 cellpadding=5px>\n"
169 ++"<tr><td valign=top><image src=/images/warn.png></td>\n"
170 ++"<td class=warn>\n"
172 ++"</td></tr></table></div>\n"
173 toHtml (Command "announce" y) = "\n<div class=announce>\n<table border=0 cellpadding=5px>\n"
174 ++"<tr><td valign=top></td>\n"
175 ++"<td class=warn>\n"
177 ++"</td></tr></table></div>\n"
178 toHtml (Command "br" _) = "\n<br/>\n"
179 toHtml (Command "cent" _) = "½"
180 toHtml (Command "euro" _) = "€"
181 toHtml (Command "ordinal" x) = (toHtml x)++"<sup>"++"th"++"</sup>"
182 -- FIXME: use "unicode vulgar fractions" here
183 toHtml (Command "fraction" [n,d]) = "<sup>"++(toHtml n)++"</sup>"++"/"++"<sub>"++(toHtml d)++"</sub>"
184 toHtml (Command "rfc" x) = "<tt><a href=http://tools.ietf.org/html/rfc"++(toHtml x)++">RFC"++(toHtml x)++"</a></tt>"
186 -- FIXME: add div as well (for display-mode math)
187 toHtml (Math m) = "<span class=math>" ++ (toHtml m) ++ "</span>"
188 toHtml (Footnote x) = error $ "footnotes not supported"
190 toHtml (GlyphText Euro) = "€"
191 toHtml (GlyphText CircleR) = "¢"
192 toHtml (GlyphText CircleC) = "®"
193 toHtml (GlyphText TradeMark) = "™"
194 toHtml (GlyphText ServiceMark) = "™"
195 toHtml (GlyphText Emdash) = "—"
196 toHtml (GlyphText Ellipsis) = "…"
197 toHtml (GlyphText Cent) = "½"
198 toHtml (GlyphText Daggar) = "†"
199 toHtml (GlyphText DoubleDaggar) = "‡"
200 toHtml (GlyphText Clover) = "⌘"
201 toHtml (GlyphText Flat) = "⋖"
202 toHtml (GlyphText Natural) = "⋗"
203 toHtml (GlyphText Sharp) = "⋘"
204 toHtml (GlyphText CheckMark) = "✓"
205 toHtml (GlyphText XMark) = "✗"
206 toHtml (GlyphText LeftArrow) = "&#;" -- FIXME
207 toHtml (GlyphText DoubleLeftArrow) = "&#;" -- FIXME
208 toHtml (GlyphText DoubleRightArrow) = "&#;" -- FIXME
209 toHtml (GlyphText DoubleLeftRightArrow) = "&#;" -- FIXME
210 toHtml (GlyphText LeftRightArrow) = "&#;" -- FIXME
211 toHtml (GlyphText Degree) = "&#;" -- FIXME
213 toHtml (Command ('k':'e':'y':'s':'t':'r':'o':'k':'e':':':k) _) =
222 toHtml (Command x y) = error $ "unsupported command "++(show x)
224 instance ToHtml String where
225 toHtml s = concatMap htmlEscapeChar s
227 htmlEscapeChar '<' = "<"
228 htmlEscapeChar '>' = ">"
229 htmlEscapeChar '&' = "&"
230 htmlEscapeChar '\'' = "'"
231 htmlEscapeChar '\"' = """
232 htmlEscapeChar c = [c]
234 pre x = "\n<div class=pre>"++ (pre' x) ++ "\n</div>\n"
236 pre' (' ':b) = " "++(pre' b)
237 pre' ('\n':b) = "<br/>\n"++(pre' b)
238 pre' (a:b) = a:(pre' b)