From 99cb6076f8f6ac1b2053f2425e2021bc14ac4796 Mon Sep 17 00:00:00 2001
From: John MacFarlane <jgm@berkeley.edu>
Date: Fri, 4 Feb 2011 19:27:53 -0800
Subject: Improved new HTML format; restored original --no-wrap behavior.

---
 src/Text/Pandoc/Writers/HTML.hs | 128 ++++++++++++++++++++++++----------------
 1 file changed, 76 insertions(+), 52 deletions(-)

(limited to 'src/Text/Pandoc/Writers')

diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index 4fa397b94..fe6bede09 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -42,7 +42,7 @@ import Data.Char ( ord, toLower )
 import Data.List ( isPrefixOf, intersperse )
 import Data.Maybe ( catMaybes )
 import Control.Monad.State
-import Text.XHtml.Transitional hiding ( stringToHtml )
+import Text.XHtml.Transitional hiding ( stringToHtml, unordList, ordList )
 import Text.TeXMath
 import Text.XML.Light.Output
 
@@ -64,8 +64,10 @@ stringToHtml :: String -> Html
 stringToHtml = primHtml . escapeStringForXML
 
 -- | Hard linebreak.
-nl :: Html
-nl = primHtml "\n"
+nl :: WriterOptions -> Html
+nl opts = if writerWrapText opts
+             then primHtml "\n"
+             else noHtml
 
 -- | Convert Pandoc document to Html string.
 writeHtmlString :: WriterOptions -> Pandoc -> String
@@ -74,7 +76,7 @@ writeHtmlString opts d =
                                                  defaultWriterState
   in  if writerStandalone opts
          then inTemplate opts tit auths date toc body' newvars
-         else showHtmlFragment body'
+         else dropWhile (=='\n') $ showHtmlFragment body'
 
 -- | Convert Pandoc document to Html structure.
 writeHtml :: WriterOptions -> Pandoc -> Html
