From 27113bda1f4858ac8ada423391d053450dada175 Mon Sep 17 00:00:00 2001 From: Jesse Rosenthal Date: Tue, 11 Oct 2016 13:10:59 -0400 Subject: 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. -- cgit v1.2.3 From 6914808139262061539736df2dc835e42f6a0ba4 Mon Sep 17 00:00:00 2001 From: Jesse Rosenthal Date: Tue, 11 Oct 2016 13:53:47 -0400 Subject: 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 "" 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 ""] -- cgit v1.2.3 From ca50deeeeee3bf0900cb91d39671d8dc5aaceb1b Mon Sep 17 00:00:00 2001 From: Jesse Rosenthal 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(-) 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 <> "" <> 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 From 14209b2ba0266f1d0aee8bfdfe01a561142930c1 Mon Sep 17 00:00:00 2001 From: Jesse Rosenthal Date: Tue, 11 Oct 2016 15:07:10 -0400 Subject: 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, -- cgit v1.2.3 From 4b0dbdc11822aa57fcd8b96d6e0be5b645d33a87 Mon Sep 17 00:00:00 2001 From: Jesse Rosenthal Date: Tue, 11 Oct 2016 22:26:03 -0400 Subject: 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)" -- cgit v1.2.3 From afbeba952ded73c5ad400f82c51e58edde83a579 Mon Sep 17 00:00:00 2001 From: Jesse Rosenthal Date: Tue, 11 Oct 2016 22:30:13 -0400 Subject: 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 -- cgit v1.2.3