module Control.Joint.Effects.Store where import "comonad" Control.Comonad (Comonad (extract, extend)) import Control.Joint.Core (type (:.), type (:=)) import Control.Joint.Operators ((<$$>)) import Control.Joint.Abilities.Interpreted (Interpreted (Primary, run)) newtype Store s a = Store ((,) s :. (->) s := a) instance Functor (Store s) where fmap :: (a -> b) -> Store s a -> Store s b fmap a -> b f (Store ((,) s :. (->) s) := a x) = (((,) s :. (->) s) := b) -> Store s b forall s a. (((,) s :. (->) s) := a) -> Store s a Store ((((,) s :. (->) s) := b) -> Store s b) -> (((,) s :. (->) s) := b) -> Store s b forall a b. (a -> b) -> a -> b $ a -> b f (a -> b) -> (((,) s :. (->) s) := a) -> ((,) s :. (->) s) := b forall (t :: * -> *) (u :: * -> *) a b. (Functor t, Functor u) => (a -> b) -> ((t :. u) := a) -> (t :. u) := b <$$> ((,) s :. (->) s) := a x instance Comonad (Store s) where extend :: (Store s a -> b) -> Store s a -> Store s b extend Store s a -> b f (Store (s s, s -> a g)) = (((,) s :. (->) s) := b) -> Store s b forall s a. (((,) s :. (->) s) := a) -> Store s a Store (s s, \s s' -> Store s a -> b f ((s, s -> a) -> Store s a forall s a. (((,) s :. (->) s) := a) -> Store s a Store (s s', s -> a g))) extract :: Store s a -> a extract (Store (s s, s -> a g)) = s -> a g s s instance Interpreted (Store s) where type Primary (Store s) a = (,) s :. (->) s := a run :: Store s a -> Primary (Store s) a run (Store ((,) s :. (->) s) := a x) = ((,) s :. (->) s) := a Primary (Store s) a x pos :: Store s a -> s pos :: Store s a -> s pos (Store (s s, s -> a _)) = s s seek :: s -> Store s a -> Store s a seek :: s -> Store s a -> Store s a seek s s (Store (s _, s -> a f)) = (s, s -> a) -> Store s a forall s a. (((,) s :. (->) s) := a) -> Store s a Store (s s, s -> a f) peek :: s -> Store s a -> a peek :: s -> Store s a -> a peek s s (Store (s _, s -> a f)) = s -> a f s s retrofit :: (s -> s) -> Store s a -> Store s a retrofit :: (s -> s) -> Store s a -> Store s a retrofit s -> s g (Store (s s, s -> a f)) = (s, s -> a) -> Store s a forall s a. (((,) s :. (->) s) := a) -> Store s a Store (s -> s g s s, s -> a f)