module Control.Comonad.Trans.Store.Memo
(
Store, store, runStore
, StoreT, storeT, runStoreT
, lowerStoreT
, pos
, seek, seeks
, peek, peeks
) where
import Control.Applicative
import Control.Comonad
import Control.Comonad.Hoist.Class
import Control.Comonad.Trans.Class
import Data.Functor.Identity
import Data.Functor.Apply
import Data.Monoid
import Data.Semigroup
#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.Memo.StoreT"
#endif
type Store s = StoreT s Identity
store :: (s -> a) -> s -> Store s a
store f s = StoreT (Identity f) s (Identity (f s))
runStore :: Store s a -> (s -> a, s)
runStore (StoreT (Identity f) s _) = (f, s)
data StoreT s w a = StoreT (w (s -> a)) s (w a)
runStoreT :: StoreT s w a -> (w (s -> a), s)
runStoreT (StoreT wf s _) = (wf, s)
storeT :: Functor w => w (s -> a) -> s -> StoreT s w a
storeT wf s = StoreT wf s (fmap ($s) wf)
instance Functor w => Functor (StoreT s w) where
fmap f (StoreT wf s w) = StoreT (fmap (f .) wf) s (fmap f w)
instance (Apply w, Semigroup s) => Apply (StoreT s w) where
StoreT ff m _ <.> StoreT fa n _ = storeT ((<*>) <$> ff <.> fa) (m <> n)
instance (Applicative w, Semigroup s, Monoid s) => Applicative (StoreT s w) where
pure a = storeT (pure (const a)) mempty
StoreT ff m _ <*> StoreT fa n _ = storeT ((<*>) <$> ff <*> fa) (m `mappend` n)
instance Extend w => Extend (StoreT s w) where
duplicate (StoreT wf s _) = storeT (extend storeT wf) s
instance Comonad w => Comonad (StoreT s w) where
extract (StoreT _ _ w) = extract w
instance ComonadTrans (StoreT s) where
lower (StoreT _ _ w) = w
lowerStoreT :: StoreT s w a -> w a
lowerStoreT (StoreT _ _ w) = w
instance ComonadHoist (StoreT s) where
cohoist (StoreT f s w) = StoreT (Identity (extract f)) s (Identity (extract w))
pos :: StoreT s w a -> s
pos (StoreT _ s _) = s
seek :: Comonad w => s -> StoreT s w a -> StoreT s w a
seek s (StoreT f _ _) = storeT f s
seeks :: Comonad w => (s -> s) -> StoreT s w a -> StoreT s w a
seeks f (StoreT g s _) = storeT g (f s)
peek :: Comonad w => s -> StoreT s w a -> a
peek s (StoreT g _ _) = extract g s
peeks :: Comonad w => (s -> s) -> StoreT s w a -> a
peeks f (StoreT g s _) = extract g (f s)