{-# LANGUAGE Trustworthy #-}

-- |
-- Module      :   Grisette.Lib.Control.Monad.Trans.State.Strict
-- Copyright   :   (c) Sirui Lu 2023
-- License     :   BSD-3-Clause (see the LICENSE file)
--
-- Maintainer  :   siruilu@cs.washington.edu
-- Stability   :   Experimental
-- Portability :   GHC only
module Grisette.Lib.Control.Monad.Trans.State.Strict
  ( -- * mrg* variants for operations in "Control.Monad.Trans.State.Strict"
    mrgState,
    mrgRunStateT,
    mrgEvalStateT,
    mrgExecStateT,
    mrgMapStateT,
    mrgWithStateT,
    mrgGet,
    mrgPut,
    mrgModify,
    mrgModify',
    mrgGets,
  )
where

import Control.Monad.Trans.State.Strict
  ( StateT (StateT),
    runStateT,
  )
import Grisette.Internal.Core.Data.Class.Mergeable (Mergeable)
import Grisette.Internal.Core.Data.Class.TryMerge (TryMerge, tryMerge)
import Grisette.Lib.Control.Monad (mrgReturn)

-- | 'Control.Monad.Trans.State.Strict.state' with
-- 'Grisette.Core.MergingStrategy' knowledge propagation.
mrgState ::
  (Monad m, TryMerge m, Mergeable s, Mergeable a) =>
  (s -> (a, s)) ->
  StateT s m a
mrgState :: forall (m :: * -> *) s a.
(Monad m, TryMerge m, Mergeable s, Mergeable a) =>
(s -> (a, s)) -> StateT s m a
mrgState s -> (a, s)
f = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((a, s) -> m (a, s)
forall (u :: * -> *) a. (MonadTryMerge u, Mergeable a) => a -> u a
mrgReturn ((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)
{-# INLINE mrgState #-}

-- | 'Control.Monad.Trans.State.Strict.runStateT' with
-- 'Grisette.Core.MergingStrategy' knowledge propagation.
mrgRunStateT ::
  (Monad m, TryMerge m, Mergeable s, Mergeable a) =>
  StateT s m a ->
  s ->
  m (a, s)
mrgRunStateT :: forall (m :: * -> *) s a.
(Monad m, TryMerge m, Mergeable s, Mergeable a) =>
StateT s m a -> s -> m (a, s)
mrgRunStateT StateT s m a
m s
s = m (a, s) -> m (a, s)
forall (m :: * -> *) a. (TryMerge m, Mergeable a) => m a -> m a
tryMerge (m (a, s) -> m (a, s)) -> m (a, s) -> m (a, s)
forall a b. (a -> b) -> a -> b
$ StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s m a
m s
s
{-# INLINE mrgRunStateT #-}

-- | 'Control.Monad.Trans.State.Strict.evalStateT' with
-- 'Grisette.Core.MergingStrategy' knowledge propagation.
mrgEvalStateT ::
  (Monad m, TryMerge m, Mergeable a) =>
  StateT s m a ->
  s ->
  m a
mrgEvalStateT :: forall (m :: * -> *) a s.
(Monad m, TryMerge m, Mergeable a) =>
StateT s m a -> s -> m a
mrgEvalStateT StateT s m a
m s
s = m a -> m a
forall (m :: * -> *) a. (TryMerge m, Mergeable a) => m a -> m a
tryMerge (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ do
  (a, _) <- StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s m a
m s
s
  return a
{-# INLINE mrgEvalStateT #-}

-- | 'Control.Monad.Trans.State.Strict.execStateT' with
-- 'Grisette.Core.MergingStrategy' knowledge propagation.
mrgExecStateT ::
  (Monad m, TryMerge m, Mergeable s) =>
  StateT s m a ->
  s ->
  m s
mrgExecStateT :: forall (m :: * -> *) s a.
(Monad m, TryMerge m, Mergeable s) =>
StateT s m a -> s -> m s
mrgExecStateT StateT s m a
m s
s = m s -> m s
forall (m :: * -> *) a. (TryMerge m, Mergeable a) => m a -> m a
tryMerge (m s -> m s) -> m s -> m s
forall a b. (a -> b) -> a -> b
$ do
  (_, s') <- StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s m a
m s
s
  return s'
{-# INLINE mrgExecStateT #-}

-- | 'Control.Monad.Trans.State.Strict.mapStateT' with
-- 'Grisette.Core.MergingStrategy' knowledge propagation.
mrgMapStateT ::
  (TryMerge n, Mergeable b, Mergeable s) =>
  (m (a, s) -> n (b, s)) ->
  StateT s m a ->
  StateT s n b
mrgMapStateT :: forall (n :: * -> *) b s (m :: * -> *) a.
(TryMerge n, Mergeable b, Mergeable s) =>
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mrgMapStateT m (a, s) -> n (b, s)
f StateT s m a
m = (s -> n (b, s)) -> StateT s n b
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((s -> n (b, s)) -> StateT s n b)
-> (s -> n (b, s)) -> StateT s n b
forall a b. (a -> b) -> a -> b
$ n (b, s) -> n (b, s)
forall (m :: * -> *) a. (TryMerge m, Mergeable a) => m a -> m a
tryMerge (n (b, s) -> n (b, s)) -> (s -> n (b, s)) -> s -> n (b, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (a, s) -> n (b, s)
f (m (a, s) -> n (b, s)) -> (s -> m (a, s)) -> s -> n (b, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s m a
m
{-# INLINE mrgMapStateT #-}

-- | 'Control.Monad.Trans.State.Strict.withStateT' with
-- 'Grisette.Core.MergingStrategy' knowledge propagation.
mrgWithStateT ::
  (TryMerge m, Mergeable s, Mergeable a) =>
  (s -> s) ->
  StateT s m a ->
  StateT s m a
mrgWithStateT :: forall (m :: * -> *) s a.
(TryMerge m, Mergeable s, Mergeable a) =>
(s -> s) -> StateT s m a -> StateT s m a
mrgWithStateT s -> s
f StateT s m a
m = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ m (a, s) -> m (a, s)
forall (m :: * -> *) a. (TryMerge m, Mergeable a) => m a -> m a
tryMerge (m (a, s) -> m (a, s)) -> (s -> m (a, s)) -> s -> m (a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s m a
m (s -> m (a, s)) -> (s -> s) -> s -> m (a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> s
f
{-# INLINE mrgWithStateT #-}

-- | 'Control.Monad.Trans.State.Strict.get' with 'Grisette.Core.MergingStrategy'
-- knowledge propagation.
mrgGet :: (Monad m, TryMerge m, Mergeable s) => StateT s m s
mrgGet :: forall (m :: * -> *) s.
(Monad m, TryMerge m, Mergeable s) =>
StateT s m s
mrgGet = (s -> (s, s)) -> StateT s m s
forall (m :: * -> *) s a.
(Monad m, TryMerge m, Mergeable s, Mergeable a) =>
(s -> (a, s)) -> StateT s m a
mrgState (\s
s -> (s
s, s
s))
{-# INLINE mrgGet #-}

-- | 'Control.Monad.Trans.State.Strict.put' with 'Grisette.Core.MergingStrategy'
-- knowledge propagation.
mrgPut :: (Monad m, TryMerge m, Mergeable s) => s -> StateT s m ()
mrgPut :: forall (m :: * -> *) s.
(Monad m, TryMerge m, Mergeable s) =>
s -> StateT s m ()
mrgPut s
s = (s -> ((), s)) -> StateT s m ()
forall (m :: * -> *) s a.
(Monad m, TryMerge m, Mergeable s, Mergeable a) =>
(s -> (a, s)) -> StateT s m a
mrgState (((), s) -> s -> ((), s)
forall a b. a -> b -> a
const ((), s
s))
{-# INLINE mrgPut #-}

-- | 'Control.Monad.Trans.State.Strict.modify' with
-- 'Grisette.Core.MergingStrategy' knowledge propagation.
mrgModify :: (Monad m, TryMerge m, Mergeable s) => (s -> s) -> StateT s m ()
mrgModify :: forall (m :: * -> *) s.
(Monad m, TryMerge m, Mergeable s) =>
(s -> s) -> StateT s m ()
mrgModify s -> s
f = (s -> ((), s)) -> StateT s m ()
forall (m :: * -> *) s a.
(Monad m, TryMerge m, Mergeable s, Mergeable a) =>
(s -> (a, s)) -> StateT s m a
mrgState (\s
s -> ((), s -> s
f s
s))
{-# INLINE mrgModify #-}

-- | 'Control.Monad.Trans.State.Strict.modify'' with
-- 'Grisette.Core.MergingStrategy' knowledge propagation.
mrgModify' :: (Monad m, TryMerge m, Mergeable s) => (s -> s) -> StateT s m ()
mrgModify' :: forall (m :: * -> *) s.
(Monad m, TryMerge m, Mergeable s) =>
(s -> s) -> StateT s m ()
mrgModify' s -> s
f = do
  s <- StateT s m s
forall (m :: * -> *) s.
(Monad m, TryMerge m, Mergeable s) =>
StateT s m s
mrgGet
  mrgPut $! f s
{-# INLINE mrgModify' #-}

-- | 'Control.Monad.Trans.State.Strict.gets' with
-- 'Grisette.Core.MergingStrategy' knowledge propagation.
mrgGets ::
  (Monad m, TryMerge m, Mergeable s, Mergeable a) =>
  (s -> a) ->
  StateT s m a
mrgGets :: forall (m :: * -> *) s a.
(Monad m, TryMerge m, Mergeable s, Mergeable a) =>
(s -> a) -> StateT s m a
mrgGets s -> a
f = (s -> (a, s)) -> StateT s m a
forall (m :: * -> *) s a.
(Monad m, TryMerge m, Mergeable s, Mergeable a) =>
(s -> (a, s)) -> StateT s m a
mrgState ((s -> (a, s)) -> StateT s m a) -> (s -> (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \s
s -> (s -> a
f s
s, s
s)
{-# INLINE mrgGets #-}