From ca50deeeeee3bf0900cb91d39671d8dc5aaceb1b Mon Sep 17 00:00:00 2001
From: Jesse Rosenthal <jrosenthal@jhu.edu>
Date: Tue, 11 Oct 2016 14:57:24 -0400
Subject: Markdown writer: Allow footnotes/refs at the end of blocks, sections
This allows footnotes and refs to be placed at the end of blocks and
sections. Note that we only place them at the end of blocks that are at
the top level and before headers that are the top level. We add an
environment variable to keep track of this. Because we clear the
footnotes and refs when we use them, we also add a state variable to
keep track of the starting number.
Finally, note that we still add any remaining footnotes at the end. This
takes care of the final section, if we are placing at the end of a
section, and will always come after a final block as well.
---
src/Text/Pandoc/Writers/Markdown.hs | 85 ++++++++++++++++++++++++++++---------
1 file changed, 64 insertions(+), 21 deletions(-)
(limited to 'src')
diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs
index 18c4befd3..3ad31d54a 100644
--- a/src/Text/Pandoc/Writers/Markdown.hs
+++ b/src/Text/Pandoc/Writers/Markdown.hs
@@ -70,23 +70,27 @@ evalMD md env st = evalState (runReaderT md env) st
data WriterEnv = WriterEnv { envInList :: Bool
, envPlain :: Bool
, envRefShortcutable :: Bool
+ , envBlockLevel :: Int
}
instance Default WriterEnv
where def = WriterEnv { envInList = False
, envPlain = False
, envRefShortcutable = True
+ , envBlockLevel = 0
}
data WriterState = WriterState { stNotes :: Notes
, stRefs :: Refs
, stIds :: Set.Set String
+ , stNoteNum :: Int
}
instance Default WriterState
where def = WriterState{ stNotes = []
, stRefs = []
, stIds = Set.empty
+ , stNoteNum = 1
}
-- | Convert Pandoc to Markdown.
@@ -238,9 +242,11 @@ keyToMarkdown opts (label, (src, tit), attr) = do
-- | Return markdown representation of notes.
notesToMarkdown :: WriterOptions -> [[Block]] -> MD Doc
-notesToMarkdown opts notes =
- mapM (\(num, note) -> noteToMarkdown opts num note) (zip [1..] notes) >>=
- return . vsep
+notesToMarkdown opts notes = do
+ n <- gets stNoteNum
+ notes' <- mapM (\(num, note) -> noteToMarkdown opts num note) (zip [n..] notes)
+ modify $ \st -> st { stNoteNum = stNoteNum st + length notes }
+ return $ vsep notes'
-- | Return markdown representation of a note.
noteToMarkdown :: WriterOptions -> Int -> [Block] -> MD Doc
@@ -335,15 +341,35 @@ beginsWithOrderedListMarker str =
blockToMarkdown :: WriterOptions -- ^ Options
-> Block -- ^ Block element
-> MD Doc
-blockToMarkdown _ Null = return empty
-blockToMarkdown opts (Div attrs ils) = do
+blockToMarkdown opts blk =
+ local (\env -> env {envBlockLevel = envBlockLevel env + 1}) $
+ do doc <- blockToMarkdown' opts blk
+ blkLevel <- asks envBlockLevel
+ if writerReferenceLocation opts == EndOfBlock && blkLevel == 1
+ then do st <- get
+ notes' <- notesToMarkdown opts (reverse $ stNotes st)
+ modify $ \s -> s { stNotes = [] }
+ st' <- get -- note that the notes may contain refs
+ refs' <- refsToMarkdown opts (reverse $ stRefs st')
+ modify $ \s -> s { stRefs = [] }
+ return $ doc <>
+ (if isEmpty notes' then empty else blankline <> notes') <>
+ (if isEmpty refs' then empty else blankline <> refs') <>
+ (if (isEmpty notes' && isEmpty refs') then empty else blankline)
+ else return doc
+
+blockToMarkdown' :: WriterOptions -- ^ Options
+ -> Block -- ^ Block element
+ -> MD Doc
+blockToMarkdown' _ Null = return empty
+blockToMarkdown' opts (Div attrs ils) = do
contents <- blockListToMarkdown opts ils
return $ if isEnabled Ext_raw_html opts &&
isEnabled Ext_markdown_in_html_blocks opts
then tagWithAttrs "div" attrs <> blankline <>
contents <> blankline <> "</div>" <> blankline
else contents <> blankline
-blockToMarkdown opts (Plain inlines) = do
+blockToMarkdown' opts (Plain inlines) = do
contents <- inlineListToMarkdown opts inlines
-- escape if para starts with ordered list marker
isPlain <- asks envPlain
@@ -360,11 +386,11 @@ blockToMarkdown opts (Plain inlines) = do
else contents
return $ contents' <> cr
-- title beginning with fig: indicates figure
-blockToMarkdown opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) =
+blockToMarkdown' opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) =
blockToMarkdown opts (Para [Image attr alt (src,tit)])
-blockToMarkdown opts (Para inlines) =
+blockToMarkdown' opts (Para inlines) =
(<> blankline) `fmap` blockToMarkdown opts (Plain inlines)
-blockToMarkdown opts (RawBlock f str)
+blockToMarkdown' opts (RawBlock f str)
| f == "markdown" = return $ text str <> text "\n"
| f == "html" && isEnabled Ext_raw_html opts = do
plain <- asks envPlain
@@ -379,9 +405,25 @@ blockToMarkdown opts (RawBlock f str)
then empty
else text str <> text "\n"
| otherwise = return empty
-blockToMarkdown opts HorizontalRule = do
+blockToMarkdown' opts HorizontalRule = do
return $ blankline <> text (replicate (writerColumns opts) '-') <> blankline
-blockToMarkdown opts (Header level attr inlines) = do
+blockToMarkdown' opts (Header level attr inlines) = do
+ -- first, if we're putting references at the end of a section, we
+ -- put them here.
+ blkLevel <- asks envBlockLevel
+ refs <- if writerReferenceLocation opts == EndOfSection && blkLevel == 1
+ then do st <- get
+ notes' <- notesToMarkdown opts (reverse $ stNotes st)
+ modify $ \s -> s { stNotes = [] }
+ st' <- get -- note that the notes may contain refs
+ refs' <- refsToMarkdown opts (reverse $ stRefs st')
+ modify $ \s -> s { stRefs = [] }
+ return $
+ (if isEmpty notes' then empty else blankline <> notes') <>
+ (if isEmpty refs' then empty else blankline <> refs') <>
+ (if (isEmpty notes' && isEmpty refs') then empty else blankline)
+ else return empty
+
plain <- asks envPlain
-- we calculate the id that would be used by auto_identifiers
-- so we know whether to print an explicit identifier
@@ -402,8 +444,7 @@ blockToMarkdown opts (Header level attr inlines) = do
then capitalize inlines
else inlines
let setext = writerSetextHeaders opts
- return $ nowrap
- $ case level of
+ hdr = nowrap $ case level of
1 | plain -> blanklines 3 <> contents <> blanklines 2
| setext ->
contents <> attr' <> cr <> text (replicate (offset contents) '=') <>
@@ -416,11 +457,13 @@ blockToMarkdown opts (Header level attr inlines) = do
_ | plain || isEnabled Ext_literate_haskell opts ->
contents <> blankline
_ -> text (replicate level '#') <> space <> contents <> attr' <> blankline
-blockToMarkdown opts (CodeBlock (_,classes,_) str)
+
+ return $ refs <> hdr
+blockToMarkdown' opts (CodeBlock (_,classes,_) str)
| "haskell" `elem` classes && "literate" `elem` classes &&
isEnabled Ext_literate_haskell opts =
return $ prefixed "> " (text str) <> blankline
-blockToMarkdown opts (CodeBlock attribs str) = return $
+blockToMarkdown' opts (CodeBlock attribs str) = return $
case attribs == nullAttr of
False | isEnabled Ext_backtick_code_blocks opts ->
backticks <> attrs <> cr <> text str <> cr <> backticks <> blankline
@@ -442,7 +485,7 @@ blockToMarkdown opts (CodeBlock attribs str) = return $
else case attribs of
(_,(cls:_),_) -> " " <> text cls
_ -> empty
-blockToMarkdown opts (BlockQuote blocks) = do
+blockToMarkdown' opts (BlockQuote blocks) = do
plain <- asks envPlain
-- if we're writing literate haskell, put a space before the bird tracks
-- so they won't be interpreted as lhs...
@@ -451,7 +494,7 @@ blockToMarkdown opts (BlockQuote blocks) = do
else if plain then " " else "> "
contents <- blockListToMarkdown opts blocks
return $ (prefixed leader contents) <> blankline
-blockToMarkdown opts t@(Table caption aligns widths headers rows) = do
+blockToMarkdown' opts t@(Table caption aligns widths headers rows) = do
caption' <- inlineListToMarkdown opts caption
let caption'' = if null caption || not (isEnabled Ext_table_captions opts)
then empty
@@ -485,10 +528,10 @@ blockToMarkdown opts t@(Table caption aligns widths headers rows) = do
$ Pandoc nullMeta [t]
| otherwise -> return $ (id, text "[TABLE]")
return $ nst $ tbl $$ blankline $$ caption'' $$ blankline
-blockToMarkdown opts (BulletList items) = do
+blockToMarkdown' opts (BulletList items) = do
contents <- inList $ mapM (bulletListItemToMarkdown opts) items
return $ cat contents <> blankline
-blockToMarkdown opts (OrderedList (start,sty,delim) items) = do
+blockToMarkdown' opts (OrderedList (start,sty,delim) items) = do
let start' = if isEnabled Ext_startnum opts then start else 1
let sty' = if isEnabled Ext_fancy_lists opts then sty else DefaultStyle
let delim' = if isEnabled Ext_fancy_lists opts then delim else DefaultDelim
@@ -501,7 +544,7 @@ blockToMarkdown opts (OrderedList (start,sty,delim) items) = do
mapM (\(item, num) -> orderedListItemToMarkdown opts item num) $
zip markers' items
return $ cat contents <> blankline
-blockToMarkdown opts (DefinitionList items) = do
+blockToMarkdown' opts (DefinitionList items) = do
contents <- inList $ mapM (definitionListItemToMarkdown opts) items
return $ cat contents <> blankline
@@ -1009,7 +1052,7 @@ inlineToMarkdown opts img@(Image attr alternate (source, tit))
inlineToMarkdown opts (Note contents) = do
modify (\st -> st{ stNotes = contents : stNotes st })
st <- get
- let ref = text $ writerIdentifierPrefix opts ++ show (length $ stNotes st)
+ let ref = text $ writerIdentifierPrefix opts ++ show (stNoteNum st + (length $ stNotes st) - 1)
if isEnabled Ext_footnotes opts
then return $ "[^" <> ref <> "]"
else return $ "[" <> ref <> "]"
--
cgit v1.2.3