github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2025-01-04 05:27:08 +03:00
Code Issues Projects Releases Wiki Activity

📝 makeTerm & friends.

Browse Source
This commit is contained in:
Rob Rix 2017-08-16 14:22:19 -04:00
parent f7abab4186
commit fb60c60c9c
1 changed files with 4 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/Data/Syntax.hs
View File

@ -25,15 +25,19 @@ import Term
-- Combinators
-- | Lift syntax and an annotation into a term, injecting the syntax into a union & ensuring the annotation encompasses all children.
makeTerm :: (HasCallStack, f :< fs, Semigroup a, Apply1 Foldable fs) => a -> f (Term (Union fs) a) -> Term (Union fs) a
makeTerm a = makeTerm' a . inj
-- | Lift a union and an annotation into a term, ensuring the annotation encompasses all children.
makeTerm' :: (HasCallStack, Semigroup a, Foldable f) => a -> f (Term f a) -> Term f a
makeTerm' a f = cofree (sconcat (a :| (headF . runCofree <$> toList f)) :< f)
-- | Lift non-empty syntax into a term, injecting the syntax into a union & appending all subterms’.annotations to make the new term’s annotation.
makeTerm1 :: (HasCallStack, f :< fs, Semigroup a, Apply1 Foldable fs) => f (Term (Union fs) a) -> Term (Union fs) a
makeTerm1 = makeTerm1' . inj
-- | Lift a non-empty union into a term, appending all subterms’.annotations to make the new term’s annotation.
makeTerm1' :: (HasCallStack, Semigroup a, Foldable f) => f (Term f a) -> Term f a
makeTerm1' f = case toList f of
a : _ -> makeTerm' (headF (runCofree a)) f