module Control.Inventory.Store (Store (..)) 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.Extractable (Extractable (extract))
import "morphisms-functors" Control.Functor.Covariant.Composition.Extendable (Extendable ((=>>)))
import "morphisms-functors" Control.Functor.Covariant.Composition.Comonad (Comonad)
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 Store (s :: *) (g :: * -> *) (a :: *) =
	Store { store :: Product s (g (Straight s a)) }

instance Covariant g => Covariant (Store s g) where
	f <$> Store x =  Store . tt . comap f $ TT @Co @Co @Co x

instance Extractable g => Extractable (Store s g) where
	extract (Store (s :&: f)) = straight (extract f) s

instance Extendable g => Extendable (Store s g) where
	Store (s :&: x) =>> f = Store . (:&:) s . (=>>) x $
		\x' -> Straight $ \s' -> f . Store $ s' :&: x'

instance Comonad g => Comonad (Store s g) where