1
1
mirror of https://github.com/github/semantic.git synced 2025-01-03 13:02:37 +03:00

Define FAlgebra in terms of the Base of some type.

This commit is contained in:
Rob Rix 2017-04-24 15:44:46 -04:00
parent c53076b071
commit 953034ccb3

View File

@ -109,8 +109,8 @@ optional :: Assignment (Node Grammar) (Term Syntax Location) -> Assignment (Node
optional a = a <|> term <*> pure Syntax.Empty
-- | An F-algebra on some carrier functor 'f'.
type FAlgebra f a = f a -> a
-- | An F-algebra on the base functor of some type 't'.
type FAlgebra t a = Base t a -> a
-- | An R-algebra on the base functor of some type 't'.
type RAlgebra t a = Base t (t, a) -> a
@ -128,7 +128,7 @@ identifiableAlg c@(_ :< union) = case union of
newtype CyclomaticComplexity = CyclomaticComplexity Int
deriving (Enum, Eq, Num, Ord, Show)
cyclomaticComplexityAlg :: (InUnion fs Statement.Return, InUnion fs Statement.Yield, Foldable (Union fs), Functor (Union fs)) => FAlgebra (Base (Term (Union fs) a)) CyclomaticComplexity
cyclomaticComplexityAlg :: (InUnion fs Statement.Return, InUnion fs Statement.Yield, Foldable (Union fs), Functor (Union fs)) => FAlgebra (Term (Union fs) a) CyclomaticComplexity
cyclomaticComplexityAlg (_ :< union) = case union of
_ | Just Statement.Return{} <- prj union -> succ (sum union)
_ | Just Statement.Yield{} <- prj union -> succ (sum union)
@ -136,7 +136,7 @@ cyclomaticComplexityAlg (_ :< union) = case union of
-- | Lift an algebra into a decorator for terms annotated with records.
decoratorWithAlgebra :: Functor f
=> FAlgebra (Base (Term f (Record fs))) a -- ^ An F-algebra on terms.
=> FAlgebra (Term f (Record fs)) a -- ^ An F-algebra on terms.
-> Term f (Record fs) -- ^ A term to decorate with values produced by the F-algebra.
-> Term f (Record (a ': fs)) -- ^ A term decorated with values produced by the F-algebra.
decoratorWithAlgebra alg = cata $ \ c@(a :< f) -> cofree $ (alg (fmap (rhead . extract) c) :. a) :< f