module Data.Comp.Sum
(
(:<:),
(:+:),
caseF,
proj,
proj2,
proj3,
proj4,
proj5,
proj6,
proj7,
proj8,
proj9,
proj10,
project,
project2,
project3,
project4,
project5,
project6,
project7,
project8,
project9,
project10,
deepProject,
deepProject2,
deepProject3,
deepProject4,
deepProject5,
deepProject6,
deepProject7,
deepProject8,
deepProject9,
deepProject10,
inj,
inj2,
inj3,
inj4,
inj5,
inj6,
inj7,
inj8,
inj9,
inj10,
inject,
inject2,
inject3,
inject4,
inject5,
inject6,
inject7,
inject8,
inject9,
inject10,
deepInject,
deepInject2,
deepInject3,
deepInject4,
deepInject5,
deepInject6,
deepInject7,
deepInject8,
deepInject9,
deepInject10,
injectConst,
injectConst2,
injectConst3,
projectConst,
injectCxt,
liftCxt,
substHoles,
substHoles'
) where
import Data.Comp.Term
import Data.Comp.Algebra
import Data.Comp.Ops
import Data.Comp.Derive.Projections
import Data.Comp.Derive.Injections
import Control.Monad hiding (mapM,sequence)
import Prelude hiding (mapM,sequence)
import Data.Maybe
import Data.Traversable
import Data.Map (Map)
import qualified Data.Map as Map
$(liftM concat $ mapM projn [2..10])
project :: (g :<: f) => Cxt h f a -> Maybe (g (Cxt h f a))
project (Hole _) = Nothing
project (Term t) = proj t
$(liftM concat $ mapM projectn [2..10])
deepProject :: (Traversable g, g :<: f) => CxtFunM Maybe f g
deepProject = appSigFunM' proj
$(liftM concat $ mapM deepProjectn [2..10])
$(liftM concat $ mapM injn [2..10])
inject :: (g :<: f) => g (Cxt h f a) -> Cxt h f a
inject = Term . inj
$(liftM concat $ mapM injectn [2..10])
deepInject :: (Functor g, g :<: f) => CxtFun g f
deepInject = appSigFun inj
$(liftM concat $ mapM deepInjectn [2..10])
injectConst :: (Functor g, g :<: f) => Const g -> Cxt h f a
injectConst = inject . fmap (const undefined)
injectConst2 :: (Functor f1, Functor f2, Functor g, f1 :<: g, f2 :<: g)
=> Const (f1 :+: f2) -> Cxt h g a
injectConst2 = inject2 . fmap (const undefined)
injectConst3 :: (Functor f1, Functor f2, Functor f3, Functor g, f1 :<: g, f2 :<: g, f3 :<: g)
=> Const (f1 :+: f2 :+: f3) -> Cxt h g a
injectConst3 = inject3 . fmap (const undefined)
projectConst :: (Functor g, g :<: f) => Cxt h f a -> Maybe (Const g)
projectConst = fmap (fmap (const ())) . project
injectCxt :: (Functor g, g :<: f) => Cxt h' g (Cxt h f a) -> Cxt h f a
injectCxt = cata' inject
liftCxt :: (Functor f, g :<: f) => g a -> Context f a
liftCxt g = simpCxt $ inj g
substHoles :: (Functor f, Functor g, f :<: g) => Cxt h' f v -> (v -> Cxt h g a) -> Cxt h g a
substHoles c f = injectCxt $ fmap f c
substHoles' :: (Functor f, Functor g, f :<: g, Ord v) => Cxt h' f v -> Map v (Cxt h g a) -> Cxt h g a
substHoles' c m = substHoles c (fromJust . (`Map.lookup` m))
instance (Functor f) => Monad (Context f) where
return = Hole
(>>=) = substHoles
instance (Show (f a), Show (g a)) => Show ((f :+: g) a) where
show (Inl v) = show v
show (Inr v) = show v
instance (Ord (f a), Ord (g a)) => Ord ((f :+: g) a) where
compare (Inl _) (Inr _) = LT
compare (Inr _) (Inl _) = GT
compare (Inl x) (Inl y) = compare x y
compare (Inr x) (Inr y) = compare x y
instance (Eq (f a), Eq (g a)) => Eq ((f :+: g) a) where
(Inl x) == (Inl y) = x == y
(Inr x) == (Inr y) = x == y
_ == _ = False