module Data.Comp.Multi.Generic where
import Control.Monad
import Data.Comp.Multi.HFoldable
import Data.Comp.Multi.HFunctor
import Data.Comp.Multi.HTraversable
import Data.Comp.Multi.Sum
import Data.Comp.Multi.Term
import GHC.Exts
import Prelude
import Data.Maybe
subterms :: forall f . HFoldable f => Term f :=> [E (Term f)]
subterms t = build (f t)
where f :: Term f :=> (E (Term f) -> b -> b) -> b -> b
f t cons nil = E t `cons` hfoldl (\u s -> f s cons u) nil (unTerm t)
subterms' :: forall f g . (HFoldable f, g :<: f) => Term f :=> [E (g (Term f))]
subterms' (Term t) = build (f t)
where f :: f (Term f) :=> (E (g (Term f)) -> b -> b) -> b -> b
f t cons nil = let rest = hfoldl (\u (Term s) -> f s cons u) nil t
in case proj t of
Just t' -> E t' `cons` rest
Nothing -> rest
transform :: forall f . (HFunctor f) => (Term f :-> Term f) -> Term f :-> Term f
transform f = run
where run :: Term f :-> Term f
run = f . Term . hfmap run . unTerm
transformM :: forall f m . (HTraversable f, Monad m) =>
NatM m (Term f) (Term f) -> NatM m (Term f) (Term f)
transformM f = run
where run :: NatM m (Term f) (Term f)
run t = f =<< liftM Term (hmapM run $ unTerm t)
query :: HFoldable f => (Term f :=> r) -> (r -> r -> r) -> Term f :=> r
query q c i@(Term t) = hfoldl (\s x -> s `c` query q c x) (q i) t
subs :: HFoldable f => Term f :=> [E (Term f)]
subs = query (\x-> [E x]) (++)
subs' :: (HFoldable f, g :<: f) => Term f :=> [E (g (Term f))]
subs' = mapMaybe pr . subs
where pr (E v) = fmap E (project v)
size :: HFoldable f => Cxt h f a :=> Int
size (Hole {}) = 0
size (Term t) = hfoldl (\s x -> s + size x) 1 t
depth :: HFoldable f => Cxt h f a :=> Int
depth (Hole {}) = 0
depth (Term t) = 1 + hfoldl (\s x -> s `max` depth x) 0 t