git.iko.soy/typeable/pandoc
on master help sign in
Added --toc support to Markdown writer.
ad7bb70fiddlosopher
src/Text/Pandoc/Writers/Markdown.hs+26−6
@@ -59,13 +59,17 @@ pandocToMarkdown opts (Pandoc meta blocks) = do
59 let head = if (writerStandalone opts)
59 let head = if (writerStandalone opts)
60 then metaBlock $$ text (writerHeader opts)
60 then metaBlock $$ text (writerHeader opts)
61 else empty
61 else empty
62+ let headerBlocks = filter isHeaderBlock blocks
63+ let toc = if writerTableOfContents opts
64+ then tableOfContents opts headerBlocks
65+ else empty
62 body <- blockListToMarkdown opts blocks
66 body <- blockListToMarkdown opts blocks
63 (notes, _) <- get
67 (notes, _) <- get
64 notes' <- notesToMarkdown opts (reverse notes)
68 notes' <- notesToMarkdown opts (reverse notes)
65 (_, refs) <- get -- note that the notes may contain refs
69 (_, refs) <- get -- note that the notes may contain refs
66 refs' <- keyTableToMarkdown opts (reverse refs)
70 refs' <- keyTableToMarkdown opts (reverse refs)
67− return $ head <> (before' $$ body <> text "\n" $$
71+ return $ head $$ before' $$ toc $$ body $$ text "" $$
68− notes' <> text "\n" $$ refs' $$ after')
72+ notes' $$ text "" $$ refs' $$ after'
69
73
70-- | Return markdown representation of reference key table.
74-- | Return markdown representation of reference key table.
71keyTableToMarkdown :: WriterOptions -> KeyTable -> State WriterState Doc
75keyTableToMarkdown :: WriterOptions -> KeyTable -> State WriterState Doc
@@ -118,22 +122,38 @@ metaToMarkdown opts (Meta title authors date) = do
118 title' <- titleToMarkdown opts title
122 title' <- titleToMarkdown opts title
119 authors' <- authorsToMarkdown authors
123 authors' <- authorsToMarkdown authors
120 date' <- dateToMarkdown date
124 date' <- dateToMarkdown date
121− return $ title' <> authors' <> date'
125+ return $ title' $$ authors' $$ date'
122
126
123titleToMarkdown :: WriterOptions -> [Inline] -> State WriterState Doc
127titleToMarkdown :: WriterOptions -> [Inline] -> State WriterState Doc
124titleToMarkdown opts [] = return empty
128titleToMarkdown opts [] = return empty
125titleToMarkdown opts lst = do
129titleToMarkdown opts lst = do
126 contents <- inlineListToMarkdown opts lst
130 contents <- inlineListToMarkdown opts lst
127− return $ text "% " <> contents <> text "\n"
131+ return $ text "% " <> contents
128
132
129authorsToMarkdown :: [String] -> State WriterState Doc
133authorsToMarkdown :: [String] -> State WriterState Doc
130authorsToMarkdown [] = return empty
134authorsToMarkdown [] = return empty
131authorsToMarkdown lst = return $
135authorsToMarkdown lst = return $
132− text "% " <> text (joinWithSep ", " (map escapeString lst)) <> text "\n"
136+ text "% " <> text (joinWithSep ", " (map escapeString lst))
133
137
134dateToMarkdown :: String -> State WriterState Doc
138dateToMarkdown :: String -> State WriterState Doc
135dateToMarkdown [] = return empty
139dateToMarkdown [] = return empty
136−dateToMarkdown str = return $ text "% " <> text (escapeString str) <> text "\n"
140+dateToMarkdown str = return $ text "% " <> text (escapeString str)
141+
142+-- | Construct table of contents from list of header blocks.
143+tableOfContents :: WriterOptions -> [Block] -> Doc
144+tableOfContents opts headers =
145+ let opts' = opts { writerIgnoreNotes = True }
146+ contents = BulletList $ map elementToListItem $ hierarchicalize headers
147+ in evalState (blockToMarkdown opts' contents) ([],[])
148+
149+-- | Converts an Element to a list item for a table of contents,
150+elementToListItem :: Element -> [Block]
151+elementToListItem (Blk _) = []
152+elementToListItem (Sec headerText subsecs) =
153+ [Plain headerText] ++
154+ if null subsecs
155+ then []
156+ else [BulletList $ map elementToListItem subsecs]
137
157
138-- | Convert Pandoc block element to markdown.
158-- | Convert Pandoc block element to markdown.
139blockToMarkdown :: WriterOptions -- ^ Options
159blockToMarkdown :: WriterOptions -- ^ Options