From 27113bda1f4858ac8ada423391d053450dada175 Mon Sep 17 00:00:00 2001
From: Jesse Rosenthal <jrosenthal@jhu.edu>
Date: Tue, 11 Oct 2016 13:10:59 -0400
Subject: [PATCH 1/6] Options: Add references location.
This will be used by the markdown writer for deciding where to put links
and footnotes.
---
src/Text/Pandoc/Options.hs | 9 +++++++++
1 file changed, 9 insertions(+)
diff --git a/src/Text/Pandoc/Options.hs b/src/Text/Pandoc/Options.hs
index 1aa07515e..39d314974 100644
--- a/src/Text/Pandoc/Options.hs
+++ b/src/Text/Pandoc/Options.hs
@@ -45,6 +45,7 @@ module Text.Pandoc.Options ( Extension(..)
, WrapOption (..)
, WriterOptions (..)
, TrackChanges (..)
+ , ReferenceLocation (..)
, def
, isEnabled
) where
@@ -336,6 +337,12 @@ data WrapOption = WrapAuto -- ^ Automatically wrap to width
| WrapPreserve -- ^ Preserve wrapping of input source
deriving (Show, Read, Eq, Data, Typeable, Generic)
+-- | Locations for footnotes and references in markdown output
+data ReferenceLocation = EndOfBlock -- ^ End of block
+ | EndOfSection -- ^ prior to next section header (or end of document)
+ | EndOfDocument -- ^ at end of document
+ deriving (Show, Read, Eq, Data, Typeable, Generic)
+
-- | Options for writers
data WriterOptions = WriterOptions
{ writerStandalone :: Bool -- ^ Include header and footer
@@ -383,6 +390,7 @@ data WriterOptions = WriterOptions
, writerMediaBag :: MediaBag -- ^ Media collected by docx or epub reader
, writerVerbose :: Bool -- ^ Verbose debugging output
, writerLaTeXArgs :: [String] -- ^ Flags to pass to latex-engine
+ , writerReferenceLocation :: ReferenceLocation -- ^ Location of footnotes and references for writing markdown
} deriving (Show, Data, Typeable, Generic)
instance Default WriterOptions where
@@ -430,6 +438,7 @@ instance Default WriterOptions where
, writerMediaBag = mempty
, writerVerbose = False
, writerLaTeXArgs = []
+ , writerReferenceLocation = EndOfDocument
}
-- | Returns True if the given extension is enabled.
From 6914808139262061539736df2dc835e42f6a0ba4 Mon Sep 17 00:00:00 2001
From: Jesse Rosenthal <jrosenthal@jhu.edu>
Date: Tue, 11 Oct 2016 13:53:47 -0400
Subject: [PATCH 2/6] Add ReaderT monad for environment variables.
This will make it easier to keep track of what level of block we are at.
---
src/Text/Pandoc/Writers/Markdown.hs | 142 +++++++++++++++-------------
1 file changed, 78 insertions(+), 64 deletions(-)
diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs
index addcdf6a1..18c4befd3 100644
--- a/src/Text/Pandoc/Writers/Markdown.hs
+++ b/src/Text/Pandoc/Writers/Markdown.hs
@@ -44,6 +44,7 @@ import Data.List ( group, stripPrefix, find, intersperse, transpose, sortBy )
import Data.Char ( isSpace, isPunctuation, ord, chr )
import Data.Ord ( comparing )
import Text.Pandoc.Pretty
+import Control.Monad.Reader
import Control.Monad.State
import Text.Pandoc.Writers.HTML (writeHtmlString)
import Text.Pandoc.Readers.TeXMath (texMathToInlines)
@@ -60,30 +61,48 @@ import Network.HTTP ( urlEncode )
type Notes = [[Block]]
type Ref = ([Inline], Target, Attr)
type Refs = [Ref]
-data WriterState = WriterState { stNotes :: Notes
- , stRefs :: Refs
- , stRefShortcutable :: Bool
- , stInList :: Bool
- , stIds :: Set.Set String
- , stPlain :: Bool }
+
+type MD = ReaderT WriterEnv (State WriterState)
+
+evalMD :: MD a -> WriterEnv -> WriterState -> a
+evalMD md env st = evalState (runReaderT md env) st
+
+data WriterEnv = WriterEnv { envInList :: Bool
+ , envPlain :: Bool
+ , envRefShortcutable :: Bool
+ }
+
+instance Default WriterEnv
+ where def = WriterEnv { envInList = False
+ , envPlain = False
+ , envRefShortcutable = True
+ }
+
+data WriterState = WriterState { stNotes :: Notes
+ , stRefs :: Refs
+ , stIds :: Set.Set String
+ }
+
instance Default WriterState
- where def = WriterState{ stNotes = [], stRefs = [], stRefShortcutable = True,
- stInList = False, stIds = Set.empty, stPlain = False }
+ where def = WriterState{ stNotes = []
+ , stRefs = []
+ , stIds = Set.empty
+ }
-- | Convert Pandoc to Markdown.
writeMarkdown :: WriterOptions -> Pandoc -> String
writeMarkdown opts document =
- evalState (pandocToMarkdown opts{
- writerWrapText = if isEnabled Ext_hard_line_breaks opts
- then WrapNone
- else writerWrapText opts }
- document) def
+ evalMD (pandocToMarkdown opts{
+ writerWrapText = if isEnabled Ext_hard_line_breaks opts
+ then WrapNone
+ else writerWrapText opts }
+ document) def def
-- | Convert Pandoc to plain text (like markdown, but without links,
-- pictures, or inline formatting).
writePlain :: WriterOptions -> Pandoc -> String
writePlain opts document =
- evalState (pandocToMarkdown opts document) def{ stPlain = True }
+ evalMD (pandocToMarkdown opts document) def{ envPlain = True } def
pandocTitleBlock :: Doc -> [Doc] -> Doc -> Doc
pandocTitleBlock tit auths dat =
@@ -146,12 +165,12 @@ jsonToYaml (Number n) = text $ show n
jsonToYaml _ = empty
-- | Return markdown representation of document.
-pandocToMarkdown :: WriterOptions -> Pandoc -> State WriterState String
+pandocToMarkdown :: WriterOptions -> Pandoc -> MD String
pandocToMarkdown opts (Pandoc meta blocks) = do
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
- isPlain <- gets stPlain
+ isPlain <- asks envPlain
metadata <- metaToJSON opts
(fmap (render colwidth) . blockListToMarkdown opts)
(fmap (render colwidth) . inlineListToMarkdown opts)
@@ -201,13 +220,13 @@ pandocToMarkdown opts (Pandoc meta blocks) = do
else return main
-- | Return markdown representation of reference key table.
-refsToMarkdown :: WriterOptions -> Refs -> State WriterState Doc
+refsToMarkdown :: WriterOptions -> Refs -> MD Doc
refsToMarkdown opts refs = mapM (keyToMarkdown opts) refs >>= return . vcat
-- | Return markdown representation of a reference key.
keyToMarkdown :: WriterOptions
-> Ref
- -> State WriterState Doc
+ -> MD Doc
keyToMarkdown opts (label, (src, tit), attr) = do
label' <- inlineListToMarkdown opts label
let tit' = if null tit
@@ -218,13 +237,13 @@ keyToMarkdown opts (label, (src, tit), attr) = do
<> linkAttributes opts attr
-- | Return markdown representation of notes.
-notesToMarkdown :: WriterOptions -> [[Block]] -> State WriterState Doc
+notesToMarkdown :: WriterOptions -> [[Block]] -> MD Doc
notesToMarkdown opts notes =
mapM (\(num, note) -> noteToMarkdown opts num note) (zip [1..] notes) >>=
return . vsep
-- | Return markdown representation of a note.
-noteToMarkdown :: WriterOptions -> Int -> [Block] -> State WriterState Doc
+noteToMarkdown :: WriterOptions -> Int -> [Block] -> MD Doc
noteToMarkdown opts num blocks = do
contents <- blockListToMarkdown opts blocks
let num' = text $ writerIdentifierPrefix opts ++ show num
@@ -261,7 +280,7 @@ tableOfContents :: WriterOptions -> [Block] -> Doc
tableOfContents opts headers =
let opts' = opts { writerIgnoreNotes = True }
contents = BulletList $ map (elementToListItem opts) $ hierarchicalize headers
- in evalState (blockToMarkdown opts' contents) def
+ in evalMD (blockToMarkdown opts' contents) def def
-- | Converts an Element to a list item for a table of contents,
elementToListItem :: WriterOptions -> Element -> [Block]
@@ -315,7 +334,7 @@ beginsWithOrderedListMarker str =
-- | Convert Pandoc block element to markdown.
blockToMarkdown :: WriterOptions -- ^ Options
-> Block -- ^ Block element
- -> State WriterState Doc
+ -> MD Doc
blockToMarkdown _ Null = return empty
blockToMarkdown opts (Div attrs ils) = do
contents <- blockListToMarkdown opts ils
@@ -327,7 +346,7 @@ blockToMarkdown opts (Div attrs ils) = do
blockToMarkdown opts (Plain inlines) = do
contents <- inlineListToMarkdown opts inlines
-- escape if para starts with ordered list marker
- st <- get
+ isPlain <- asks envPlain
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
@@ -336,7 +355,7 @@ blockToMarkdown opts (Plain inlines) = do
| otherwise = x : escapeDelimiter xs
escapeDelimiter [] = []
let contents' = if isEnabled Ext_all_symbols_escapable opts &&
- not (stPlain st) && beginsWithOrderedListMarker rendered
+ not isPlain && beginsWithOrderedListMarker rendered
then text $ escapeDelimiter rendered
else contents
return $ contents' <> cr
@@ -348,14 +367,14 @@ blockToMarkdown opts (Para inlines) =
blockToMarkdown opts (RawBlock f str)
| f == "markdown" = return $ text str <> text "\n"
| f == "html" && isEnabled Ext_raw_html opts = do
- plain <- gets stPlain
+ plain <- asks envPlain
return $ if plain
then empty
else if isEnabled Ext_markdown_attribute opts
then text (addMarkdownAttribute str) <> text "\n"
else text str <> text "\n"
| f `elem` ["latex", "tex"] && isEnabled Ext_raw_tex opts = do
- plain <- gets stPlain
+ plain <- asks envPlain
return $ if plain
then empty
else text str <> text "\n"
@@ -363,7 +382,7 @@ blockToMarkdown opts (RawBlock f str)
blockToMarkdown opts HorizontalRule = do
return $ blankline <> text (replicate (writerColumns opts) '-') <> blankline
blockToMarkdown opts (Header level attr inlines) = do
- plain <- gets stPlain
+ plain <- asks envPlain
-- we calculate the id that would be used by auto_identifiers
-- so we know whether to print an explicit identifier
ids <- gets stIds
@@ -424,7 +443,7 @@ blockToMarkdown opts (CodeBlock attribs str) = return $
(_,(cls:_),_) -> " " <> text cls
_ -> empty
blockToMarkdown opts (BlockQuote blocks) = do
- plain <- gets stPlain
+ plain <- asks envPlain
-- if we're writing literate haskell, put a space before the bird tracks
-- so they won't be interpreted as lhs...
let leader = if isEnabled Ext_literate_haskell opts
@@ -486,13 +505,8 @@ blockToMarkdown opts (DefinitionList items) = do
contents <- inList $ mapM (definitionListItemToMarkdown opts) items
return $ cat contents <> blankline
-inList :: State WriterState a -> State WriterState a
-inList p = do
- oldInList <- gets stInList
- modify $ \st -> st{ stInList = True }
- res <- p
- modify $ \st -> st{ stInList = oldInList }
- return res
+inList :: MD a -> MD a
+inList p = local (\env -> env {envInList = True}) p
addMarkdownAttribute :: String -> String
addMarkdownAttribute s =
@@ -503,7 +517,7 @@ addMarkdownAttribute s =
x /= "markdown"]
_ -> s
-pipeTable :: Bool -> [Alignment] -> [Doc] -> [[Doc]] -> State WriterState Doc
+pipeTable :: Bool -> [Alignment] -> [Doc] -> [[Doc]] -> MD Doc
pipeTable headless aligns rawHeaders rawRows = do
let sp = text " "
let blockFor AlignLeft x y = lblock (x + 2) (sp <> y) <> lblock 0 empty
@@ -532,7 +546,7 @@ pipeTable headless aligns rawHeaders rawRows = do
return $ header $$ border $$ body
pandocTable :: WriterOptions -> Bool -> [Alignment] -> [Double]
- -> [Doc] -> [[Doc]] -> State WriterState Doc
+ -> [Doc] -> [[Doc]] -> MD Doc
pandocTable opts headless aligns widths rawHeaders rawRows = do
let isSimple = all (==0) widths
let alignHeader alignment = case alignment of
@@ -572,7 +586,7 @@ pandocTable opts headless aligns widths rawHeaders rawRows = do
return $ head'' $$ underline $$ body $$ bottom
gridTable :: WriterOptions -> Bool -> [Alignment] -> [Double]
- -> [Doc] -> [[Doc]] -> State WriterState Doc
+ -> [Doc] -> [[Doc]] -> MD Doc
gridTable opts headless _aligns widths headers' rawRows = do
let numcols = length headers'
let widths' = if all (==0) widths
@@ -599,7 +613,7 @@ gridTable opts headless _aligns widths headers' rawRows = do
return $ border '-' $$ head'' $$ body $$ border '-'
-- | Convert bullet list item (list of blocks) to markdown.
-bulletListItemToMarkdown :: WriterOptions -> [Block] -> State WriterState Doc
+bulletListItemToMarkdown :: WriterOptions -> [Block] -> MD Doc
bulletListItemToMarkdown opts items = do
contents <- blockListToMarkdown opts items
let sps = replicate (writerTabStop opts - 2) ' '
@@ -617,7 +631,7 @@ bulletListItemToMarkdown opts items = do
orderedListItemToMarkdown :: WriterOptions -- ^ options
-> String -- ^ list item marker
-> [Block] -- ^ list item (list of blocks)
- -> State WriterState Doc
+ -> MD Doc
orderedListItemToMarkdown opts marker items = do
contents <- blockListToMarkdown opts items
let sps = case length marker - writerTabStop opts of
@@ -629,15 +643,15 @@ orderedListItemToMarkdown opts marker items = do
-- | Convert definition list item (label, list of blocks) to markdown.
definitionListItemToMarkdown :: WriterOptions
-> ([Inline],[[Block]])
- -> State WriterState Doc
+ -> MD Doc
definitionListItemToMarkdown opts (label, defs) = do
labelText <- inlineListToMarkdown opts label
defs' <- mapM (mapM (blockToMarkdown opts)) defs
if isEnabled Ext_definition_lists opts
then do
let tabStop = writerTabStop opts
- st <- get
- let leader = if stPlain st then " " else ": "
+ isPlain <- asks envPlain
+ let leader = if isPlain then " " else ": "
let sps = case writerTabStop opts - 3 of
n | n > 0 -> text $ replicate n ' '
_ -> text " "
@@ -661,7 +675,7 @@ definitionListItemToMarkdown opts (label, defs) = do
-- | Convert list of Pandoc block elements to markdown.
blockListToMarkdown :: WriterOptions -- ^ Options
-> [Block] -- ^ List of block elements
- -> State WriterState Doc
+ -> MD Doc
blockListToMarkdown opts blocks =
mapM (blockToMarkdown opts) (fixBlocks blocks) >>= return . cat
-- insert comment between list and indented code block, or the
@@ -688,7 +702,7 @@ blockListToMarkdown opts blocks =
-- | Get reference for target; if none exists, create unique one and return.
-- Prefer label if possible; otherwise, generate a unique key.
-getReference :: Attr -> [Inline] -> Target -> State WriterState [Inline]
+getReference :: Attr -> [Inline] -> Target -> MD [Inline]
getReference attr label target = do
st <- get
case find (\(_,t,a) -> t == target && a == attr) (stRefs st) of
@@ -706,9 +720,9 @@ getReference attr label target = do
return label'
-- | Convert list of Pandoc inline elements to markdown.
-inlineListToMarkdown :: WriterOptions -> [Inline] -> State WriterState Doc
+inlineListToMarkdown :: WriterOptions -> [Inline] -> MD Doc
inlineListToMarkdown opts lst = do
- inlist <- gets stInList
+ inlist <- asks envInList
go (if inlist then avoidBadWrapsInList lst else lst)
where go [] = return empty
go (i:is) = case i of
@@ -731,9 +745,9 @@ inlineListToMarkdown opts lst = do
_ -> shortcutable
where shortcutable = liftM2 (<>) (inlineToMarkdown opts i) (go is)
unshortcutable = do
- iMark <- withState (\s -> s { stRefShortcutable = False })
- (inlineToMarkdown opts i)
- modify (\s -> s {stRefShortcutable = True })
+ iMark <- local
+ (\env -> env { envRefShortcutable = False })
+ (inlineToMarkdown opts i)
fmap (iMark <>) (go is)
isSp :: Inline -> Bool
@@ -773,22 +787,22 @@ escapeSpaces SoftBreak = Str "\\ "
escapeSpaces x = x
-- | Convert Pandoc inline element to markdown.
-inlineToMarkdown :: WriterOptions -> Inline -> State WriterState Doc
+inlineToMarkdown :: WriterOptions -> Inline -> MD Doc
inlineToMarkdown opts (Span attrs ils) = do
- plain <- gets stPlain
+ plain <- asks envPlain
contents <- inlineListToMarkdown opts ils
return $ if not plain &&
(isEnabled Ext_raw_html opts || isEnabled Ext_native_spans opts)
then tagWithAttrs "span" attrs <> contents <> text "</span>"
else contents
inlineToMarkdown opts (Emph lst) = do
- plain <- gets stPlain
+ plain <- asks envPlain
contents <- inlineListToMarkdown opts lst
return $ if plain
then "_" <> contents <> "_"
else "*" <> contents <> "*"
inlineToMarkdown opts (Strong lst) = do
- plain <- gets stPlain
+ plain <- asks envPlain
if plain
then inlineListToMarkdown opts $ capitalize lst
else do
@@ -827,7 +841,7 @@ inlineToMarkdown opts (Subscript lst) = do
_ -> contents
where toSubscript c = chr (0x2080 + (ord c - 48))
inlineToMarkdown opts (SmallCaps lst) = do
- plain <- gets stPlain
+ plain <- asks envPlain
if not plain &&
(isEnabled Ext_raw_html opts || isEnabled Ext_native_spans opts)
then do
@@ -852,13 +866,13 @@ inlineToMarkdown opts (Code attr str) = do
let attrs = if isEnabled Ext_inline_code_attributes opts && attr /= nullAttr
then attrsToMarkdown attr
else empty
- plain <- gets stPlain
+ plain <- asks envPlain
if plain
then return $ text str
else return $ text (marker ++ spacer ++ str ++ spacer ++ marker) <> attrs
inlineToMarkdown opts (Str str) = do
- st <- get
- if stPlain st
+ isPlain <- asks envPlain
+ if isPlain
then return $ text str
else return $ text $ escapeString opts str
inlineToMarkdown opts (Math InlineMath str) =
@@ -873,7 +887,7 @@ inlineToMarkdown opts (Math InlineMath str) =
| isEnabled Ext_tex_math_double_backslash opts ->
return $ "\\\\(" <> text str <> "\\\\)"
| otherwise -> do
- plain <- gets stPlain
+ plain <- asks envPlain
inlineListToMarkdown opts $
(if plain then makeMathPlainer else id) $
texMathToInlines InlineMath str
@@ -887,7 +901,7 @@ inlineToMarkdown opts (Math DisplayMath str)
| otherwise = (\x -> cr <> x <> cr) `fmap`
inlineListToMarkdown opts (texMathToInlines DisplayMath str)
inlineToMarkdown opts (RawInline f str) = do
- plain <- gets stPlain
+ plain <- asks envPlain
if not plain &&
( f == "markdown" ||
(isEnabled Ext_raw_tex opts && (f == "latex" || f == "tex")) ||
@@ -895,7 +909,7 @@ inlineToMarkdown opts (RawInline f str) = do
then return $ text str
else return empty
inlineToMarkdown opts (LineBreak) = do
- plain <- gets stPlain
+ plain <- asks envPlain
if plain || isEnabled Ext_hard_line_breaks opts
then return cr
else return $
@@ -944,7 +958,7 @@ inlineToMarkdown opts lnk@(Link attr txt (src, tit))
attr /= nullAttr = -- use raw HTML
return $ text $ trim $ writeHtmlString def $ Pandoc nullMeta [Plain [lnk]]
| otherwise = do
- plain <- gets stPlain
+ plain <- asks envPlain
linktext <- inlineListToMarkdown opts txt
let linktitle = if null tit
then empty
@@ -955,7 +969,7 @@ inlineToMarkdown opts lnk@(Link attr txt (src, tit))
[Str s] | escapeURI s == srcSuffix -> True
_ -> False
let useRefLinks = writerReferenceLinks opts && not useAuto
- shortcutable <- gets stRefShortcutable
+ shortcutable <- asks envRefShortcutable
let useShortcutRefLinks = shortcutable &&
isEnabled Ext_shortcut_reference_links opts
ref <- if useRefLinks then getReference attr txt (src, tit) else return []
@@ -983,7 +997,7 @@ inlineToMarkdown opts img@(Image attr alternate (source, tit))
attr /= nullAttr = -- use raw HTML
return $ text $ trim $ writeHtmlString def $ Pandoc nullMeta [Plain [img]]
| otherwise = do
- plain <- gets stPlain
+ plain <- asks envPlain
let txt = if null alternate || alternate == [Str source]
-- to prevent autolinks
then [Str ""]
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: [PATCH 3/6] 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(-)
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 <> "]"
From 14209b2ba0266f1d0aee8bfdfe01a561142930c1 Mon Sep 17 00:00:00 2001
From: Jesse Rosenthal <jrosenthal@jhu.edu>
Date: Tue, 11 Oct 2016 15:07:10 -0400
Subject: [PATCH 4/6] Add reference-location options to executable.
---
pandoc.hs | 17 +++++++++++++++++
1 file changed, 17 insertions(+)
diff --git a/pandoc.hs b/pandoc.hs
index 9b05e3ea7..c574b39a5 100644
--- a/pandoc.hs
+++ b/pandoc.hs
@@ -196,6 +196,7 @@ data Opt = Opt
, optIgnoreArgs :: Bool -- ^ Ignore command-line arguments
, optVerbose :: Bool -- ^ Verbose diagnostic output
, optReferenceLinks :: Bool -- ^ Use reference links in writing markdown, rst
+ , optReferenceLocation :: ReferenceLocation -- ^ location for footnotes and link references in markdown output
, optDpi :: Int -- ^ Dpi
, optWrapText :: WrapOption -- ^ Options for wrapping text
, optColumns :: Int -- ^ Line length in characters
@@ -260,6 +261,7 @@ defaultOpts = Opt
, optIgnoreArgs = False
, optVerbose = False
, optReferenceLinks = False
+ , optReferenceLocation = EndOfDocument
, optDpi = 96
, optWrapText = WrapAuto
, optColumns = 72
@@ -584,6 +586,19 @@ options =
(\opt -> return opt { optReferenceLinks = True } ))
"" -- "Use reference links in parsing HTML"
+ , Option "" ["reference-location"]
+ (ReqArg
+ (\arg opt -> do
+ action <- case arg of
+ "block" -> return EndOfBlock
+ "section" -> return EndOfSection
+ "document" -> return EndOfDocument
+ _ -> err 6
+ ("Unknown option for reference-location: " ++ arg)
+ return opt { optReferenceLocation = action })
+ "block|section|document")
+ "" -- "Accepting or reject MS Word track-changes.""
+
, Option "" ["atx-headers"]
(NoArg
(\opt -> return opt { optSetextHeaders = False } ))
@@ -1120,6 +1135,7 @@ convertWithOpts opts args = do
, optIgnoreArgs = ignoreArgs
, optVerbose = verbose
, optReferenceLinks = referenceLinks
+ , optReferenceLocation = referenceLocation
, optDpi = dpi
, optWrapText = wrap
, optColumns = columns
@@ -1360,6 +1376,7 @@ convertWithOpts opts args = do
writerNumberOffset = numberFrom,
writerSectionDivs = sectionDivs,
writerReferenceLinks = referenceLinks,
+ writerReferenceLocation = referenceLocation,
writerDpi = dpi,
writerWrapText = wrap,
writerColumns = columns,
From 4b0dbdc11822aa57fcd8b96d6e0be5b645d33a87 Mon Sep 17 00:00:00 2001
From: Jesse Rosenthal <jrosenthal@jhu.edu>
Date: Tue, 11 Oct 2016 22:26:03 -0400
Subject: [PATCH 5/6] Markdown writer: add test for note placement.
---
tests/Tests/Writers/Markdown.hs | 140 +++++++++++++++++++++++++++++++-
1 file changed, 138 insertions(+), 2 deletions(-)
diff --git a/tests/Tests/Writers/Markdown.hs b/tests/Tests/Writers/Markdown.hs
index 1c27ebdf4..cfc5f8410 100644
--- a/tests/Tests/Writers/Markdown.hs
+++ b/tests/Tests/Writers/Markdown.hs
@@ -11,6 +11,9 @@ import Tests.Arbitrary()
markdown :: (ToPandoc a) => a -> String
markdown = writeMarkdown def . toPandoc
+markdownWithOpts :: (ToPandoc a) => WriterOptions -> a -> String
+markdownWithOpts opts x = writeMarkdown opts $ toPandoc x
+
{-
"my test" =: X =?> Y
@@ -36,13 +39,146 @@ tests = [ "indented code after list"
=: bulletList [ plain "foo" <> bulletList [ plain "bar" ],
plain "baz" ]
=?> "- foo\n - bar\n- baz\n"
- ] ++ [shortcutLinkRefsTests]
+ ] ++ [noteTests] ++ [shortcutLinkRefsTests]
+
+{-
+
+Testing with the following text:
+
+First Header
+============
+
+This is a footnote.[^1] And this is a [link](https://www.google.com).
+
+> A note inside a block quote.[^2]
+>
+> A second paragraph.
+
+Second Header
+=============
+
+Some more text.
+
+
+[^1]: Down here.
+
+[^2]: The second note.
+
+-}
+
+noteTestDoc :: Blocks
+noteTestDoc =
+ header 1 "First Header" <>
+ para ("This is a footnote." <>
+ note (para "Down here.") <>
+ " And this is a " <>
+ link "https://www.google.com" "" "link" <>
+ ".") <>
+ blockQuote (para ("A note inside a block quote." <>
+ note (para "The second note.")) <>
+ para ("A second paragraph.")) <>
+ header 1 "Second Header" <>
+ para "Some more text."
+
+
+
+noteTests :: Test
+noteTests = testGroup "note and reference location"
+ [ test (markdownWithOpts def)
+ "footnotes at the end of a document" $
+ noteTestDoc =?>
+ (unlines $ [ "First Header"
+ , "============"
+ , ""
+ , "This is a footnote.[^1] And this is a [link](https://www.google.com)."
+ , ""
+ , "> A note inside a block quote.[^2]"
+ , ">"
+ , "> A second paragraph."
+ , ""
+ , "Second Header"
+ , "============="
+ , ""
+ , "Some more text."
+ , ""
+ , "[^1]: Down here."
+ , ""
+ , "[^2]: The second note."
+ ])
+ , test (markdownWithOpts def{writerReferenceLocation=EndOfBlock})
+ "footnotes at the end of blocks" $
+ noteTestDoc =?>
+ (unlines $ [ "First Header"
+ , "============"
+ , ""
+ , "This is a footnote.[^1] And this is a [link](https://www.google.com)."
+ , ""
+ , "[^1]: Down here."
+ , ""
+ , "> A note inside a block quote.[^2]"
+ , ">"
+ , "> A second paragraph."
+ , ""
+ , "[^2]: The second note."
+ , ""
+ , "Second Header"
+ , "============="
+ , ""
+ , "Some more text."
+ ])
+ , test (markdownWithOpts def{writerReferenceLocation=EndOfBlock, writerReferenceLinks=True})
+ "footnotes and reference links at the end of blocks" $
+ noteTestDoc =?>
+ (unlines $ [ "First Header"
+ , "============"
+ , ""
+ , "This is a footnote.[^1] And this is a [link]."
+ , ""
+ , "[^1]: Down here."
+ , ""
+ , " [link]: https://www.google.com"
+ , ""
+ , "> A note inside a block quote.[^2]"
+ , ">"
+ , "> A second paragraph."
+ , ""
+ , "[^2]: The second note."
+ , ""
+ , "Second Header"
+ , "============="
+ , ""
+ , "Some more text."
+ ])
+ , test (markdownWithOpts def{writerReferenceLocation=EndOfSection})
+ "footnotes at the end of section" $
+ noteTestDoc =?>
+ (unlines $ [ "First Header"
+ , "============"
+ , ""
+ , "This is a footnote.[^1] And this is a [link](https://www.google.com)."
+ , ""
+ , "> A note inside a block quote.[^2]"
+ , ">"
+ , "> A second paragraph."
+ , ""
+ , "[^1]: Down here."
+ , ""
+ , "[^2]: The second note."
+ , ""
+ , "Second Header"
+ , "============="
+ , ""
+ , "Some more text."
+ ])
+
+ ]
shortcutLinkRefsTests :: Test
shortcutLinkRefsTests =
let infix 4 =:
(=:) :: (ToString a, ToPandoc a)
- => String -> (a, String) -> Test
+
+ => String -> (a, String) -> Test
(=:) = test (writeMarkdown (def {writerReferenceLinks = True}) . toPandoc)
in testGroup "Shortcut reference links"
[ "Simple link (shortcutable)"
From afbeba952ded73c5ad400f82c51e58edde83a579 Mon Sep 17 00:00:00 2001
From: Jesse Rosenthal <jrosenthal@jhu.edu>
Date: Tue, 11 Oct 2016 22:30:13 -0400
Subject: [PATCH 6/6] MANUAL.txt: document --reference-location.
---
MANUAL.txt | 7 +++++++
1 file changed, 7 insertions(+)
diff --git a/MANUAL.txt b/MANUAL.txt
index 5c6217861..f867ad78f 100644
--- a/MANUAL.txt
+++ b/MANUAL.txt
@@ -645,6 +645,13 @@ Options affecting specific writers
: Use reference-style links, rather than inline links, in writing Markdown
or reStructuredText. By default inline links are used.
+`--reference-location = block` | `section` | `document`
+
+: Specify whether footnotes (and references, if `reference-links` is
+ set) are placed at the end of the current (top-level) block, the
+ current section, or the document. The default is
+ `document`. Currently only affects the markdown writer.
+
`--atx-headers`
: Use ATX-style headers in Markdown and asciidoc output. The default is