@@ -44,6 +44,7 @@ import Data.List ( group, stripPrefix, find, intersperse, transpose, sortBy )
4444import Data.Char ( isSpace, isPunctuation, ord, chr )
4545import Data.Ord ( comparing )
4646import Text.Pandoc.Pretty
47+import Control.Monad.Reader
4748import Control.Monad.State
4849import Text.Pandoc.Writers.HTML (writeHtmlString)
4950import Text.Pandoc.Readers.TeXMath (texMathToInlines)
@@ -60,30 +61,48 @@ import Network.HTTP ( urlEncode )
6061type Notes = [[Block]]
6162type Ref = ([Inline], Target, Attr)
6263type Refs = [Ref]
63−data WriterState = WriterState { stNotes :: Notes
64− , stRefs :: Refs
65− , stRefShortcutable :: Bool
66− , stInList :: Bool
67− , stIds :: Set.Set String
68− , stPlain :: Bool }
64+
65+type MD = ReaderT WriterEnv (State WriterState)
66+
67+evalMD :: MD a -> WriterEnv -> WriterState -> a
68+evalMD md env st = evalState (runReaderT md env) st
69+
70+data WriterEnv = WriterEnv { envInList :: Bool
71+ , envPlain :: Bool
72+ , envRefShortcutable :: Bool
73+ }
74+
75+instance Default WriterEnv
76+ where def = WriterEnv { envInList = False
77+ , envPlain = False
78+ , envRefShortcutable = True
79+ }
80+
81+data WriterState = WriterState { stNotes :: Notes
82+ , stRefs :: Refs
83+ , stIds :: Set.Set String
84+ }
85+
6986instance Default WriterState
70− where def = WriterState{ stNotes = [], stRefs = [], stRefShortcutable = True,
71− stInList = False, stIds = Set.empty, stPlain = False }
87+ where def = WriterState{ stNotes = []
88+ , stRefs = []
89+ , stIds = Set.empty
90+ }
7291
7392-- | Convert Pandoc to Markdown.
7493writeMarkdown :: WriterOptions -> Pandoc -> String
7594writeMarkdown opts document =
76− evalState (pandocToMarkdown opts{
77− writerWrapText = if isEnabled Ext_hard_line_breaks opts
78− then WrapNone
79− else writerWrapText opts }
80− document) def
95+ evalMD (pandocToMarkdown opts{
96+ writerWrapText = if isEnabled Ext_hard_line_breaks opts
97+ then WrapNone
98+ else writerWrapText opts }
99+ document) def def
81100
82101-- | Convert Pandoc to plain text (like markdown, but without links,
83102-- pictures, or inline formatting).
84103writePlain :: WriterOptions -> Pandoc -> String
85104writePlain opts document =
86− evalState (pandocToMarkdown opts document) def{ stPlain = True }
105+ evalMD (pandocToMarkdown opts document) def{ envPlain = True } def
87106
88107pandocTitleBlock :: Doc -> [Doc] -> Doc -> Doc
89108pandocTitleBlock tit auths dat =
@@ -146,12 +165,12 @@ jsonToYaml (Number n) = text $ show n
146165jsonToYaml _ = empty
147166
148167-- | Return markdown representation of document.
149−pandocToMarkdown :: WriterOptions -> Pandoc -> State WriterState String
168+pandocToMarkdown :: WriterOptions -> Pandoc -> MD String
150169pandocToMarkdown opts (Pandoc meta blocks) = do
151170 let colwidth = if writerWrapText opts == WrapAuto
152171 then Just $ writerColumns opts
153172 else Nothing
154− isPlain <- gets stPlain
173+ isPlain <- asks envPlain
155174 metadata <- metaToJSON opts
156175 (fmap (render colwidth) . blockListToMarkdown opts)
157176 (fmap (render colwidth) . inlineListToMarkdown opts)
@@ -201,13 +220,13 @@ pandocToMarkdown opts (Pandoc meta blocks) = do
201220 else return main
202221
203222-- | Return markdown representation of reference key table.
204−refsToMarkdown :: WriterOptions -> Refs -> State WriterState Doc
223+refsToMarkdown :: WriterOptions -> Refs -> MD Doc
205224refsToMarkdown opts refs = mapM (keyToMarkdown opts) refs >>= return . vcat
206225
207226-- | Return markdown representation of a reference key.
208227keyToMarkdown :: WriterOptions
209228 -> Ref
210− -> State WriterState Doc
229+ -> MD Doc
211230keyToMarkdown opts (label, (src, tit), attr) = do
212231 label' <- inlineListToMarkdown opts label
213232 let tit' = if null tit
@@ -218,13 +237,13 @@ keyToMarkdown opts (label, (src, tit), attr) = do
218237 <> linkAttributes opts attr
219238
220239-- | Return markdown representation of notes.
221−notesToMarkdown :: WriterOptions -> [[Block]] -> State WriterState Doc
240+notesToMarkdown :: WriterOptions -> [[Block]] -> MD Doc
222241notesToMarkdown opts notes =
223242 mapM (\(num, note) -> noteToMarkdown opts num note) (zip [1..] notes) >>=
224243 return . vsep
225244
226245-- | Return markdown representation of a note.
227−noteToMarkdown :: WriterOptions -> Int -> [Block] -> State WriterState Doc
246+noteToMarkdown :: WriterOptions -> Int -> [Block] -> MD Doc
228247noteToMarkdown opts num blocks = do
229248 contents <- blockListToMarkdown opts blocks
230249 let num' = text $ writerIdentifierPrefix opts ++ show num
@@ -261,7 +280,7 @@ tableOfContents :: WriterOptions -> [Block] -> Doc
261280tableOfContents opts headers =
262281 let opts' = opts { writerIgnoreNotes = True }
263282 contents = BulletList $ map (elementToListItem opts) $ hierarchicalize headers
264− in evalState (blockToMarkdown opts' contents) def
283+ in evalMD (blockToMarkdown opts' contents) def def
265284
266285-- | Converts an Element to a list item for a table of contents,
267286elementToListItem :: WriterOptions -> Element -> [Block]
@@ -315,7 +334,7 @@ beginsWithOrderedListMarker str =
315334-- | Convert Pandoc block element to markdown.
316335blockToMarkdown :: WriterOptions -- ^ Options
317336 -> Block -- ^ Block element
318− -> State WriterState Doc
337+ -> MD Doc
319338blockToMarkdown _ Null = return empty
320339blockToMarkdown opts (Div attrs ils) = do
321340 contents <- blockListToMarkdown opts ils
@@ -327,7 +346,7 @@ blockToMarkdown opts (Div attrs ils) = do
327346blockToMarkdown opts (Plain inlines) = do
328347 contents <- inlineListToMarkdown opts inlines
329348 -- escape if para starts with ordered list marker
330− st <- get
349+ isPlain <- asks envPlain
331350 let colwidth = if writerWrapText opts == WrapAuto
332351 then Just $ writerColumns opts
333352 else Nothing
@@ -336,7 +355,7 @@ blockToMarkdown opts (Plain inlines) = do
336355 | otherwise = x : escapeDelimiter xs
337356 escapeDelimiter [] = []
338357 let contents' = if isEnabled Ext_all_symbols_escapable opts &&
339− not (stPlain st) && beginsWithOrderedListMarker rendered
358+ not isPlain && beginsWithOrderedListMarker rendered
340359 then text $ escapeDelimiter rendered
341360 else contents
342361 return $ contents' <> cr
@@ -348,14 +367,14 @@ blockToMarkdown opts (Para inlines) =
348367blockToMarkdown opts (RawBlock f str)
349368 | f == "markdown" = return $ text str <> text "\n"
350369 | f == "html" && isEnabled Ext_raw_html opts = do
351− plain <- gets stPlain
370+ plain <- asks envPlain
352371 return $ if plain
353372 then empty
354373 else if isEnabled Ext_markdown_attribute opts
355374 then text (addMarkdownAttribute str) <> text "\n"
356375 else text str <> text "\n"
357376 | f `elem` ["latex", "tex"] && isEnabled Ext_raw_tex opts = do
358− plain <- gets stPlain
377+ plain <- asks envPlain
359378 return $ if plain
360379 then empty
361380 else text str <> text "\n"
@@ -363,7 +382,7 @@ blockToMarkdown opts (RawBlock f str)
363382blockToMarkdown opts HorizontalRule = do
364383 return $ blankline <> text (replicate (writerColumns opts) '-') <> blankline
365384blockToMarkdown opts (Header level attr inlines) = do
366− plain <- gets stPlain
385+ plain <- asks envPlain
367386 -- we calculate the id that would be used by auto_identifiers
368387 -- so we know whether to print an explicit identifier
369388 ids <- gets stIds
@@ -424,7 +443,7 @@ blockToMarkdown opts (CodeBlock attribs str) = return $
424443 (_,(cls:_),_) -> " " <> text cls
425444 _ -> empty
426445blockToMarkdown opts (BlockQuote blocks) = do
427− plain <- gets stPlain
446+ plain <- asks envPlain
428447 -- if we're writing literate haskell, put a space before the bird tracks
429448 -- so they won't be interpreted as lhs...
430449 let leader = if isEnabled Ext_literate_haskell opts
@@ -486,13 +505,8 @@ blockToMarkdown opts (DefinitionList items) = do
486505 contents <- inList $ mapM (definitionListItemToMarkdown opts) items
487506 return $ cat contents <> blankline
488507
489−inList :: State WriterState a -> State WriterState a
490−inList p = do
491− oldInList <- gets stInList
492− modify $ \st -> st{ stInList = True }
493− res <- p
494− modify $ \st -> st{ stInList = oldInList }
495− return res
508+inList :: MD a -> MD a
509+inList p = local (\env -> env {envInList = True}) p
496510
497511addMarkdownAttribute :: String -> String
498512addMarkdownAttribute s =
@@ -503,7 +517,7 @@ addMarkdownAttribute s =
503517 x /= "markdown"]
504518 _ -> s
505519
506−pipeTable :: Bool -> [Alignment] -> [Doc] -> [[Doc]] -> State WriterState Doc
520+pipeTable :: Bool -> [Alignment] -> [Doc] -> [[Doc]] -> MD Doc
507521pipeTable headless aligns rawHeaders rawRows = do
508522 let sp = text " "
509523 let blockFor AlignLeft x y = lblock (x + 2) (sp <> y) <> lblock 0 empty
@@ -532,7 +546,7 @@ pipeTable headless aligns rawHeaders rawRows = do
532546 return $ header $$ border $$ body
533547
534548pandocTable :: WriterOptions -> Bool -> [Alignment] -> [Double]
535− -> [Doc] -> [[Doc]] -> State WriterState Doc
549+ -> [Doc] -> [[Doc]] -> MD Doc
536550pandocTable opts headless aligns widths rawHeaders rawRows = do
537551 let isSimple = all (==0) widths
538552 let alignHeader alignment = case alignment of
@@ -572,7 +586,7 @@ pandocTable opts headless aligns widths rawHeaders rawRows = do
572586 return $ head'' $$ underline $$ body $$ bottom
573587
574588gridTable :: WriterOptions -> Bool -> [Alignment] -> [Double]
575− -> [Doc] -> [[Doc]] -> State WriterState Doc
589+ -> [Doc] -> [[Doc]] -> MD Doc
576590gridTable opts headless _aligns widths headers' rawRows = do
577591 let numcols = length headers'
578592 let widths' = if all (==0) widths
@@ -599,7 +613,7 @@ gridTable opts headless _aligns widths headers' rawRows = do
599613 return $ border '-' $$ head'' $$ body $$ border '-'
600614
601615-- | Convert bullet list item (list of blocks) to markdown.
602−bulletListItemToMarkdown :: WriterOptions -> [Block] -> State WriterState Doc
616+bulletListItemToMarkdown :: WriterOptions -> [Block] -> MD Doc
603617bulletListItemToMarkdown opts items = do
604618 contents <- blockListToMarkdown opts items
605619 let sps = replicate (writerTabStop opts - 2) ' '
@@ -617,7 +631,7 @@ bulletListItemToMarkdown opts items = do
617631orderedListItemToMarkdown :: WriterOptions -- ^ options
618632 -> String -- ^ list item marker
619633 -> [Block] -- ^ list item (list of blocks)
620− -> State WriterState Doc
634+ -> MD Doc
621635orderedListItemToMarkdown opts marker items = do
622636 contents <- blockListToMarkdown opts items
623637 let sps = case length marker - writerTabStop opts of
@@ -629,15 +643,15 @@ orderedListItemToMarkdown opts marker items = do
629643-- | Convert definition list item (label, list of blocks) to markdown.
630644definitionListItemToMarkdown :: WriterOptions
631645 -> ([Inline],[[Block]])
632− -> State WriterState Doc
646+ -> MD Doc
633647definitionListItemToMarkdown opts (label, defs) = do
634648 labelText <- inlineListToMarkdown opts label
635649 defs' <- mapM (mapM (blockToMarkdown opts)) defs
636650 if isEnabled Ext_definition_lists opts
637651 then do
638652 let tabStop = writerTabStop opts
639− st <- get
640− let leader = if stPlain st then " " else ": "
653+ isPlain <- asks envPlain
654+ let leader = if isPlain then " " else ": "
641655 let sps = case writerTabStop opts - 3 of
642656 n | n > 0 -> text $ replicate n ' '
643657 _ -> text " "
@@ -661,7 +675,7 @@ definitionListItemToMarkdown opts (label, defs) = do
661675-- | Convert list of Pandoc block elements to markdown.
662676blockListToMarkdown :: WriterOptions -- ^ Options
663677 -> [Block] -- ^ List of block elements
664− -> State WriterState Doc
678+ -> MD Doc
665679blockListToMarkdown opts blocks =
666680 mapM (blockToMarkdown opts) (fixBlocks blocks) >>= return . cat
667681 -- insert comment between list and indented code block, or the
@@ -688,7 +702,7 @@ blockListToMarkdown opts blocks =
688702
689703-- | Get reference for target; if none exists, create unique one and return.
690704-- Prefer label if possible; otherwise, generate a unique key.
691−getReference :: Attr -> [Inline] -> Target -> State WriterState [Inline]
705+getReference :: Attr -> [Inline] -> Target -> MD [Inline]
692706getReference attr label target = do
693707 st <- get
694708 case find (\(_,t,a) -> t == target && a == attr) (stRefs st) of
@@ -706,9 +720,9 @@ getReference attr label target = do
706720 return label'
707721
708722-- | Convert list of Pandoc inline elements to markdown.
709−inlineListToMarkdown :: WriterOptions -> [Inline] -> State WriterState Doc
723+inlineListToMarkdown :: WriterOptions -> [Inline] -> MD Doc
710724inlineListToMarkdown opts lst = do
711− inlist <- gets stInList
725+ inlist <- asks envInList
712726 go (if inlist then avoidBadWrapsInList lst else lst)
713727 where go [] = return empty
714728 go (i:is) = case i of
@@ -731,9 +745,9 @@ inlineListToMarkdown opts lst = do
731745 _ -> shortcutable
732746 where shortcutable = liftM2 (<>) (inlineToMarkdown opts i) (go is)
733747 unshortcutable = do
734− iMark <- withState (\s -> s { stRefShortcutable = False })
735− (inlineToMarkdown opts i)
736− modify (\s -> s {stRefShortcutable = True })
748+ iMark <- local
749+ (\env -> env { envRefShortcutable = False })
750+ (inlineToMarkdown opts i)
737751 fmap (iMark <>) (go is)
738752
739753isSp :: Inline -> Bool
@@ -773,22 +787,22 @@ escapeSpaces SoftBreak = Str "\\ "
773787escapeSpaces x = x
774788
775789-- | Convert Pandoc inline element to markdown.
776−inlineToMarkdown :: WriterOptions -> Inline -> State WriterState Doc
790+inlineToMarkdown :: WriterOptions -> Inline -> MD Doc
777791inlineToMarkdown opts (Span attrs ils) = do
778− plain <- gets stPlain
792+ plain <- asks envPlain
779793 contents <- inlineListToMarkdown opts ils
780794 return $ if not plain &&
781795 (isEnabled Ext_raw_html opts || isEnabled Ext_native_spans opts)
782796 then tagWithAttrs "span" attrs <> contents <> text "</span>"
783797 else contents
784798inlineToMarkdown opts (Emph lst) = do
785− plain <- gets stPlain
799+ plain <- asks envPlain
786800 contents <- inlineListToMarkdown opts lst
787801 return $ if plain
788802 then "_" <> contents <> "_"
789803 else "*" <> contents <> "*"
790804inlineToMarkdown opts (Strong lst) = do
791− plain <- gets stPlain
805+ plain <- asks envPlain
792806 if plain
793807 then inlineListToMarkdown opts $ capitalize lst
794808 else do
@@ -827,7 +841,7 @@ inlineToMarkdown opts (Subscript lst) = do
827841 _ -> contents
828842 where toSubscript c = chr (0x2080 + (ord c - 48))
829843inlineToMarkdown opts (SmallCaps lst) = do
830− plain <- gets stPlain
844+ plain <- asks envPlain
831845 if not plain &&
832846 (isEnabled Ext_raw_html opts || isEnabled Ext_native_spans opts)
833847 then do
@@ -852,13 +866,13 @@ inlineToMarkdown opts (Code attr str) = do
852866 let attrs = if isEnabled Ext_inline_code_attributes opts && attr /= nullAttr
853867 then attrsToMarkdown attr
854868 else empty
855− plain <- gets stPlain
869+ plain <- asks envPlain
856870 if plain
857871 then return $ text str
858872 else return $ text (marker ++ spacer ++ str ++ spacer ++ marker) <> attrs
859873inlineToMarkdown opts (Str str) = do
860− st <- get
861− if stPlain st
874+ isPlain <- asks envPlain
875+ if isPlain
862876 then return $ text str
863877 else return $ text $ escapeString opts str
864878inlineToMarkdown opts (Math InlineMath str) =
@@ -873,7 +887,7 @@ inlineToMarkdown opts (Math InlineMath str) =
873887 | isEnabled Ext_tex_math_double_backslash opts ->
874888 return $ "\\\\(" <> text str <> "\\\\)"
875889 | otherwise -> do
876− plain <- gets stPlain
890+ plain <- asks envPlain
877891 inlineListToMarkdown opts $
878892 (if plain then makeMathPlainer else id) $
879893 texMathToInlines InlineMath str
@@ -887,7 +901,7 @@ inlineToMarkdown opts (Math DisplayMath str)
887901 | otherwise = (\x -> cr <> x <> cr) `fmap`
888902 inlineListToMarkdown opts (texMathToInlines DisplayMath str)
889903inlineToMarkdown opts (RawInline f str) = do
890− plain <- gets stPlain
904+ plain <- asks envPlain
891905 if not plain &&
892906 ( f == "markdown" ||
893907 (isEnabled Ext_raw_tex opts && (f == "latex" || f == "tex")) ||
@@ -895,7 +909,7 @@ inlineToMarkdown opts (RawInline f str) = do
895909 then return $ text str
896910 else return empty
897911inlineToMarkdown opts (LineBreak) = do
898− plain <- gets stPlain
912+ plain <- asks envPlain
899913 if plain || isEnabled Ext_hard_line_breaks opts
900914 then return cr
901915 else return $
@@ -944,7 +958,7 @@ inlineToMarkdown opts lnk@(Link attr txt (src, tit))
944958 attr /= nullAttr = -- use raw HTML
945959 return $ text $ trim $ writeHtmlString def $ Pandoc nullMeta [Plain [lnk]]
946960 | otherwise = do
947− plain <- gets stPlain
961+ plain <- asks envPlain
948962 linktext <- inlineListToMarkdown opts txt
949963 let linktitle = if null tit
950964 then empty
@@ -955,7 +969,7 @@ inlineToMarkdown opts lnk@(Link attr txt (src, tit))
955969 [Str s] | escapeURI s == srcSuffix -> True
956970 _ -> False
957971 let useRefLinks = writerReferenceLinks opts && not useAuto
958− shortcutable <- gets stRefShortcutable
972+ shortcutable <- asks envRefShortcutable
959973 let useShortcutRefLinks = shortcutable &&
960974 isEnabled Ext_shortcut_reference_links opts
961975 ref <- if useRefLinks then getReference attr txt (src, tit) else return []
@@ -983,7 +997,7 @@ inlineToMarkdown opts img@(Image attr alternate (source, tit))
983997 attr /= nullAttr = -- use raw HTML
984998 return $ text $ trim $ writeHtmlString def $ Pandoc nullMeta [Plain [img]]
985999 | otherwise = do
986− plain <- gets stPlain
1000+ plain <- asks envPlain
9871001 let txt = if null alternate || alternate == [Str source]
9881002 -- to prevent autolinks
9891003 then [Str ""]