{-# LANGUAGE UndecidableInstances, TypeOperators, FlexibleContexts, ExistentialQuantification, KindSignatures, FlexibleInstances, MultiParamTypeClasses #-} module Data.TrieMap.MultiRec.Base (module Generics.MultiRec.Base, module Generics.MultiRec.HFix, {-A0(..), X(..), -}Family(..)) where --, FamT(..), KeyFam(..), FunctorT (..), breakEither) where -- import Data.TrieMap.TriseKey -- import Generics.MultiRec import Generics.MultiRec.Base import Generics.MultiRec.HFix -- import Control.Applicative -- newtype A f (r :: * -> *) ix = A {unA :: f r ix} -- newtype A0 (r :: * -> *) ix = A0 {unA0 :: r ix} -- newtype R (r1 :: * -> *) (r :: * -> *) ix = Rec {unRec :: r1 (r ix)} -- newtype X (r :: * -> *) ix = X {unX :: ix} newtype Family (phi :: * -> *) ix = F {unF :: ix} -- data KeyFam k = TrieKey k (TrieMap k) => KF -- newtype FamT (phi :: * -> *) f ix = FamT (f ix) -- instance TrieKey k (TrieMap k) => El KeyFam k where -- proof = KF -- instance HFunctor phi f => HFunctor phi (A f) where -- hmapA f pf (A x) = A <$> hmapA f pf x -- instance HFunctor phi A0 where -- hmapA f pf (A0 x) = A0 <$> f pf x -- instance HEq phi f => HEq phi (A f) where -- heq f pf (A x) (A y) = heq f pf x y -- instance HEq phi A0 where -- heq f pf (A0 x) (A0 y) = f pf x y {- class FunctorT f where fmapp :: Functor r => (a -> b) -> f r a -> f r b -- instance FunctorT (FamT phi) where -- fmapp f (FamT x) = FamT (fmap f x) instance Functor (Family phi) where fmap f (F x) = F (f x) -- instance Functor f => Functor (FamT phi f) where -- fmap = fmapp -- instance FunctorT (K k) where -- fmapp = fmap instance Functor (K k r) where fmap f (K a) = K a instance FunctorT (I ix) where fmapp = fmap instance Functor (I ix r) where fmap f (I a) = I a instance FunctorT U where fmapp f U = U instance Functor (U r) where fmap f U = U instance (FunctorT f, FunctorT g) => FunctorT (f :*: g) where fmapp f (x :*: y) = fmapp f x :*: fmapp f y instance (Functor (f r), Functor (g r)) => Functor ((f :*: g) r) where fmap f (x :*: y) = fmap f x :*: fmap f y instance (FunctorT f, FunctorT g) => FunctorT (f :+: g) where fmapp f (L l) = L (fmapp f l) fmapp f (R r) = R (fmapp f r) instance (Functor (f r), Functor (g r)) => Functor ((f :+: g) r) where fmap f (L l) = L (fmap f l) fmap f (R r) = R (fmap f r) -- instance FunctorT f => FunctorT (A f) where -- fmapp f (A x) = A (fmapp f x) -- instance FunctorT A0 where -- fmapp f (A0 x) = A0 (fmap f x) -- instance (FunctorT f, Functor r) => Functor (A f r) where -- fmap = fmapp -- instance Functor r => Functor (A0 r) where -- fmap = fmapp -- instance FunctorT X where -- fmapp = fmap -- instance Functor (X r) where -- fmap f (X x) = X (f x) instance FunctorT f => Functor (HFix f) where fmap f (HIn x) = HIn (fmapp f x) -} breakEither :: [((f :+: g) r ix, a)] -> ([(f r ix, a)], [(g r ix, a)]) breakEither = foldr breakEither' ([], []) where breakEither' (L k, a) (xs, ys) = ((k, a):xs, ys) breakEither' (R k, a) (xs, ys) = (xs, (k, a):ys)