module Control.Comonad.Store.MemoTrie
(
Store, store, runStore
, StoreT(..), storeT, runStoreT
, module Control.Comonad.Store.Class
) where
import Control.Applicative
import Control.Comonad
import Control.Comonad.Hoist.Class
import Control.Comonad.Trans.Class
import Control.Comonad.Store.Class
import Control.Comonad.Env.Class
import Control.Comonad.Traced.Class
import Data.Functor.Identity
import Data.MemoTrie
#ifdef __GLASGOW_HASKELL__
import Data.Typeable
instance (Typeable s, Typeable1 w) => Typeable1 (StoreT s w) where
typeOf1 dswa = mkTyConApp storeTTyCon [typeOf (s dswa), typeOf1 (w dswa)]
where
s :: StoreT s w a -> s
s = undefined
w :: StoreT s w a -> w a
w = undefined
instance (Typeable s, Typeable1 w, Typeable a) => Typeable (StoreT s w a) where
typeOf = typeOfDefault
storeTTyCon :: TyCon
storeTTyCon = mkTyCon "Control.Comonad.Trans.Store.Strict.StoreT"
#endif
type Store s = StoreT s Identity
store :: HasTrie s => (s -> a) -> s -> Store s a
store f s = StoreT (Identity (trie f)) s
runStore :: HasTrie s => Store s a -> (s -> a, s)
runStore (StoreT (Identity f) s) = (untrie f, s)
data StoreT s w a = StoreT (w (s :->: a)) s
storeT :: (Functor w, HasTrie s) => w (s -> a) -> s -> StoreT s w a
storeT wf s = StoreT (trie <$> wf) s
runStoreT :: (Functor w, HasTrie s) => StoreT s w a -> (w (s -> a), s)
runStoreT (StoreT wf s) = (untrie <$> wf, s)
instance (Functor w, HasTrie s) => Functor (StoreT s w) where
fmap f (StoreT wf s) = StoreT (fmap (fmap f) wf) s
instance (Extend w, HasTrie s) => Extend (StoreT s w) where
duplicate (StoreT wf s) = StoreT (extend (trie . StoreT) wf) s
instance (Comonad w, HasTrie s) => Comonad (StoreT s w) where
extract (StoreT wf s) = untrie (extract wf) s
instance HasTrie s => ComonadTrans (StoreT s) where
lower (StoreT f s) = fmap (`untrie` s) f
instance ComonadHoist (StoreT s) where
cohoist (StoreT f s) = StoreT (Identity (extract f)) s
instance (Comonad w, HasTrie s) => ComonadStore s (StoreT s w) where
pos (StoreT _ s) = s
seek s (StoreT f _) = StoreT f s
seeks f (StoreT g s) = StoreT g (f s)
peek s (StoreT g _) = untrie (extract g) s
peeks f (StoreT g s) = untrie (extract g) (f s)
instance (ComonadTraced m w, HasTrie s) => ComonadTraced m (StoreT s w) where
trace m = trace m . lower
instance (ComonadEnv m w, HasTrie s) => ComonadEnv m (StoreT s w) where
ask = ask . lower