Update Markdown

semantic-diff.cabal

@@ -41,7 +41,6 @@ library
                      , Data.Syntax.Declaration
                      , Data.Syntax.Expression
                      , Data.Syntax.Literal
-                     , Data.Syntax.Markup
                      , Data.Syntax.Statement
                      , Data.Syntax.Type
                      , Data.Term
@@ -50,6 +49,7 @@ library
                      , Interpreter
                      , Language
                      , Language.Markdown
+                     , Language.Markdown.Assignment
                      , Language.Markdown.Syntax
                      , Language.Go
                      , Language.Go.Syntax

src/Data/Syntax/Markup.hs

@@ -1,158 +0,0 @@
-{-# LANGUAGE DeriveAnyClass #-}
-module Data.Syntax.Markup where
-
-import Algorithm
-import Data.Align.Generic
-import Data.ByteString (ByteString)
-import Data.Functor.Classes.Eq.Generic
-import Data.Functor.Classes.Ord.Generic
-import Data.Functor.Classes.Show.Generic
-import Data.Mergeable
-import GHC.Generics
-
-
-newtype Document a = Document [a]
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
-
-instance Eq1 Document where liftEq = genericLiftEq
-instance Ord1 Document where liftCompare = genericLiftCompare
-instance Show1 Document where liftShowsPrec = genericLiftShowsPrec
-
-
--- Block elements
-
-newtype Paragraph a = Paragraph [a]
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
-
-instance Eq1 Paragraph where liftEq = genericLiftEq
-instance Ord1 Paragraph where liftCompare = genericLiftCompare
-instance Show1 Paragraph where liftShowsPrec = genericLiftShowsPrec
-
-data Section a = Section { sectionLevel :: Int, sectionHeading :: a, sectionContent :: [a] }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
-
-instance Eq1 Section where liftEq = genericLiftEq
-instance Ord1 Section where liftCompare = genericLiftCompare
-instance Show1 Section where liftShowsPrec = genericLiftShowsPrec
-
-data Heading a = Heading { headingLevel :: Int, headingContent :: [a] }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
-
-instance Eq1 Heading where liftEq = genericLiftEq
-instance Ord1 Heading where liftCompare = genericLiftCompare
-instance Show1 Heading where liftShowsPrec = genericLiftShowsPrec
-
-newtype UnorderedList a = UnorderedList [a]
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
-
-instance Eq1 UnorderedList where liftEq = genericLiftEq
-instance Ord1 UnorderedList where liftCompare = genericLiftCompare
-instance Show1 UnorderedList where liftShowsPrec = genericLiftShowsPrec
-
-newtype OrderedList a = OrderedList [a]
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
-
-instance Eq1 OrderedList where liftEq = genericLiftEq
-instance Ord1 OrderedList where liftCompare = genericLiftCompare
-instance Show1 OrderedList where liftShowsPrec = genericLiftShowsPrec
-
-newtype BlockQuote a = BlockQuote [a]
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
-
-instance Eq1 BlockQuote where liftEq = genericLiftEq
-instance Ord1 BlockQuote where liftCompare = genericLiftCompare
-instance Show1 BlockQuote where liftShowsPrec = genericLiftShowsPrec
-
-data ThematicBreak a = ThematicBreak
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
-
-instance Eq1 ThematicBreak where liftEq = genericLiftEq
-instance Ord1 ThematicBreak where liftCompare = genericLiftCompare
-instance Show1 ThematicBreak where liftShowsPrec = genericLiftShowsPrec
-
-data HTMLBlock a = HTMLBlock ByteString
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
-
-instance Eq1 HTMLBlock where liftEq = genericLiftEq
-instance Ord1 HTMLBlock where liftCompare = genericLiftCompare
-instance Show1 HTMLBlock where liftShowsPrec = genericLiftShowsPrec
-
-newtype Table a = Table [a]
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
-
-instance Eq1 Table where liftEq = genericLiftEq
-instance Ord1 Table where liftCompare = genericLiftCompare
-instance Show1 Table where liftShowsPrec = genericLiftShowsPrec
-
-newtype TableRow a = TableRow [a]
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
-
-instance Eq1 TableRow where liftEq = genericLiftEq
-instance Ord1 TableRow where liftCompare = genericLiftCompare
-instance Show1 TableRow where liftShowsPrec = genericLiftShowsPrec
-
-newtype TableCell a = TableCell [a]
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
-
-instance Eq1 TableCell where liftEq = genericLiftEq
-instance Ord1 TableCell where liftCompare = genericLiftCompare
-instance Show1 TableCell where liftShowsPrec = genericLiftShowsPrec
-
-
--- Inline elements
-
-newtype Strong a = Strong [a]
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
-
-instance Eq1 Strong where liftEq = genericLiftEq
-instance Ord1 Strong where liftCompare = genericLiftCompare
-instance Show1 Strong where liftShowsPrec = genericLiftShowsPrec
-
-newtype Emphasis a = Emphasis [a]
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
-
-instance Eq1 Emphasis where liftEq = genericLiftEq
-instance Ord1 Emphasis where liftCompare = genericLiftCompare
-instance Show1 Emphasis where liftShowsPrec = genericLiftShowsPrec
-
-newtype Text a = Text ByteString
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
-
-instance Eq1 Text where liftEq = genericLiftEq
-instance Ord1 Text where liftCompare = genericLiftCompare
-instance Show1 Text where liftShowsPrec = genericLiftShowsPrec
-
-data Link a = Link { linkURL :: ByteString, linkTitle :: Maybe ByteString }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
-
-instance Eq1 Link where liftEq = genericLiftEq
-instance Ord1 Link where liftCompare = genericLiftCompare
-instance Show1 Link where liftShowsPrec = genericLiftShowsPrec
-
-data Image a = Image { imageURL :: ByteString, imageTitle :: Maybe ByteString }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
-
-instance Eq1 Image where liftEq = genericLiftEq
-instance Ord1 Image where liftCompare = genericLiftCompare
-instance Show1 Image where liftShowsPrec = genericLiftShowsPrec
-
-data Code a = Code { codeLanguage :: Maybe ByteString, codeContent :: ByteString }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
-
-instance Eq1 Code where liftEq = genericLiftEq
-instance Ord1 Code where liftCompare = genericLiftCompare
-instance Show1 Code where liftShowsPrec = genericLiftShowsPrec
-
-data LineBreak a = LineBreak
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
-
-instance Eq1 LineBreak where liftEq = genericLiftEq
-instance Ord1 LineBreak where liftCompare = genericLiftCompare
-instance Show1 LineBreak where liftShowsPrec = genericLiftShowsPrec
-
-newtype Strikethrough a = Strikethrough [a]
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
-
-instance Eq1 Strikethrough where liftEq = genericLiftEq
-instance Ord1 Strikethrough where liftCompare = genericLiftCompare
-instance Show1 Strikethrough where liftShowsPrec = genericLiftShowsPrec

src/Language/Markdown/Assignment.hs

@@ -0,0 +1,145 @@
+{-# LANGUAGE DataKinds, RankNTypes, TypeOperators #-}
+module Language.Markdown.Assignment
+( assignment
+, Syntax
+, Grammar
+, Language.Markdown.Assignment.Term
+) where
+
+import qualified CMarkGFM
+import Data.ByteString (ByteString)
+import Data.Function (on)
+import Data.Record
+import Data.Syntax (makeTerm)
+import qualified Data.Syntax as Syntax
+import Data.Syntax.Assignment hiding (Assignment, Error)
+import qualified Data.Syntax.Assignment as Assignment
+import Data.Term as Term (Term(..), TermF(..), termIn, unwrap)
+import qualified Data.Text as Text
+import Data.Text.Encoding (encodeUtf8)
+import Data.Union
+import GHC.Stack
+import Language.Markdown as Grammar (Grammar(..))
+import qualified Language.Markdown.Syntax as Markup
+
+type Syntax =
+  '[ Markup.Document
+   -- Block elements
+   , Markup.BlockQuote
+   , Markup.Heading
+   , Markup.HTMLBlock
+   , Markup.OrderedList
+   , Markup.Paragraph
+   , Markup.Section
+   , Markup.ThematicBreak
+   , Markup.UnorderedList
+   , Markup.Table
+   , Markup.TableRow
+   , Markup.TableCell
+   -- Inline elements
+   , Markup.Code
+   , Markup.Emphasis
+   , Markup.Image
+   , Markup.LineBreak
+   , Markup.Link
+   , Markup.Strong
+   , Markup.Text
+   , Markup.Strikethrough
+   -- Assignment errors; cmark does not provide parse errors.
+   , Syntax.Error
+   , []
+   ]
+
+type Term = Term.Term (Union Syntax) (Record Location)
+type Assignment = HasCallStack => Assignment.Assignment (TermF [] CMarkGFM.NodeType) Grammar Language.Markdown.Assignment.Term
+
+
+assignment :: Assignment
+assignment = makeTerm <$> symbol Document <*> children (Markup.Document <$> many blockElement)
+
+
+-- Block elements
+
+blockElement :: Assignment
+blockElement = paragraph <|> list <|> blockQuote <|> codeBlock <|> thematicBreak <|> htmlBlock <|> section <|> table
+
+paragraph :: Assignment
+paragraph = makeTerm <$> symbol Paragraph <*> children (Markup.Paragraph <$> many inlineElement)
+
+list :: Assignment
+list = termIn <$> symbol List <*> ((\ (CMarkGFM.LIST CMarkGFM.ListAttributes{..}) -> case listType of
+  CMarkGFM.BULLET_LIST -> inj . Markup.UnorderedList
+  CMarkGFM.ORDERED_LIST -> inj . Markup.OrderedList) . termAnnotation . termOut <$> currentNode <*> 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 <*> ((\ (CMarkGFM.HEADING level) -> Markup.Heading level) . termAnnotation . termOut <$> currentNode <*> 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
+          _ -> maxBound
+
+blockQuote :: Assignment
+blockQuote = makeTerm <$> symbol BlockQuote <*> children (Markup.BlockQuote <$> many blockElement)
+
+codeBlock :: Assignment
+codeBlock = makeTerm <$> symbol CodeBlock <*> ((\ (CMarkGFM.CODE_BLOCK language _) -> Markup.Code (nullText language)) . termAnnotation . termOut <$> currentNode <*> source)
+
+thematicBreak :: Assignment
+thematicBreak = makeTerm <$> token 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 = strong <|> emphasis <|> strikethrough <|> text <|> link <|> htmlInline <|> image <|> code <|> lineBreak <|> softBreak
+
+strong :: Assignment
+strong = makeTerm <$> symbol Strong <*> children (Markup.Strong <$> many inlineElement)
+
+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)
+
+htmlInline :: Assignment
+htmlInline = makeTerm <$> symbol HTMLInline <*> (Markup.HTMLBlock <$> source)
+
+link :: Assignment
+link = makeTerm <$> symbol Link <*> ((\ (CMarkGFM.LINK url title) -> Markup.Link (encodeUtf8 url) (nullText title)) . termAnnotation . termOut <$> currentNode) <* advance
+
+image :: Assignment
+image = makeTerm <$> symbol Image <*> ((\ (CMarkGFM.IMAGE url title) -> Markup.Image (encodeUtf8 url) (nullText title)) . termAnnotation . termOut <$> currentNode) <* advance
+
+code :: Assignment
+code = makeTerm <$> symbol Code <*> (Markup.Code Nothing <$> source)
+
+lineBreak :: Assignment
+lineBreak = makeTerm <$> token LineBreak <*> pure Markup.LineBreak
+
+softBreak :: Assignment
+softBreak = makeTerm <$> token SoftBreak <*> pure Markup.LineBreak
+
+
+-- Implementation details
+
+nullText :: Text.Text -> Maybe ByteString
+nullText text = if Text.null text then Nothing else Just (encodeUtf8 text)

src/Language/Markdown/Syntax.hs

@@ -1,145 +1,158 @@
-{-# LANGUAGE DataKinds, GADTs, RankNTypes, TypeOperators #-}
+{-# LANGUAGE DeriveAnyClass #-}
-module Language.Markdown.Syntax
+module Language.Markdown.Syntax where
-( assignment
-, Syntax
-, Grammar
-, Language.Markdown.Syntax.Term
-) where
 
-import qualified CMarkGFM
+import Algorithm
+import Data.Align.Generic
 import Data.ByteString (ByteString)
-import Data.Function (on)
+import Data.Functor.Classes.Eq.Generic
-import Data.Record
+import Data.Functor.Classes.Ord.Generic
-import Data.Syntax (makeTerm)
+import Data.Functor.Classes.Show.Generic
-import qualified Data.Syntax as Syntax
+import Data.Mergeable
-import Data.Syntax.Assignment hiding (Assignment, Error)
+import GHC.Generics
-import qualified Data.Syntax.Assignment as Assignment
-import qualified Data.Syntax.Markup as Markup
-import Data.Term as Term (Term(..), TermF(..), termIn, unwrap)
-import qualified Data.Text as Text
-import Data.Text.Encoding (encodeUtf8)
-import Data.Union
-import GHC.Stack
-import Language.Markdown as Grammar (Grammar(..))
-
-type Syntax =
-  '[ Markup.Document
-   -- Block elements
-   , Markup.BlockQuote
-   , Markup.Heading
-   , Markup.HTMLBlock
-   , Markup.OrderedList
-   , Markup.Paragraph
-   , Markup.Section
-   , Markup.ThematicBreak
-   , Markup.UnorderedList
-   , Markup.Table
-   , Markup.TableRow
-   , Markup.TableCell
-   -- Inline elements
-   , Markup.Code
-   , Markup.Emphasis
-   , Markup.Image
-   , Markup.LineBreak
-   , Markup.Link
-   , Markup.Strong
-   , Markup.Text
-   , Markup.Strikethrough
-   -- Assignment errors; cmark does not provide parse errors.
-   , Syntax.Error
-   , []
-   ]
-
-type Term = Term.Term (Union Syntax) (Record Location)
-type Assignment = HasCallStack => Assignment.Assignment (TermF [] CMarkGFM.NodeType) Grammar Language.Markdown.Syntax.Term
 
 
-assignment :: Assignment
+newtype Document a = Document [a]
-assignment = makeTerm <$> symbol Document <*> children (Markup.Document <$> many blockElement)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
+
+instance Eq1 Document where liftEq = genericLiftEq
+instance Ord1 Document where liftCompare = genericLiftCompare
+instance Show1 Document where liftShowsPrec = genericLiftShowsPrec
 
 
 -- Block elements
 
-blockElement :: Assignment
+newtype Paragraph a = Paragraph [a]
-blockElement = paragraph <|> list <|> blockQuote <|> codeBlock <|> thematicBreak <|> htmlBlock <|> section <|> table
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
 
-paragraph :: Assignment
+instance Eq1 Paragraph where liftEq = genericLiftEq
-paragraph = makeTerm <$> symbol Paragraph <*> children (Markup.Paragraph <$> many inlineElement)
+instance Ord1 Paragraph where liftCompare = genericLiftCompare
+instance Show1 Paragraph where liftShowsPrec = genericLiftShowsPrec
 
-list :: Assignment
+data Section a = Section { sectionLevel :: Int, sectionHeading :: a, sectionContent :: [a] }
-list = termIn <$> symbol List <*> ((\ (CMarkGFM.LIST CMarkGFM.ListAttributes{..}) -> case listType of
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
-  CMarkGFM.BULLET_LIST -> inj . Markup.UnorderedList
-  CMarkGFM.ORDERED_LIST -> inj . Markup.OrderedList) . termAnnotation . termOut <$> currentNode <*> children (many item))
 
-item :: Assignment
+instance Eq1 Section where liftEq = genericLiftEq
-item = makeTerm <$> symbol Item <*> children (many blockElement)
+instance Ord1 Section where liftCompare = genericLiftCompare
+instance Show1 Section where liftShowsPrec = genericLiftShowsPrec
 
-section :: Assignment
+data Heading a = Heading { headingLevel :: Int, headingContent :: [a] }
-section = makeTerm <$> symbol Heading <*> (heading >>= \ headingTerm -> Markup.Section (level headingTerm) headingTerm <$> while (((<) `on` level) headingTerm) blockElement)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
-  where heading = makeTerm <$> symbol Heading <*> ((\ (CMarkGFM.HEADING level) -> Markup.Heading level) . termAnnotation . termOut <$> currentNode <*> 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
-          _ -> maxBound
 
-blockQuote :: Assignment
+instance Eq1 Heading where liftEq = genericLiftEq
-blockQuote = makeTerm <$> symbol BlockQuote <*> children (Markup.BlockQuote <$> many blockElement)
+instance Ord1 Heading where liftCompare = genericLiftCompare
+instance Show1 Heading where liftShowsPrec = genericLiftShowsPrec
 
-codeBlock :: Assignment
+newtype UnorderedList a = UnorderedList [a]
-codeBlock = makeTerm <$> symbol CodeBlock <*> ((\ (CMarkGFM.CODE_BLOCK language _) -> Markup.Code (nullText language)) . termAnnotation . termOut <$> currentNode <*> source)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
 
-thematicBreak :: Assignment
+instance Eq1 UnorderedList where liftEq = genericLiftEq
-thematicBreak = makeTerm <$> token ThematicBreak <*> pure Markup.ThematicBreak
+instance Ord1 UnorderedList where liftCompare = genericLiftCompare
+instance Show1 UnorderedList where liftShowsPrec = genericLiftShowsPrec
 
-htmlBlock :: Assignment
+newtype OrderedList a = OrderedList [a]
-htmlBlock = makeTerm <$> symbol HTMLBlock <*> (Markup.HTMLBlock <$> source)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
 
-table :: Assignment
+instance Eq1 OrderedList where liftEq = genericLiftEq
-table = makeTerm <$> symbol Table <*> children (Markup.Table <$> many tableRow)
+instance Ord1 OrderedList where liftCompare = genericLiftCompare
+instance Show1 OrderedList where liftShowsPrec = genericLiftShowsPrec
 
-tableRow :: Assignment
+newtype BlockQuote a = BlockQuote [a]
-tableRow = makeTerm <$> symbol TableRow <*> children (Markup.TableRow <$> many tableCell)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
+
+instance Eq1 BlockQuote where liftEq = genericLiftEq
+instance Ord1 BlockQuote where liftCompare = genericLiftCompare
+instance Show1 BlockQuote where liftShowsPrec = genericLiftShowsPrec
+
+data ThematicBreak a = ThematicBreak
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
+
+instance Eq1 ThematicBreak where liftEq = genericLiftEq
+instance Ord1 ThematicBreak where liftCompare = genericLiftCompare
+instance Show1 ThematicBreak where liftShowsPrec = genericLiftShowsPrec
+
+data HTMLBlock a = HTMLBlock ByteString
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
+
+instance Eq1 HTMLBlock where liftEq = genericLiftEq
+instance Ord1 HTMLBlock where liftCompare = genericLiftCompare
+instance Show1 HTMLBlock where liftShowsPrec = genericLiftShowsPrec
+
+newtype Table a = Table [a]
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
+
+instance Eq1 Table where liftEq = genericLiftEq
+instance Ord1 Table where liftCompare = genericLiftCompare
+instance Show1 Table where liftShowsPrec = genericLiftShowsPrec
+
+newtype TableRow a = TableRow [a]
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
+
+instance Eq1 TableRow where liftEq = genericLiftEq
+instance Ord1 TableRow where liftCompare = genericLiftCompare
+instance Show1 TableRow where liftShowsPrec = genericLiftShowsPrec
+
+newtype TableCell a = TableCell [a]
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
+
+instance Eq1 TableCell where liftEq = genericLiftEq
+instance Ord1 TableCell where liftCompare = genericLiftCompare
+instance Show1 TableCell where liftShowsPrec = genericLiftShowsPrec
 
-tableCell :: Assignment
-tableCell = makeTerm <$> symbol TableCell <*> children (Markup.TableCell <$> many inlineElement)
 
 -- Inline elements
 
-inlineElement :: Assignment
+newtype Strong a = Strong [a]
-inlineElement = strong <|> emphasis <|> strikethrough <|> text <|> link <|> htmlInline <|> image <|> code <|> lineBreak <|> softBreak
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
 
-strong :: Assignment
+instance Eq1 Strong where liftEq = genericLiftEq
-strong = makeTerm <$> symbol Strong <*> children (Markup.Strong <$> many inlineElement)
+instance Ord1 Strong where liftCompare = genericLiftCompare
+instance Show1 Strong where liftShowsPrec = genericLiftShowsPrec
 
-emphasis :: Assignment
+newtype Emphasis a = Emphasis [a]
-emphasis = makeTerm <$> symbol Emphasis <*> children (Markup.Emphasis <$> many inlineElement)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
 
-strikethrough :: Assignment
+instance Eq1 Emphasis where liftEq = genericLiftEq
-strikethrough = makeTerm <$> symbol Strikethrough <*> children (Markup.Strikethrough <$> many inlineElement)
+instance Ord1 Emphasis where liftCompare = genericLiftCompare
+instance Show1 Emphasis where liftShowsPrec = genericLiftShowsPrec
 
-text :: Assignment
+newtype Text a = Text ByteString
-text = makeTerm <$> symbol Text <*> (Markup.Text <$> source)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
 
-htmlInline :: Assignment
+instance Eq1 Text where liftEq = genericLiftEq
-htmlInline = makeTerm <$> symbol HTMLInline <*> (Markup.HTMLBlock <$> source)
+instance Ord1 Text where liftCompare = genericLiftCompare
+instance Show1 Text where liftShowsPrec = genericLiftShowsPrec
 
-link :: Assignment
+data Link a = Link { linkURL :: ByteString, linkTitle :: Maybe ByteString }
-link = makeTerm <$> symbol Link <*> ((\ (CMarkGFM.LINK url title) -> Markup.Link (encodeUtf8 url) (nullText title)) . termAnnotation . termOut <$> currentNode) <* advance
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
 
-image :: Assignment
+instance Eq1 Link where liftEq = genericLiftEq
-image = makeTerm <$> symbol Image <*> ((\ (CMarkGFM.IMAGE url title) -> Markup.Image (encodeUtf8 url) (nullText title)) . termAnnotation . termOut <$> currentNode) <* advance
+instance Ord1 Link where liftCompare = genericLiftCompare
+instance Show1 Link where liftShowsPrec = genericLiftShowsPrec
 
-code :: Assignment
+data Image a = Image { imageURL :: ByteString, imageTitle :: Maybe ByteString }
-code = makeTerm <$> symbol Code <*> (Markup.Code Nothing <$> source)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
 
-lineBreak :: Assignment
+instance Eq1 Image where liftEq = genericLiftEq
-lineBreak = makeTerm <$> token LineBreak <*> pure Markup.LineBreak
+instance Ord1 Image where liftCompare = genericLiftCompare
+instance Show1 Image where liftShowsPrec = genericLiftShowsPrec
 
-softBreak :: Assignment
+data Code a = Code { codeLanguage :: Maybe ByteString, codeContent :: ByteString }
-softBreak = makeTerm <$> token SoftBreak <*> pure Markup.LineBreak
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
 
+instance Eq1 Code where liftEq = genericLiftEq
+instance Ord1 Code where liftCompare = genericLiftCompare
+instance Show1 Code where liftShowsPrec = genericLiftShowsPrec
 
--- Implementation details
+data LineBreak a = LineBreak
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
 
-nullText :: Text.Text -> Maybe ByteString
+instance Eq1 LineBreak where liftEq = genericLiftEq
-nullText text = if Text.null text then Nothing else Just (encodeUtf8 text)
+instance Ord1 LineBreak where liftCompare = genericLiftCompare
+instance Show1 LineBreak where liftShowsPrec = genericLiftShowsPrec
+
+newtype Strikethrough a = Strikethrough [a]
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
+
+instance Eq1 Strikethrough where liftEq = genericLiftEq
+instance Ord1 Strikethrough where liftCompare = genericLiftCompare
+instance Show1 Strikethrough where liftShowsPrec = genericLiftShowsPrec

src/Renderer/TOC.hs

@@ -52,7 +52,7 @@ import Syntax as S
 import Data.Syntax.Algebra (RAlgebra)
 import qualified Data.Syntax as Syntax
 import qualified Data.Syntax.Declaration as Declaration
-import qualified Data.Syntax.Markup as Markup
+import qualified Language.Markdown.Syntax as Markup
 
 data Summaries = Summaries { changes, errors :: !(Map.Map T.Text [Value]) }
   deriving (Eq, Show)