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