\begin{code}
-- Copyright 2008 the Contributors, as shown in the revision logs.
-- Licensed under the Apache Public Source License 2.0 ("the License").
-- You may not use this file except in compliance with the License.
module Html
where
import Edu_Berkeley_Sbp_Haskell_SBP
import FromTree
import Doc
import List(isSuffixOf,isPrefixOf)
-- FIXME: use pretty-printing when asked to for better display
class ToHtml a where
toHtml :: a -> String
instance ToHtml a => ToHtml [a] where
toHtml x = concatMap toHtml x
style =
"\n\n"
instance ToHtml Doc where
toHtml (Doc h secs) =
"\n"++
"\n\n"++
"\n"++
"
\n"++
style++
--FIXME: title tag
"\n"++
"\n"++ -- tell jsmath we will escape stuff manually
-- FIXME: only put this in if math appears on the page
"\n"++
"\n"++
" \n"++
" Warning: jsMath requires JavaScript to process the mathematics on this page. If your browser supports JavaScript, be sure it is enabled. \n"++
"\n"++
(toHtml secs) ++
" \n"++
"\n"++
"
\n"++
""
quoteIconBase64 =
"data:image/png;base64,"
++"iVBORw0KGgoAAAANSUhEUgAAABAAAAAVCAYAAABPPm7SAAAABmJLR0QA/wD/AP+gvaeTAAAA"
++"CXBIWXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1wQPAx0rP5obpAAAAWJJREFUOMvdlKFvg0AU"
++"xr8tVZ1cbU+04lUuwc2WypMX9AxiomoJ/RNYqmaaYKpb5kBys1UkWBCdKLqVs8zwFnrQmYol"
++"+xLC8X55H/e+wAENhWGoPM/zT6eThQ4lSWJf5EEQuAAqAJXv+95vXCkVtpwZuq4bmM1pmlrM"
++"LctKWzuwbTsBUNX3lph3Njfd6/WZ9vv9iHkYhsrkPa21zQ9aa9v3fRsAFovFK9cMPgIApdT7"
++"eDz+RB1Y1XEBwEVe54ZbXKm/N7haNwCQ5zmtVqtnE0op49lspgFgPp+/dfF/EGIPAAaDgZBS"
++"xgBwPB7vd7vdIwD0+/2v5ry8juNYmgY/P1GWZQ9sQER3XOcwD4fDkA2IqGiNwN8+ERVNY/Pt"
++"RFQIIcozg+Vy+VKW5dDcMmuz2ThFURAATKfTj7MQ1+v1Ezc7jrMVQpTmocOjOY6znUwmRSvR"
++"KIpknud0KfEoimSWZQ/N2jfhtb1AvGklDQAAAABJRU5ErkJggg=="
warnIconBase64 =
"data:image/png;base64,"
++"iVBORw0KGgoAAAANSUhEUgAAABQAAAAREAYAAACN1FD9AAAABmJLR0QA/wD/AP+gvaeTAAAA"
++"CXBIWXMAAABIAAAASABGyWs+AAAACXZwQWcAAAAUAAAAEQDeTN6UAAAD/ElEQVRIx8WUbUyV"
++"ZRjHf+chxDi8yZcDa0mKh/wSuNE5eNYHZBiRwoespayEkdgx22hmjB1glTlenDYlMccAX1cb"
++"CDFlg+aQ1JGEazGWpixdbbweDucctPF2PNxXX3pw00gL09+X59m1+77+v+d+nueCBRJ+ECAs"
++"78dnAPp2nLEDtMdpPwMYZhfaf8GU1gLsixwdBRDRr7lRAHmxT0zs+UKAuKmhXgDfGleAYZVh"
++"lXynC/Z1AYyeX+IFiLjw+MwWAxDQuBqgNVsX+iNta/nWcnV0vD+9Ir1CndDre68AfDH42PzW"
++"2QDW79UFxkxh6WHp8o5a5lznXCfJ/nPX867nSYArO7AssEyOjOwE8GfGZwC84Pu3edrDLgzK"
++"AFj06q7DAPt/1evBK4szizMlpXy4tqO2g/MHa9sm2ibwP23M78zvFE0rBAg4U24DqFpieAqA"
++"6kd+cjuiAAqu6Sfn/n55/fJ6CZOc6YHpATmkNWgNWoOIZtSMmlFE1d9ae2utvDt21ZRiSpHV"
++"+r43LwFkBT4ysehigKgDvxcC3P5QD5qxNtU11anj8hfhg+GD4YMixipjlbFK5pjyHok8Enn3"
++"m7yyG2DAEdIFYLy9YMHDLoBjK/WA8fhkb7JXtcqMnJbT4tJFYlpiWmJaRKJio2KjYu8KSp9K"
++"UAly2ZtpSbWkql/0PrsuAJR3/2cx65cA1qujRgBV6HpWy9fy5dydOz2JPYlqQO4hwZ/gT/CL"
++"mB1mh9kh93Enq2tP1x7V4wo0pBnS5KehVwBmPjA7AcxtDy2mBQIYPmk/B/CDb26MxGw5teWU"
++"+krmIdWaak21iiR2JHYkdsi83G7KtmRb1HG9b+PHAK2lJAEQ9EDBt88C5BybGyOLQgtCC8Su"
++"gkesI1axzRd8Mvdk7slckeoN1RuqN8wvODsyVDNUIxaXP0SFKHlfz8l4GSDTfd+B6Tdh5QCh"
++"hUUvAlR8o9eDI4qSipLkJcOEqdvUzaX5HmzSNGmaNMFN+037TTvgxInzb96QKTovOo/LRmuJ"
++"r8QnFr3+2esAB/IX9wAEjd+3cfc+gD2euTFSv2zzss0SIdnTG6c3SqU8AFulrdJWKRJSElIS"
++"UiLia/Y1+5r/YcNHM9tntku1e2KFZ4VHAvXcwnyAksY5MfNvAOYdQ+8BzHytL5warDtRd2I2"
++"QjWNh46HqjR11LvGu0aVqUOei56LYlD7PRWeCmlWpe4p95R87h66Yb9hV+7+o71BvUHKoWyj"
++"jlGHSlbPOTc5N6kkFTqybWSbeksxfHb4rGqd9Q3nDOdI5lRHTXtNu6rWc/vfAJjoXHoNYOl6"
++"Q70CaFEpYwAZhof+m/5nvv0UoDFLW/UagCXuSQvdSzwAiTv/BGXg1AxNKyCeAAAAAElFTkSu"
++"QmCC"
printIconBase64 =
"data:image/png;base64,"
++"iVBORw0KGgoAAAANSUhEUgAAAA8AAAAOCAMAAADHVLbdAAAALHRFWHRDcmVhdGlvbiBUaW1l"
++"AEZyaSAxOSBTZXAgMjAwMyAxODozOTozMiAtMDAwME2jAt8AAAAHdElNRQfTCRMRKABXeznM"
++"AAAACXBIWXMAAAsSAAALEgHS3X78AAAABGdBTUEAALGPC/xhBQAAACRQTFRF////AAAA7+/v"
++"3t7ezs7OtbW1ra2tlJSUnJycEBAQKSkphISEbGtEogAAAAF0Uk5TAEDm2GYAAABLSURBVHja"
++"nY1BEsAgCAMDKm31//81qB3l6h4Y4mYQQNvAmXNv7W/gytcTRj6pppQHNWoW6JWS13Ix86yr"
++"O7MEPkDWuWLPK/7hoYEOxksDsk8eppEAAAAASUVORK5CYII="
emailIconBase64 =
"data:image/png;base64,"
++"iVBORw0KGgoAAAANSUhEUgAAABUAAAAOCAMAAAD32Kf8AAAALHRFWHRDcmVhdGlvbiBUaW1l"
++"AEZyaSAxOSBTZXAgMjAwMyAxODo0MjowOSAtMDAwMBDwv7IAAAAHdElNRQfTCRMRKhqYL6I0"
++"AAAACXBIWXMAAAsSAAALEgHS3X78AAAABGdBTUEAALGPC/xhBQAAADBQTFRF////AAAAhISE"
++"9/fv9/f3////CAgI7+/v1tbOxsa9tbWtpaWclJSMlJSUe3t7a2trxDv8WgAAAAF0Uk5TAEDm"
++"2GYAAABiSURBVHjabc9JEoAgDETRpNOKs/e/rSEYF8jfhHpQFAi6JHpHBg5VOdIj+KeXkgO9"
++"tUj/Bldo3WdRnktt3fbjgoWKK5EKsunkyryCn86Oxsj/UZqKEkFmNF+mvieFdSK16wFr7QK5"
++"tASqkwAAAABJRU5ErkJggg=="
pdfIconBase64 =
"data:image/png;base64,"
++"iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAMAAAAoLQ9TAAAAK3RFWHRDcmVhdGlvbiBUaW1l"
++"AFRodSA2IE5vdiAyMDAzIDE1OjMwOjAwIC0wMDAwSwt8PwAAAAd0SU1FB9MLBg8fD1x8/t4A"
++"AAAJcEhZcwAACxIAAAsSAdLdfvwAAAAEZ0FNQQAAsY8L/GEFAAAAQlBMVEX///9zc3Nra2uE"
++"hITGxsaUlJScnJx7e3uMjIz////39/fv7+/n5+fe3t69vb1jY2OlpaXW1ta1tbVaWlqtra3O"
++"zs5w48BYAAAAAXRSTlMAQObYZgAAAIdJREFUeNpNz1ESBBEMBNCRwSCJMOT+V10WW9vKz6uO"
++"iusa0R137ShxjImwHsnSMCbEX6dPiIje+SUKC6hav8CbAQlZD/RmJ1Tdz6oTwETMfAByK0hT"
++"1kgH7E1phFfjdvS2JlJpN8RAyEHMhgJgaexJTBPyA1JiGoD0BXgg2H8wcFs3/jDvPB+sOwir"
++"+o6iKQAAAABJRU5ErkJggg=="
instance ToHtml Section where
toHtml (Section level header paragraphs) =
"\n\n"++
(toHtml header)++
"\n \n"++
(toHtml paragraphs)
stag t body = "\n<"++t++">\n"++body++"\n"++t++">\n"
tag t body = "<"++t++">"++body++""++t++">"
instance ToHtml Paragraph where
toHtml (Blockquote t) = "\n\n"
++" \n"
++"\n"
++(toHtml t)
++"
\n"
toHtml HR = stag "hr" []
toHtml (OL t) = stag "ol" $ concatMap (\x -> stag "li" $ concatMap toHtml x) t
toHtml (UL t) = stag "ul" $ concatMap (\x -> stag "li" $ concatMap toHtml x) t
toHtml (P t) = stag "p" $ toHtml t
link ref body = ""++icon++body++" "
where
urlify = toHtml
icon = if ".pdf" `isSuffixOf` ref then " "
else if "mailto:" `isPrefixOf` ref then " "
else ""
img = "style='vertical-align: text-bottom;' border=0 "
-- margin-bottom: -2px; padding-bottom: 2px; border-bottom: 1px blue solid;
instance ToHtml Text where
toHtml WS = " "
toHtml (Chars s) = toHtml s
-- directional quotes: see http://www.dwheeler.com/essays/quotes-in-html.html
toHtml (Quotes x) = "“"++(toHtml x)++"”"
toHtml (Verbatim x) = pre x
toHtml (Link t ref) = link (show ref) (toHtml t)
toHtml (Command "comment" y) = ""
toHtml (Command "url" y) = ""++(link (toHtml y) (toHtml y))++" "
toHtml (Command "WiX" y) = "WI X"
toHtml (Command "TeX" y) = "TE X"
-- u'1/2' : u'\u00BD',
-- u'1/4' : u'\u00BC',
-- u'3/4' : u'\u00BE',
-- u'1/3' : u'\u2153',
-- u'2/3' : u'\u2154',
-- u'1/5' : u'\u2155',
-- u'2/5' : u'\u2156',
-- u'3/5' : u'\u2157',
-- u'4/5' : u'\u2158',
-- u'1/6' : u'\u2159',
-- u'5/6' : u'\u215A',
-- u'1/8' : u'\u215B',
-- u'3/8' : u'\u215C',
-- u'5/8' : u'\u215D',
-- u'7/8' : u'\u215E',
toHtml (Styled Underline x) = tag "u" $ toHtml x
toHtml (Styled TT x) = tag "tt" $ toHtml x
toHtml (Styled Italic x) = tag "i" $ toHtml x
toHtml (Styled Strikethrough x) = tag "strike" $ toHtml x
toHtml (Styled Superscript x) = tag "sup" $ toHtml x
toHtml (Styled Subscript x) = tag "sub" $ toHtml x
toHtml (Styled Bold x) = tag "b" $ toHtml x
toHtml (Styled Highlight x) = ""++(toHtml x)++" "
toHtml (Keyword x) = tag "tt" $ toHtml x
toHtml (SubPar x) = stag "p" $ concatMap toHtml x
toHtml (Command "red" y) = ""++(toHtml y)++" "
toHtml (Command "orange" y) = ""++(toHtml y)++" "
toHtml (Command "green" y) = ""++(toHtml y)++" "
toHtml (Command "sc" y) = ""++(toHtml y)++" "
toHtml (Command "image" y) = " "
toHtml (Command "imagec" y) = " "
toHtml (Command "image2" y) = " "
toHtml (Command "image3" y) = " "
toHtml (Command "image4" y) = " "
toHtml (Command "warn" y) = "\n\n
\n"
++" \n"
++"\n"
++(toHtml y)
++"
\n"
toHtml (Command "announce" y) = "\n\n
\n"
++" \n"
++"\n"
++(toHtml y)
++"
\n"
toHtml (Command "br" _) = "\n \n"
toHtml (Command "cent" _) = "½"
toHtml (Command "euro" _) = "€"
-- gross hack
toHtml (Command "ordinal" x) | (last (toHtml x) == '1') = (toHtml x)++""++"st"++" "
| (last (toHtml x) == '2') = (toHtml x)++""++"nd"++" "
| (last (toHtml x) == '3') = (toHtml x)++""++"rd"++" "
| otherwise = (toHtml x)++""++"th"++" "
-- FIXME: use "unicode vulgar fractions" here
toHtml (Command "fraction" [n,d]) = ""++(toHtml n)++" "++"/"++""++(toHtml d)++" "
toHtml (Command "rfc" x) = "RFC"++(toHtml x)++" "
-- FIXME: add div as well (for display-mode math)
toHtml (Math m) = "" ++ (toHtml m) ++ " "
toHtml (Footnote x) = error $ "footnotes not supported"
toHtml (GlyphText Euro) = "€"
toHtml (GlyphText CircleR) = "¢"
toHtml (GlyphText CircleC) = "®"
toHtml (GlyphText TradeMark) = "™"
toHtml (GlyphText ServiceMark) = "™"
toHtml (GlyphText Emdash) = "—"
toHtml (GlyphText Ellipsis) = "
" -- &cdots;?
toHtml (GlyphText Cent) = "½"
toHtml (GlyphText Daggar) = "†"
toHtml (GlyphText DoubleDaggar) = "‡"
toHtml (GlyphText Clover) = "⌘"
toHtml (GlyphText Flat) = "⋖"
toHtml (GlyphText Natural) = "⋗"
toHtml (GlyphText Sharp) = "⋘"
toHtml (GlyphText CheckMark) = "✓"
toHtml (GlyphText XMark) = "✗"
toHtml (GlyphText LeftArrow) = "←"
toHtml (GlyphText RightArrow) = "→"
toHtml (GlyphText DoubleLeftArrow) = "" -- FIXME
toHtml (GlyphText DoubleRightArrow) = "" -- FIXME
toHtml (GlyphText DoubleLeftRightArrow) = "" -- FIXME
toHtml (GlyphText LeftRightArrow) = "" -- FIXME
toHtml (GlyphText Degree) = "" -- FIXME
toHtml (Command ('k':'e':'y':'s':'t':'r':'o':'k':'e':':':k) _) =
""++(case k of
"command" -> "2318"
"shift" -> "21E7"
"option" -> "2325"
"control" -> "2303"
"capslock" -> "21EA"
"apple" -> "F8FF"
)++";"
toHtml (Command x y) = error $ "unsupported command "++(show x)
instance ToHtml String where
toHtml s = concatMap htmlEscapeChar s
htmlEscapeChar '<' = "<"
htmlEscapeChar '>' = ">"
htmlEscapeChar '&' = "&"
htmlEscapeChar '\'' = "'"
htmlEscapeChar '\"' = """
htmlEscapeChar c = [c]
pre x = "\n"++ (pre' x) ++ "\n
\n"
where
pre' (' ':b) = " "++(pre' b)
pre' ('\n':b) = " \n"++(pre' b)
pre' (a:b) = (htmlEscapeChar a)++(pre' b)
pre' [] = []
\end{code}