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)