3eff378 · typeable/pandoc

39import Text.Pandoc.Options

40import Text.Pandoc.Parsing hiding (blankline, char, space)

41import Data.List ( group, isPrefixOf, find, intersperse, transpose, sortBy )

42−import Data.Char ( isSpace, isPunctuation )

42+import Data.Char ( isSpace, isPunctuation, toUpper )

43import Data.Ord ( comparing )

44import Text.Pandoc.Pretty

45import Control.Monad.State

77writePlain opts document =

78 evalState (pandocToMarkdown opts{

79 writerExtensions = Set.delete Ext_escaped_line_breaks $

80+ Set.delete Ext_pipe_tables $

81+ Set.delete Ext_raw_html $

80 writerExtensions opts }

82 writerExtensions opts }

81− document') def{ stPlain = True }

83+ document) def{ stPlain = True }

82− where document' = plainify document

83−

84−plainify :: Pandoc -> Pandoc

85−plainify = walk go

86− where go :: Inline -> Inline

87− go (Emph xs) = Span ("",[],[]) xs

88− go (Strong xs) = Span ("",[],[]) xs

89− go (Strikeout xs) = Span ("",[],[]) xs

90− go (Superscript xs) = Span ("",[],[]) xs

91− go (Subscript xs) = Span ("",[],[]) xs

92− go (SmallCaps xs) = Span ("",[],[]) xs

93− go (Span _ xs) = Span ("",[],[]) xs

94− go (Code _ s) = Str s

95− go (Math _ s) = Str s

96− go (RawInline _ _) = Str ""

97− go (Link xs _) = Span ("",[],[]) xs

98− go (Image xs _) = Span ("",[],[]) $ [Str "["] ++ xs ++ [Str "]"]

99− go (Cite _ cits) = Span ("",[],[]) cits

100− go x = x

101

84

102pandocTitleBlock :: Doc -> [Doc] -> Doc -> Doc

85pandocTitleBlock :: Doc -> [Doc] -> Doc -> Doc

103pandocTitleBlock tit auths dat =

86pandocTitleBlock tit auths dat =

309 -> State WriterState Doc

292 -> State WriterState Doc

310blockToMarkdown _ Null = return empty

293blockToMarkdown _ Null = return empty

311blockToMarkdown opts (Div attrs ils) = do

294blockToMarkdown opts (Div attrs ils) = do

312− isPlain <- gets stPlain

295+ plain <- gets stPlain

313 contents <- blockListToMarkdown opts ils

296 contents <- blockListToMarkdown opts ils

314− return $ if isPlain || not (isEnabled Ext_markdown_in_html_blocks opts)

297+ return $ if plain || not (isEnabled Ext_markdown_in_html_blocks opts)

315 then contents <> blankline

298 then contents <> blankline

316 else tagWithAttrs "div" attrs <> blankline <>

299 else tagWithAttrs "div" attrs <> blankline <>

317 contents <> blankline <> "</div>" <> blankline

300 contents <> blankline <> "</div>" <> blankline

338 (<> blankline) `fmap` blockToMarkdown opts (Plain inlines)

321 (<> blankline) `fmap` blockToMarkdown opts (Plain inlines)

339blockToMarkdown opts (RawBlock f str)

322blockToMarkdown opts (RawBlock f str)

340 | f == "html" = do

323 | f == "html" = do

341− st <- get

342− if stPlain st

324+ plain <- gets stPlain

325+ return $ if plain

343− then return empty

326+ then empty

344− else return $ if isEnabled Ext_markdown_attribute opts

327+ else if isEnabled Ext_markdown_attribute opts

345 then text (addMarkdownAttribute str) <> text "\n"

328 then text (addMarkdownAttribute str) <> text "\n"

346 else text str <> text "\n"

329 else text str <> text "\n"

347 | f `elem` ["latex", "tex", "markdown"] = do

330 | f `elem` ["latex", "tex", "markdown"] = do

348− st <- get

349− if stPlain st

331+ plain <- gets stPlain

332+ return $ if plain

350− then return empty

333+ then empty

351− else return $ text str <> text "\n"

334+ else text str <> text "\n"

352blockToMarkdown _ (RawBlock _ _) = return empty

335blockToMarkdown _ (RawBlock _ _) = return empty

353−blockToMarkdown _ HorizontalRule =

336+blockToMarkdown opts HorizontalRule = do

354− return $ blankline <> text "* * * * *" <> blankline

337+ return $ blankline <> text (replicate (writerColumns opts) '-') <> blankline

355blockToMarkdown opts (Header level attr inlines) = do

338blockToMarkdown opts (Header level attr inlines) = do

339+ plain <- gets stPlain

356 -- we calculate the id that would be used by auto_identifiers

340 -- we calculate the id that would be used by auto_identifiers

