module Control.Comonad.Representable.Store
( Store
, store
, runStore
, StoreT(..)
, storeT
, runStoreT
, pos
, peek
, peeks
, seek
, seeks
) where
import Control.Comonad
import Control.Applicative
import Data.Key
import Data.Functor.Apply
import Data.Functor.Extend
import Data.Semigroup
import Control.Comonad.Hoist.Class
import Control.Comonad.Env.Class
import Control.Comonad.Traced.Class
import Control.Comonad.Cofree.Class
import Control.Comonad.Trans.Class
import Control.Comonad.Store.Class
import Control.Monad.Identity
import Data.Functor.Representable
type Store g = StoreT g Identity
store :: Representable g
=> (Key g -> a)
-> Key g
-> Store g a
store = storeT . Identity
runStore :: Indexable g
=> Store g a
-> (Key g -> a, Key g)
runStore (StoreT (Identity ga) k) = (index ga, k)
data StoreT g w a = StoreT (w (g a)) (Key g)
storeT :: (Functor w, Representable g) => w (Key g -> a) -> Key g -> StoreT g w a
storeT = StoreT . fmap tabulate
runStoreT :: (Functor w, Indexable g) => StoreT g w a -> (w (Key g -> a), Key g)
runStoreT (StoreT w s) = (index <$> w, s)
instance (Comonad w, Representable g, Key g ~ s) => ComonadStore s (StoreT g w) where
pos (StoreT _ s) = s
peek s (StoreT w _) = extract w `index` s
peeks f (StoreT w s) = extract w `index` f s
seek s (StoreT w _) = StoreT w s
seeks f (StoreT w s) = StoreT w (f s)
instance (Functor w, Functor g) => Functor (StoreT g w) where
fmap f (StoreT w s) = StoreT (fmap (fmap f) w) s
instance (Apply w, Semigroup (Key g), Representable g) => Apply (StoreT g w) where
StoreT ff m <.> StoreT fa n = StoreT (apRep <$> ff <.> fa) (m <> n)
instance (ComonadApply w, Semigroup (Key g), Representable g) => ComonadApply (StoreT g w) where
StoreT ff m <@> StoreT fa n = StoreT (apRep <$> ff <@> fa) (m <> n)
instance (Applicative w, Semigroup (Key g), Monoid (Key g), Representable g) => Applicative (StoreT g w) where
pure a = StoreT (pure (pureRep a)) mempty
StoreT ff m <*> StoreT fa n = StoreT (apRep <$> ff <*> fa) (m `mappend` n)
instance (Extend w, Representable g) => Extend (StoreT g w) where
duplicated (StoreT wf s) = StoreT (extended (tabulate . StoreT) wf) s
instance (Comonad w, Representable g) => Comonad (StoreT g w) where
duplicate (StoreT wf s) = StoreT (extend (tabulate . StoreT) wf) s
extract (StoreT wf s) = index (extract wf) s
instance Indexable g => ComonadTrans (StoreT g) where
lower (StoreT w s) = fmap (`index` s) w
instance ComonadHoist (StoreT g) where
cohoist (StoreT w s) = StoreT (Identity (extract w)) s
instance (ComonadTraced m w, Representable g) => ComonadTraced m (StoreT g w) where
trace m = trace m . lower
instance (ComonadEnv m w, Representable g) => ComonadEnv m (StoreT g w) where
ask = ask . lower
instance (Representable g, ComonadCofree f w) => ComonadCofree f (StoreT g w) where
unwrap (StoreT w s) = fmap (`StoreT` s) (unwrap w)