module Control.Comonad.Store.Class
( ComonadStore(..)
, gets
, experiment
) where
import Control.Comonad
import Control.Comonad.Trans.Class
import qualified Control.Comonad.Trans.Store.Strict as Strict
import qualified Control.Comonad.Trans.Store.Lazy as Lazy
import qualified Control.Comonad.Trans.Discont.Strict as Strict
import qualified Control.Comonad.Trans.Discont.Lazy as Lazy
import qualified Control.Comonad.Trans.Env.Strict as Strict
import qualified Control.Comonad.Trans.Env.Lazy as Lazy
import Control.Comonad.Trans.Stream
import Control.Comonad.Trans.Identity
import Control.Comonad.Trans.Traced
import Data.Monoid
import Data.Semigroup
class Comonad w => ComonadStore s w | w -> s where
get :: w a -> s
put :: s -> w a -> a
modify :: (s -> s) -> w a -> a
modify f wa = put (f (get wa)) wa
gets :: ComonadStore s w => (s -> t) -> w a -> t
gets f wa = f (get wa)
experiment :: (ComonadStore s w, Functor f) => f (s -> s) -> w a -> f a
experiment ff wa = fmap (`modify` wa) ff
instance Comonad w => ComonadStore s (Strict.StoreT s w) where
get = Strict.get
put = Strict.put
modify = Strict.modify
instance Comonad w => ComonadStore s (Lazy.StoreT s w) where
get = Lazy.get
put = Lazy.put
modify = Lazy.modify
lowerGet :: (ComonadTrans t, ComonadStore s w) => t w a -> s
lowerGet = get . lower
lowerPut :: (ComonadTrans t, ComonadStore s w) => s -> t w a -> a
lowerPut s = put s . lower
lowerModify :: (ComonadTrans t, ComonadStore s w) => (s -> s) -> t w a -> a
lowerModify f = modify f . lower
instance ComonadStore s w => ComonadStore s (Lazy.DiscontT k w) where
get = lowerGet
put = lowerPut
modify = lowerModify
instance ComonadStore s w => ComonadStore s (Strict.DiscontT k w) where
get = lowerGet
put = lowerPut
modify = lowerModify
instance ComonadStore s w => ComonadStore s (IdentityT w) where
get = lowerGet
put = lowerPut
modify = lowerModify
instance ComonadStore s w => ComonadStore s (Lazy.EnvT e w) where
get = lowerGet
put = lowerPut
modify = lowerModify
instance ComonadStore s w => ComonadStore s (Strict.EnvT e w) where
get = lowerGet
put = lowerPut
modify = lowerModify
instance (ComonadStore s w, Semigroup m, Monoid m) => ComonadStore s (TracedT m w) where
get = lowerGet
put = lowerPut
modify = lowerModify
instance (ComonadStore s w, Functor f) => ComonadStore s (StreamT f w) where
get = lowerGet
put = lowerPut
modify = lowerModify