module Control.Monad.DeepState where

import Control.Lens (Lens')
import qualified Control.Lens as Lens (mapMOf, over, set, view, views)
import qualified Control.Monad.State.Class as MS (MonadState(get), modify)
import qualified Control.Monad.Trans.State.Lazy as Lazy (StateT)

import Data.DeepLenses (DeepLenses(deepLens))

class Monad m => MonadDeepState (s :: *) (s' :: *) (m :: * -> *) | m -> s where
  get :: m s'
  put :: s' -> m ()
  stateM :: (s' -> m (a, s')) -> m a
  stateM s' -> m (a, s')
f = do
    ~(a
a, s'
s'') <- s' -> m (a, s')
f (s' -> m (a, s')) -> m s' -> m (a, s')
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m s'
forall s s' (m :: * -> *). MonadDeepState s s' m => m s'
get
    a
a a -> m () -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ s' -> m ()
forall s s' (m :: * -> *). MonadDeepState s s' m => s' -> m ()
put s'
s''
  state :: (s' -> (a, s')) -> m a
  state s' -> (a, s')
f =
    (s' -> m (a, s')) -> m a
forall s s' (m :: * -> *) a.
MonadDeepState s s' m =>
(s' -> m (a, s')) -> m a
stateM ((a, s') -> m (a, s')
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a, s') -> m (a, s')) -> (s' -> (a, s')) -> s' -> m (a, s')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s' -> (a, s')
f)
  modifyM' :: (s' -> m s') -> m s'
  modifyM' s' -> m s'
f = do
    s'
s' <- s' -> m s'
f (s' -> m s') -> m s' -> m s'
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m s'
forall s s' (m :: * -> *). MonadDeepState s s' m => m s'
get
    s'
s' s' -> m () -> m s'
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ s' -> m ()
forall s s' (m :: * -> *). MonadDeepState s s' m => s' -> m ()
put s'
s'
  modify :: (s' -> s') -> m ()
  modify s' -> s'
f =
    (s' -> m s') -> m ()
forall s s' (m :: * -> *).
MonadDeepState s s' m =>
(s' -> m s') -> m ()
modifyM (s' -> m s'
forall (f :: * -> *) a. Applicative f => a -> f a
pure (s' -> m s') -> (s' -> s') -> s' -> m s'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s' -> s'
f)

instance {-# OVERLAPPING #-} (Monad m, DeepLenses s s') => MonadDeepState s s' (Lazy.StateT s m) where
  get :: StateT s m s'
get = Getting s' s s' -> s -> s'
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
Lens.view Getting s' s s'
forall s s'. DeepLenses s s' => Lens' s s'
deepLens (s -> s') -> StateT s m s -> StateT s m s'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT s m s
forall s (m :: * -> *). MonadState s m => m s
MS.get
  put :: s' -> StateT s m ()
put = (s -> s) -> StateT s m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
MS.modify ((s -> s) -> StateT s m ())
-> (s' -> s -> s) -> s' -> StateT s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter s s s' s' -> s' -> s -> s
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.set ASetter s s s' s'
forall s s'. DeepLenses s s' => Lens' s s'
deepLens

instance {-# OVERLAPPING #-} (Monad m, DeepLenses s s') => MonadDeepState s s' (StateT s m) where
  get :: StateT s m s'
get = Getting s' s s' -> s -> s'
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
Lens.view Getting s' s s'
forall s s'. DeepLenses s s' => Lens' s s'
deepLens (s -> s') -> StateT s m s -> StateT s m s'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT s m s
forall s (m :: * -> *). MonadState s m => m s
MS.get
  put :: s' -> StateT s m ()
put = (s -> s) -> StateT s m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
MS.modify ((s -> s) -> StateT s m ())
-> (s' -> s -> s) -> s' -> StateT s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter s s s' s' -> s' -> s -> s
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.set ASetter s s s' s'
forall s s'. DeepLenses s s' => Lens' s s'
deepLens

instance {-# OVERLAPPABLE #-} (Monad (t m), MonadTrans t, MonadDeepState s s' m) => MonadDeepState s s' (t m) where
  get :: t m s'
get = m s' -> t m s'
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m s'
forall s s' (m :: * -> *). MonadDeepState s s' m => m s'
get
  put :: s' -> t m ()
put = m () -> t m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> t m ()) -> (s' -> m ()) -> s' -> t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s' -> m ()
forall s s' (m :: * -> *). MonadDeepState s s' m => s' -> m ()
put
  state :: (s' -> (a, s')) -> t m a
state = m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> t m a)
-> ((s' -> (a, s')) -> m a) -> (s' -> (a, s')) -> t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s' -> (a, s')) -> m a
forall s s' (m :: * -> *) a.
MonadDeepState s s' m =>
(s' -> (a, s')) -> m a
state

