aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Text/Pandoc/Readers/CommonMark.hs158
-rw-r--r--test/command/gfm.md8
2 files changed, 85 insertions, 81 deletions
diff --git a/src/Text/Pandoc/Readers/CommonMark.hs b/src/Text/Pandoc/Readers/CommonMark.hs
index 14be946e6..2dba18c9f 100644
--- a/src/Text/Pandoc/Readers/CommonMark.hs
+++ b/src/Text/Pandoc/Readers/CommonMark.hs
@@ -43,44 +43,34 @@ import Text.Pandoc.Definition
import Text.Pandoc.Emoji (emojis)
import Text.Pandoc.Options
import Text.Pandoc.Shared (stringify)
-import Text.Pandoc.Walk (walkM, walk)
+import Text.Pandoc.Walk (walkM)
-- | Parse a CommonMark formatted string into a 'Pandoc' structure.
readCommonMark :: PandocMonad m => ReaderOptions -> Text -> m Pandoc
readCommonMark opts s = return $
- (if enabled Ext_gfm_auto_identifiers
+ (if enabled Ext_gfm_auto_identifiers opts
then addHeaderIdentifiers
else id) $
- (if enabled Ext_emoji
- then addEmojis
- else id) $
- (if enabled Ext_hard_line_breaks
- then walk softToHardBreaks
- else id) $
- nodeToPandoc $ commonmarkToNode opts' exts s
- where opts' = [ optSmart | enabled Ext_smart ]
- exts = [ extStrikethrough | enabled Ext_strikeout ] ++
- [ extTable | enabled Ext_pipe_tables ] ++
- [ extAutolink | enabled Ext_autolink_bare_uris ]
- enabled x = extensionEnabled x (readerExtensions opts)
-
-softToHardBreaks :: Inline -> Inline
-softToHardBreaks SoftBreak = LineBreak
-softToHardBreaks x = x
-
-addEmojis :: Pandoc -> Pandoc
-addEmojis = walk go
- where go (Str xs) = Str (convertEmojis xs)
- go x = x
- convertEmojis (':':xs) =
- case break (==':') xs of
- (ys,':':zs) ->
- case Map.lookup ys emojis of
- Just s -> s ++ convertEmojis zs
- Nothing -> ':' : ys ++ convertEmojis (':':zs)
- _ -> ':':xs
- convertEmojis (x:xs) = x : convertEmojis xs
- convertEmojis [] = []
+ nodeToPandoc opts $ commonmarkToNode opts' exts s
+ where opts' = [ optSmart | enabled Ext_smart opts ]
+ exts = [ extStrikethrough | enabled Ext_strikeout opts ] ++
+ [ extTable | enabled Ext_pipe_tables opts ] ++
+ [ extAutolink | enabled Ext_autolink_bare_uris opts ]
+
+-- | Returns True if the given extension is enabled.
+enabled :: Extension -> ReaderOptions -> Bool
+enabled ext opts = ext `extensionEnabled` (readerExtensions opts)
+
+convertEmojis :: String -> String
+convertEmojis (':':xs) =
+ case break (==':') xs of
+ (ys,':':zs) ->
+ case Map.lookup ys emojis of
+ Just s -> s ++ convertEmojis zs
+ Nothing -> ':' : ys ++ convertEmojis (':':zs)
+ _ -> ':':xs
+convertEmojis (x:xs) = x : convertEmojis xs
+convertEmojis [] = []
addHeaderIdentifiers :: Pandoc -> Pandoc
addHeaderIdentifiers doc = evalState (walkM addHeaderId doc) mempty
@@ -105,34 +95,35 @@ toIdent = map (\c -> if isSpace c then '-' else c)
c == '_' || c == '-')
. map toLower . stringify
-nodeToPandoc :: Node -> Pandoc
-nodeToPandoc (Node _ DOCUMENT nodes) =
- Pandoc nullMeta $ foldr addBlock [] nodes
-nodeToPandoc n = -- shouldn't happen
- Pandoc nullMeta $ foldr addBlock [] [n]
+nodeToPandoc :: ReaderOptions -> Node -> Pandoc
+nodeToPandoc opts (Node _ DOCUMENT nodes) =
+ Pandoc nullMeta $ foldr (addBlock opts) [] nodes
+nodeToPandoc opts n = -- shouldn't happen
+ Pandoc nullMeta $ foldr (addBlock opts) [] [n]
-addBlocks :: [Node] -> [Block]
-addBlocks = foldr addBlock []
+addBlocks :: ReaderOptions -> [Node] -> [Block]
+addBlocks opts = foldr (addBlock opts) []
-addBlock :: Node -> [Block] -> [Block]
-addBlock (Node _ PARAGRAPH nodes) =
- (Para (addInlines nodes) :)
-addBlock (Node _ THEMATIC_BREAK _) =
+addBlock :: ReaderOptions -> Node -> [Block] -> [Block]
+addBlock opts (Node _ PARAGRAPH nodes) =
+ (Para (addInlines opts nodes) :)
+addBlock _ (Node _ THEMATIC_BREAK _) =
(HorizontalRule :)
-addBlock (Node _ BLOCK_QUOTE nodes) =
- (BlockQuote (addBlocks nodes) :)
-addBlock (Node _ (HTML_BLOCK t) _) =
- (RawBlock (Format "html") (unpack t) :)
+addBlock opts (Node _ BLOCK_QUOTE nodes) =
+ (BlockQuote (addBlocks opts nodes) :)
+addBlock opts (Node _ (HTML_BLOCK t) _)
+ | enabled Ext_raw_html opts = (RawBlock (Format "html") (unpack t) :)
+ | otherwise = id
-- Note: the cmark parser will never generate CUSTOM_BLOCK,
-- so we don't need to handle it:
-addBlock (Node _ (CUSTOM_BLOCK _onEnter _onExit) _nodes) =
+addBlock _ (Node _ (CUSTOM_BLOCK _onEnter _onExit) _nodes) =
id
-addBlock (Node _ (CODE_BLOCK info t) _) =
+addBlock _ (Node _ (CODE_BLOCK info t) _) =
(CodeBlock ("", take 1 (words (unpack info)), []) (unpack t) :)
-addBlock (Node _ (HEADING lev) nodes) =
- (Header lev ("",[],[]) (addInlines nodes) :)
-addBlock (Node _ (LIST listAttrs) nodes) =
- (constructor (map (setTightness . addBlocks . children) nodes) :)
+addBlock opts (Node _ (HEADING lev) nodes) =
+ (Header lev ("",[],[]) (addInlines opts nodes) :)
+addBlock opts (Node _ (LIST listAttrs) nodes) =
+ (constructor (map (setTightness . addBlocks opts . children) nodes) :)
where constructor = case listType listAttrs of
BULLET_LIST -> BulletList
ORDERED_LIST -> OrderedList
@@ -146,7 +137,7 @@ addBlock (Node _ (LIST listAttrs) nodes) =
delim = case listDelim listAttrs of
PERIOD_DELIM -> Period
PAREN_DELIM -> OneParen
-addBlock (Node _ (TABLE alignments) nodes) = do
+addBlock opts (Node _ (TABLE alignments) nodes) = do
(Table [] aligns widths headers rows :)
where aligns = map fromTableCellAlignment alignments
fromTableCellAlignment NoAlignment = AlignDefault
@@ -169,12 +160,12 @@ addBlock (Node _ (TABLE alignments) nodes) = do
toRow (Node _ t _) = error $ "toRow encountered non-row " ++ show t
toCell (Node _ TABLE_CELL []) = []
toCell (Node _ TABLE_CELL (n:ns))
- | isBlockNode n = addBlocks (n:ns)
- | otherwise = [Plain (addInlines (n:ns))]
+ | isBlockNode n = addBlocks opts (n:ns)
+ | otherwise = [Plain (addInlines opts (n:ns))]
toCell (Node _ t _) = error $ "toCell encountered non-cell " ++ show t
-addBlock (Node _ TABLE_ROW _) = id -- handled in TABLE
-addBlock (Node _ TABLE_CELL _) = id -- handled in TABLE
-addBlock _ = id
+addBlock _ (Node _ TABLE_ROW _) = id -- handled in TABLE
+addBlock _ (Node _ TABLE_CELL _) = id -- handled in TABLE
+addBlock _ _ = id
isBlockNode :: Node -> Bool
isBlockNode (Node _ nodetype _) =
@@ -207,11 +198,11 @@ isBlockNode (Node _ nodetype _) =
children :: Node -> [Node]
children (Node _ _ ns) = ns
-addInlines :: [Node] -> [Inline]
-addInlines = foldr addInline []
+addInlines :: ReaderOptions -> [Node] -> [Inline]
+addInlines opts = foldr (addInline opts) []
-addInline :: Node -> [Inline] -> [Inline]
-addInline (Node _ (TEXT t) _) = (map toinl clumps ++)
+addInline :: ReaderOptions -> Node -> [Inline] -> [Inline]
+addInline opts (Node _ (TEXT t) _) = (map toinl clumps ++)
where raw = unpack t
clumps = groupBy samekind raw
samekind ' ' ' ' = True
@@ -219,25 +210,30 @@ addInline (Node _ (TEXT t) _) = (map toinl clumps ++)
samekind _ ' ' = False
samekind _ _ = True
toinl (' ':_) = Space
- toinl xs = Str xs
-addInline (Node _ LINEBREAK _) = (LineBreak :)
-addInline (Node _ SOFTBREAK _) = (SoftBreak :)
-addInline (Node _ (HTML_INLINE t) _) =
- (RawInline (Format "html") (unpack t) :)
+ toinl xs = Str $ if enabled Ext_emoji opts
+ then convertEmojis xs
+ else xs
+addInline _ (Node _ LINEBREAK _) = (LineBreak :)
+addInline opts (Node _ SOFTBREAK _)
+ | enabled Ext_hard_line_breaks opts = (LineBreak :)
+ | otherwise = (SoftBreak :)
+addInline opts (Node _ (HTML_INLINE t) _)
+ | enabled Ext_raw_html opts = (RawInline (Format "html") (unpack t) :)
+ | otherwise = id
-- Note: the cmark parser will never generate CUSTOM_BLOCK,
-- so we don't need to handle it:
-addInline (Node _ (CUSTOM_INLINE _onEnter _onExit) _nodes) =
+addInline _ (Node _ (CUSTOM_INLINE _onEnter _onExit) _nodes) =
id
-addInline (Node _ (CODE t) _) =
+addInline _ (Node _ (CODE t) _) =
(Code ("",[],[]) (unpack t) :)
-addInline (Node _ EMPH nodes) =
- (Emph (addInlines nodes) :)
-addInline (Node _ STRONG nodes) =
- (Strong (addInlines nodes) :)
-addInline (Node _ STRIKETHROUGH nodes) =
- (Strikeout (addInlines nodes) :)
-addInline (Node _ (LINK url title) nodes) =
- (Link nullAttr (addInlines nodes) (unpack url, unpack title) :)
-addInline (Node _ (IMAGE url title) nodes) =
- (Image nullAttr (addInlines nodes) (unpack url, unpack title) :)
-addInline _ = id
+addInline opts (Node _ EMPH nodes) =
+ (Emph (addInlines opts nodes) :)
+addInline opts (Node _ STRONG nodes) =
+ (Strong (addInlines opts nodes) :)
+addInline opts (Node _ STRIKETHROUGH nodes) =
+ (Strikeout (addInlines opts nodes) :)
+addInline opts (Node _ (LINK url title) nodes) =
+ (Link nullAttr (addInlines opts nodes) (unpack url, unpack title) :)
+addInline opts (Node _ (IMAGE url title) nodes) =
+ (Image nullAttr (addInlines opts nodes) (unpack url, unpack title) :)
+addInline _ _ = id
diff --git a/test/command/gfm.md b/test/command/gfm.md
index c83fa96e3..6dd080dc1 100644
--- a/test/command/gfm.md
+++ b/test/command/gfm.md
@@ -101,3 +101,11 @@ The caption.
```
+
+```
+% pandoc -f gfm+hard_line_breaks -t native
+hi
+hi
+^D
+[Para [Str "hi",LineBreak,Str "hi"]]
+```