{-# LANGUAGE Trustworthy #-}

-- |
-- Module      :   Grisette.Lib.Control.Monad.State.Class
-- 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.State.Class
  ( -- * mrg* variants for operations in "Control.Monad.State.Class"
    mrgGet,
    mrgPut,
    mrgState,
    mrgModify,
    mrgModify',
    mrgGets,
  )
where

import Control.Monad.State.Class (MonadState (get, put))
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.State.Class.get' with 'Grisette.Core.MergingStrategy'
-- knowledge propagation.
mrgGet :: (MonadState s m, TryMerge m, Mergeable s) => m s
mrgGet :: forall s (m :: * -> *).
(MonadState s m, TryMerge m, Mergeable s) =>
m s
mrgGet = m s -> m s
forall (m :: * -> *) a. (TryMerge m, Mergeable a) => m a -> m a
tryMerge m s
forall s (m :: * -> *). MonadState s m => m s
get
{-# INLINE mrgGet #-}

-- | 'Control.Monad.State.Class.put' with 'Grisette.Core.MergingStrategy'
-- knowledge propagation.
mrgPut :: (MonadState s m, TryMerge m) => s -> m ()
mrgPut :: forall s (m :: * -> *). (MonadState s m, TryMerge m) => s -> m ()
mrgPut = m () -> m ()
forall (m :: * -> *) a. (TryMerge m, Mergeable a) => m a -> m a
tryMerge (m () -> m ()) -> (s -> m ()) -> s -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
{-# INLINE mrgPut #-}

-- | 'Control.Monad.State.Class.state' with 'Grisette.Core.MergingStrategy'
-- knowledge propagation.
mrgState ::
  (MonadState s m, TryMerge m, Mergeable s, Mergeable a) =>
  (s -> (a, s)) ->
  m a
mrgState :: forall s (m :: * -> *) a.
(MonadState s m, TryMerge m, Mergeable s, Mergeable a) =>
(s -> (a, s)) -> m a
mrgState s -> (a, s)
f = 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
  s <- m s
forall s (m :: * -> *).
(MonadState s m, TryMerge m, Mergeable s) =>
m s
mrgGet
  let ~(a, s') = f s
  mrgPut s'
  mrgReturn a

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

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

-- | 'Control.Monad.State.Class.gets' with 'Grisette.Core.MergingStrategy'
-- knowledge propagation.
mrgGets ::
  (MonadState s m, TryMerge m, Mergeable s, Mergeable a) =>
  (s -> a) ->
  m a
mrgGets :: forall s (m :: * -> *) a.
(MonadState s m, TryMerge m, Mergeable s, Mergeable a) =>
(s -> a) -> m a
mrgGets s -> a
f = do
  s <- m s
forall s (m :: * -> *).
(MonadState s m, TryMerge m, Mergeable s) =>
m s
mrgGet
  mrgReturn $ f s
{-# INLINE mrgGets #-}