357 -- so we know whether to print an explicit identifier

341 -- so we know whether to print an explicit identifier

358 ids <- gets stIds

342 ids <- gets stIds

368 space <> attrsToMarkdown attr

352 space <> attrsToMarkdown attr

369 | otherwise -> empty

353 | otherwise -> empty

370 contents <- inlineListToMarkdown opts inlines

354 contents <- inlineListToMarkdown opts inlines

371− st <- get

372 let setext = writerSetextHeaders opts

355 let setext = writerSetextHeaders opts

373 return $ nowrap

356 return $ nowrap

374 $ case level of

357 $ case level of

358+ 1 | plain -> blankline <> text "\n\n" <> contents <> blankline <> text "\n"

375− 1 | setext ->

359+ | setext ->

376 contents <> attr' <> cr <> text (replicate (offset contents) '=') <>

360 contents <> attr' <> cr <> text (replicate (offset contents) '=') <>

377 blankline

361 blankline

362+ 2 | plain -> blankline <> text "\n" <> contents <> blankline

378− 2 | setext ->

363+ | setext ->

379 contents <> attr' <> cr <> text (replicate (offset contents) '-') <>

364 contents <> attr' <> cr <> text (replicate (offset contents) '-') <>

380 blankline

365 blankline

381 -- ghc interprets '#' characters in column 1 as linenum specifiers.

366 -- ghc interprets '#' characters in column 1 as linenum specifiers.

382− _ | stPlain st || isEnabled Ext_literate_haskell opts ->

367+ _ | plain || isEnabled Ext_literate_haskell opts ->

383 contents <> blankline

368 contents <> blankline

384 _ -> text (replicate level '#') <> space <> contents <> attr' <> blankline

369 _ -> text (replicate level '#') <> space <> contents <> attr' <> blankline

385blockToMarkdown opts (CodeBlock (_,classes,_) str)

370blockToMarkdown opts (CodeBlock (_,classes,_) str)

409 (_,(cls:_),_) -> " " <> text cls

394 (_,(cls:_),_) -> " " <> text cls

410 _ -> empty

395 _ -> empty

411blockToMarkdown opts (BlockQuote blocks) = do

396blockToMarkdown opts (BlockQuote blocks) = do

412− st <- get

397+ plain <- gets stPlain

413 -- if we're writing literate haskell, put a space before the bird tracks

398 -- if we're writing literate haskell, put a space before the bird tracks

414 -- so they won't be interpreted as lhs...

399 -- so they won't be interpreted as lhs...

415 let leader = if isEnabled Ext_literate_haskell opts

400 let leader = if isEnabled Ext_literate_haskell opts

416 then " > "

401 then " > "

417− else if stPlain st

402+ else if plain then " " else "> "

418− then " "

419− else "> "

420 contents <- blockListToMarkdown opts blocks

403 contents <- blockListToMarkdown opts blocks

421 return $ (prefixed leader contents) <> blankline

404 return $ (prefixed leader contents) <> blankline

422blockToMarkdown opts t@(Table caption aligns widths headers rows) = do

405blockToMarkdown opts t@(Table caption aligns widths headers rows) = do

680escapeSpaces Space = Str "\\ "

663escapeSpaces Space = Str "\\ "

681escapeSpaces x = x

664escapeSpaces x = x

682

665

666+toCaps :: Inline -> Inline

667+toCaps (Str s) = Str (map toUpper s)

668+toCaps x = x

669+

683-- | Convert Pandoc inline element to markdown.

670-- | Convert Pandoc inline element to markdown.

684inlineToMarkdown :: WriterOptions -> Inline -> State WriterState Doc

671inlineToMarkdown :: WriterOptions -> Inline -> State WriterState Doc

685inlineToMarkdown opts (Span attrs ils) = do

672inlineToMarkdown opts (Span attrs ils) = do

686− st <- get

673+ plain <- gets stPlain

687 contents <- inlineListToMarkdown opts ils

674 contents <- inlineListToMarkdown opts ils

688− return $ if stPlain st

675+ return $ if plain

689 then contents

676 then contents

690 else tagWithAttrs "span" attrs <> contents <> text ""

677 else tagWithAttrs "span" attrs <> contents <> text ""

691inlineToMarkdown opts (Emph lst) = do

678inlineToMarkdown opts (Emph lst) = do

679+ plain <- gets stPlain

692 contents <- inlineListToMarkdown opts lst

680 contents <- inlineListToMarkdown opts lst

681+ return $ if plain

682+ then "_" <> contents <> "_"

693− return $ "*" <> contents <> "*"

683+ else "*" <> contents <> "*"

694inlineToMarkdown opts (Strong lst) = do

684inlineToMarkdown opts (Strong lst) = do

685+ plain <- gets stPlain

686+ if plain

687+ then inlineListToMarkdown opts $ walk toCaps lst

