aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Text/Pandoc/Writers/HTML.hs56
1 files changed, 32 insertions, 24 deletions
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index ab85a3472..eaed5ab90 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -38,15 +38,11 @@ import Data.List ( isPrefixOf, partition, intersperse )
import Control.Monad.State
import Text.XHtml.Strict
-type Notes = [Html]
-type Ids = [String]
-type ForHeader = [Html]
-type WriterState = (Notes, Ids, ForHeader)
-
--- | Add some Html to be included in the document header.
-addToHeader :: Html -> State WriterState ()
-addToHeader item = modify (\(notes, ids, forheader) ->
- (notes, ids, item:forheader))
+data WriterState = WriterState
+ { stNotes :: [Html] -- ^ List of notes
+ , stIds :: [String] -- ^ List of header identifiers
+ , stHead :: [Html] -- ^ Html to include in header
+ } deriving Show
-- | Convert Pandoc document to Html string.
writeHtmlString :: WriterOptions -> Pandoc -> String
@@ -59,7 +55,8 @@ writeHtmlString opts =
writeHtml :: WriterOptions -> Pandoc -> Html
writeHtml opts (Pandoc (Meta tit authors date) blocks) =
let titlePrefix = writerTitlePrefix opts
- topTitle = evalState (inlineListToHtml opts tit) ([],[],[])
+ topTitle = evalState (inlineListToHtml opts tit)
+ (WriterState {stNotes = [], stIds = [], stHead = []})
topTitle' = if null titlePrefix
then topTitle
else titlePrefix +++ " - " +++ topTitle
@@ -81,11 +78,12 @@ writeHtml opts (Pandoc (Meta tit authors date) blocks) =
toc = if writerTableOfContents opts
then tableOfContents opts headerBlocks ids
else noHtml
- (blocks', (revnotes,_,forhead)) =
- runState (blockListToHtml opts blocks) ([],ids,[])
- head = header $ metadata +++ toHtmlFromList forhead +++
+ (blocks', newstate) =
+ runState (blockListToHtml opts blocks)
+ (WriterState {stNotes = [], stIds = ids, stHead = []})
+ head = header $ metadata +++ toHtmlFromList (stHead newstate) +++
primHtml (writerHeader opts)
- notes = reverse revnotes
+ notes = reverse (stNotes newstate)
before = primHtml $ writerIncludeBefore opts
after = primHtml $ writerIncludeAfter opts
thebody = before +++ titleHeader +++ toc +++ blocks' +++
@@ -96,12 +94,12 @@ writeHtml opts (Pandoc (Meta tit authors date) blocks) =
-- | Construct table of contents from list of header blocks and identifiers.
-- Assumes there are as many identifiers as header blocks.
-tableOfContents :: WriterOptions -> [Block] -> Ids -> Html
+tableOfContents :: WriterOptions -> [Block] -> [String] -> Html
tableOfContents opts headers ids =
let opts' = opts { writerIgnoreNotes = True }
contentsTree = hierarchicalize headers
contents = evalState (mapM (elementToListItem opts') contentsTree)
- ([],ids,[])
+ (WriterState {stNotes= [], stIds = [], stHead = []})
in thediv ! [identifier "toc"] $ unordList contents
-- | Converts an Element to a list item for a table of contents,
@@ -109,11 +107,12 @@ tableOfContents opts headers ids =
elementToListItem :: WriterOptions -> Element -> State WriterState Html
elementToListItem opts (Blk _) = return noHtml
elementToListItem opts (Sec headerText subsecs) = do
- (notes, ids, forhead) <- get
+ st <- get
+ let ids = stIds st
let (id, rest) = if null ids
- then ("",[])
+ then ("", [])
else (head ids, tail ids)
- put (notes, rest, forhead)
+ put $ st {stIds = rest}
txt <- inlineListToHtml opts headerText
subHeads <- mapM (elementToListItem opts) subsecs
let subList = if null subHeads
@@ -123,7 +122,7 @@ elementToListItem opts (Sec headerText subsecs) = do
-- | Convert list of Note blocks to a footnote <div>.
-- Assumes notes are sorted.
-footnoteSection :: WriterOptions -> Notes -> Html
+footnoteSection :: WriterOptions -> [Html] -> Html
footnoteSection opts notes =
if null notes
then noHtml
@@ -180,6 +179,13 @@ isPunctuation c =
then True
else False
+-- | Add Html to document header.
+addToHeader :: Html -> State WriterState ()
+addToHeader item = do
+ st <- get
+ let current = stHead st
+ put $ st {stHead = (item:current)}
+
-- | Convert Pandoc inline list to plain text identifier.
inlineListToIdentifier :: [Inline] -> String
inlineListToIdentifier [] = ""
@@ -243,11 +249,12 @@ blockToHtml opts block =
(return . blockquote)
else blockListToHtml opts blocks >>= (return . blockquote)
(Header level lst) -> do contents <- inlineListToHtml opts lst
- (notes, ids, forhead) <- get
+ st <- get
+ let ids = stIds st
let (id, rest) = if null ids
then ("", [])
else (head ids, tail ids)
- put (notes, rest, forhead)
+ put $ st {stIds = rest}
let attribs = [identifier id]
let headerHtml = case level of
1 -> h1 contents ! attribs
@@ -369,11 +376,12 @@ inlineToHtml opts inline =
if null txt then [] else [alt alternate']
return $ image ! attributes
-- note: null title included, as in Markdown.pl
- (Note contents) -> do (notes, ids, forhead) <- get
+ (Note contents) -> do st <- get
+ let notes = stNotes st
let number = (length notes) + 1
let ref = show number
htmlContents <- blockListToNote opts ref contents
- put (htmlContents:notes, ids, forhead) -- push contents onto front of notes
+ put $ st {stNotes = (htmlContents:notes)} -- push contents onto front of notes
return $ anchor ! [href ("#fn" ++ ref),
theclass "footnoteRef",
identifier ("fnref" ++ ref)] << sup << ref