git.iko.soy/typeable/pandoc
on master help sign in
Improved new HTML format; restored original --no-wrap behavior.
commit99cb6076f8f6ac1b2053f2425e2021bc14ac4796 authorJohn MacFarlane <jgm@berkeley.edu> dateFri 4 Feb 2011, 19:27 (16 years ago) parentf9dcea6
1 file changed+76−52
src/Text/Pandoc/Writers/HTML.hs+76−52
src/Text/Pandoc/Writers/HTML.hs+76−52
@@ -42,7 +42,7 @@ import Data.Char ( ord, toLower )
4242import Data.List ( isPrefixOf, intersperse )
4343import Data.Maybe ( catMaybes )
4444import Control.Monad.State
45−import Text.XHtml.Transitional hiding ( stringToHtml )
45+import Text.XHtml.Transitional hiding ( stringToHtml, unordList, ordList )
4646import Text.TeXMath
4747import Text.XML.Light.Output
4848
@@ -64,8 +64,10 @@ stringToHtml :: String -> Html
6464stringToHtml = primHtml . escapeStringForXML
6565
6666-- | Hard linebreak.
67−nl :: Html
68−nl = primHtml "\n"
67+nl :: WriterOptions -> Html
68+nl opts = if writerWrapText opts
69+ then primHtml "\n"
70+ else noHtml
6971
7072-- | Convert Pandoc document to Html string.
7173writeHtmlString :: WriterOptions -> Pandoc -> String
@@ -74,7 +76,7 @@ writeHtmlString opts d =
7476 defaultWriterState
7577 in if writerStandalone opts
7678 then inTemplate opts tit auths date toc body' newvars
77− else showHtmlFragment body'
79+ else dropWhile (=='\n') $ showHtmlFragment body'
7880
7981-- | Convert Pandoc document to Html structure.
8082writeHtml :: WriterOptions -> Pandoc -> Html
@@ -118,13 +120,13 @@ pandocToHtml opts (Pandoc (Meta title' authors' date') blocks) = do
118120 cutUp xs ++ [endSlide]
119121 _ -> [startSlide] ++ cutUp blocks ++
120122 [endSlide]
121− blocks' <- liftM toHtmlFromList $
123+ blocks' <- liftM (toHtmlFromList . intersperse (nl opts)) $
122124 if writerSlideVariant opts `elem` [SlidySlides, S5Slides]
123125 then mapM (blockToHtml opts) slides
124126 else mapM (elementToHtml opts) sects
125127 st <- get
126128 let notes = reverse (stNotes st)
127− let thebody = blocks' +++ footnoteSection notes
129+ let thebody = blocks' +++ footnoteSection opts notes
128130 let math = if stMath st
129131 then case writerHTMLMathMethod opts of
130132 LaTeXMathML (Just url) ->
@@ -146,7 +148,7 @@ pandocToHtml opts (Pandoc (Meta title' authors' date') blocks) = do
146148 else noHtml
147149 let newvars = [("highlighting-css", defaultHighlightingCss) |
148150 stHighlighting st] ++
149− [("math", renderHtmlFragment math) | stMath st]
151+ [("math", showHtmlFragment math) | stMath st]
150152 return (tit, auths, date, toc, thebody, newvars)
151153
152154inTemplate :: TemplateTarget a
@@ -165,13 +167,13 @@ inTemplate opts tit auths date toc body' newvars =
165167 date' = stripTags $ showHtmlFragment date
166168 variables = writerVariables opts ++ newvars
167169 context = variables ++
168− [ ("body", renderHtmlFragment body')
170+ [ ("body", dropWhile (=='\n') $ showHtmlFragment body')
169171 , ("pagetitle", topTitle')
170− , ("title", renderHtmlFragment tit)
172+ , ("title", dropWhile (=='\n') $ showHtmlFragment tit)
171173 , ("date", date') ] ++
172174 [ ("html5","true") | writerHtml5 opts ] ++
173175 (case toc of
174− Just t -> [ ("toc", renderHtmlFragment t)]
176+ Just t -> [ ("toc", showHtmlFragment t)]
175177 Nothing -> []) ++
176178 [ ("author", a) | a <- authors ]
177179 in renderTemplate context $ writerTemplate opts
@@ -180,6 +182,14 @@ inTemplate opts tit auths date toc body' newvars =
180182prefixedId :: WriterOptions -> String -> HtmlAttr
181183prefixedId opts s = identifier $ writerIdentifierPrefix opts ++ s
182184
185+-- | Replacement for Text.XHtml's unordList.
186+unordList :: WriterOptions -> ([Html] -> Html)
187+unordList opts items = ulist << toListItems opts items
188+
189+-- | Replacement for Text.XHtml's ordList.
190+ordList :: WriterOptions -> ([Html] -> Html)
191+ordList opts items = olist << toListItems opts items
192+
183193-- | Construct table of contents from list of elements.
184194tableOfContents :: WriterOptions -> [Element] -> State WriterState (Maybe Html)
185195tableOfContents _ [] = return Nothing
@@ -192,9 +202,9 @@ tableOfContents opts sects = do
192202 else Just $
193203 if writerHtml5 opts
194204 then tag "nav" ! [prefixedId opts' "TOC"] $
195− unordList tocList
205+ nl opts +++ unordList opts tocList
196206 else thediv ! [prefixedId opts' "TOC"] $
197− unordList tocList
207+ nl opts +++ unordList opts tocList
198208
199209-- | Convert section number to string
200210showSecNum :: [Int] -> String
@@ -213,7 +223,7 @@ elementToListItem opts (Sec _ num id' headerText subsecs) = do
213223 subHeads <- mapM (elementToListItem opts) subsecs >>= return . catMaybes
214224 let subList = if null subHeads
215225 then noHtml
216− else unordList subHeads
226+ else unordList opts subHeads
217227 return $ Just $ (anchor ! [href ("#" ++ writerIdentifierPrefix opts ++ id')] $ txt) +++ subList
218228
219229-- | Convert an Element to Html.
@@ -229,21 +239,23 @@ elementToHtml opts (Sec level num id' title' elements) = do
229239 writerSectionDivs opts || slides)]
230240 let stuff = header'' : innerContents
231241 return $ if slides -- S5 gets confused by the extra divs around sections
232− then toHtmlFromList stuff
242+ then toHtmlFromList $ intersperse (nl opts) stuff
233243 else if writerSectionDivs opts
234244 then if writerHtml5 opts
235245 then tag "section" ! [prefixedId opts id']
236− << stuff
237− else thediv ! [prefixedId opts id'] << stuff
238− else toHtmlFromList stuff
246+ << intersperse (nl opts) stuff
247+ else thediv ! [prefixedId opts id'] <<
248+ intersperse (nl opts) stuff
249+ else toHtmlFromList $ intersperse (nl opts) stuff
239250
240251-- | Convert list of Note blocks to a footnote <div>.
241252-- Assumes notes are sorted.
242−footnoteSection :: [Html] -> Html
243−footnoteSection notes =
253+footnoteSection :: WriterOptions -> [Html] -> Html
254+footnoteSection opts notes =
244255 if null notes
245256 then noHtml
246− else thediv ! [theclass "footnotes"] $ hr +++ (olist << notes)
257+ else thediv ! [theclass "footnotes"]
258+ $ nl opts +++ hr +++ nl opts +++ olist << (notes ++ [nl opts])
247259
248260
249261-- | Parse a mailto link; return Just (name, domain) or Nothing.
@@ -305,23 +317,27 @@ attrsToHtml opts (id',classes',keyvals) =
305317
306318-- | Convert Pandoc block element to HTML.
307319blockToHtml :: WriterOptions -> Block -> State WriterState Html
308−blockToHtml _ Null = return noHtml
309−blockToHtml opts (Plain lst) = inlineListToHtml opts lst
310−blockToHtml opts (Para [Image txt (s,tit)]) = do
320+blockToHtml opts b = blockToHtml' opts b >>= return . (nl opts +++)
321+
322+blockToHtml' :: WriterOptions -> Block -> State WriterState Html
323+blockToHtml' _ Null = return noHtml
324+blockToHtml' opts (Plain lst) = inlineListToHtml opts lst
325+blockToHtml' opts (Para [Image txt (s,tit)]) = do
311326 img <- inlineToHtml opts (Image txt (s,tit))
312327 capt <- inlineListToHtml opts txt
313328 return $ if writerHtml5 opts
314329 then tag "figure" <<
315− [img, tag "figcaption" << capt] +++ nl
330+ [nl opts, img, tag "figcaption" << capt, nl opts]
316331 else thediv ! [theclass "figure"] <<
317− [img, paragraph ! [theclass "caption"] << capt] +++ nl
318−blockToHtml opts (Para lst) = do
332+ [nl opts, img, paragraph ! [theclass "caption"] << capt,
333+ nl opts]
334+blockToHtml' opts (Para lst) = do
319335 contents <- inlineListToHtml opts lst
320− return $ paragraph contents +++ nl
321−blockToHtml _ (RawBlock "html" str) = return $ primHtml str
322−blockToHtml _ (RawBlock _ _) = return noHtml
323−blockToHtml _ (HorizontalRule) = return $ hr +++ nl
324−blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do
336+ return $ paragraph contents
337+blockToHtml' _ (RawBlock "html" str) = return $ primHtml str
338+blockToHtml' _ (RawBlock _ _) = return noHtml
339+blockToHtml' _ (HorizontalRule) = return hr
340+blockToHtml' opts (CodeBlock (id',classes,keyvals) rawCode) = do
325341 let classes' = if writerLiterateHaskell opts
326342 then classes
327343 else filter (/= "literate") classes
@@ -335,10 +351,10 @@ blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do
335351 else unlines . lines
336352 in return $ pre ! attrs $ thecode <<
337353 (replicate (length leadingBreaks) br +++
338− [stringToHtml $ addBird rawCode']) +++ nl
354+ [stringToHtml $ addBird rawCode'])
339355 Right h -> modify (\st -> st{ stHighlighting = True }) >>
340− return (h +++ nl)
341−blockToHtml opts (BlockQuote blocks) =
356+ return h
357+blockToHtml' opts (BlockQuote blocks) =
342358 -- in S5, treat list in blockquote specially
343359 -- if default is incremental, make it nonincremental;
344360 -- otherwise incremental
@@ -354,8 +370,8 @@ blockToHtml opts (BlockQuote blocks) =
354370 (return . blockquote)
355371 else do
356372 contents <- blockListToHtml opts blocks
357− return $ blockquote contents +++ nl
358−blockToHtml opts (Header level lst) = do
373+ return $ blockquote contents
374+blockToHtml' opts (Header level lst) = do
359375 contents <- inlineListToHtml opts lst
360376 secnum <- liftM stSecNum get
361377 let contents' = if writerNumberSections opts
@@ -372,14 +388,14 @@ blockToHtml opts (Header level lst) = do
372388 4 -> h4 contents''
373389 5 -> h5 contents''
374390 6 -> h6 contents''
375− _ -> paragraph contents'') +++ nl
376−blockToHtml opts (BulletList lst) = do
391+ _ -> paragraph contents'')
392+blockToHtml' opts (BulletList lst) = do
377393 contents <- mapM (blockListToHtml opts) lst
378394 let attribs = if writerIncremental opts
379395 then [theclass "incremental"]
380396 else []
381− return $ (unordList ! attribs) contents +++ nl
382−blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do
397+ return $ (unordList opts contents) ! attribs
398+blockToHtml' opts (OrderedList (startnum, numstyle, _) lst) = do
383399 contents <- mapM (blockListToHtml opts) lst
384400 let numstyle' = camelCaseToHyphenated $ show numstyle
385401 let attribs = (if writerIncremental opts
@@ -401,17 +417,18 @@ blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do
401417 else [thestyle $ "list-style-type: " ++
402418 numstyle']
403419 else [])
404− return $ (ordList ! attribs) contents +++ nl
405−blockToHtml opts (DefinitionList lst) = do
420+ return $ (ordList opts contents) ! attribs
421+blockToHtml' opts (DefinitionList lst) = do
406422 contents <- mapM (\(term, defs) ->
407423 do term' <- liftM (dterm <<) $ inlineListToHtml opts term
408− defs' <- mapM (liftM (ddef <<) . blockListToHtml opts) defs
409− return $ nl : term' : nl : defs') lst
424+ defs' <- mapM ((liftM (\x -> ddef << (x +++ nl opts))) .
425+ blockListToHtml opts) defs
426+ return $ nl opts : term' : nl opts : defs') lst
410427 let attribs = if writerIncremental opts
411428 then [theclass "incremental"]
412429 else []
413− return $ (dlist ! attribs << concat contents) +++ nl
414−blockToHtml opts (Table capt aligns widths headers rows') = do
430+ return $ dlist ! attribs << (concat contents +++ nl opts)
431+blockToHtml' opts (Table capt aligns widths headers rows') = do
415432 captionDoc <- if null capt
416433 then return noHtml
417434 else inlineListToHtml opts capt >>= return . caption
@@ -428,7 +445,7 @@ blockToHtml opts (Table capt aligns widths headers rows') = do
428445 else liftM (thead <<) $ tableRowToHtml opts aligns 0 headers
429446 body' <- liftM (tbody <<) $
430447 zipWithM (tableRowToHtml opts aligns) [1..] rows'
431− return $ table $ captionDoc +++ coltags +++ head' +++ body' +++ nl
448+ return $ table $ captionDoc +++ coltags +++ head' +++ body'
432449
433450tableRowToHtml :: WriterOptions
434451 -> [Alignment]
@@ -444,7 +461,7 @@ tableRowToHtml opts aligns rownum cols' = do
444461 cols'' <- sequence $ zipWith
445462 (\alignment item -> tableItemToHtml opts mkcell alignment item)
446463 aligns cols'
447− return $ (tr ! [theclass rowclass] $ toHtmlFromList cols'') +++ nl
464+ return $ (tr ! [theclass rowclass] $ toHtmlFromList cols'') +++ nl opts
448465
449466alignmentToString :: Alignment -> [Char]
450467alignmentToString alignment = case alignment of
@@ -463,11 +480,18 @@ tableItemToHtml opts tag' align' item = do
463480 let alignAttrs = if writerHtml5 opts
464481 then [thestyle $ "align: " ++ alignmentToString align']
465482 else [align $ alignmentToString align']
466− return $ (tag' ! alignAttrs) contents +++ nl
483+ return $ (tag' ! alignAttrs) contents +++ nl opts
484+
485+toListItems :: WriterOptions -> [Html] -> [Html]
486+toListItems opts items = map (toListItem opts) items ++ [nl opts]
487+
488+toListItem :: WriterOptions -> Html -> Html
489+toListItem opts item = nl opts +++ li item
467490
468491blockListToHtml :: WriterOptions -> [Block] -> State WriterState Html
469−blockListToHtml opts lst =
470− mapM (blockToHtml opts) lst >>= return . toHtmlFromList
492+blockListToHtml opts lst =
493+ mapM (blockToHtml opts) lst >>=
494+ return . toHtmlFromList . intersperse (nl opts)
471495
472496-- | Convert list of Pandoc inline elements to HTML.
473497inlineListToHtml :: WriterOptions -> [Inline] -> State WriterState Html
@@ -614,5 +638,5 @@ blockListToNote opts ref blocks =
614638 _ -> otherBlocks ++ [lastBlock,
615639 Plain backlink]
616640 in do contents <- blockListToHtml opts blocks'
617− return $ nl +++ (li ! [prefixedId opts ("fn" ++ ref)]) contents
641+ return $ nl opts +++ (li ! [prefixedId opts ("fn" ++ ref)]) contents
618642