688+ else do

695− contents <- inlineListToMarkdown opts lst

689+ contents <- inlineListToMarkdown opts lst

696− return $ "**" <> contents <> "**"

690+ return $ "**" <> contents <> "**"

697inlineToMarkdown opts (Strikeout lst) = do

691inlineToMarkdown opts (Strikeout lst) = do

698 contents <- inlineListToMarkdown opts lst

692 contents <- inlineListToMarkdown opts lst

693+ plain <- gets stPlain

699− return $ if isEnabled Ext_strikeout opts

694+ return $ if plain || isEnabled Ext_strikeout opts

700 then "~~" <> contents <> "~~"

695 then "~~" <> contents <> "~~"

701 else "<s>" <> contents <> "</s>"

696 else "<s>" <> contents <> "</s>"

702inlineToMarkdown opts (Superscript lst) = do

697inlineToMarkdown opts (Superscript lst) = do

698+ plain <- gets stPlain

699+ if plain

700+ then inlineListToMarkdown opts lst

701+ else do

703− let lst' = walk escapeSpaces lst

702+ contents <- inlineListToMarkdown opts $ walk escapeSpaces lst

704− contents <- inlineListToMarkdown opts lst'

705− return $ if isEnabled Ext_superscript opts

703+ return $ if isEnabled Ext_superscript opts

706− then "^" <> contents <> "^"

704+ then "^" <> contents <> "^"

707− else "" <> contents <> ""

705+ else "" <> contents <> ""

708inlineToMarkdown opts (Subscript lst) = do

706inlineToMarkdown opts (Subscript lst) = do

707+ plain <- gets stPlain

708+ if plain

709+ then inlineListToMarkdown opts lst

710+ else do

709− let lst' = walk escapeSpaces lst

711+ contents <- inlineListToMarkdown opts $ walk escapeSpaces lst

710− contents <- inlineListToMarkdown opts lst'

711− return $ if isEnabled Ext_subscript opts

712+ return $ if isEnabled Ext_subscript opts

712− then "~" <> contents <> "~"

713+ then "~" <> contents <> "~"

713− else "" <> contents <> ""

714+ else "" <> contents <> ""

714inlineToMarkdown opts (SmallCaps lst) = do

715inlineToMarkdown opts (SmallCaps lst) = do

715− contents <- inlineListToMarkdown opts lst

716− st <- get

717− return $ if stPlain st

716+ plain <- gets stPlain

718− then contents

717+ if plain

718+ then inlineListToMarkdown opts $ walk toCaps lst

719+ else do

720+ contents <- inlineListToMarkdown opts lst

719− else tagWithAttrs "span"

721+ return $ tagWithAttrs "span"

720− ("",[],[("style","font-variant:small-caps;")])

722+ ("",[],[("style","font-variant:small-caps;")])

721− <> contents <> text ""

723+ <> contents <> text ""

722inlineToMarkdown opts (Quoted SingleQuote lst) = do

724inlineToMarkdown opts (Quoted SingleQuote lst) = do

723 contents <- inlineListToMarkdown opts lst

725 contents <- inlineListToMarkdown opts lst

724 return $ "‘" <> contents <> "’"

726 return $ "‘" <> contents <> "’"

725inlineToMarkdown opts (Quoted DoubleQuote lst) = do

727inlineToMarkdown opts (Quoted DoubleQuote lst) = do

726 contents <- inlineListToMarkdown opts lst

728 contents <- inlineListToMarkdown opts lst

727 return $ "“" <> contents <> "”"

729 return $ "“" <> contents <> "”"

728−inlineToMarkdown opts (Code attr str) =

730+inlineToMarkdown opts (Code attr str) = do

729 let tickGroups = filter (\s -> '`' `elem` s) $ group str

731 let tickGroups = filter (\s -> '`' `elem` s) $ group str

730− longest = if null tickGroups

732+ let longest = if null tickGroups

731 then 0

733 then 0

732 else maximum $ map length tickGroups

734 else maximum $ map length tickGroups

733− marker = replicate (longest + 1) '`'

735+ let marker = replicate (longest + 1) '`'

734− spacer = if (longest == 0) then "" else " "

736+ let spacer = if (longest == 0) then "" else " "

735− attrs = if isEnabled Ext_inline_code_attributes opts && attr /= nullAttr

737+ let attrs = if isEnabled Ext_inline_code_attributes opts && attr /= nullAttr

736 then attrsToMarkdown attr

738 then attrsToMarkdown attr

737 else empty

739 else empty

740+ plain <- gets stPlain

741+ if plain

742+ then return $ text str

738− in return $ text (marker ++ spacer ++ str ++ spacer ++ marker) <> attrs

743+ else return $ text (marker ++ spacer ++ str ++ spacer ++ marker) <> attrs

