@@ -1,3 +1,4 @@
1+{-# LANGUAGE OverloadedStrings #-}
12{-# OPTIONS_GHC -fno-warn-deprecations #-}
23{-
34Copyright (C) 2006-2010 John MacFarlane <jgm@berkeley.edu>
@@ -35,43 +36,44 @@ import Text.Pandoc.Shared
3536import Text.Pandoc.Templates
3637import Text.Pandoc.Readers.TeXMath
3738import Text.Pandoc.Highlighting ( highlightHtml, defaultHighlightingCss )
38−import Text.Pandoc.XML (stripTags, escapeStringForXML)
39+import Text.Pandoc.XML (stripTags)
3940import Network.HTTP ( urlEncode )
4041import Numeric ( showHex )
4142import Data.Char ( ord, toLower )
4243import Data.List ( isPrefixOf, intersperse )
44+import Data.String ( fromString )
4345import Data.Maybe ( catMaybes )
4446import Control.Monad.State
45−import Text.XHtml.Transitional hiding ( stringToHtml, unordList, ordList )
46−import qualified Text.XHtml.Transitional as XHtml
47+import Text.Blaze
48+import qualified Text.Blaze.Html5 as H
49+import qualified Text.Blaze.Html5.Attributes as A
50+import qualified Text.Blaze.Html4.Transitional.Attributes as A4
51+import Text.Blaze.Renderer.String (renderHtml)
4752import Text.TeXMath
4853import Text.XML.Light.Output
4954import System.FilePath (takeExtension)
55+import Data.Monoid (mempty, mconcat)
5056
5157data WriterState = WriterState
5258 { stNotes :: [Html] -- ^ List of notes
5359 , stMath :: Bool -- ^ Math is used in document
5460 , stHighlighting :: Bool -- ^ Syntax highlighting is used
5561 , stSecNum :: [Int] -- ^ Number of current section
56− } deriving Show
62+ }
5763
5864defaultWriterState :: WriterState
5965defaultWriterState = WriterState {stNotes= [], stMath = False, stHighlighting = False, stSecNum = []}
6066
6167-- Helpers to render HTML with the appropriate function.
6268
63−-- | Modified version of Text.XHtml's stringToHtml.
64−-- Use unicode characters wherever possible.
65−stringToHtml :: WriterOptions -> String -> Html
66−stringToHtml opts = if writerAscii opts
67− then XHtml.stringToHtml
68− else primHtml . escapeStringForXML
69+strToHtml :: String -> Html
70+strToHtml = toHtml
6971
7072-- | Hard linebreak.
7173nl :: WriterOptions -> Html
7274nl opts = if writerWrapText opts
73− then primHtml "\n"
74− else noHtml
75+ then preEscapedString "\n"
76+ else mempty
7577
7678-- | Convert Pandoc document to Html string.
7779writeHtmlString :: WriterOptions -> Pandoc -> String
@@ -80,7 +82,7 @@ writeHtmlString opts d =
8082 defaultWriterState
8183 in if writerStandalone opts
8284 then inTemplate opts tit auths date toc body' newvars
83− else dropWhile (=='\n') $ showHtmlFragment body'
85+ else renderHtml body'
8486
8587-- | Convert Pandoc document to Html structure.
8688writeHtml :: WriterOptions -> Pandoc -> Html
@@ -99,13 +101,13 @@ pandocToHtml opts (Pandoc (Meta title' authors' date') blocks) = do
99101 let standalone = writerStandalone opts
100102 tit <- if standalone
101103 then inlineListToHtml opts title'
102− else return noHtml
104+ else return mempty
103105 auths <- if standalone
104106 then mapM (inlineListToHtml opts) authors'
105107 else return []
106108 date <- if standalone
107109 then inlineListToHtml opts date'
108− else return noHtml
110+ else return mempty
109111 let splitHrule (HorizontalRule : Header 1 xs : ys)
110112 = Header 1 xs : splitHrule ys
111113 splitHrule (HorizontalRule : xs) = Header 1 [] : splitHrule xs
@@ -120,34 +122,39 @@ pandocToHtml opts (Pandoc (Meta title' authors' date') blocks) = do
120122 toc <- if writerTableOfContents opts
121123 then tableOfContents opts sects
122124 else return Nothing
123− blocks' <- liftM (toHtmlFromList . intersperse (nl opts)) $
125+ blocks' <- liftM (mconcat . intersperse (nl opts)) $
124126 mapM (elementToHtml opts) sects
125127 st <- get
126128 let notes = reverse (stNotes st)
127− let thebody = blocks' +++ footnoteSection opts notes
129+ let thebody = blocks' >> footnoteSection opts notes
128130 let math = if stMath st
129131 then case writerHTMLMathMethod opts of
130132 LaTeXMathML (Just url) ->
131− script !
132− [src url, thetype "text/javascript"] $ noHtml
133+ H.script ! A.src (toValue url)
134+ ! A.type_ "text/javascript"
135+ $ mempty
133136 MathML (Just url) ->
134− script !
135− [src url, thetype "text/javascript"] $ noHtml
137+ H.script ! A.src (toValue url)
138+ ! A.type_ "text/javascript"
139+ $ mempty
136140 MathJax url ->
137− script ! [src url, thetype "text/javascript"] $ noHtml
141+ H.script ! A.src (toValue url)
142+ ! A.type_ "text/javascript"
143+ $ mempty
138144 JsMath (Just url) ->
139− script !
140− [src url, thetype "text/javascript"] $ noHtml
145+ H.script ! A.src (toValue url)
146+ ! A.type_ "text/javascript"
147+ $ mempty
141148 _ -> case lookup "mathml-script" (writerVariables opts) of
142149 Just s ->
143− script ! [thetype "text/javascript"] <<
144− primHtml ("/*<![CDATA[*/\n" ++ s ++
145− "/*]]>*/\n")
146− Nothing -> noHtml
147− else noHtml
150+ H.script ! A.type_ "text/javascript"
151+ $ preEscapedString
152+ ("/*<![CDATA[*/\n" ++ s ++ "/*]]>*/\n")
153+ Nothing -> mempty
154+ else mempty
148155 let newvars = [("highlighting-css", defaultHighlightingCss) |
149156 stHighlighting st] ++
150− [("math", showHtmlFragment math) | stMath st]
157+ [("math", renderHtml math) | stMath st]
151158 return (tit, auths, date, toc, thebody, newvars)
152159
153160inTemplate :: TemplateTarget a
@@ -160,12 +167,12 @@ inTemplate :: TemplateTarget a
160167 -> [(String,String)]
161168 -> a
162169inTemplate opts tit auths date toc body' newvars =
163− let title' = dropWhile (=='\n') $ showHtmlFragment tit
164− authors = map showHtmlFragment auths
165− date' = showHtmlFragment date
170+ let title' = renderHtml tit
171+ authors = map renderHtml auths
172+ date' = renderHtml date
166173 variables = writerVariables opts ++ newvars
167174 context = variables ++
168− [ ("body", dropWhile (=='\n') $ showHtmlFragment body')
175+ [ ("body", dropWhile (=='\n') $ renderHtml body')
169176 , ("pagetitle", stripTags title')
170177 , ("title", title')
171178 , ("date", date')
@@ -175,23 +182,23 @@ inTemplate opts tit auths date toc body' newvars =
175182 , ("s5-url", "s5/default") ] ++
176183 [ ("html5","true") | writerHtml5 opts ] ++
177184 (case toc of
178− Just t -> [ ("toc", showHtmlFragment t)]
185+ Just t -> [ ("toc", renderHtml t)]
179186 Nothing -> []) ++
180187 [ ("author", a) | a <- authors ] ++
181188 [ ("author-meta", stripTags a) | a <- authors ]
182189 in renderTemplate context $ writerTemplate opts
183190
184191-- | Like Text.XHtml's identifier, but adds the writerIdentifierPrefix
185−prefixedId :: WriterOptions -> String -> HtmlAttr
186−prefixedId opts s = identifier $ writerIdentifierPrefix opts ++ s
192+prefixedId :: WriterOptions -> String -> Attribute
193+prefixedId opts s = A.id $ toValue $ writerIdentifierPrefix opts ++ s
187194
188195-- | Replacement for Text.XHtml's unordList.
189196unordList :: WriterOptions -> ([Html] -> Html)
190−unordList opts items = ulist << toListItems opts items
197+unordList opts items = H.ul $ mconcat $ toListItems opts items
191198
192199-- | Replacement for Text.XHtml's ordList.
193200ordList :: WriterOptions -> ([Html] -> Html)
194−ordList opts items = olist << toListItems opts items
201+ordList opts items = H.ol $ mconcat $ toListItems opts items
195202
196203-- | Construct table of contents from list of elements.
197204tableOfContents :: WriterOptions -> [Element] -> State WriterState (Maybe Html)
@@ -214,15 +221,16 @@ elementToListItem :: WriterOptions -> Element -> State WriterState (Maybe Html)
214221elementToListItem _ (Blk _) = return Nothing
215222elementToListItem opts (Sec _ num id' headerText subsecs) = do
216223 let sectnum = if writerNumberSections opts
217− then (thespan ! [theclass "toc-section-number"] << showSecNum num) +++
218− stringToHtml opts" "
219− else noHtml
220− txt <- liftM (sectnum +++) $ inlineListToHtml opts headerText
224+ then (H.span ! A.class_ "toc-section-number" $ toHtml $ showSecNum num) >>
225+ preEscapedString " "
226+ else mempty
227+ txt <- liftM (sectnum >>) $ inlineListToHtml opts headerText
221228 subHeads <- mapM (elementToListItem opts) subsecs >>= return . catMaybes
222229 let subList = if null subHeads
223− then noHtml
230+ then mempty
224231 else unordList opts subHeads
225− return $ Just $ (anchor ! [href ("#" ++ writerIdentifierPrefix opts ++ id')] $ txt) +++ subList
232+ return $ Just $ (H.a ! A.href (toValue $ "#" ++ writerIdentifierPrefix opts ++ id')
233+ $ toHtml txt) >> subList
226234
227235-- | Convert an Element to Html.
228236elementToHtml :: WriterOptions -> Element -> State WriterState Html
@@ -231,37 +239,38 @@ elementToHtml opts (Sec level num id' title' elements) = do
231239 modify $ \st -> st{stSecNum = num} -- update section number
232240 header' <- blockToHtml opts (Header level title')
233241 innerContents <- mapM (elementToHtml opts) elements
234− let header'' = header' ! [prefixedId opts id' |
235− not (writerStrictMarkdown opts ||
236− writerSectionDivs opts ||
237− writerSlideVariant opts == S5Slides)]
242+ let header'' = if (writerStrictMarkdown opts ||
243+ writerSectionDivs opts ||
244+ writerSlideVariant opts == S5Slides)
245+ then header'
246+ else header' ! prefixedId opts id'
238247 let stuff = header'' : innerContents
239248 let slide = writerSlideVariant opts /= NoSlides && level == 1
240249 let titleSlide = slide && null elements
241250 let attrs = [prefixedId opts id' | writerSectionDivs opts] ++
242− [theclass "titleslide" | titleSlide] ++
243− [theclass "slide" | slide]
244− let inNl x = nl opts : intersperse (nl opts) x ++ [nl opts]
251+ [A.class_ "titleslide" | titleSlide] ++
252+ [A.class_ "slide" | slide]
253+ let inNl x = mconcat $ nl opts : intersperse (nl opts) x ++ [nl opts]
245254 return $ if writerSectionDivs opts || slide
246255 then if writerHtml5 opts
247− then tag "section" ! attrs << inNl stuff
248− else thediv ! attrs << inNl stuff
249− else toHtmlFromList $ intersperse (nl opts) stuff
256+ then foldl (!) (H.section $ inNl stuff) attrs
257+ else foldl (!) (H.div $ inNl stuff) attrs
258+ else mconcat $ intersperse (nl opts) stuff
250259
251260-- | Convert list of Note blocks to a footnote <div>.
252261-- Assumes notes are sorted.
253262footnoteSection :: WriterOptions -> [Html] -> Html
254263footnoteSection opts notes =
255264 if null notes
256− then noHtml
257− else nl opts +++ (container
258− $ nl opts +++ hr +++ nl opts +++
259− (olist << (notes ++ [nl opts])) +++ nl opts)
260− where container = if writerHtml5 opts
261− then tag "section" ! [theclass "footnotes"]
262− else if writerSlideVariant opts /= NoSlides
263− then thediv ! [theclass "footnotes slide"]
264− else thediv ! [theclass "footnotes"]
265+ then mempty
266+ else nl opts >> (container
267+ $ nl opts >> H.hr >> nl opts >>
268+ H.ol (mconcat notes >> nl opts))
269+ where container x = if writerHtml5 opts
270+ then H.section ! A.class_ "footnotes" $ x
271+ else if writerSlideVariant opts /= NoSlides
272+ then H.div ! A.class_ "footnotes slide" $ x
273+ else H.div ! A.class_ "footnotes" $ x
265274
266275-- | Parse a mailto link; return Just (name, domain) or Nothing.
267276parseMailto :: String -> Maybe (String, String)
@@ -274,7 +283,7 @@ parseMailto _ = Nothing
274283-- | Obfuscate a "mailto:" link.
275284obfuscateLink :: WriterOptions -> String -> String -> Html
276285obfuscateLink opts txt s | writerEmailObfuscation opts == NoObfuscation =
277− anchor ! [href s] << txt
286+ H.a ! A.href (toValue s) $ toHtml txt
278287obfuscateLink opts txt s =
279288 let meth = writerEmailObfuscation opts
280289 s' = map toLower s
@@ -289,19 +298,19 @@ obfuscateLink opts txt s =
289298 domain' ++ ")")
290299 in case meth of
291300 ReferenceObfuscation ->
292− -- need to use primHtml or &'s are escaped to & in URL
293− primHtml $ "<a href=\"" ++ (obfuscateString s')
301+ -- need to use preEscapedString or &'s are escaped to & in URL
302+ preEscapedString $ "<a href=\"" ++ (obfuscateString s')
294303 ++ "\">" ++ (obfuscateString txt) ++ "</a>"
295304 JavascriptObfuscation ->
296− (script ! [thetype "text/javascript"] $
297− primHtml ("\n<!--\nh='" ++
305+ (H.script ! A.type_ "text/javascript" $
306+ preEscapedString ("\n<!--\nh='" ++
298307 obfuscateString domain ++ "';a='" ++ at' ++ "';n='" ++
299308 obfuscateString name' ++ "';e=n+a+h;\n" ++
300309 "document.write('<a h'+'ref'+'=\"ma'+'ilto'+':'+e+'\">'+" ++
301− linkText ++ "+'<\\/'+'a'+'>');\n// -->\n")) +++
302− noscript (primHtml $ obfuscateString altText)
310+ linkText ++ "+'<\\/'+'a'+'>');\n// -->\n")) >>
311+ H.noscript (preEscapedString $ obfuscateString altText)
303312 _ -> error $ "Unknown obfuscation method: " ++ show meth
304− _ -> anchor ! [href s] $ stringToHtml opts txt -- malformed email
313+ _ -> H.a ! A.href (toValue s) $ toHtml txt -- malformed email
305314
306315-- | Obfuscate character as entity.
307316obfuscateChar :: Char -> String
@@ -314,11 +323,11 @@ obfuscateChar char =
314323obfuscateString :: String -> String
315324obfuscateString = concatMap obfuscateChar . decodeCharacterReferences
316325
317−attrsToHtml :: WriterOptions -> Attr -> [HtmlAttr]
326+attrsToHtml :: WriterOptions -> Attr -> [Attribute]
318327attrsToHtml opts (id',classes',keyvals) =
319− [theclass (unwords classes') | not (null classes')] ++
328+ [A.class_ (toValue $ unwords classes') | not (null classes')] ++
320329 [prefixedId opts id' | not (null id')] ++
321− map (\(x,y) -> strAttr x y) keyvals
330+ map (\(x,y) -> customAttribute (fromString x) (toValue y)) keyvals
322331
323332imageExts :: [String]
324333imageExts = [ "art", "bmp", "cdr", "cdt", "cpt", "cr2", "crw", "djvu", "erf",
@@ -333,38 +342,34 @@ treatAsImage fp =
333342
334343-- | Convert Pandoc block element to HTML.
335344blockToHtml :: WriterOptions -> Block -> State WriterState Html
336−blockToHtml _ Null = return noHtml
345+blockToHtml _ Null = return mempty
337346blockToHtml opts (Plain lst) = inlineListToHtml opts lst
338347blockToHtml opts (Para [Image txt (s,tit)]) = do
339348 img <- inlineToHtml opts (Image txt (s,tit))
340349 capt <- inlineListToHtml opts txt
341350 return $ if writerHtml5 opts
342− then tag "figure" <<
343− [nl opts, img, tag "figcaption" << capt, nl opts]
344− else thediv ! [theclass "figure"] <<
345− [nl opts, img, paragraph ! [theclass "caption"] << capt,
351+ then H.figure $ mconcat
352+ [nl opts, img, H.figcaption capt, nl opts]
353+ else H.div ! A.class_ "figure" $ mconcat
354+ [nl opts, img, H.p ! A.class_ "caption" $ capt,
346355 nl opts]
347356blockToHtml opts (Para lst) = do
348357 contents <- inlineListToHtml opts lst
349− return $ paragraph contents
350−blockToHtml _ (RawBlock "html" str) = return $ primHtml str
351−blockToHtml _ (RawBlock _ _) = return noHtml
352−blockToHtml _ (HorizontalRule) = return hr
358+ return $ H.p contents
359+blockToHtml _ (RawBlock "html" str) = return $ preEscapedString str
360+blockToHtml _ (RawBlock _ _) = return mempty
361+blockToHtml _ (HorizontalRule) = return H.hr
353362blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do
354363 let classes' = if writerLiterateHaskell opts
355364 then classes
356365 else filter (/= "literate") classes
357366 case highlightHtml False (id',classes',keyvals) rawCode of
358− Left _ -> -- change leading newlines into <br /> tags, because some
359− -- browsers ignore leading newlines in pre blocks
360− let (leadingBreaks, rawCode') = span (=='\n') rawCode
361− attrs = attrsToHtml opts (id', classes', keyvals)
367+ Left _ -> let attrs = attrsToHtml opts (id', classes', keyvals)
362368 addBird = if "literate" `elem` classes'
363369 then unlines . map ("> " ++) . lines
364370 else unlines . lines
365− in return $ pre ! attrs $ thecode <<
366− (replicate (length leadingBreaks) br +++
367− [stringToHtml opts $ addBird rawCode'])
371+ in return $ foldl (!) H.pre attrs $ H.code
372+ $ toHtml $ addBird rawCode
368373 Right h -> modify (\st -> st{ stHighlighting = True }) >>
369374 return h
370375blockToHtml opts (BlockQuote blocks) =
@@ -380,47 +385,48 @@ blockToHtml opts (BlockQuote blocks) =
380385 blockToHtml (opts {writerIncremental = inc})
381386 (OrderedList attribs lst)
382387 _ -> do contents <- blockListToHtml opts blocks
383− return $ blockquote (nl opts +++
384− contents +++ nl opts)
388+ return $ H.blockquote
389+ $ nl opts >> contents >> nl opts
385390 else do
386391 contents <- blockListToHtml opts blocks
387− return $ blockquote (nl opts +++ contents +++ nl opts)
392+ return $ H.blockquote $ nl opts >> contents >> nl opts
388393blockToHtml opts (Header level lst) = do
389394 contents <- inlineListToHtml opts lst
390395 secnum <- liftM stSecNum get
391396 let contents' = if writerNumberSections opts
392− then (thespan ! [theclass "header-section-number"] << showSecNum secnum) +++
393− stringToHtml opts " " +++ contents
397+ then (H.span ! A.class_ "header-section-number" $ toHtml $ showSecNum secnum) >>
398+ strToHtml " " >> contents
394399 else contents
395400 let contents'' = if writerTableOfContents opts
396− then anchor ! [href $ "#" ++ writerIdentifierPrefix opts ++ "TOC"] $ contents'
401+ then H.a ! A.href (toValue $ "#" ++ writerIdentifierPrefix opts ++ "TOC") $ contents'
397402 else contents'
398403 return $ (case level of
399− 1 -> h1 contents''
400− 2 -> h2 contents''
401− 3 -> h3 contents''
402− 4 -> h4 contents''
403− 5 -> h5 contents''
404− 6 -> h6 contents''
405− _ -> paragraph contents'')
404+ 1 -> H.h1 contents''
405+ 2 -> H.h2 contents''
406+ 3 -> H.h3 contents''
407+ 4 -> H.h4 contents''
408+ 5 -> H.h5 contents''
409+ 6 -> H.h6 contents''
410+ _ -> H.p contents'')
406411blockToHtml opts (BulletList lst) = do
407412 contents <- mapM (blockListToHtml opts) lst
408− let attribs = if writerIncremental opts
409− then [theclass "incremental"]
410− else []
411− return $ (unordList opts contents) ! attribs
413+ let lst' = unordList opts contents
414+ let lst'' = if writerIncremental opts
415+ then lst' ! A.class_ "incremental"
416+ else lst'
417+ return lst''
412418blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do
413419 contents <- mapM (blockListToHtml opts) lst
414420 let numstyle' = camelCaseToHyphenated $ show numstyle
415421 let attribs = (if writerIncremental opts
416− then [theclass "incremental"]
422+ then [A.class_ "incremental"]
417423 else []) ++
418424 (if startnum /= 1
419− then [start startnum]
425+ then [A.start $ toValue startnum]
420426 else []) ++
421427 (if numstyle /= DefaultStyle
422428 then if writerHtml5 opts
423− then [strAttr "type" $
429+ then [A.type_ $
424430 case numstyle of
425431 Decimal -> "1"
426432 LowerAlpha -> "a"
@@ -428,44 +434,44 @@ blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do
428434 LowerRoman -> "i"
429435 UpperRoman -> "I"
430436 _ -> "1"]
431− else [thestyle $ "list-style-type: " ++
437+ else [A.style $ toValue $ "list-style-type: " ++
432438 numstyle']
433439 else [])
434− return $ (ordList opts contents) ! attribs
440+ return $ foldl (!) (ordList opts contents) attribs
435441blockToHtml opts (DefinitionList lst) = do
436442 contents <- mapM (\(term, defs) ->
437− do term' <- liftM (dterm <<) $ inlineListToHtml opts term
438− defs' <- mapM ((liftM (\x -> ddef << (x +++ nl opts))) .
443+ do term' <- liftM (H.dt) $ inlineListToHtml opts term
444+ defs' <- mapM ((liftM (\x -> H.dd $ (x >> nl opts))) .
439445 blockListToHtml opts) defs
440− return $ nl opts : term' : nl opts : defs') lst
441− let attribs = if writerIncremental opts
442− then [theclass "incremental"]
443− else []
444− return $ dlist ! attribs << (concat contents +++ nl opts)
446+ return $ mconcat $ nl opts : term' : nl opts : defs') lst
447+ let lst' = H.dl $ mconcat contents >> nl opts
448+ let lst'' = if writerIncremental opts
449+ then lst' ! A.class_ "incremental"
450+ else lst'
451+ return lst''
445452blockToHtml opts (Table capt aligns widths headers rows') = do
446453 captionDoc <- if null capt
447− then return noHtml
454+ then return mempty
448455 else do
449456 cs <- inlineListToHtml opts capt
450− return $ caption cs +++ nl opts
457+ return $ H.caption cs >> nl opts
451458 let percent w = show (truncate (100*w) :: Integer) ++ "%"
452− let widthAttrs w = if writerHtml5 opts
453− then [thestyle $ "width: " ++ percent w]
454− else [width $ percent w]
455459 let coltags = if all (== 0.0) widths
456− then noHtml
457− else concatHtml $ map
458− (\w -> (col ! (widthAttrs w)) noHtml +++ nl opts)
459− widths
460+ then mempty
461+ else mconcat $ map (\w ->
462+ if writerHtml5 opts
463+ then H.col ! A.style (toValue $ "width: " ++ percent w)
464+ else H.col ! A.width (toValue $ percent w) >> nl opts)
465+ widths
460466 head' <- if all null headers
461− then return noHtml
467+ then return mempty
462468 else do
463469 contents <- tableRowToHtml opts aligns 0 headers
464− return $ thead << (nl opts +++ contents) +++ nl opts
465− body' <- liftM (\x -> tbody << (nl opts +++ x)) $
470+ return $ H.thead (nl opts >> contents) >> nl opts
471+ body' <- liftM (\x -> H.tbody (nl opts >> mconcat x)) $
466472 zipWithM (tableRowToHtml opts aligns) [1..] rows'
467− return $ table $ nl opts +++ captionDoc +++ coltags +++ head' +++
468− body' +++ nl opts
473+ return $ H.table $ nl opts >> captionDoc >> coltags >> head' >>
474+ body' >> nl opts
469475
470476tableRowToHtml :: WriterOptions
471477 -> [Alignment]
@@ -473,7 +479,7 @@ tableRowToHtml :: WriterOptions
473479 -> [[Block]]
474480 -> State WriterState Html
475481tableRowToHtml opts aligns rownum cols' = do
476− let mkcell = if rownum == 0 then th else td
482+ let mkcell = if rownum == 0 then H.th else H.td
477483 let rowclass = case rownum of
478484 0 -> "header"
479485 x | x `rem` 2 == 1 -> "odd"
@@ -481,8 +487,8 @@ tableRowToHtml opts aligns rownum cols' = do
481487 cols'' <- sequence $ zipWith
482488 (\alignment item -> tableItemToHtml opts mkcell alignment item)
483489 aligns cols'
484− return $ (tr ! [theclass rowclass] $ nl opts +++ toHtmlFromList cols'')
485− +++ nl opts
490+ return $ (H.tr ! A.class_ rowclass $ nl opts >> mconcat cols'')
491+ >> nl opts
486492
487493alignmentToString :: Alignment -> [Char]
488494alignmentToString alignment = case alignment of
@@ -498,85 +504,87 @@ tableItemToHtml :: WriterOptions
498504 -> State WriterState Html
499505tableItemToHtml opts tag' align' item = do
500506 contents <- blockListToHtml opts item
501− let alignAttrs = if writerHtml5 opts
502− then [thestyle $ "align: " ++ alignmentToString align']
503− else [align $ alignmentToString align']
504− return $ (tag' ! alignAttrs) contents +++ nl opts
507+ let alignStr = alignmentToString align'
508+ let attribs = if writerHtml5 opts
509+ then A.style (toValue $ "text-align: " ++ alignStr ++ ";")
510+ else A4.align (toValue alignStr)
511+ return $ tag' ! attribs $ contents >> nl opts
505512
506513toListItems :: WriterOptions -> [Html] -> [Html]
507514toListItems opts items = map (toListItem opts) items ++ [nl opts]
508515
509516toListItem :: WriterOptions -> Html -> Html
510−toListItem opts item = nl opts +++ li item
517+toListItem opts item = nl opts >> H.li item
511518
512519blockListToHtml :: WriterOptions -> [Block] -> State WriterState Html
513520blockListToHtml opts lst =
514521 mapM (blockToHtml opts) lst >>=
515− return . toHtmlFromList . intersperse (nl opts)
522+ return . mconcat . intersperse (nl opts)
516523
517524-- | Convert list of Pandoc inline elements to HTML.
518525inlineListToHtml :: WriterOptions -> [Inline] -> State WriterState Html
519526inlineListToHtml opts lst =
520− mapM (inlineToHtml opts) lst >>= return . toHtmlFromList
527+ mapM (inlineToHtml opts) lst >>= return . mconcat
521528
522529-- | Convert Pandoc inline element to HTML.
523530inlineToHtml :: WriterOptions -> Inline -> State WriterState Html
524531inlineToHtml opts inline =
525532 case inline of
526− (Str str) -> return $ stringToHtml opts str
527− (Space) -> return $ stringToHtml opts " "
528− (LineBreak) -> return br
529− (EmDash) -> return $ stringToHtml opts "—"
530− (EnDash) -> return $ stringToHtml opts "–"
531− (Ellipses) -> return $ stringToHtml opts "…"
532− (Apostrophe) -> return $ stringToHtml opts "’"
533− (Emph lst) -> inlineListToHtml opts lst >>= return . emphasize
534− (Strong lst) -> inlineListToHtml opts lst >>= return . strong
533+ (Str str) -> return $ strToHtml str
534+ (Space) -> return $ strToHtml " "
535+ (LineBreak) -> return H.br
536+ (EmDash) -> return $ strToHtml "—"
537+ (EnDash) -> return $ strToHtml "–"
538+ (Ellipses) -> return $ strToHtml "…"
539+ (Apostrophe) -> return $ strToHtml "’"
540+ (Emph lst) -> inlineListToHtml opts lst >>= return . H.em
541+ (Strong lst) -> inlineListToHtml opts lst >>= return . H.strong
535542 (Code attr str) -> case highlightHtml True attr str of
536543 Left _ -> return
537− $ thecode ! (attrsToHtml opts attr)
538− $ stringToHtml opts str
544+ $ foldl (!) H.code (attrsToHtml opts attr)
545+ $ strToHtml str
539546 Right h -> return h
540547 (Strikeout lst) -> inlineListToHtml opts lst >>=
541− return . (thespan ! [thestyle "text-decoration: line-through;"])
548+ return . (H.span ! A.style "text-decoration: line-through;")
542549 (SmallCaps lst) -> inlineListToHtml opts lst >>=
543− return . (thespan ! [thestyle "font-variant: small-caps;"])
544− (Superscript lst) -> inlineListToHtml opts lst >>= return . sup
545− (Subscript lst) -> inlineListToHtml opts lst >>= return . sub
550+ return . (H.span ! A.style "font-variant: small-caps;")
551+ (Superscript lst) -> inlineListToHtml opts lst >>= return . H.sup
552+ (Subscript lst) -> inlineListToHtml opts lst >>= return . H.sub
546553 (Quoted quoteType lst) ->
547554 let (leftQuote, rightQuote) = case quoteType of
548− SingleQuote -> (stringToHtml opts "‘",
549− stringToHtml opts "’")
550− DoubleQuote -> (stringToHtml opts "“",
551− stringToHtml opts "”")
555+ SingleQuote -> (strToHtml "‘",
556+ strToHtml "’")
557+ DoubleQuote -> (strToHtml "“",
558+ strToHtml "”")
552559 in do contents <- inlineListToHtml opts lst
553− return $ leftQuote +++ contents +++ rightQuote
560+ return $ leftQuote >> contents >> rightQuote
554561 (Math t str) -> modify (\st -> st {stMath = True}) >>
555562 (case writerHTMLMathMethod opts of
556563 LaTeXMathML _ ->
557564 -- putting LaTeXMathML in container with class "LaTeX" prevents
558565 -- non-math elements on the page from being treated as math by
559566 -- the javascript
560− return $ thespan ! [theclass "LaTeX"] $
567+ return $ H.span ! A.class_ "LaTeX" $
561568 case t of
562− InlineMath -> primHtml ("$" ++ str ++ "$")
563− DisplayMath -> primHtml ("$$" ++ str ++ "$$")
569+ InlineMath -> toHtml ("$" ++ str ++ "$")
570+ DisplayMath -> toHtml ("$$" ++ str ++ "$$")
564571 JsMath _ -> do
565− let m = primHtml str
572+ let m = preEscapedString str
566573 return $ case t of
567− InlineMath -> thespan ! [theclass "math"] $ m
568− DisplayMath -> thediv ! [theclass "math"] $ m
574+ InlineMath -> H.span ! A.class_ "math" $ m
575+ DisplayMath -> H.div ! A.class_ "math" $ m
569576 WebTeX url -> do
570− let m = image ! [thestyle "vertical-align:middle",
571− src (url ++ urlEncode str),
572− alt str, title str]
577+ let m = H.img ! A.style "vertical-align:middle"
578+ ! A.src (toValue $ url ++ urlEncode str)
579+ ! A.alt (toValue str)
580+ ! A.title (toValue str)
573581 return $ case t of
574582 InlineMath -> m
575− DisplayMath -> br +++ m +++ br
583+ DisplayMath -> H.br >> m >> H.br
576584 GladTeX ->
577585 return $ case t of
578− InlineMath -> primHtml $ "<EQ ENV=\"math\">" ++ str ++ "</EQ>"
579− DisplayMath -> primHtml $ "<EQ ENV=\"displaymath\">" ++ str ++ "</EQ>"
586+ InlineMath -> preEscapedString "<EQ ENV=\"math\">" >> toHtml str >> preEscapedString "</EQ>"
587+ DisplayMath -> preEscapedString "<EQ ENV=\"displaymath\">" >> toHtml str >> preEscapedString "</EQ>"
580588 MathML _ -> do
581589 let dt = if t == InlineMath
582590 then DisplayInline
@@ -584,54 +592,55 @@ inlineToHtml opts inline =
584592 let conf = useShortEmptyTags (const False)
585593 defaultConfigPP
586594 case texMathToMathML dt str of
587− Right r -> return $ primHtml $
595+ Right r -> return $ preEscapedString $
588596 ppcElement conf r
589597 Left _ -> inlineListToHtml opts
590598 (readTeXMath str) >>= return .
591− (thespan ! [theclass "math"])
592− MathJax _ -> return $ primHtml $
599+ (H.span ! A.class_ "math")
600+ MathJax _ -> return $ toHtml $
593601 case t of
594602 InlineMath -> "\\(" ++ str ++ "\\)"
595603 DisplayMath -> "\\[" ++ str ++ "\\]"
596604 PlainMath -> do
597605 x <- inlineListToHtml opts (readTeXMath str)
598− let m = thespan ! [theclass "math"] $ x
606+ let m = H.span ! A.class_ "math" $ x
599607 return $ case t of
600608 InlineMath -> m
601− DisplayMath -> br +++ m +++ br )
609+ DisplayMath -> H.br >> m >> H.br )
602610 (RawInline "latex" str) -> case writerHTMLMathMethod opts of
603611 LaTeXMathML _ -> do modify (\st -> st {stMath = True})
604− return $ primHtml str
605− _ -> return noHtml
606− (RawInline "html" str) -> return $ primHtml str
607− (RawInline _ _) -> return noHtml
612+ return $ toHtml str
613+ _ -> return mempty
614+ (RawInline "html" str) -> return $ preEscapedString str
615+ (RawInline _ _) -> return mempty
608616 (Link [Code _ str] (s,_)) | "mailto:" `isPrefixOf` s ->
609617 return $ obfuscateLink opts str s
610618 (Link txt (s,_)) | "mailto:" `isPrefixOf` s -> do
611619 linkText <- inlineListToHtml opts txt
612− return $ obfuscateLink opts (show linkText) s
620+ return $ obfuscateLink opts (renderHtml linkText) s
613621 (Link txt (s,tit)) -> do
614622 linkText <- inlineListToHtml opts txt
615− return $ anchor ! ([href s] ++
616− if null tit then [] else [title tit]) $
617− linkText
623+ let link = H.a ! A.href (toValue s) $ linkText
624+ return $ if null tit
625+ then link
626+ else link ! A.title (toValue tit)
618627 (Image txt (s,tit)) | treatAsImage s -> do
619628 let alternate' = stringify txt
620− let attributes = [src s] ++
629+ let attributes = [A.src $ toValue s] ++
621630 (if null tit
622631 then []
623− else [title tit]) ++
632+ else [A.title $ toValue tit]) ++
624633 if null txt
625634 then []
626− else [alt alternate']
627− return $ image ! attributes
635+ else [A.alt $ toValue alternate']
636+ return $ foldl (!) H.img attributes
628637 -- note: null title included, as in Markdown.pl
629638 (Image _ (s,tit)) -> do
630− let attributes = [src s] ++
639+ let attributes = [A.src $ toValue s] ++
631640 (if null tit
632641 then []
633− else [title tit])
634− return $ itag "embed" ! attributes
642+ else [A.title $ toValue tit])
643+ return $ foldl (!) H.embed attributes
635644 -- note: null title included, as in Markdown.pl
636645 (Note contents) -> do
637646 st <- get
@@ -641,20 +650,20 @@ inlineToHtml opts inline =
641650 htmlContents <- blockListToNote opts ref contents
642651 -- push contents onto front of notes
643652 put $ st {stNotes = (htmlContents:notes)}
644− return $ sup <<
645− anchor ! [href ("#" ++ writerIdentifierPrefix opts ++ "fn" ++ ref),
646− theclass "footnoteRef",
647− prefixedId opts ("fnref" ++ ref)] << ref
653+ return $ H.sup $
654+ H.a ! A.href (toValue $ "#" ++ writerIdentifierPrefix opts ++ "fn" ++ ref)
655+ ! A.class_ "footnoteRef"
656+ ! prefixedId opts ("fnref" ++ ref)
657+ $ toHtml ref
648658 (Cite _ il) -> do contents <- inlineListToHtml opts il
649− return $ thespan ! [theclass "citation"] << contents
659+ return $ H.span ! A.class_ "citation" $ contents
650660
651661blockListToNote :: WriterOptions -> String -> [Block] -> State WriterState Html
652662blockListToNote opts ref blocks =
653663 -- If last block is Para or Plain, include the backlink at the end of
654664 -- that block. Otherwise, insert a new Plain block with the backlink.
655665 let backlink = [RawInline "html" $ " <a href=\"#" ++ writerIdentifierPrefix opts ++ "fnref" ++ ref ++
656− "\" class=\"footnoteBackLink\">" ++
657− (if writerAscii opts then "↩" else "↩") ++ "</a>"]
666+ "\" class=\"footnoteBackLink\">↩</a>"]
658667 blocks' = if null blocks
659668 then []
660669 else let lastBlock = last blocks
@@ -667,4 +676,4 @@ blockListToNote opts ref blocks =
667676 _ -> otherBlocks ++ [lastBlock,
668677 Plain backlink]
669678 in do contents <- blockListToHtml opts blocks'
670− return $ nl opts +++ (li ! [prefixedId opts ("fn" ++ ref)]) contents
679+ return $ nl opts >> (H.li ! (prefixedId opts ("fn" ++ ref)) $ contents)