github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-29 01:42:43 +03:00
Code Issues Projects Releases Wiki Activity

Links’ & images’ titles are optional.

Browse Source
This commit is contained in:
Rob Rix 2017-06-07 19:44:22 -04:00
parent a2b931c6ac
commit 6d7602dc64
2 changed files with 8 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -68,13 +68,13 @@ newtype Text a = Text ByteString
instance Eq1 Text where liftEq = genericLiftEq instance Eq1 Text where liftEq = genericLiftEq
instance Show1 Text where liftShowsPrec = genericLiftShowsPrec instance Show1 Text where liftShowsPrec = genericLiftShowsPrec
data Link a = Link { linkURL :: ByteString, linkTitle :: ByteString } data Link a = Link { linkURL :: ByteString, linkTitle :: Maybe ByteString }
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
instance Eq1 Link where liftEq = genericLiftEq instance Eq1 Link where liftEq = genericLiftEq
instance Show1 Link where liftShowsPrec = genericLiftShowsPrec instance Show1 Link where liftShowsPrec = genericLiftShowsPrec
data Image a = Image { imageURL :: ByteString, imageTitle :: ByteString } data Image a = Image { imageURL :: ByteString, imageTitle :: Maybe ByteString }
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
instance Eq1 Image where liftEq = genericLiftEq instance Eq1 Image where liftEq = genericLiftEq

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

@ -71,7 +71,7 @@ blockQuote :: Assignment
blockQuote = makeTerm <$> symbol BlockQuote <*> children (Markup.BlockQuote <$> many blockElement) blockQuote = makeTerm <$> symbol BlockQuote <*> children (Markup.BlockQuote <$> many blockElement)
codeBlock :: Assignment codeBlock :: Assignment
codeBlock = makeTerm <$> symbol CodeBlock <*> (Markup.Code <$> project (\ (((CMark.CODE_BLOCK language _) :. _) :< _) -> if Text.null language then Nothing else Just (toS language)) <*> source) codeBlock = makeTerm <$> symbol CodeBlock <*> (Markup.Code <$> project (\ (((CMark.CODE_BLOCK language _) :. _) :< _) -> nullText language) <*> source)
-- Inline elements -- Inline elements
@ -89,10 +89,10 @@ text :: Assignment
text = makeTerm <$> symbol Text <*> (Markup.Text <$> source) text = makeTerm <$> symbol Text <*> (Markup.Text <$> source)
link :: Assignment link :: Assignment
link = makeTerm <$> symbol Link <*> (uncurry Markup.Link <$> project (\ (((CMark.LINK url title) :. _) :< _) -> (toS url, toS title))) <* source link = makeTerm <$> symbol Link <*> (uncurry Markup.Link <$> project (\ (((CMark.LINK url title) :. _) :< _) -> (toS url, nullText title))) <* source
image :: Assignment image :: Assignment
image = makeTerm <$> symbol Image <*> (uncurry Markup.Image <$> project (\ (((CMark.IMAGE url title) :. _) :< _) -> (toS url, toS title))) <* source image = makeTerm <$> symbol Image <*> (uncurry Markup.Image <$> project (\ (((CMark.IMAGE url title) :. _) :< _) -> (toS url, nullText title))) <* source
code :: Assignment code :: Assignment
code = makeTerm <$> symbol Code <*> (Markup.Code Nothing <$> source) code = makeTerm <$> symbol Code <*> (Markup.Code Nothing <$> source)
@ -102,3 +102,6 @@ code = makeTerm <$> symbol Code <*> (Markup.Code Nothing <$> source)
makeTerm :: (InUnion fs f, HasCallStack) => a -> f (Term.Term (Union fs) a) -> Term.Term (Union fs) a makeTerm :: (InUnion fs f, HasCallStack) => a -> f (Term.Term (Union fs) a) -> Term.Term (Union fs) a
makeTerm a f = cofree $ a :< inj f makeTerm a f = cofree $ a :< inj f
nullText :: Text.Text -> Maybe ByteString
nullText text = if Text.null text then Nothing else Just (toS text)