739inlineToMarkdown _ (Str str) = do

744inlineToMarkdown _ (Str str) = do

740 st <- get

745 st <- get

741 if stPlain st

746 if stPlain st

758 return $ "\\\\[" <> text str <> "\\\\]"

763 return $ "\\\\[" <> text str <> "\\\\]"

759 | otherwise = (\x -> cr <> x <> cr) `fmap`

764 | otherwise = (\x -> cr <> x <> cr) `fmap`

760 inlineListToMarkdown opts (texMathToInlines DisplayMath str)

765 inlineListToMarkdown opts (texMathToInlines DisplayMath str)

761−inlineToMarkdown opts (RawInline f str)

766+inlineToMarkdown opts (RawInline f str) = do

767+ plain <- gets stPlain

762− | f == "html" || f == "markdown" ||

768+ if not plain && f == "html" || f == "markdown" ||

763− (isEnabled Ext_raw_tex opts && (f == "latex" || f == "tex")) =

769+ (isEnabled Ext_raw_tex opts && (f == "latex" || f == "tex"))

764− return $ text str

770+ then return $ text str

765−inlineToMarkdown _ (RawInline _ _) = return empty

771+ else return empty

766−inlineToMarkdown opts (LineBreak)

772+inlineToMarkdown opts (LineBreak) = do

773+ plain <- gets stPlain

767− | isEnabled Ext_hard_line_breaks opts = return cr

774+ if plain || isEnabled Ext_hard_line_breaks opts

775+ then return cr

776+ else return $

768− | isEnabled Ext_escaped_line_breaks opts = return $ "\\" <> cr

777+ if isEnabled Ext_escaped_line_breaks opts

769− | otherwise = return $ " " <> cr

778+ then "\\" <> cr

779+ else " " <> cr

770inlineToMarkdown _ Space = return space

780inlineToMarkdown _ Space = return space

771inlineToMarkdown opts (Cite [] lst) = inlineListToMarkdown opts lst

781inlineToMarkdown opts (Cite [] lst) = inlineListToMarkdown opts lst

772inlineToMarkdown opts (Cite (c:cs) lst)

782inlineToMarkdown opts (Cite (c:cs) lst)

799 modekey SuppressAuthor = "-"

809 modekey SuppressAuthor = "-"

800 modekey _ = ""

810 modekey _ = ""

801inlineToMarkdown opts (Link txt (src, tit)) = do

811inlineToMarkdown opts (Link txt (src, tit)) = do

812+ plain <- gets stPlain

802 linktext <- inlineListToMarkdown opts txt

813 linktext <- inlineListToMarkdown opts txt

803 let linktitle = if null tit

814 let linktitle = if null tit

804 then empty

815 then empty

812 ref <- if useRefLinks then getReference txt (src, tit) else return []

823 ref <- if useRefLinks then getReference txt (src, tit) else return []

813 reftext <- inlineListToMarkdown opts ref

824 reftext <- inlineListToMarkdown opts ref

814 return $ if useAuto

825 return $ if useAuto

826+ then if plain

827+ then text srcSuffix

815− then "<" <> text srcSuffix <> ">"

828+ else "<" <> text srcSuffix <> ">"

816 else if useRefLinks

829 else if useRefLinks

817 then let first = "[" <> linktext <> "]"

830 then let first = "[" <> linktext <> "]"

818 second = if txt == ref

831 second = if txt == ref

819 then "[]"

832 then "[]"

820 else "[" <> reftext <> "]"

833 else "[" <> reftext <> "]"

821 in first <> second

834 in first <> second

835+ else if plain

836+ then linktext

822− else "[" <> linktext <> "](" <>

837+ else "[" <> linktext <> "](" <>

823− text src <> linktitle <> ")"

838+ text src <> linktitle <> ")"

824inlineToMarkdown opts (Image alternate (source, tit)) = do

839inlineToMarkdown opts (Image alternate (source, tit)) = do

840+ plain <- gets stPlain

825 let txt = if null alternate || alternate == [Str source]

841 let txt = if null alternate || alternate == [Str source]

826 -- to prevent autolinks

842 -- to prevent autolinks

827 then [Str ""]

843 then [Str ""]

828 else alternate

844 else alternate

829 linkPart <- inlineToMarkdown opts (Link txt (source, tit))

845 linkPart <- inlineToMarkdown opts (Link txt (source, tit))

846+ return $ if plain

847+ then "[" <> linkPart <> "]"

830− return $ "!" <> linkPart

848+ else "!" <> linkPart

831inlineToMarkdown opts (Note contents) = do

849inlineToMarkdown opts (Note contents) = do

832 modify (\st -> st{ stNotes = contents : stNotes st })

850 modify (\st -> st{ stNotes = contents : stNotes st })

833 st <- get

851 st <- get