@@ -38,15 +38,11 @@ import Data.List ( isPrefixOf, partition, intersperse )
38import Control.Monad.State
38import Control.Monad.State
39import Text.XHtml.Strict
39import Text.XHtml.Strict
41−type Notes = [Html]
41+data WriterState = WriterState
42−type Ids = [String]
42+ { stNotes :: [Html] -- ^ List of notes
43−type ForHeader = [Html]
43+ , stIds :: [String] -- ^ List of header identifiers
44−type WriterState = (Notes, Ids, ForHeader)
44+ , stHead :: [Html] -- ^ Html to include in header
46−-- | Add some Html to be included in the document header.
47−addToHeader :: Html -> State WriterState ()
48−addToHeader item = modify (\(notes, ids, forheader) ->
49− (notes, ids, item:forheader))
51-- | Convert Pandoc document to Html string.
47-- | Convert Pandoc document to Html string.
52writeHtmlString :: WriterOptions -> Pandoc -> String
48writeHtmlString :: WriterOptions -> Pandoc -> String
@@ -59,7 +55,8 @@ writeHtmlString opts =
59writeHtml :: WriterOptions -> Pandoc -> Html
55writeHtml :: WriterOptions -> Pandoc -> Html
60writeHtml opts (Pandoc (Meta tit authors date) blocks) =
56writeHtml opts (Pandoc (Meta tit authors date) blocks) =
61 let titlePrefix = writerTitlePrefix opts
57 let titlePrefix = writerTitlePrefix opts
62− topTitle = evalState (inlineListToHtml opts tit) ([],[],[])
58+ topTitle = evalState (inlineListToHtml opts tit)
59+ (WriterState {stNotes = [], stIds = [], stHead = []})
63 topTitle' = if null titlePrefix
60 topTitle' = if null titlePrefix
64 then topTitle
61 then topTitle
65 else titlePrefix +++ " - " +++ topTitle
62 else titlePrefix +++ " - " +++ topTitle
@@ -81,11 +78,12 @@ writeHtml opts (Pandoc (Meta tit authors date) blocks) =
81 toc = if writerTableOfContents opts
78 toc = if writerTableOfContents opts
82 then tableOfContents opts headerBlocks ids
79 then tableOfContents opts headerBlocks ids
83 else noHtml
80 else noHtml
84− (blocks', (revnotes,_,forhead)) =
81+ (blocks', newstate) =
85− runState (blockListToHtml opts blocks) ([],ids,[])
82+ runState (blockListToHtml opts blocks)
83+ (WriterState {stNotes = [], stIds = ids, stHead = []})
86− head = header $ metadata +++ toHtmlFromList forhead +++
84+ head = header $ metadata +++ toHtmlFromList (stHead newstate) +++
87 primHtml (writerHeader opts)
85 primHtml (writerHeader opts)
88− notes = reverse revnotes
86+ notes = reverse (stNotes newstate)
89 before = primHtml $ writerIncludeBefore opts
87 before = primHtml $ writerIncludeBefore opts
90 after = primHtml $ writerIncludeAfter opts
88 after = primHtml $ writerIncludeAfter opts
91 thebody = before +++ titleHeader +++ toc +++ blocks' +++
89 thebody = before +++ titleHeader +++ toc +++ blocks' +++
@@ -96,12 +94,12 @@ writeHtml opts (Pandoc (Meta tit authors date) blocks) =
97-- | Construct table of contents from list of header blocks and identifiers.
95-- | Construct table of contents from list of header blocks and identifiers.
98-- Assumes there are as many identifiers as header blocks.
96-- Assumes there are as many identifiers as header blocks.
99−tableOfContents :: WriterOptions -> [Block] -> Ids -> Html
97+tableOfContents :: WriterOptions -> [Block] -> [String] -> Html
100tableOfContents opts headers ids =
98tableOfContents opts headers ids =
101 let opts' = opts { writerIgnoreNotes = True }
99 let opts' = opts { writerIgnoreNotes = True }
102 contentsTree = hierarchicalize headers
100 contentsTree = hierarchicalize headers
103 contents = evalState (mapM (elementToListItem opts') contentsTree)
101 contents = evalState (mapM (elementToListItem opts') contentsTree)
104− ([],ids,[])
102+ (WriterState {stNotes= [], stIds = [], stHead = []})
105 in thediv ! [identifier "toc"] $ unordList contents
103 in thediv ! [identifier "toc"] $ unordList contents
107-- | Converts an Element to a list item for a table of contents,
105-- | Converts an Element to a list item for a table of contents,
@@ -109,11 +107,12 @@ tableOfContents opts headers ids =
109elementToListItem :: WriterOptions -> Element -> State WriterState Html
107elementToListItem :: WriterOptions -> Element -> State WriterState Html
110elementToListItem opts (Blk _) = return noHtml
108elementToListItem opts (Blk _) = return noHtml
111elementToListItem opts (Sec headerText subsecs) = do
109elementToListItem opts (Sec headerText subsecs) = do
112− (notes, ids, forhead) <- get
110+ st <- get
113 let (id, rest) = if null ids
112 let (id, rest) = if null ids
114− then ("",[])
113+ then ("", [])
115 else (head ids, tail ids)
114 else (head ids, tail ids)
116− put (notes, rest, forhead)
115+ put $ st {stIds = rest}
117 txt <- inlineListToHtml opts headerText
116 txt <- inlineListToHtml opts headerText
118 subHeads <- mapM (elementToListItem opts) subsecs
117 subHeads <- mapM (elementToListItem opts) subsecs
119 let subList = if null subHeads
118 let subList = if null subHeads
@@ -123,7 +122,7 @@ elementToListItem opts (Sec headerText subsecs) = do
124-- | Convert list of Note blocks to a footnote <div>.
123-- | Convert list of Note blocks to a footnote <div>.
125-- Assumes notes are sorted.
124-- Assumes notes are sorted.
126−footnoteSection :: WriterOptions -> Notes -> Html
125+footnoteSection :: WriterOptions -> [Html] -> Html
127footnoteSection opts notes =
126footnoteSection opts notes =
128 if null notes
127 if null notes
129 then noHtml
128 then noHtml
@@ -180,6 +179,13 @@ isPunctuation c =
180 then True
179 then True
181 else False
180 else False
182+-- | Add Html to document header.
183+addToHeader :: Html -> State WriterState ()
184+addToHeader item = do
186+ let current = stHead st
187+ put $ st {stHead = (item:current)}
183-- | Convert Pandoc inline list to plain text identifier.
189-- | Convert Pandoc inline list to plain text identifier.
184inlineListToIdentifier :: [Inline] -> String
190inlineListToIdentifier :: [Inline] -> String
185inlineListToIdentifier [] = ""
191inlineListToIdentifier [] = ""
@@ -243,11 +249,12 @@ blockToHtml opts block =
243 (return . blockquote)
249 (return . blockquote)
244 else blockListToHtml opts blocks >>= (return . blockquote)
250 else blockListToHtml opts blocks >>= (return . blockquote)
245 (Header level lst) -> do contents <- inlineListToHtml opts lst
251 (Header level lst) -> do contents <- inlineListToHtml opts lst
246− (notes, ids, forhead) <- get
252+ st <- get
247 let (id, rest) = if null ids
254 let (id, rest) = if null ids
248 then ("", [])
255 then ("", [])
249 else (head ids, tail ids)
256 else (head ids, tail ids)
250− put (notes, rest, forhead)
257+ put $ st {stIds = rest}
251 let attribs = [identifier id]
258 let attribs = [identifier id]
252 let headerHtml = case level of
259 let headerHtml = case level of
253 1 -> h1 contents ! attribs
260 1 -> h1 contents ! attribs
@@ -369,11 +376,12 @@ inlineToHtml opts inline =
369 if null txt then [] else [alt alternate']
376 if null txt then [] else [alt alternate']
370 return $ image ! attributes
377 return $ image ! attributes
371 -- note: null title included, as in Markdown.pl
378 -- note: null title included, as in Markdown.pl
372− (Note contents) -> do (notes, ids, forhead) <- get
379+ (Note contents) -> do st <- get
380+ let notes = stNotes st
373 let number = (length notes) + 1
381 let number = (length notes) + 1
374 let ref = show number
382 let ref = show number
375 htmlContents <- blockListToNote opts ref contents
383 htmlContents <- blockListToNote opts ref contents
376− put (htmlContents:notes, ids, forhead) -- push contents onto front of notes
384+ put $ st {stNotes = (htmlContents:notes)} -- push contents onto front of notes
377 return $ anchor ! [href ("#fn" ++ ref),
385 return $ anchor ! [href ("#fn" ++ ref),
378 theclass "footnoteRef",
386 theclass "footnoteRef",
379 identifier ("fnref" ++ ref)] << sup << ref
387 identifier ("fnref" ++ ref)] << sup << ref