module Math.Combinatorics.Species.Structures
(
Void
, Unit(..)
, Const(..)
, Id(..)
, (:+:)(..)
, (:*:)(..)
, (:.:)(..)
, Cycle(..)
, Set(..)
, Star(..)
, Mu(..), Interp
) where
import NumericPrelude
#if MIN_VERSION_numeric_prelude(0,2,0)
#else
import PreludeBase
#endif
import Data.List (intercalate, foldl', delete, inits, tails)
import Data.Typeable
data Void a
deriving Typeable
instance Functor Void where
fmap = undefined
instance Show (Void a) where
show = undefined
data Unit a = Unit
deriving (Typeable, Show)
instance Functor Unit where
fmap _ Unit = Unit
newtype Const x a = Const x
instance Functor (Const x) where
fmap _ (Const x) = Const x
instance (Show x) => Show (Const x a) where
show (Const x) = show x
instance Typeable2 Const where
typeOf2 _ = mkTyConApp (mkTyCon "Const") []
instance Typeable x => Typeable1 (Const x) where
typeOf1 = typeOf1Default
newtype Id a = Id a
deriving Typeable
instance Functor Id where
fmap f (Id x) = Id (f x)
instance (Show a) => Show (Id a) where
show (Id x) = show x
data (f :+: g) a = Inl (f a) | Inr (g a)
instance (Functor f, Functor g) => Functor (f :+: g) where
fmap f (Inl fa) = Inl (fmap f fa)
fmap f (Inr ga) = Inr (fmap f ga)
instance (Show (f a), Show (g a)) => Show ((f :+: g) a) where
show (Inl fa) = "inl(" ++ show fa ++ ")"
show (Inr ga) = "inr(" ++ show ga ++ ")"
instance (Typeable1 f, Typeable1 g) => Typeable1 (f :+: g) where
typeOf1 x = mkTyConApp (mkTyCon "Math.Combinatorics.Species.Types.(:+:)") [typeOf1 (getF x), typeOf1 (getG x)]
where getF :: (f :+: g) a -> f a
getF = undefined
getG :: (f :+: g) a -> g a
getG = undefined
data (f :*: g) a = f a :*: g a
pFst :: (f :*: g) a -> f a
pFst (x :*: y) = x
pSnd :: (f :*: g) a -> g a
pSnd (x :*: y) = y
pSwap :: (f :*: g) a -> (g :*: f) a
pSwap (x :*: y) = y :*: x
instance (Functor f, Functor g) => Functor (f :*: g) where
fmap f (fa :*: ga) = fmap f fa :*: fmap f ga
instance (Show (f a), Show (g a)) => Show ((f :*: g) a) where
show (x :*: y) = show (x,y)
instance (Typeable1 f, Typeable1 g) => Typeable1 (f :*: g) where
typeOf1 x = mkTyConApp (mkTyCon "Math.Combinatorics.Species.Types.(:*:)") [typeOf1 (getF x), typeOf1 (getG x)]
where getF :: (f :*: g) a -> f a
getF = undefined
getG :: (f :*: g) a -> g a
getG = undefined
data (f :.: g) a = Comp { unComp :: (f (g a)) }
instance (Functor f, Functor g) => Functor (f :.: g) where
fmap f (Comp fga) = Comp (fmap (fmap f) fga)
instance (Show (f (g a))) => Show ((f :.: g) a) where
show (Comp x) = show x
instance (Typeable1 f, Typeable1 g) => Typeable1 (f :.: g) where
typeOf1 x = mkTyConApp (mkTyCon "Math.Combinatorics.Species.Types.(:.:)") [typeOf1 (getF x), typeOf1 (getG x)]
where getF :: (f :.: g) a -> f a
getF = undefined
getG :: (f :.: g) a -> g a
getG = undefined
newtype Cycle a = Cycle { getCycle :: [a] }
deriving (Functor, Typeable)
instance (Show a) => Show (Cycle a) where
show (Cycle xs) = "<" ++ intercalate "," (map show xs) ++ ">"
instance Eq a => Eq (Cycle a) where
Cycle xs == Cycle ys = any (==ys) (rotations xs)
where rotations xs = zipWith (++) (tails xs)
(inits xs)
newtype Set a = Set { getSet :: [a] }
deriving (Functor, Typeable)
instance (Show a) => Show (Set a) where
show (Set xs) = "{" ++ intercalate "," (map show xs) ++ "}"
instance Eq a => Eq (Set a) where
Set xs == Set ys = xs `subBag` ys && ys `subBag` xs
where subBag b = null . foldl' (flip delete) b
data Star a = Star | Original a
deriving (Typeable)
instance Functor Star where
fmap _ Star = Star
fmap f (Original a) = Original (f a)
instance (Show a) => Show (Star a) where
show Star = "*"
show (Original a) = show a
data Mu f a = Mu { unMu :: Interp f (Mu f) a }
deriving Typeable
type family Interp f (self :: * -> *) :: * -> *