@@ -29,7 +29,7 @@ Conversion of 'Pandoc' documents to markdown-formatted plain text.
2929
3030Markdown: <http://daringfireball.net/projects/markdown/>
3131-}
32−module Text.Pandoc.Writers.Markdown ( writeMarkdown) where
32+module Text.Pandoc.Writers.Markdown (writeMarkdown, writePlain) where
3333import Text.Pandoc.Definition
3434import Text.Pandoc.Templates (renderTemplate)
3535import Text.Pandoc.Shared
@@ -41,12 +41,43 @@ import Control.Monad.State
4141
4242type Notes = [[Block]]
4343type Refs = KeyTable
44−type WriterState = (Notes, Refs)
44+data WriterState = WriterState { stNotes :: Notes
45+ , stRefs :: Refs
46+ , stPlain :: Bool }
4547
4648-- | Convert Pandoc to Markdown.
4749writeMarkdown :: WriterOptions -> Pandoc -> String
4850writeMarkdown opts document =
49− evalState (pandocToMarkdown opts document) ([],[])
51+ evalState (pandocToMarkdown opts document) WriterState{ stNotes = []
52+ , stRefs = []
53+ , stPlain = False }
54+
55+-- | Convert Pandoc to plain text (like markdown, but without links,
56+-- pictures, or inline formatting).
57+writePlain :: WriterOptions -> Pandoc -> String
58+writePlain opts document =
59+ evalState (pandocToMarkdown opts document') WriterState{ stNotes = []
60+ , stRefs = []
61+ , stPlain = True }
62+ where document' = plainify document
63+
64+plainify :: Pandoc -> Pandoc
65+plainify = processWith go
66+ where go :: [Inline] -> [Inline]
67+ go (Emph xs : ys) = go xs ++ go ys
68+ go (Strong xs : ys) = go xs ++ go ys
69+ go (Strikeout xs : ys) = go xs ++ go ys
70+ go (Superscript xs : ys) = go xs ++ go ys
71+ go (Subscript xs : ys) = go xs ++ go ys
72+ go (SmallCaps xs : ys) = go xs ++ go ys
73+ go (Code s : ys) = Str s : go ys
74+ go (Math _ s : ys) = Str s : go ys
75+ go (TeX _ : ys) = Str "" : go ys
76+ go (HtmlInline _ : ys) = Str "" : go ys
77+ go (Link xs _ : ys) = go xs ++ go ys
78+ go (Image _ _ : ys) = go ys
79+ go (x : ys) = x : go ys
80+ go [] = []
5081
5182-- | Return markdown representation of document.
5283pandocToMarkdown :: WriterOptions -> Pandoc -> State WriterState String
@@ -60,10 +91,10 @@ pandocToMarkdown opts (Pandoc (Meta title authors date) blocks) = do
6091 then tableOfContents opts headerBlocks
6192 else empty
6293 body <- blockListToMarkdown opts blocks
63− (notes, _) <- get
64− notes' <- notesToMarkdown opts (reverse notes)
65− (_, refs) <- get -- note that the notes may contain refs
66− refs' <- keyTableToMarkdown opts (reverse refs)
94+ st <- get
95+ notes' <- notesToMarkdown opts (reverse $ stNotes st)
96+ st' <- get -- note that the notes may contain refs
97+ refs' <- keyTableToMarkdown opts (reverse $ stRefs st')
6798 let main = render $ body $+$ text "" $+$ notes' $+$ text "" $+$ refs'
6899 let context = writerVariables opts ++
69100 [ ("toc", render toc)
@@ -114,7 +145,9 @@ tableOfContents :: WriterOptions -> [Block] -> Doc
114145tableOfContents opts headers =
115146 let opts' = opts { writerIgnoreNotes = True }
116147 contents = BulletList $ map elementToListItem $ hierarchicalize headers
117− in evalState (blockToMarkdown opts' contents) ([],[])
148+ in evalState (blockToMarkdown opts' contents) WriterState{ stNotes = []
149+ , stRefs = []
150+ , stPlain = False }
118151
119152-- | Converts an Element to a list item for a table of contents,
120153elementToListItem :: Element -> [Block]
@@ -164,13 +197,18 @@ blockToMarkdown opts (Para inlines) = do
164197 then char '\\'
165198 else empty
166199 return $ esc <> contents <> text "\n"
167−blockToMarkdown _ (RawHtml str) = return $ text str
200+blockToMarkdown _ (RawHtml str) = do
201+ st <- get
202+ if stPlain st
203+ then return empty
204+ else return $ text str
168205blockToMarkdown _ HorizontalRule = return $ text "\n* * * * *\n"
169206blockToMarkdown opts (Header level inlines) = do
170207 contents <- inlineListToMarkdown opts inlines
208+ st <- get
171209 -- use setext style headers if in literate haskell mode.
172210 -- ghc interprets '#' characters in column 1 as line number specifiers.
173− if writerLiterateHaskell opts
211+ if writerLiterateHaskell opts || stPlain st
174212 then let len = length $ render contents
175213 in return $ contents <> text "\n" <>
176214 case level of
@@ -185,11 +223,14 @@ blockToMarkdown opts (CodeBlock (_,classes,_) str) | "haskell" `elem` classes &&
185223blockToMarkdown opts (CodeBlock _ str) = return $
186224 (nest (writerTabStop opts) $ vcat $ map text (lines str)) <> text "\n"
187225blockToMarkdown opts (BlockQuote blocks) = do
226+ st <- get
188227 -- if we're writing literate haskell, put a space before the bird tracks
189228 -- so they won't be interpreted as lhs...
190229 let leader = if writerLiterateHaskell opts
191230 then text . (" > " ++)
192− else text . ("> " ++)
231+ else if stPlain st
232+ then text . (" " ++)
233+ else text . ("> " ++)
193234 contents <- blockListToMarkdown opts blocks
194235 return $ (vcat $ map leader $ lines $ render contents) <>
195236 text "\n"
@@ -273,7 +314,8 @@ definitionListItemToMarkdown :: WriterOptions
273314definitionListItemToMarkdown opts (label, defs) = do
274315 labelText <- inlineListToMarkdown opts label
275316 let tabStop = writerTabStop opts
276− let leader = char ':'
317+ st <- get
318+ let leader = if stPlain st then empty else text " ~"
277319 contents <- liftM vcat $
278320 mapM (liftM ((leader $$) . nest tabStop . vcat) . mapM (blockToMarkdown opts)) defs
279321 return $ labelText $+$ contents
@@ -289,18 +331,18 @@ blockListToMarkdown opts blocks =
289331-- Prefer label if possible; otherwise, generate a unique key.
290332getReference :: [Inline] -> Target -> State WriterState [Inline]
291333getReference label (src, tit) = do
292− (_,refs) <- get
293− case find ((== (src, tit)) . snd) refs of
334+ st <- get
335+ case find ((== (src, tit)) . snd) (stRefs st) of
294336 Just (ref, _) -> return ref
295337 Nothing -> do
296− let label' = case find ((== label) . fst) refs of
338+ let label' = case find ((== label) . fst) (stRefs st) of
297339 Just _ -> -- label is used; generate numerical label
298340 case find (\n -> not (any (== [Str (show n)])
299− (map fst refs))) [1..(10000 :: Integer)] of
341+ (map fst (stRefs st)))) [1..(10000 :: Integer)] of
300342 Just x -> [Str (show x)]
301343 Nothing -> error "no unique label"
302344 Nothing -> label
303− modify (\(notes, refs') -> (notes, (label', (src,tit)):refs'))
345+ modify (\s -> s{ stRefs = (label', (src,tit)) : stRefs st })
304346 return label'
305347
306348-- | Convert list of Pandoc inline elements to markdown.
@@ -346,7 +388,11 @@ inlineToMarkdown _ (Code str) =
346388 marker = replicate (longest + 1) '`'
347389 spacer = if (longest == 0) then "" else " " in
348390 return $ text (marker ++ spacer ++ str ++ spacer ++ marker)
349−inlineToMarkdown _ (Str str) = return $ text $ escapeString str
391+inlineToMarkdown _ (Str str) = do
392+ st <- get
393+ if stPlain st
394+ then return $ text str
395+ else return $ text $ escapeString str
350396inlineToMarkdown _ (Math InlineMath str) = return $ char '$' <> text str <> char '$'
351397inlineToMarkdown _ (Math DisplayMath str) = return $ text "$$" <> text str <> text "$$"
352398inlineToMarkdown _ (TeX str) = return $ text str
@@ -380,7 +426,7 @@ inlineToMarkdown opts (Image alternate (source, tit)) = do
380426 linkPart <- inlineToMarkdown opts (Link txt (source, tit))
381427 return $ char '!' <> linkPart
382428inlineToMarkdown _ (Note contents) = do
383− modify (\(notes, refs) -> (contents:notes, refs)) -- add to notes in state
384− (notes, _) <- get
385− let ref = show $ (length notes)
429+ modify (\st -> st{ stNotes = contents : stNotes st })
430+ st <- get
431+ let ref = show $ (length $ stNotes st)
386432 return $ text "[^" <> text ref <> char ']'