gets ::
  ∀ s' s m a .
  MonadDeepState s s' m =>
  (s' -> a) ->
  m a
gets :: (s' -> a) -> m a
gets =
  ((s' -> a) -> m s' -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m s'
forall s s' (m :: * -> *). MonadDeepState s s' m => m s'
get)

modifyM ::
  MonadDeepState s s' m =>
  (s' -> m s') ->
  m ()
modifyM :: (s' -> m s') -> m ()
modifyM =
  m s' -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m s' -> m ()) -> ((s' -> m s') -> m s') -> (s' -> m s') -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s' -> m s') -> m s'
forall s s' (m :: * -> *).
MonadDeepState s s' m =>
(s' -> m s') -> m s'
modifyM'

modifyL ::
  ∀ s' s a m.
  MonadDeepState s s' m =>
  Lens' s' a ->
  (a -> a) ->
  m ()
modifyL :: Lens' s' a -> (a -> a) -> m ()
modifyL Lens' s' a
lens a -> a
f =
  (s' -> s') -> m ()
forall s s' (m :: * -> *).
MonadDeepState s s' m =>
(s' -> s') -> m ()
modify ((s' -> s') -> m ()) -> (s' -> s') -> m ()
forall a b. (a -> b) -> a -> b
$ ASetter s' s' a a -> (a -> a) -> s' -> s'
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
Lens.over ASetter s' s' a a
Lens' s' a
lens a -> a
f

modifyML' ::
  ∀ s' s a m.
  MonadDeepState s s' m =>
  Lens' s' a ->
  (a -> m a) ->
  m a
modifyML' :: Lens' s' a -> (a -> m a) -> m a
modifyML' Lens' s' a
lens a -> m a
f =
  Getting a s' a -> s' -> a
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
Lens.view Getting a s' a
Lens' s' a
lens (s' -> a) -> m s' -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (s' -> m s') -> m s'
forall s s' (m :: * -> *).
MonadDeepState s s' m =>
(s' -> m s') -> m s'
modifyM' (LensLike (WrappedMonad m) s' s' a a -> (a -> m a) -> s' -> m s'
forall (m :: * -> *) s t a b.
LensLike (WrappedMonad m) s t a b -> (a -> m b) -> s -> m t
Lens.mapMOf LensLike (WrappedMonad m) s' s' a a
Lens' s' a
lens a -> m a
f)

modifyML ::
  ∀ s' s a m.
  MonadDeepState s s' m =>
  Lens' s' a ->
  (a -> m a) ->
  m ()
modifyML :: Lens' s' a -> (a -> m a) -> m ()
modifyML Lens' s' a
lens a -> m a
f =
  (s' -> m s') -> m ()
forall s s' (m :: * -> *).
MonadDeepState s s' m =>
(s' -> m s') -> m ()
modifyM ((s' -> m s') -> m ()) -> (s' -> m s') -> m ()
forall a b. (a -> b) -> a -> b
$ LensLike (WrappedMonad m) s' s' a a -> (a -> m a) -> s' -> m s'
forall (m :: * -> *) s t a b.
LensLike (WrappedMonad m) s t a b -> (a -> m b) -> s -> m t
Lens.mapMOf LensLike (WrappedMonad m) s' s' a a
Lens' s' a
lens a -> m a
f

getL ::
  ∀ s' s m a.
  MonadDeepState s s' m =>
  Lens' s' a ->
  m a
getL :: Lens' s' a -> m a
getL =
  (s' -> a) -> m a
forall s' s (m :: * -> *) a.
MonadDeepState s s' m =>
(s' -> a) -> m a
gets ((s' -> a) -> m a)
-> (Getting a s' a -> s' -> a) -> Getting a s' a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting a s' a -> s' -> a
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
Lens.view

getsL ::
  ∀ s' s m a b.
  MonadDeepState s s' m =>
  Lens' s' a ->
  (a -> b) ->
  m b
getsL :: Lens' s' a -> (a -> b) -> m b
getsL Lens' s' a
lens =
  (s' -> b) -> m b
forall s' s (m :: * -> *) a.
MonadDeepState s s' m =>
(s' -> a) -> m a
gets ((s' -> b) -> m b) -> ((a -> b) -> s' -> b) -> (a -> b) -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike' (Const b) s' a -> (a -> b) -> s' -> b
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
Lens.views LensLike' (Const b) s' a
Lens' s' a
lens

setL ::
  ∀ s' s m a.
  MonadDeepState s s' m =>
  Lens' s' a ->
  a ->
  m ()
setL :: Lens' s' a -> a -> m ()
setL Lens' s' a
lens =
  (s' -> s') -> m ()
forall s s' (m :: * -> *).
MonadDeepState s s' m =>
(s' -> s') -> m ()
modify ((s' -> s') -> m ()) -> (a -> s' -> s') -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter s' s' a a -> a -> s' -> s'
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.set ASetter s' s' a a
Lens' s' a
lens