module Control.Inventory.State (State (..)) where import "morphisms" Control.Morphism ((\$), (.)) import "morphisms-functors" Control.Variance ((:.:), Variant (Co, Contra)) import "morphisms-functors" Control.Functor.Covariant (Covariant ((<\$>), comap)) import "morphisms-functors" Control.Functor.Covariant.Pointable (Pointable (point)) import "morphisms-functors" Control.Functor.Covariant.Applicative (Applicative ((<*>))) import "morphisms-functors" Control.Functor.Covariant.Composition.Bindable (Bindable ((>>=))) import "morphisms-functors" Control.Functor.Covariant.Composition.Monad (Monad) import "morphisms-functors" Data.Functor.Arrow.Straight (Straight (Straight, straight)) import "morphisms-functors" Data.Functor.Product (Product ((:&:))) import "morphisms-functors" Data.Functor.Composition.TT (TT (TT, tt)) newtype State (s :: *) (g :: * -> *) (a :: *) = State { state :: Straight s (g (Product s a)) } instance Covariant g => Covariant (State s g) where f <\$> State x = State . tt . comap f \$ TT @Co @Co @Co x instance Monad g => Applicative (State s g) where State (Straight f) <*> State (Straight x) = State . Straight \$ \old -> f old >>= \(new :&: g) -> comap g <\$> x new instance Pointable g => Pointable (State s g) where point x = State . Straight \$ \s -> point \$ s :&: x instance Bindable g => Bindable (State s g) where State (Straight x) >>= f = State . Straight \$ \old -> x old >>= \(new :&: y) -> straight (state \$ f y) new instance Monad g => Monad (State s g) where