{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} module Optics.Polysemy.State ( modifying , modifying' , assign , assign' , use , preuse , (.=) , (?=) , (%=) , (%%=) , (<.=) , (<?=) , (<%=) , (<<.=) , (<<?=) , (<<%=) , guse , guses , zoom , zoomMaybe ) where import Optics ( A_Getter , A_Lens , A_Setter , An_AffineFold , An_AffineTraversal , Is , Optic , Optic' , ViewResult , ViewableOptic , castOptic ) import qualified Optics import qualified Optics.State import Optics.State.Operators ( PermeableOptic ) import qualified Optics.State.Operators import Polysemy import Polysemy.State import Polysemy.ConstraintAbsorber.MonadState modifying :: (Is k A_Setter, Member (State s) effs) => Optic k is s s a b -> (a -> b) -> Sem effs () modifying :: Optic k is s s a b -> (a -> b) -> Sem effs () modifying Optic k is s s a b o a -> b f = (MonadState s (Sem effs) => Sem effs ()) -> Sem effs () forall s (r :: [(* -> *) -> * -> *]) a. Member (State s) r => (MonadState s (Sem r) => Sem r a) -> Sem r a absorbState (Optic k is s s a b -> (a -> b) -> Sem effs () forall k s (m :: * -> *) (is :: IxList) a b. (Is k A_Setter, MonadState s m) => Optic k is s s a b -> (a -> b) -> m () Optics.State.modifying Optic k is s s a b o a -> b f) {-# INLINE modifying #-} modifying' :: (Is k A_Setter, Member (State s) effs) => Optic k is s s a b -> (a -> b) -> Sem effs () modifying' :: Optic k is s s a b -> (a -> b) -> Sem effs () modifying' Optic k is s s a b o a -> b f = (MonadState s (Sem effs) => Sem effs ()) -> Sem effs () forall s (r :: [(* -> *) -> * -> *]) a. Member (State s) r => (MonadState s (Sem r) => Sem r a) -> Sem r a absorbState (Optic k is s s a b -> (a -> b) -> Sem effs () forall k s (m :: * -> *) (is :: IxList) a b. (Is k A_Setter, MonadState s m) => Optic k is s s a b -> (a -> b) -> m () Optics.State.modifying Optic k is s s a b o a -> b f) {-# INLINE modifying' #-} assign :: (Is k A_Setter, Member (State s) effs) => Optic k is s s a b -> b -> Sem effs () assign :: Optic k is s s a b -> b -> Sem effs () assign Optic k is s s a b o b b = (MonadState s (Sem effs) => Sem effs ()) -> Sem effs () forall s (r :: [(* -> *) -> * -> *]) a. Member (State s) r => (MonadState s (Sem r) => Sem r a) -> Sem r a absorbState (Optic k is s s a b -> b -> Sem effs () forall k s (m :: * -> *) (is :: IxList) a b. (Is k A_Setter, MonadState s m) => Optic k is s s a b -> b -> m () Optics.State.assign Optic k is s s a b o b b) {-# INLINE assign #-} assign' :: (Is k A_Setter, Member (State s) effs) => Optic k is s s a b -> b -> Sem effs () assign' :: Optic k is s s a b -> b -> Sem effs () assign' Optic k is s s a b o b b = (MonadState s (Sem effs) => Sem effs ()) -> Sem effs () forall s (r :: [(* -> *) -> * -> *]) a. Member (State s) r => (MonadState s (Sem r) => Sem r a) -> Sem r a absorbState (Optic k is s s a b -> b -> Sem effs () forall k s (m :: * -> *) (is :: IxList) a b. (Is k A_Setter, MonadState s m) => Optic k is s s a b -> b -> m () Optics.State.assign' Optic k is s s a b o b b) {-# INLINE assign' #-} use :: (Is k A_Getter, Member (State s) effs) => Optic' k is s a -> Sem effs a use :: Optic' k is s a -> Sem effs a use Optic' k is s a o = (MonadState s (Sem effs) => Sem effs a) -> Sem effs a forall s (r :: [(* -> *) -> * -> *]) a. Member (State s) r => (MonadState s (Sem r) => Sem r a) -> Sem r a absorbState (Optic' k is s a -> Sem effs a forall k s (m :: * -> *) (is :: IxList) a. (Is k A_Getter, MonadState s m) => Optic' k is s a -> m a Optics.State.use Optic' k is s a o) {-# INLINE use #-} preuse :: (Is k An_AffineFold, Member (State s) effs) => Optic' k is s a -> Sem effs (Maybe a) preuse :: Optic' k is s a -> Sem effs (Maybe a) preuse Optic' k is s a o = (MonadState s (Sem effs) => Sem effs (Maybe a)) -> Sem effs (Maybe a) forall s (r :: [(* -> *) -> * -> *]) a. Member (State s) r => (MonadState s (Sem r) => Sem r a) -> Sem r a absorbState (Optic' k is s a -> Sem effs (Maybe a) forall k s (m :: * -> *) (is :: IxList) a. (Is k An_AffineFold, MonadState s m) => Optic' k is s a -> m (Maybe a) Optics.State.preuse Optic' k is s a o) {-# INLINE preuse #-} infix 4 .= (.=) :: (Is k A_Setter, Member (State s) effs) => Optic k is s s a b -> b -> Sem effs () Optic k is s s a b o .= :: Optic k is s s a b -> b -> Sem effs () .= b b = (MonadState s (Sem effs) => Sem effs ()) -> Sem effs () forall s (r :: [(* -> *) -> * -> *]) a. Member (State s) r => (MonadState s (Sem r) => Sem r a) -> Sem r a absorbState (Optic k is s s a b -> b -> Sem effs () forall k s (m :: * -> *) (is :: IxList) a b. (Is k A_Setter, MonadState s m) => Optic k is s s a b -> b -> m () (Optics.State.Operators..=) Optic k is s s a b o b b) {-# INLINE (.=) #-} infix 4 ?= (?=) :: (Is k A_Setter, Member (State s) effs) => Optic k is s s (Maybe a) (Maybe b) -> b -> Sem effs () Optic k is s s (Maybe a) (Maybe b) o ?= :: Optic k is s s (Maybe a) (Maybe b) -> b -> Sem effs () ?= b b = (MonadState s (Sem effs) => Sem effs ()) -> Sem effs () forall s (r :: [(* -> *) -> * -> *]) a. Member (State s) r => (MonadState s (Sem r) => Sem r a) -> Sem r a absorbState (Optic k is s s (Maybe a) (Maybe b) -> b -> Sem effs () forall k s (m :: * -> *) (is :: IxList) a b. (Is k A_Setter, MonadState s m) => Optic k is s s (Maybe a) (Maybe b) -> b -> m () (Optics.State.Operators.?=) Optic k is s s (Maybe a) (Maybe b) o b b) {-# INLINE (?=) #-} infix 4 %= (%=) :: (Is k A_Setter, Member (State s) effs) => Optic k is s s a b -> (a -> b) -> Sem effs () Optic k is s s a b o %= :: Optic k is s s a b -> (a -> b) -> Sem effs () %= a -> b f = (MonadState s (Sem effs) => Sem effs ()) -> Sem effs () forall s (r :: [(* -> *) -> * -> *]) a. Member (State s) r => (MonadState s (Sem r) => Sem r a) -> Sem r a absorbState (Optic k is s s a b -> (a -> b) -> Sem effs () forall k s (m :: * -> *) (is :: IxList) a b. (Is k A_Setter, MonadState s m) => Optic k is s s a b -> (a -> b) -> m () (Optics.State.Operators.%=) Optic k is s s a b o a -> b f) {-# INLINE (%=) #-} infix 4 %%= (%%=) :: (PermeableOptic k r, Member (State s) effs) => Optic k is s s a b -> (a -> (r, b)) -> Sem effs (ViewResult k r) Optic k is s s a b o %%= :: Optic k is s s a b -> (a -> (r, b)) -> Sem effs (ViewResult k r) %%= a -> (r, b) f = (MonadState s (Sem effs) => Sem effs (ViewResult k r)) -> Sem effs (ViewResult k r) forall s (r :: [(* -> *) -> * -> *]) a. Member (State s) r => (MonadState s (Sem r) => Sem r a) -> Sem r a absorbState (Optic k is s s a b -> (a -> (r, b)) -> Sem effs (ViewResult k r) forall k r s (m :: * -> *) (is :: IxList) a b. (PermeableOptic k r, MonadState s m) => Optic k is s s a b -> (a -> (r, b)) -> m (ViewResult k r) (Optics.State.Operators.%%=) Optic k is s s a b o a -> (r, b) f) {-# INLINE (%%=) #-} infix 4 <.= (<.=) :: (PermeableOptic k b, Member (State s) effs) => Optic k is s s a b -> b -> Sem effs (ViewResult k b) Optic k is s s a b o <.= :: Optic k is s s a b -> b -> Sem effs (ViewResult k b) <.= b b = (MonadState s (Sem effs) => Sem effs (ViewResult k b)) -> Sem effs (ViewResult k b) forall s (r :: [(* -> *) -> * -> *]) a. Member (State s) r => (MonadState s (Sem r) => Sem r a) -> Sem r a absorbState (Optic k is s s a b -> b -> Sem effs (ViewResult k b) forall k b s (m :: * -> *) (is :: IxList) a. (PermeableOptic k b, MonadState s m) => Optic k is s s a b -> b -> m (ViewResult k b) (Optics.State.Operators.<.=) Optic k is s s a b o b b) {-# INLINE (<.=) #-} infix 4 <?= (<?=) :: (PermeableOptic k (Maybe b), Member (State s) effs) => Optic k is s s (Maybe a) (Maybe b) -> b -> Sem effs (ViewResult k (Maybe b)) Optic k is s s (Maybe a) (Maybe b) o <?= :: Optic k is s s (Maybe a) (Maybe b) -> b -> Sem effs (ViewResult k (Maybe b)) <?= b b = (MonadState s (Sem effs) => Sem effs (ViewResult k (Maybe b))) -> Sem effs (ViewResult k (Maybe b)) forall s (r :: [(* -> *) -> * -> *]) a. Member (State s) r => (MonadState s (Sem r) => Sem r a) -> Sem r a absorbState (Optic k is s s (Maybe a) (Maybe b) -> b -> Sem effs (ViewResult k (Maybe b)) forall k b s (m :: * -> *) (is :: IxList) a. (PermeableOptic k (Maybe b), MonadState s m) => Optic k is s s (Maybe a) (Maybe b) -> b -> m (ViewResult k (Maybe b)) (Optics.State.Operators.<?=) Optic k is s s (Maybe a) (Maybe b) o b b) {-# INLINE (<?=) #-} infix 4 <%= (<%=) :: (PermeableOptic k b, Member (State s) effs) => Optic k is s s a b -> (a -> b) -> Sem effs (ViewResult k b) Optic k is s s a b o <%= :: Optic k is s s a b -> (a -> b) -> Sem effs (ViewResult k b) <%= a -> b f = (MonadState s (Sem effs) => Sem effs (ViewResult k b)) -> Sem effs (ViewResult k b) forall s (r :: [(* -> *) -> * -> *]) a. Member (State s) r => (MonadState s (Sem r) => Sem r a) -> Sem r a absorbState (Optic k is s s a b -> (a -> b) -> Sem effs (ViewResult k b) forall k b s (m :: * -> *) (is :: IxList) a. (PermeableOptic k b, MonadState s m) => Optic k is s s a b -> (a -> b) -> m (ViewResult k b) (Optics.State.Operators.<%=) Optic k is s s a b o a -> b f) {-# INLINE (<%=) #-} infix 4 <<.= (<<.=) :: (PermeableOptic k a, Member (State s) effs) => Optic k is s s a b -> b -> Sem effs (ViewResult k a) Optic k is s s a b o <<.= :: Optic k is s s a b -> b -> Sem effs (ViewResult k a) <<.= b b = (MonadState s (Sem effs) => Sem effs (ViewResult k a)) -> Sem effs (ViewResult k a) forall s (r :: [(* -> *) -> * -> *]) a. Member (State s) r => (MonadState s (Sem r) => Sem r a) -> Sem r a absorbState (Optic k is s s a b -> b -> Sem effs (ViewResult k a) forall k a s (m :: * -> *) (is :: IxList) b. (PermeableOptic k a, MonadState s m) => Optic k is s s a b -> b -> m (ViewResult k a) (Optics.State.Operators.<<.=) Optic k is s s a b o b b) {-# INLINE (<<.=) #-} infix 4 <<?= (<<?=) :: (PermeableOptic k (Maybe a), Member (State s) effs) => Optic k is s s (Maybe a) (Maybe b) -> b -> Sem effs (ViewResult k (Maybe a)) Optic k is s s (Maybe a) (Maybe b) o <<?= :: Optic k is s s (Maybe a) (Maybe b) -> b -> Sem effs (ViewResult k (Maybe a)) <<?= b b = (MonadState s (Sem effs) => Sem effs (ViewResult k (Maybe a))) -> Sem effs (ViewResult k (Maybe a)) forall s (r :: [(* -> *) -> * -> *]) a. Member (State s) r => (MonadState s (Sem r) => Sem r a) -> Sem r a absorbState (Optic k is s s (Maybe a) (Maybe b) -> b -> Sem effs (ViewResult k (Maybe a)) forall k a s (m :: * -> *) (is :: IxList) b. (PermeableOptic k (Maybe a), MonadState s m) => Optic k is s s (Maybe a) (Maybe b) -> b -> m (ViewResult k (Maybe a)) (Optics.State.Operators.<<?=) Optic k is s s (Maybe a) (Maybe b) o b b) {-# INLINE (<<?=) #-} infix 4 <<%= (<<%=) :: (PermeableOptic k a, Member (State s) effs) => Optic k is s s a b -> (a -> b) -> Sem effs (ViewResult k a) Optic k is s s a b o <<%= :: Optic k is s s a b -> (a -> b) -> Sem effs (ViewResult k a) <<%= a -> b f = (MonadState s (Sem effs) => Sem effs (ViewResult k a)) -> Sem effs (ViewResult k a) forall s (r :: [(* -> *) -> * -> *]) a. Member (State s) r => (MonadState s (Sem r) => Sem r a) -> Sem r a absorbState (Optic k is s s a b -> (a -> b) -> Sem effs (ViewResult k a) forall k a s (m :: * -> *) (is :: IxList) b. (PermeableOptic k a, MonadState s m) => Optic k is s s a b -> (a -> b) -> m (ViewResult k a) (Optics.State.Operators.<<%=) Optic k is s s a b o a -> b f) {-# INLINE (<<%=) #-} guse :: (ViewableOptic k a, Member (State s) effs) => Optic' k is s a -> Sem effs (ViewResult k a) guse :: Optic' k is s a -> Sem effs (ViewResult k a) guse Optic' k is s a o = (MonadState s (Sem effs) => Sem effs (ViewResult k a)) -> Sem effs (ViewResult k a) forall s (r :: [(* -> *) -> * -> *]) a. Member (State s) r => (MonadState s (Sem r) => Sem r a) -> Sem r a absorbState (Optic' k is s a -> Sem effs (ViewResult k a) forall k a s (m :: * -> *) (is :: IxList). (ViewableOptic k a, MonadState s m) => Optic' k is s a -> m (ViewResult k a) Optics.guse Optic' k is s a o) {-# INLINE guse #-} guses :: (ViewableOptic k r, Member (State s) effs) => Optic' k is s a -> (a -> r) -> Sem effs (ViewResult k r) guses :: Optic' k is s a -> (a -> r) -> Sem effs (ViewResult k r) guses Optic' k is s a o a -> r f = (MonadState s (Sem effs) => Sem effs (ViewResult k r)) -> Sem effs (ViewResult k r) forall s (r :: [(* -> *) -> * -> *]) a. Member (State s) r => (MonadState s (Sem r) => Sem r a) -> Sem r a absorbState (Optic' k is s a -> (a -> r) -> Sem effs (ViewResult k r) forall k r s (m :: * -> *) (is :: IxList) a. (ViewableOptic k r, MonadState s m) => Optic' k is s a -> (a -> r) -> m (ViewResult k r) Optics.guses Optic' k is s a o a -> r f) {-# INLINE guses #-} zoom :: (Is k A_Lens, Member (State s) effs) => Optic' k is s a -> Sem (State a ': effs) c -> Sem effs c zoom :: Optic' k is s a -> Sem (State a : effs) c -> Sem effs c zoom Optic' k is s a o = (forall x (rInitial :: [(* -> *) -> * -> *]). State a (Sem rInitial) x -> Sem effs x) -> Sem (State a : effs) c -> Sem effs c forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a. FirstOrder e "interpret" => (forall x (rInitial :: [(* -> *) -> * -> *]). e (Sem rInitial) x -> Sem r x) -> Sem (e : r) a -> Sem r a interpret \case State a (Sem rInitial) x Get -> Optic' A_Lens is s a -> Sem effs a forall k s (effs :: [(* -> *) -> * -> *]) (is :: IxList) a. (Is k A_Getter, Member (State s) effs) => Optic' k is s a -> Sem effs a use Optic' A_Lens is s a o' Put a -> Optic' A_Lens is s a -> a -> Sem effs () forall k s (effs :: [(* -> *) -> * -> *]) (is :: IxList) a b. (Is k A_Setter, Member (State s) effs) => Optic k is s s a b -> b -> Sem effs () assign Optic' A_Lens is s a o' a a where o' :: Optic' A_Lens is s a o' = Optic' k is s a -> Optic' A_Lens is s a forall destKind srcKind (is :: IxList) s t a b. Is srcKind destKind => Optic srcKind is s t a b -> Optic destKind is s t a b castOptic @A_Lens Optic' k is s a o {-# INLINE zoom #-} zoomMaybe :: (Is k An_AffineTraversal, Member (State s) effs) => Optic' k is s a -> Sem (State a ': effs) c -> Sem effs (Maybe c) zoomMaybe :: Optic' k is s a -> Sem (State a : effs) c -> Sem effs (Maybe c) zoomMaybe Optic' k is s a o Sem (State a : effs) c m = Optic' An_AffineTraversal is s a -> Sem effs (Maybe a) forall k s (effs :: [(* -> *) -> * -> *]) (is :: IxList) a. (Is k An_AffineFold, Member (State s) effs) => Optic' k is s a -> Sem effs (Maybe a) preuse Optic' An_AffineTraversal is s a o' Sem effs (Maybe a) -> (Maybe a -> Sem effs (Maybe c)) -> Sem effs (Maybe c) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= (a -> Sem effs c) -> Maybe a -> Sem effs (Maybe c) forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse \a a -> ( (forall x (rInitial :: [(* -> *) -> * -> *]). State a (Sem rInitial) x -> Sem effs x) -> Sem (State a : effs) c -> Sem effs c forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a. FirstOrder e "interpret" => (forall x (rInitial :: [(* -> *) -> * -> *]). e (Sem rInitial) x -> Sem r x) -> Sem (e : r) a -> Sem r a interpret \case State a (Sem rInitial) x Get -> a -> (a -> a) -> Maybe a -> a forall b a. b -> (a -> b) -> Maybe a -> b maybe a a a -> a forall a. a -> a id (Maybe a -> a) -> Sem effs (Maybe a) -> Sem effs a forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Optic' An_AffineTraversal is s a -> Sem effs (Maybe a) forall k s (effs :: [(* -> *) -> * -> *]) (is :: IxList) a. (Is k An_AffineFold, Member (State s) effs) => Optic' k is s a -> Sem effs (Maybe a) preuse Optic' An_AffineTraversal is s a o' Put a' -> Optic' An_AffineTraversal is s a -> a -> Sem effs () forall k s (effs :: [(* -> *) -> * -> *]) (is :: IxList) a b. (Is k A_Setter, Member (State s) effs) => Optic k is s s a b -> b -> Sem effs () assign Optic' An_AffineTraversal is s a o' a a' ) Sem (State a : effs) c m where o' :: Optic' An_AffineTraversal is s a o' = Optic' k is s a -> Optic' An_AffineTraversal is s a forall destKind srcKind (is :: IxList) s t a b. Is srcKind destKind => Optic srcKind is s t a b -> Optic destKind is s t a b castOptic @An_AffineTraversal Optic' k is s a o {-# INLINE zoomMaybe #-}