mirror of
https://github.com/github/semantic.git
synced 2024-12-24 15:35:14 +03:00
Update Markdown
This commit is contained in:
Rick Winfrey
parent
a1185a3800
commit
2be6e5eef6
@ -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
|
||||
|
||||
@ -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
|
||||
145
src/Language/Markdown/Assignment.hs
Normal file
145
src/Language/Markdown/Assignment.hs
Normal file
@ -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)
|
||||
@ -1,145 +1,158 @@
|
||||
{-# LANGUAGE DataKinds, GADTs, RankNTypes, TypeOperators #-}
|
||||
module Language.Markdown.Syntax
|
||||
( assignment
|
||||
, Syntax
|
||||
, Grammar
|
||||
, Language.Markdown.Syntax.Term
|
||||
) where
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
module Language.Markdown.Syntax where
|
||||
|
||||
import qualified CMarkGFM
|
||||
import Algorithm
|
||||
import Data.Align.Generic
|
||||
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 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
|
||||
import Data.Functor.Classes.Eq.Generic
|
||||
import Data.Functor.Classes.Ord.Generic
|
||||
import Data.Functor.Classes.Show.Generic
|
||||
import Data.Mergeable
|
||||
import GHC.Generics
|
||||
|
||||
|
||||
assignment :: Assignment
|
||||
assignment = makeTerm <$> symbol Document <*> children (Markup.Document <$> many blockElement)
|
||||
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
|
||||
|
||||
blockElement :: Assignment
|
||||
blockElement = paragraph <|> list <|> blockQuote <|> codeBlock <|> thematicBreak <|> htmlBlock <|> section <|> table
|
||||
newtype Paragraph a = Paragraph [a]
|
||||
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
|
||||
|
||||
paragraph :: Assignment
|
||||
paragraph = makeTerm <$> symbol Paragraph <*> children (Markup.Paragraph <$> many inlineElement)
|
||||
instance Eq1 Paragraph where liftEq = genericLiftEq
|
||||
instance Ord1 Paragraph where liftCompare = genericLiftCompare
|
||||
instance Show1 Paragraph where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
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))
|
||||
data Section a = Section { sectionLevel :: Int, sectionHeading :: a, sectionContent :: [a] }
|
||||
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
|
||||
|
||||
item :: Assignment
|
||||
item = makeTerm <$> symbol Item <*> children (many blockElement)
|
||||
instance Eq1 Section where liftEq = genericLiftEq
|
||||
instance Ord1 Section where liftCompare = genericLiftCompare
|
||||
instance Show1 Section where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
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
|
||||
data Heading a = Heading { headingLevel :: Int, headingContent :: [a] }
|
||||
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
|
||||
|
||||
blockQuote :: Assignment
|
||||
blockQuote = makeTerm <$> symbol BlockQuote <*> children (Markup.BlockQuote <$> many blockElement)
|
||||
instance Eq1 Heading where liftEq = genericLiftEq
|
||||
instance Ord1 Heading where liftCompare = genericLiftCompare
|
||||
instance Show1 Heading where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
codeBlock :: Assignment
|
||||
codeBlock = makeTerm <$> symbol CodeBlock <*> ((\ (CMarkGFM.CODE_BLOCK language _) -> Markup.Code (nullText language)) . termAnnotation . termOut <$> currentNode <*> source)
|
||||
newtype UnorderedList a = UnorderedList [a]
|
||||
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
|
||||
|
||||
thematicBreak :: Assignment
|
||||
thematicBreak = makeTerm <$> token ThematicBreak <*> pure Markup.ThematicBreak
|
||||
instance Eq1 UnorderedList where liftEq = genericLiftEq
|
||||
instance Ord1 UnorderedList where liftCompare = genericLiftCompare
|
||||
instance Show1 UnorderedList where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
htmlBlock :: Assignment
|
||||
htmlBlock = makeTerm <$> symbol HTMLBlock <*> (Markup.HTMLBlock <$> source)
|
||||
newtype OrderedList a = OrderedList [a]
|
||||
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
|
||||
|
||||
table :: Assignment
|
||||
table = makeTerm <$> symbol Table <*> children (Markup.Table <$> many tableRow)
|
||||
instance Eq1 OrderedList where liftEq = genericLiftEq
|
||||
instance Ord1 OrderedList where liftCompare = genericLiftCompare
|
||||
instance Show1 OrderedList where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
tableRow :: Assignment
|
||||
tableRow = makeTerm <$> symbol TableRow <*> children (Markup.TableRow <$> many tableCell)
|
||||
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
|
||||
|
||||
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
|
||||
newtype Strong a = Strong [a]
|
||||
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
|
||||
|
||||
strong :: Assignment
|
||||
strong = makeTerm <$> symbol Strong <*> children (Markup.Strong <$> many inlineElement)
|
||||
instance Eq1 Strong where liftEq = genericLiftEq
|
||||
instance Ord1 Strong where liftCompare = genericLiftCompare
|
||||
instance Show1 Strong where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
emphasis :: Assignment
|
||||
emphasis = makeTerm <$> symbol Emphasis <*> children (Markup.Emphasis <$> many inlineElement)
|
||||
newtype Emphasis a = Emphasis [a]
|
||||
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
|
||||
|
||||
strikethrough :: Assignment
|
||||
strikethrough = makeTerm <$> symbol Strikethrough <*> children (Markup.Strikethrough <$> many inlineElement)
|
||||
instance Eq1 Emphasis where liftEq = genericLiftEq
|
||||
instance Ord1 Emphasis where liftCompare = genericLiftCompare
|
||||
instance Show1 Emphasis where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
text :: Assignment
|
||||
text = makeTerm <$> symbol Text <*> (Markup.Text <$> source)
|
||||
newtype Text a = Text ByteString
|
||||
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
|
||||
|
||||
htmlInline :: Assignment
|
||||
htmlInline = makeTerm <$> symbol HTMLInline <*> (Markup.HTMLBlock <$> source)
|
||||
instance Eq1 Text where liftEq = genericLiftEq
|
||||
instance Ord1 Text where liftCompare = genericLiftCompare
|
||||
instance Show1 Text where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
link :: Assignment
|
||||
link = makeTerm <$> symbol Link <*> ((\ (CMarkGFM.LINK url title) -> Markup.Link (encodeUtf8 url) (nullText title)) . termAnnotation . termOut <$> currentNode) <* advance
|
||||
data Link a = Link { linkURL :: ByteString, linkTitle :: Maybe ByteString }
|
||||
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
|
||||
|
||||
image :: Assignment
|
||||
image = makeTerm <$> symbol Image <*> ((\ (CMarkGFM.IMAGE url title) -> Markup.Image (encodeUtf8 url) (nullText title)) . termAnnotation . termOut <$> currentNode) <* advance
|
||||
instance Eq1 Link where liftEq = genericLiftEq
|
||||
instance Ord1 Link where liftCompare = genericLiftCompare
|
||||
instance Show1 Link where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
code :: Assignment
|
||||
code = makeTerm <$> symbol Code <*> (Markup.Code Nothing <$> source)
|
||||
data Image a = Image { imageURL :: ByteString, imageTitle :: Maybe ByteString }
|
||||
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
|
||||
|
||||
lineBreak :: Assignment
|
||||
lineBreak = makeTerm <$> token LineBreak <*> pure Markup.LineBreak
|
||||
instance Eq1 Image where liftEq = genericLiftEq
|
||||
instance Ord1 Image where liftCompare = genericLiftCompare
|
||||
instance Show1 Image where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
softBreak :: Assignment
|
||||
softBreak = makeTerm <$> token SoftBreak <*> pure Markup.LineBreak
|
||||
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
|
||||
|
||||
-- Implementation details
|
||||
data LineBreak a = LineBreak
|
||||
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
|
||||
|
||||
nullText :: Text.Text -> Maybe ByteString
|
||||
nullText text = if Text.null text then Nothing else Just (encodeUtf8 text)
|
||||
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
|
||||
|
||||
@ -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)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user