1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
|
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{- |
Module : Text.Pandoc.Readers.CommonMark
Copyright : Copyright (C) 2015-2024 John MacFarlane
License : GNU GPL, version 2 or above
Maintainer : John MacFarlane <[email protected]>
Stability : alpha
Portability : portable
Conversion of CommonMark-formatted plain text to 'Pandoc' document.
CommonMark is a strongly specified variant of Markdown: http://commonmark.org.
-}
module Text.Pandoc.Readers.CommonMark (readCommonMark)
where
import Commonmark
import Commonmark.Extensions
import Commonmark.Pandoc
import Data.Text (Text)
import Text.Pandoc.Class.PandocMonad (PandocMonad)
import Text.Pandoc.Definition
import Text.Pandoc.Builder as B
import Text.Pandoc.Options
import Text.Pandoc.Readers.Metadata (yamlMetaBlock)
import Control.Monad (MonadPlus(mzero))
import Control.Monad.Except ( MonadError(throwError) )
import Data.Functor.Identity (runIdentity)
import Data.Typeable
import Text.Pandoc.Parsing (runParserT, getInput, getPosition,
runF, defaultParserState, option, many1, anyChar,
Sources(..), ToSources(..), ParsecT, Future,
incSourceLine, fromParsecError)
import Text.Pandoc.Walk (walk)
import qualified Data.Text as T
import qualified Data.Attoparsec.Text as A
import Control.Applicative ((<|>))
-- | Parse a CommonMark formatted string into a 'Pandoc' structure.
readCommonMark :: (PandocMonad m, ToSources a)
=> ReaderOptions -> a -> m Pandoc
readCommonMark opts s
| isEnabled Ext_yaml_metadata_block opts = do
let sources = toSources s
let firstSourceName = case unSources sources of
((pos,_):_) -> sourceName pos
_ -> ""
let toks = concatMap sourceToToks (unSources sources)
res <- runParserT (do meta <- yamlMetaBlock (metaValueParser opts)
pos <- getPosition
rest <- getInput
let rest' = case rest of
-- update position of first source (#7863):
Sources ((_,t):xs) -> Sources ((pos,t):xs)
_ -> rest
return (meta, rest'))
defaultParserState firstSourceName sources
case res of
Left _ -> readCommonMarkBody opts sources toks
Right (meta, rest) -> do
-- strip off metadata section and parse body
let body = concatMap sourceToToks (unSources rest)
Pandoc _ bs <- readCommonMarkBody opts sources body
return $ Pandoc (runF meta defaultParserState) bs
| otherwise = do
let sources = toSources s
let toks = concatMap sourceToToks (unSources sources)
readCommonMarkBody opts sources toks
makeFigures :: Block -> Block
makeFigures (Para [Image (ident,classes,kvs) alt (src,tit)])
| not (null alt) =
Figure (ident,[],[])
(Caption Nothing [Plain alt])
[Plain [Image ("",classes,kvs) alt (src,tit)]]
makeFigures b = b
sourceToToks :: (SourcePos, Text) -> [Tok]
sourceToToks (pos, s) = map adjust $ tokenize (sourceName pos) s
where
adjust = case sourceLine pos of
1 -> id
n -> \tok -> tok{ tokPos =
incSourceLine (tokPos tok) (n - 1) }
metaValueParser :: Monad m
=> ReaderOptions -> ParsecT Sources st m (Future st MetaValue)
metaValueParser opts = do
inp <- option "" $ T.pack <$> many1 anyChar
let toks = concatMap sourceToToks (unSources (toSources inp))
case runIdentity (parseCommonmarkWith (specFor opts) toks) of
Left _ -> mzero
Right (Cm bls :: Cm () Blocks) -> return $ return $ B.toMetaValue bls
readCommonMarkBody :: PandocMonad m => ReaderOptions -> Sources -> [Tok] -> m Pandoc
readCommonMarkBody opts s toks =
(if isEnabled Ext_implicit_figures opts
then walk makeFigures
else id) .
(if isEnabled Ext_tex_math_gfm opts
then walk handleGfmMath
else id) .
(if readerStripComments opts
then walk stripBlockComments . walk stripInlineComments
else id) <$>
if isEnabled Ext_sourcepos opts
then case runIdentity (parseCommonmarkWith (specFor opts) toks) of
Left err -> throwError $ fromParsecError s err
Right (Cm bls :: Cm SourceRange Blocks) -> return $ B.doc bls
else case runIdentity (parseCommonmarkWith (specFor opts) toks) of
Left err -> throwError $ fromParsecError s err
Right (Cm bls :: Cm () Blocks) -> return $ B.doc bls
handleGfmMath :: Block -> Block
handleGfmMath (CodeBlock ("",["math"],[]) raw) = Para [Math DisplayMath raw]
handleGfmMath x = walk handleGfmMathInline x
handleGfmMathInline :: Inline -> Inline
handleGfmMathInline (Math InlineMath math'') =
let math' = T.replace "\\\\{" "\\{" . T.replace "\\\\}" "\\}" $ math''
-- see #10631
(ticks, rest) = T.span (== '`') math'
in if T.null ticks
then Math InlineMath math'
else case T.stripSuffix ticks rest of
Just middle | not (T.null middle) && (T.last middle /= '`')
-> Math InlineMath middle
_ -> Math InlineMath math'
handleGfmMathInline x = x
stripBlockComments :: Block -> Block
stripBlockComments (RawBlock (B.Format "html") s) =
RawBlock (B.Format "html") (removeComments s)
stripBlockComments x = x
stripInlineComments :: Inline -> Inline
stripInlineComments (RawInline (B.Format "html") s) =
RawInline (B.Format "html") (removeComments s)
stripInlineComments x = x
removeComments :: Text -> Text
removeComments s =
either (const s) id $ A.parseOnly pRemoveComments s
where
pRemoveComments = mconcat <$> A.many'
("" <$ (A.string "<!--" *> A.scan (0 :: Int) scanChar <* A.char '>') <|>
(A.takeWhile1 (/= '<')) <|>
(A.string "<"))
scanChar st c =
case c of
'-' -> Just (st + 1)
'>' | st >= 2 -> Nothing
_ -> Just 0
specFor :: (Monad m, Typeable m, Typeable a,
Rangeable (Cm a Inlines), Rangeable (Cm a Blocks))
=> ReaderOptions -> SyntaxSpec m (Cm a Inlines) (Cm a Blocks)
specFor opts = foldr ($) defaultSyntaxSpec exts
where
exts = [ (hardLineBreaksSpec <>) | isEnabled Ext_hard_line_breaks opts ] ++
[ (smartPunctuationSpec <>) | isEnabled Ext_smart opts ] ++
[ (strikethroughSpec <>) | isEnabled Ext_strikeout opts ] ++
[ (superscriptSpec <>) | isEnabled Ext_superscript opts ] ++
[ (subscriptSpec <>) | isEnabled Ext_subscript opts ] ++
[ (mathSpec <>) | isEnabled Ext_tex_math_dollars opts ] ++
[ (fancyListSpec <>) | isEnabled Ext_fancy_lists opts ] ++
[ (fencedDivSpec <>) | isEnabled Ext_fenced_divs opts ] ++
[ (bracketedSpanSpec <>) | isEnabled Ext_bracketed_spans opts ] ++
[ (rawAttributeSpec <>) | isEnabled Ext_raw_attribute opts ] ++
[ (attributesSpec <>) | isEnabled Ext_attributes opts ] ++
[ (alertSpec <>) | isEnabled Ext_alerts opts ] ++
[ (<> pipeTableSpec) | isEnabled Ext_pipe_tables opts ] ++
-- see #6739
[ (autolinkSpec <>) | isEnabled Ext_autolink_bare_uris opts ] ++
[ (emojiSpec <>) | isEnabled Ext_emoji opts ] ++
[ (autoIdentifiersSpec <>)
| isEnabled Ext_gfm_auto_identifiers opts
, not (isEnabled Ext_ascii_identifiers opts) ] ++
[ (autoIdentifiersAsciiSpec <>)
| isEnabled Ext_gfm_auto_identifiers opts
, isEnabled Ext_ascii_identifiers opts ] ++
[ (implicitHeadingReferencesSpec <>)
| isEnabled Ext_implicit_header_references opts ] ++
[ (footnoteSpec <>) | isEnabled Ext_footnotes opts ] ++
[ (definitionListSpec <>) | isEnabled Ext_definition_lists opts ] ++
[ (taskListSpec <>) | isEnabled Ext_task_lists opts ] ++
[ (wikilinksSpec TitleAfterPipe <>)
| isEnabled Ext_wikilinks_title_after_pipe opts ] ++
[ (wikilinksSpec TitleBeforePipe <>)
| isEnabled Ext_wikilinks_title_before_pipe opts ] ++
[ (rebaseRelativePathsSpec <>)
| isEnabled Ext_rebase_relative_paths opts ]
|
