diff --git a/semantic-diff.cabal b/semantic-diff.cabal index a091b20ec..4ec534fb9 100644 --- a/semantic-diff.cabal +++ b/semantic-diff.cabal @@ -87,7 +87,7 @@ library , async , bifunctors , bytestring - , cmark + , cmark-gfm , comonad , containers , directory diff --git a/src/Language/Markdown.hs b/src/Language/Markdown.hs index 2b01e2b3e..514e909e1 100644 --- a/src/Language/Markdown.hs +++ b/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,21 @@ 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 +79,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 diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs index eaceb529b..6a511ea37 100644 --- a/src/Language/Markdown/Syntax.hs +++ b/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) diff --git a/src/Parser.hs b/src/Parser.hs index 1329a7173..d8e06a462 100644 --- a/src/Parser.hs +++ b/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)