{-# LANGUAGE Trustworthy #-}

-- |
-- Module      :   Grisette.Lib.Control.Monad.Trans.Cont
-- Copyright   :   (c) Sirui Lu 2021-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.Cont
  ( -- * mrg* variants for operations in "Control.Monad.Trans.Cont"
    mrgRunContT,
    mrgEvalContT,
    mrgResetT,
  )
where

import Control.Monad.Cont (ContT (runContT))
import Control.Monad.Trans.Class (lift)
import Grisette.Core.Data.Class.Mergeable (Mergeable)
import Grisette.Core.Data.Class.SimpleMergeable
  ( UnionLike,
    merge,
  )
import Grisette.Lib.Control.Monad (mrgReturn)

-- | 'Control.Monad.Cont.runContT' with 'MergingStrategy' knowledge propagation
mrgRunContT :: (UnionLike m, Mergeable r) => ContT r m a -> (a -> m r) -> m r
mrgRunContT :: forall (m :: * -> *) r a.
(UnionLike m, Mergeable r) =>
ContT r m a -> (a -> m r) -> m r
mrgRunContT ContT r m a
c = m r -> m r
forall (u :: * -> *) a. (UnionLike u, Mergeable a) => u a -> u a
merge (m r -> m r) -> ((a -> m r) -> m r) -> (a -> m r) -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT r m a -> (a -> m r) -> m r
forall {k} (r :: k) (m :: k -> *) a.
ContT r m a -> (a -> m r) -> m r
runContT ContT r m a
c
{-# INLINE mrgRunContT #-}

-- | 'Control.Monad.Cont.evalContT' with 'MergingStrategy' knowledge propagation
mrgEvalContT :: (UnionLike m, Mergeable r, Monad m) => ContT r m r -> m r
mrgEvalContT :: forall (m :: * -> *) r.
(UnionLike m, Mergeable r, Monad m) =>
ContT r m r -> m r
mrgEvalContT ContT r m r
c = ContT r m r -> (r -> m r) -> m r
forall {k} (r :: k) (m :: k -> *) a.
ContT r m a -> (a -> m r) -> m r
runContT ContT r m r
c r -> m r
forall (u :: * -> *) a. (MonadUnion u, Mergeable a) => a -> u a
mrgReturn
{-# INLINE mrgEvalContT #-}

-- | 'Control.Monad.Cont.resetT' with 'MergingStrategy' knowledge propagation
mrgResetT :: (UnionLike m, Mergeable r, Monad m) => (Monad m) => ContT r m r -> ContT r' m r
mrgResetT :: forall (m :: * -> *) r r'.
(UnionLike m, Mergeable r, Monad m, Monad m) =>
ContT r m r -> ContT r' m r
mrgResetT = m r -> ContT r' m r
forall (m :: * -> *) a. Monad m => m a -> ContT r' m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m r -> ContT r' m r)
-> (ContT r m r -> m r) -> ContT r m r -> ContT r' m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT r m r -> m r
forall (m :: * -> *) r.
(UnionLike m, Mergeable r, Monad m) =>
ContT r m r -> m r
mrgEvalContT
{-# INLINE mrgResetT #-}