github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-28 01:47:01 +03:00
Code Issues Projects Releases Wiki Activity

Move the markup datatypes to their own module.

Browse Source
This commit is contained in:
Rob Rix 2017-06-07 19:13:49 -04:00
parent a60f9954f4
commit 988cbdb404
2 changed files with 57 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
src/Data/Syntax/Markup.hs
View File

@ -1 +1,44 @@
{-# LANGUAGE DeriveAnyClass #-}
module Data.Syntax.Markup where
import Data.Align.Generic
import Data.Functor.Classes.Eq.Generic
import Data.Functor.Classes.Show.Generic
import GHC.Generics
import Prologue hiding (Text)
newtype Document a = Document [a]
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
instance Eq1 Document where liftEq = genericLiftEq
instance Show1 Document where liftShowsPrec = genericLiftShowsPrec
newtype Paragraph a = Paragraph [a]
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
instance Eq1 Paragraph where liftEq = genericLiftEq
instance Show1 Paragraph where liftShowsPrec = genericLiftShowsPrec
data Heading a = Heading { headingLevel :: Int, headingContent :: [a] }
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
instance Eq1 Heading where liftEq = genericLiftEq
instance Show1 Heading where liftShowsPrec = genericLiftShowsPrec
newtype Strong a = Strong [a]
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
instance Eq1 Strong where liftEq = genericLiftEq
instance Show1 Strong where liftShowsPrec = genericLiftShowsPrec
newtype Emphasis a = Emphasis [a]
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
instance Eq1 Emphasis where liftEq = genericLiftEq
instance Show1 Emphasis where liftShowsPrec = genericLiftShowsPrec
newtype Text a = Text ByteString
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
instance Eq1 Text where liftEq = genericLiftEq
instance Show1 Text where liftShowsPrec = genericLiftShowsPrec

67
src/Language/Markdown/Syntax.hs
View File

@ -8,73 +8,34 @@ module Language.Markdown.Syntax
) where
import qualified CMark
import Data.Align.Generic
import Data.Functor.Classes.Eq.Generic
import Data.Functor.Classes.Show.Generic
import Data.Functor.Union
import Data.Record
import Data.Syntax.Assignment hiding (Assignment, Error)
import qualified Data.Syntax.Assignment as Assignment
import qualified Data.Syntax.Markup as Markup
import qualified Data.Syntax as Syntax
import GHC.Generics
import GHC.Stack
import qualified Language.Markdown as Grammar (Grammar(..), NodeType(..))
import Prologue hiding (Location, Text, list)
import Prologue hiding (Location, list)
import qualified Term
type Syntax =
'[ Document
, Paragraph
, Heading
, Strong
, Emphasis
, Text
'[ Markup.Document
, Markup.Emphasis
, Markup.Heading
, Markup.Paragraph
, Markup.Strong
, Markup.Text
, Syntax.Error Error
, []
]
newtype Document a = Document [a]
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
instance Eq1 Document where liftEq = genericLiftEq
instance Show1 Document where liftShowsPrec = genericLiftShowsPrec
newtype Paragraph a = Paragraph [a]
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
instance Eq1 Paragraph where liftEq = genericLiftEq
instance Show1 Paragraph where liftShowsPrec = genericLiftShowsPrec
data Heading a = Heading { headingLevel :: Int, headingContent :: [a] }
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
instance Eq1 Heading where liftEq = genericLiftEq
instance Show1 Heading where liftShowsPrec = genericLiftShowsPrec
newtype Strong a = Strong [a]
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
instance Eq1 Strong where liftEq = genericLiftEq
instance Show1 Strong where liftShowsPrec = genericLiftShowsPrec
newtype Emphasis a = Emphasis [a]
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
instance Eq1 Emphasis where liftEq = genericLiftEq
instance Show1 Emphasis where liftShowsPrec = genericLiftShowsPrec
newtype Text a = Text ByteString
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
instance Eq1 Text where liftEq = genericLiftEq
instance Show1 Text where liftShowsPrec = genericLiftShowsPrec
type Error = Assignment.Error Grammar.Grammar
type Term = Term.Term (Union Syntax) (Record Location)
type Assignment = HasCallStack => Assignment.Assignment (Cofree [] (Record (CMark.NodeType ': Location))) Grammar.Grammar Term
assignment :: Assignment
assignment = makeTerm <$> symbol Grammar.Document <*> children (Document <$> many blockElement)
assignment = makeTerm <$> symbol Grammar.Document <*> children (Markup.Document <$> many blockElement)
-- Block elements
@ -82,7 +43,7 @@ blockElement :: Assignment
blockElement = paragraph <|> list <|> heading
paragraph :: Assignment
paragraph = makeTerm <$> symbol Grammar.Paragraph <*> children (Paragraph <$> many inlineElement)
paragraph = makeTerm <$> symbol Grammar.Paragraph <*> children (Markup.Paragraph <$> many inlineElement)
list :: Assignment
list = makeTerm <$> symbol Grammar.List <*> children (many item)
@ -91,7 +52,7 @@ item :: Assignment
item = symbol Grammar.Item *> children blockElement
heading :: Assignment
heading = makeTerm <$> symbol Grammar.Heading <*> (Heading <$> project (\ ((Grammar.HEADING level :. _) :< _) -> level) <*> children (many inlineElement))
heading = makeTerm <$> symbol Grammar.Heading <*> (Markup.Heading <$> project (\ ((Grammar.HEADING level :. _) :< _) -> level) <*> children (many inlineElement))
-- Inline elements
@ -100,13 +61,13 @@ inlineElement :: Assignment
inlineElement = strong <|> emphasis <|> text
strong :: Assignment
strong = makeTerm <$> symbol Grammar.Strong <*> children (Strong <$> many inlineElement)
strong = makeTerm <$> symbol Grammar.Strong <*> children (Markup.Strong <$> many inlineElement)
emphasis :: Assignment
emphasis = makeTerm <$> symbol Grammar.Emphasis <*> children (Emphasis <$> many inlineElement)
emphasis = makeTerm <$> symbol Grammar.Emphasis <*> children (Markup.Emphasis <$> many inlineElement)
text :: Assignment
text = makeTerm <$> symbol Grammar.Text <*> (Text <$> source)
text = makeTerm <$> symbol Grammar.Text <*> (Markup.Text <$> source)
makeTerm :: (InUnion fs f, HasCallStack) => a -> f (Term.Term (Union fs) a) -> Term.Term (Union fs) a