{-# 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 #-}