@@ -118,13 +120,13 @@ pandocToHtml opts (Pandoc (Meta title' authors' date') blocks) = do
                                            cutUp xs ++ [endSlide]
                 _                     -> [startSlide] ++ cutUp blocks ++
                                            [endSlide]
-  blocks' <- liftM toHtmlFromList $
+  blocks' <- liftM (toHtmlFromList . intersperse (nl opts)) $
               if writerSlideVariant opts `elem` [SlidySlides, S5Slides]
                  then mapM (blockToHtml opts) slides
                  else mapM (elementToHtml opts) sects
   st <- get
   let notes = reverse (stNotes st)
-  let thebody = blocks' +++ footnoteSection notes
+  let thebody = blocks' +++ footnoteSection opts notes
   let  math = if stMath st
                 then case writerHTMLMathMethod opts of
                            LaTeXMathML (Just url) ->
@@ -146,7 +148,7 @@ pandocToHtml opts (Pandoc (Meta title' authors' date') blocks) = do
                 else noHtml
   let newvars = [("highlighting-css", defaultHighlightingCss) |
                    stHighlighting st] ++
-                [("math", renderHtmlFragment math) | stMath st]
+                [("math", showHtmlFragment math) | stMath st]
   return (tit, auths, date, toc, thebody, newvars)
 
 inTemplate :: TemplateTarget a
@@ -165,13 +167,13 @@ inTemplate opts tit auths date toc body' newvars =
       date'       = stripTags $ showHtmlFragment date
       variables   = writerVariables opts ++ newvars
       context     = variables ++
-                    [ ("body", renderHtmlFragment body')
+                    [ ("body", dropWhile (=='\n') $ showHtmlFragment body')
                     , ("pagetitle", topTitle')
-                    , ("title", renderHtmlFragment tit)
+                    , ("title", dropWhile (=='\n') $ showHtmlFragment tit)
                     , ("date", date') ] ++
                     [ ("html5","true") | writerHtml5 opts ] ++
                     (case toc of
-                         Just t  -> [ ("toc", renderHtmlFragment t)]
+                         Just t  -> [ ("toc", showHtmlFragment t)]
                          Nothing -> [])  ++
                     [ ("author", a) | a <- authors ]
   in  renderTemplate context $ writerTemplate opts
@@ -180,6 +182,14 @@ inTemplate opts tit auths date toc body' newvars =
 prefixedId :: WriterOptions -> String -> HtmlAttr
 prefixedId opts s = identifier $ writerIdentifierPrefix opts ++ s
 
+-- | Replacement for Text.XHtml's unordList.
+unordList :: WriterOptions -> ([Html] -> Html)
+unordList opts items = ulist << toListItems opts items
+
+-- | Replacement for Text.XHtml's ordList.
+ordList :: WriterOptions -> ([Html] -> Html)
+ordList opts items = olist << toListItems opts items
+
 -- | Construct table of contents from list of elements.
 tableOfContents :: WriterOptions -> [Element] -> State WriterState (Maybe Html)
 tableOfContents _ [] = return Nothing
@@ -192,9 +202,9 @@ tableOfContents opts sects = do
               else Just $
                    if writerHtml5 opts
                       then tag "nav" ! [prefixedId opts' "TOC"] $
-                           unordList tocList
+                           nl opts +++ unordList opts tocList
                       else thediv ! [prefixedId opts' "TOC"] $
-                           unordList tocList
+                           nl opts +++ unordList opts tocList
 
 -- | Convert section number to string
 showSecNum :: [Int] -> String
@@ -213,7 +223,7 @@ elementToListItem opts (Sec _ num id' headerText subsecs) = do
   subHeads <- mapM (elementToListItem opts) subsecs >>= return . catMaybes
   let subList = if null subHeads
                    then noHtml
-                   else unordList subHeads
+                   else unordList opts subHeads
   return $ Just $ (anchor ! [href ("#" ++ writerIdentifierPrefix opts ++ id')] $ txt) +++ subList
 
 -- | Convert an Element to Html.
@@ -229,21 +239,23 @@ elementToHtml opts (Sec level num id' title' elements) = do
                                   writerSectionDivs opts || slides)]
   let stuff = header'' : innerContents
   return $ if slides   -- S5 gets confused by the extra divs around sections
-              then toHtmlFromList stuff
+              then toHtmlFromList $ intersperse (nl opts) stuff
               else if writerSectionDivs opts
                       then if writerHtml5 opts
                               then tag "section" ! [prefixedId opts id']
-                                     << stuff
-                              else thediv ! [prefixedId opts id'] << stuff
-                      else toHtmlFromList stuff
+                                     << intersperse (nl opts) stuff
+                              else thediv ! [prefixedId opts id'] <<
+                                      intersperse (nl opts) stuff
+                      else toHtmlFromList $ intersperse (nl opts) stuff
 
 -- | Convert list of Note blocks to a footnote <div>.
 -- Assumes notes are sorted.
-footnoteSection :: [Html] -> Html
-footnoteSection notes =
+footnoteSection :: WriterOptions -> [Html] -> Html
+footnoteSection opts notes =
   if null notes 
      then noHtml
-     else thediv ! [theclass "footnotes"] $ hr +++ (olist << notes)
+     else thediv ! [theclass "footnotes"]
+          $ nl opts +++ hr +++ nl opts +++ olist << (notes ++ [nl opts])
 
 
 -- | Parse a mailto link; return Just (name, domain) or Nothing.
@@ -305,23 +317,27 @@ attrsToHtml opts (id',classes',keyvals) =
 
 -- | Convert Pandoc block element to HTML.
 blockToHtml :: WriterOptions -> Block -> State WriterState Html
-blockToHtml _ Null = return noHtml
-blockToHtml opts (Plain lst) = inlineListToHtml opts lst
-blockToHtml opts (Para [Image txt (s,tit)]) = do
+blockToHtml opts b = blockToHtml' opts b >>= return . (nl opts +++)
+
+blockToHtml' :: WriterOptions -> Block -> State WriterState Html
+blockToHtml' _ Null = return noHtml
+blockToHtml' opts (Plain lst) = inlineListToHtml opts lst
+blockToHtml' opts (Para [Image txt (s,tit)]) = do
   img <- inlineToHtml opts (Image txt (s,tit))
   capt <- inlineListToHtml opts txt
   return $ if writerHtml5 opts
               then tag "figure" <<
-                    [img, tag "figcaption" << capt] +++ nl
+                    [nl opts, img, tag "figcaption" << capt, nl opts]
               else thediv ! [theclass "figure"] <<
-                    [img, paragraph ! [theclass "caption"] << capt] +++ nl
-blockToHtml opts (Para lst) = do
+                    [nl opts, img, paragraph ! [theclass "caption"] << capt,
+                    nl opts]
+blockToHtml' opts (Para lst) = do
   contents <- inlineListToHtml opts lst
-  return $ paragraph contents +++ nl
-blockToHtml _ (RawBlock "html" str) = return $ primHtml str
-blockToHtml _ (RawBlock _ _) = return noHtml
-blockToHtml _ (HorizontalRule) = return $ hr +++ nl
-blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do
+  return $ paragraph contents
+blockToHtml' _ (RawBlock "html" str) = return $ primHtml str
+blockToHtml' _ (RawBlock _ _) = return noHtml
+blockToHtml' _ (HorizontalRule) = return hr
+blockToHtml' opts (CodeBlock (id',classes,keyvals) rawCode) = do
   let classes' = if writerLiterateHaskell opts
                     then classes
                     else filter (/= "literate") classes
@@ -335,10 +351,10 @@ blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do
                                      else unlines . lines
                     in  return $ pre ! attrs $ thecode <<
                                  (replicate (length leadingBreaks) br +++
-                                 [stringToHtml $ addBird rawCode']) +++ nl
+                                 [stringToHtml $ addBird rawCode'])
          Right h -> modify (\st -> st{ stHighlighting = True }) >>
-                    return (h +++ nl)
-blockToHtml opts (BlockQuote blocks) =
+                    return h
+blockToHtml' opts (BlockQuote blocks) =
   -- in S5, treat list in blockquote specially
   -- if default is incremental, make it nonincremental; 
   -- otherwise incremental
@@ -354,8 +370,8 @@ blockToHtml opts (BlockQuote blocks) =
                                   (return . blockquote)
      else do
        contents <- blockListToHtml opts blocks
-       return $ blockquote contents +++ nl
-blockToHtml opts (Header level lst) = do 
+       return $ blockquote contents
+blockToHtml' opts (Header level lst) = do 
   contents <- inlineListToHtml opts lst
   secnum <- liftM stSecNum get
   let contents' = if writerNumberSections opts
@@ -372,14 +388,14 @@ blockToHtml opts (Header level lst) = do
               4 -> h4 contents''
               5 -> h5 contents''
               6 -> h6 contents''
-              _ -> paragraph contents'') +++ nl
-blockToHtml opts (BulletList lst) = do
+              _ -> paragraph contents'')
+blockToHtml' opts (BulletList lst) = do
   contents <- mapM (blockListToHtml opts) lst
   let attribs = if writerIncremental opts
                    then [theclass "incremental"]
                    else []
-  return $ (unordList ! attribs) contents +++ nl
-blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do
+  return $ (unordList opts contents) ! attribs
+blockToHtml' opts (OrderedList (startnum, numstyle, _) lst) = do
   contents <- mapM (blockListToHtml opts) lst
   let numstyle' = camelCaseToHyphenated $ show numstyle
   let attribs = (if writerIncremental opts
@@ -401,17 +417,18 @@ blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do
                            else [thestyle $ "list-style-type: " ++
                                    numstyle']
                    else [])
-  return $ (ordList ! attribs) contents +++ nl
-blockToHtml opts (DefinitionList lst) = do
+  return $ (ordList opts contents) ! attribs
+blockToHtml' opts (DefinitionList lst) = do
   contents <- mapM (\(term, defs) ->
                   do term' <- liftM (dterm <<) $ inlineListToHtml opts term
-                     defs' <- mapM (liftM (ddef <<) . blockListToHtml opts) defs
-                     return $ nl : term' : nl : defs') lst
+                     defs' <- mapM ((liftM (\x -> ddef << (x +++ nl opts))) .
+                                    blockListToHtml opts) defs
+                     return $ nl opts : term' : nl opts : defs') lst
   let attribs = if writerIncremental opts
                    then [theclass "incremental"]
                    else []
-  return $ (dlist ! attribs << concat contents) +++ nl
-blockToHtml opts (Table capt aligns widths headers rows') = do
+  return $ dlist ! attribs << (concat contents +++ nl opts)
+blockToHtml' opts (Table capt aligns widths headers rows') = do
   captionDoc <- if null capt
                    then return noHtml
                    else inlineListToHtml opts capt >>= return . caption
@@ -428,7 +445,7 @@ blockToHtml opts (Table capt aligns widths headers rows') = do
               else liftM (thead <<) $ tableRowToHtml opts aligns 0 headers
   body' <- liftM (tbody <<) $
                zipWithM (tableRowToHtml opts aligns) [1..] rows'
-  return $ table $ captionDoc +++ coltags +++ head' +++ body' +++ nl
+  return $ table $ captionDoc +++ coltags +++ head' +++ body'
 
 tableRowToHtml :: WriterOptions
                -> [Alignment]
@@ -444,7 +461,7 @@ tableRowToHtml opts aligns rownum cols' = do
   cols'' <- sequence $ zipWith 
             (\alignment item -> tableItemToHtml opts mkcell alignment item) 
             aligns cols'
-  return $ (tr ! [theclass rowclass] $ toHtmlFromList cols'') +++ nl
+  return $ (tr ! [theclass rowclass] $ toHtmlFromList cols'') +++ nl opts
 
 alignmentToString :: Alignment -> [Char]
 alignmentToString alignment = case alignment of
@@ -463,11 +480,18 @@ tableItemToHtml opts tag' align' item = do
   let alignAttrs = if writerHtml5 opts
                       then [thestyle $ "align: " ++ alignmentToString align']
                       else [align $ alignmentToString align']
-  return $ (tag' ! alignAttrs) contents +++ nl
+  return $ (tag' ! alignAttrs) contents +++ nl opts
+
+toListItems :: WriterOptions -> [Html] -> [Html]
+toListItems opts items = map (toListItem opts) items ++ [nl opts]
+
+toListItem :: WriterOptions -> Html -> Html
+toListItem opts item = nl opts +++ li item
 
 blockListToHtml :: WriterOptions -> [Block] -> State WriterState Html
-blockListToHtml opts lst = 
-  mapM (blockToHtml opts) lst >>= return . toHtmlFromList
+blockListToHtml opts lst =
+  mapM (blockToHtml opts) lst >>=
+  return . toHtmlFromList . intersperse (nl opts)
 
 -- | Convert list of Pandoc inline elements to HTML.
 inlineListToHtml :: WriterOptions -> [Inline] -> State WriterState Html
@@ -614,5 +638,5 @@ blockListToNote opts ref blocks =
                                   _           -> otherBlocks ++ [lastBlock,
                                                  Plain backlink]
   in  do contents <- blockListToHtml opts blocks'
-         return $ nl +++ (li ! [prefixedId opts ("fn" ++ ref)]) contents
+         return $ nl opts +++ (li ! [prefixedId opts ("fn" ++ ref)]) contents
 
-- 
cgit v1.2.3