Merge pull request #1278 from github/cmark-gfm

Use cmark-gfm package

semantic-diff.cabal

@@ -87,7 +87,7 @@ library
                      , async
                      , bifunctors
                      , bytestring
-                     , cmark
+                     , cmark-gfm
                      , comonad
                      , containers
                      , directory

src/Language/Markdown.hs

@@ -5,7 +5,7 @@ module Language.Markdown
 , toGrammar
 ) where
 
-import CMark
+import CMarkGFM
 import Data.Source
 import qualified Data.Syntax.Assignment as A (AST, Node(..))
 import Info
@@ -33,10 +33,22 @@ data Grammar
   | Strong
   | Link
   | Image
+  | Strikethrough
+  | Table
+  | TableRow
+  | TableCell
   deriving (Bounded, Enum, Eq, Ord, Show)
 
+exts :: [CMarkExtension]
+exts = [
+    extStrikethrough
+  , extTable
+  , extAutolink
+  , extTagfilter
+  ]
+
 cmarkParser :: Source -> A.AST NodeType
-cmarkParser source = toTerm (totalRange source) (totalSpan source) $ commonmarkToNode [ optSourcePos, optSafe ] (toText source)
+cmarkParser source = toTerm (totalRange source) (totalSpan source) $ commonmarkToNode [ optSourcePos, optSafe ] exts (toText source)
   where toTerm :: Range -> Span -> Node -> A.AST NodeType
         toTerm within withinSpan (Node position t children) =
           let range = maybe within (spanToRangeInLineRanges lineRanges . toSpan) position
@@ -68,6 +80,10 @@ toGrammar EMPH{} = Emphasis
 toGrammar STRONG{} = Strong
 toGrammar LINK{} = Link
 toGrammar IMAGE{} = Image
+toGrammar STRIKETHROUGH{} = Strikethrough
+toGrammar TABLE{} = Table
+toGrammar TABLE_ROW{} = TableRow
+toGrammar TABLE_CELL{} = TableCell
 
 
 instance Symbol Grammar where

src/Language/Markdown/Syntax.hs

@@ -6,7 +6,7 @@ module Language.Markdown.Syntax
 , Term
 ) where
 
-import qualified CMark
+import qualified CMarkGFM
 import Data.Record
 import Data.Syntax.Assignment hiding (Assignment, Error)
 import qualified Data.Syntax.Assignment as Assignment
@@ -44,7 +44,7 @@ type Syntax =
    ]
 
 type Term = Term.Term (Union Syntax) (Record Location)
-type Assignment = HasCallStack => Assignment.Assignment (AST CMark.NodeType) Grammar Term
+type Assignment = HasCallStack => Assignment.Assignment (AST CMarkGFM.NodeType) Grammar Term
 
 
 assignment :: Assignment
@@ -60,16 +60,16 @@ paragraph :: Assignment
 paragraph = makeTerm <$> symbol Paragraph <*> children (Markup.Paragraph <$> many inlineElement)
 
 list :: Assignment
-list = (cofree .) . (:<) <$> symbol List <*> (project (\ (Node (CMark.LIST CMark.ListAttributes{..}) _ _ :< _) -> case listType of
-  CMark.BULLET_LIST -> inj . Markup.UnorderedList
-  CMark.ORDERED_LIST -> inj . Markup.OrderedList) <*> children (many item))
+list = (cofree .) . (:<) <$> symbol List <*> (project (\ (Node (CMarkGFM.LIST CMarkGFM.ListAttributes{..}) _ _ :< _) -> case listType of
+  CMarkGFM.BULLET_LIST -> inj . Markup.UnorderedList
+  CMarkGFM.ORDERED_LIST -> inj . Markup.OrderedList) <*> children (many item))
 
 item :: Assignment
 item = makeTerm <$> symbol Item <*> children (many blockElement)
 
 section :: Assignment
 section = makeTerm <$> symbol Heading <*> (heading >>= \ headingTerm -> Markup.Section (level headingTerm) headingTerm <$> while (((<) `on` level) headingTerm) blockElement)
-  where heading = makeTerm <$> symbol Heading <*> (project (\ (Node (CMark.HEADING level) _ _ :< _) -> Markup.Heading level) <*> children (many inlineElement))
+  where heading = makeTerm <$> symbol Heading <*> (project (\ (Node (CMarkGFM.HEADING level) _ _ :< _) -> Markup.Heading level) <*> children (many inlineElement))
         level term = case term of
           _ | Just section <- prj (unwrap term) -> level (Markup.sectionHeading section)
           _ | Just heading <- prj (unwrap term) -> Markup.headingLevel heading
@@ -79,7 +79,7 @@ blockQuote :: Assignment
 blockQuote = makeTerm <$> symbol BlockQuote <*> children (Markup.BlockQuote <$> many blockElement)
 
 codeBlock :: Assignment
-codeBlock = makeTerm <$> symbol CodeBlock <*> (project (\ (Node (CMark.CODE_BLOCK language _) _ _ :< _) -> Markup.Code (nullText language)) <*> source)
+codeBlock = makeTerm <$> symbol CodeBlock <*> (project (\ (Node (CMarkGFM.CODE_BLOCK language _) _ _ :< _) -> Markup.Code (nullText language)) <*> source)
 
 thematicBreak :: Assignment
 thematicBreak = makeTerm <$> symbol ThematicBreak <*> pure Markup.ThematicBreak <* source
@@ -106,10 +106,10 @@ htmlInline :: Assignment
 htmlInline = makeTerm <$> symbol HTMLInline <*> (Markup.HTMLBlock <$> source)
 
 link :: Assignment
-link = makeTerm <$> symbol Link <*> project (\ (Node (CMark.LINK url title) _ _ :< _) -> Markup.Link (toS url) (nullText title)) <* source
+link = makeTerm <$> symbol Link <*> project (\ (Node (CMarkGFM.LINK url title) _ _ :< _) -> Markup.Link (toS url) (nullText title)) <* source
 
 image :: Assignment
-image = makeTerm <$> symbol Image <*> project (\ (Node (CMark.IMAGE url title) _ _ :< _) -> Markup.Image (toS url) (nullText title)) <* source
+image = makeTerm <$> symbol Image <*> project (\ (Node (CMarkGFM.IMAGE url title) _ _ :< _) -> Markup.Image (toS url) (nullText title)) <* source
 
 code :: Assignment
 code = makeTerm <$> symbol Code <*> (Markup.Code Nothing <$> source)

src/Parser.hs

@@ -11,7 +11,7 @@ module Parser
 , rubyParser
 ) where
 
-import qualified CMark
+import qualified CMarkGFM
 import Data.Functor.Foldable hiding (fold, Nil)
 import Data.Record
 import Data.Source as Source
@@ -49,7 +49,7 @@ data Parser term where
   -- | A tree-sitter parser.
   TreeSitterParser :: Ptr TS.Language -> Parser (SyntaxTerm DefaultFields)
   -- | A parser for 'Markdown' using cmark.
-  MarkdownParser :: Parser (AST CMark.NodeType)
+  MarkdownParser :: Parser (AST CMarkGFM.NodeType)
   -- | A parser which will parse any input 'Source' into a top-level 'Term' whose children are leaves consisting of the 'Source's lines.
   LineByLineParser :: Parser (SyntaxTerm DefaultFields)