Merge branch 'master' into delimited-control

src/Data/Syntax/Markup.hs

@@ -66,6 +66,24 @@ data HTMLBlock a = HTMLBlock ByteString
 instance Eq1 HTMLBlock where liftEq = genericLiftEq
 instance Show1 HTMLBlock where liftShowsPrec = genericLiftShowsPrec
 
+newtype Table a = Table [a]
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+
+instance Eq1 Table where liftEq = genericLiftEq
+instance Show1 Table where liftShowsPrec = genericLiftShowsPrec
+
+newtype TableRow a = TableRow [a]
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+
+instance Eq1 TableRow where liftEq = genericLiftEq
+instance Show1 TableRow where liftShowsPrec = genericLiftShowsPrec
+
+newtype TableCell a = TableCell [a]
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+
+instance Eq1 TableCell where liftEq = genericLiftEq
+instance Show1 TableCell where liftShowsPrec = genericLiftShowsPrec
+
 
 -- Inline elements
 
@@ -110,3 +128,9 @@ data LineBreak a = LineBreak
 
 instance Eq1 LineBreak where liftEq = genericLiftEq
 instance Show1 LineBreak where liftShowsPrec = genericLiftShowsPrec
+
+newtype Strikethrough a = Strikethrough [a]
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+
+instance Eq1 Strikethrough where liftEq = genericLiftEq
+instance Show1 Strikethrough where liftShowsPrec = genericLiftShowsPrec

src/Language/Markdown/Syntax.hs

@@ -34,6 +34,9 @@ type Syntax =
    , Markup.Section
    , Markup.ThematicBreak
    , Markup.UnorderedList
+   , Markup.Table
+   , Markup.TableRow
+   , Markup.TableCell
    -- Inline elements
    , Markup.Code
    , Markup.Emphasis
@@ -42,6 +45,7 @@ type Syntax =
    , Markup.Link
    , Markup.Strong
    , Markup.Text
+   , Markup.Strikethrough
    -- Assignment errors; cmark does not provide parse errors.
    , Syntax.Error
    , []
@@ -58,7 +62,7 @@ assignment = makeTerm <$> symbol Document <*> children (Markup.Document <$> many
 -- Block elements
 
 blockElement :: Assignment
-blockElement = handleError $ paragraph <|> list <|> blockQuote <|> codeBlock <|> thematicBreak <|> htmlBlock <|> section
+blockElement = handleError $ paragraph <|> list <|> blockQuote <|> codeBlock <|> thematicBreak <|> htmlBlock <|> section <|> table
 
 paragraph :: Assignment
 paragraph = makeTerm <$> symbol Paragraph <*> children (Markup.Paragraph <$> many inlineElement)
@@ -91,11 +95,19 @@ thematicBreak = makeTerm <$> symbol ThematicBreak <*> pure Markup.ThematicBreak
 htmlBlock :: Assignment
 htmlBlock = makeTerm <$> symbol HTMLBlock <*> (Markup.HTMLBlock <$> source)
 
+table :: Assignment
+table = makeTerm <$> symbol Table <*> children (Markup.Table <$> many tableRow)
+
+tableRow :: Assignment
+tableRow = makeTerm <$> symbol TableRow <*> children (Markup.TableRow <$> many tableCell)
+
+tableCell :: Assignment
+tableCell = makeTerm <$> symbol TableCell <*> children (Markup.TableCell <$> many inlineElement)
 
 -- Inline elements
 
 inlineElement :: Assignment
-inlineElement = handleError $ strong <|> emphasis <|> text <|> link <|> htmlInline <|> image <|> code <|> lineBreak <|> softBreak
+inlineElement = handleError $ strong <|> emphasis <|> strikethrough <|> text <|> link <|> htmlInline <|> image <|> code <|> lineBreak <|> softBreak
 
 strong :: Assignment
 strong = makeTerm <$> symbol Strong <*> children (Markup.Strong <$> many inlineElement)
@@ -103,6 +115,9 @@ strong = makeTerm <$> symbol Strong <*> children (Markup.Strong <$> many inlineE
 emphasis :: Assignment
 emphasis = makeTerm <$> symbol Emphasis <*> children (Markup.Emphasis <$> many inlineElement)
 
+strikethrough :: Assignment
+strikethrough = makeTerm <$> symbol Strikethrough <*> children (Markup.Strikethrough <$> many inlineElement)
+
 text :: Assignment
 text = makeTerm <$> symbol Text <*> (Markup.Text <$> source)
 

src/Parser.hs

@@ -43,7 +43,7 @@ data Parser term where
   -- | A parser producing 'AST' using a 'TS.Language'.
   ASTParser :: (Bounded grammar, Enum grammar) => Ptr TS.Language -> Parser (AST grammar)
   -- | A parser producing an à la carte term given an 'AST'-producing parser and an 'Assignment' onto 'Term's in some syntax type.
-  AssignmentParser :: (Ix grammar, Show grammar, Symbol grammar, Syntax.Error :< fs, Foldable (Union fs), Functor (Union fs), Eq ast, Recursive ast, Foldable (Base ast))
+  AssignmentParser :: (Ix grammar, Show grammar, Symbol grammar, Syntax.Error :< fs, Apply1 Foldable fs, Apply1 Functor fs, Eq ast, Recursive ast, Foldable (Base ast))
                    => Parser ast                                                 -- ^ A parser producing AST.
                    -> (forall x. Base ast x -> Node grammar)                     -- ^ A function extracting the symbol and location.
                    -> Assignment ast grammar (Term (Union fs) (Record Location)) -- ^ An assignment from AST onto 'Term's.