module Data.TrieMap.Regular.Base where
import Data.TrieMap.TrieKey
newtype K0 a r = K0 {unK0 :: a} deriving (Show)
newtype I0 r = I0 {unI0 :: r} deriving (Show)
data U0 r = U0 deriving (Show)
data (f :*: g) r = f r :*: g r deriving (Show)
data (f :+: g) r = L (f r) | R (g r) deriving (Show)
newtype L f r = List [f r] deriving (Show)
newtype Reg r = Reg {unReg :: r} deriving (Show)
newtype Fix f = In {out :: f (Fix f)}
type family PF a :: * -> *
class Regular a where
from :: a -> PF a a
to :: PF a a -> a
type instance PF (K0 a r) = K0 a
type instance PF (I0 r) = I0
type instance PF (U0 r) = U0
type instance PF ((f :*: g) r) = PF (f r) :*: PF (g r)
type instance PF ((f :+: g) r) = PF (f r) :+: PF (g r)
type instance PF (Fix f) = f
type instance PF [a] = L (PF a)
type instance PF (L f a) = L (PF (f a))
instance Functor (K0 a) where
fmap _ (K0 a) = K0 a
instance Functor I0 where
fmap f (I0 a) = I0 (f a)
instance Functor U0 where
fmap _ U0 = U0
instance Functor f => Functor (L f) where
fmap f (List xs) = List (map (fmap f) xs)
instance (Functor f, Functor g) => Functor (f :*: g) where
fmap f (x :*: y) = fmap f x :*: fmap f y
instance (Functor f, Functor g) => Functor (f :+: g) where
fmap f (L x) = L (fmap f x)
fmap f (R x) = R (fmap f x)
from' :: (Functor (PF a), Regular a) => Reg a -> PF a (Reg a)
from' (Reg a) = fmap Reg (from a)
to' :: (Functor (PF a), Regular a) => PF a (Reg a) -> Reg a
to' = Reg . to . fmap unReg
infixr 7 :*:
infixr 6 :+: