{-# LANGUAGE Trustworthy #-}

-- |
-- Module      :   Grisette.Lib.Control.Monad.Except
-- Copyright   :   (c) Sirui Lu 2021-2024
-- License     :   BSD-3-Clause (see the LICENSE file)
--
-- Maintainer  :   siruilu@cs.washington.edu
-- Stability   :   Experimental
-- Portability :   GHC only
module Grisette.Lib.Control.Monad.Except
  ( -- * mrg* variants for operations in "Control.Monad.Except"
    mrgThrowError,
    mrgCatchError,
    mrgLiftEither,
    mrgTryError,
    mrgWithError,
    mrgHandleError,
    mrgMapError,
    mrgModifyError,
  )
where

import Control.Monad.Except (ExceptT, MonadError (catchError, throwError))
import Grisette.Internal.Core.Data.Class.Mergeable (Mergeable)
import Grisette.Internal.Core.Data.Class.TryMerge (TryMerge, tryMerge)
import Grisette.Lib.Control.Monad (mrgReturn)
import Grisette.Lib.Control.Monad.Trans.Except (mrgRunExceptT)
import Grisette.Lib.Data.Functor (mrgFmap)

-- | 'Control.Monad.Except.throwError' with 'MergingStrategy' knowledge
-- propagation.
mrgThrowError :: (MonadError e m, TryMerge m, Mergeable a) => e -> m a
mrgThrowError :: forall e (m :: * -> *) a.
(MonadError e m, TryMerge m, Mergeable a) =>
e -> m a
mrgThrowError = m a -> m a
forall (m :: * -> *) a. (TryMerge m, Mergeable a) => m a -> m a
tryMerge (m a -> m a) -> (e -> m a) -> e -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall a. e -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
{-# INLINE mrgThrowError #-}

-- | 'Control.Monad.Except.catchError' with 'MergingStrategy' knowledge
-- propagation.
mrgCatchError ::
  (MonadError e m, TryMerge m, Mergeable a) =>
  m a ->
  (e -> m a) ->
  m a
mrgCatchError :: forall e (m :: * -> *) a.
(MonadError e m, TryMerge m, Mergeable a) =>
m a -> (e -> m a) -> m a
mrgCatchError m a
v e -> m a
handler = 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
$ m a
v m a -> (e -> m a) -> m a
forall a. m a -> (e -> m a) -> m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` (m a -> m a
forall (m :: * -> *) a. (TryMerge m, Mergeable a) => m a -> m a
tryMerge (m a -> m a) -> (e -> m a) -> e -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
handler)
{-# INLINE mrgCatchError #-}

-- | 'Control.Monad.Except.liftEither' with 'MergingStrategy' knowledge
-- propagation.
mrgLiftEither ::
  (MonadError e m, TryMerge m, Mergeable a, Mergeable e) => Either e a -> m a
mrgLiftEither :: forall e (m :: * -> *) a.
(MonadError e m, TryMerge m, Mergeable a, Mergeable e) =>
Either e a -> m a
mrgLiftEither = (e -> m a) -> (a -> m a) -> Either e a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> m a
forall e (m :: * -> *) a.
(MonadError e m, TryMerge m, Mergeable a) =>
e -> m a
mrgThrowError a -> m a
forall (u :: * -> *) a. (MonadTryMerge u, Mergeable a) => a -> u a
mrgReturn
{-# INLINE mrgLiftEither #-}

-- | 'Control.Monad.Except.tryError' with 'MergingStrategy' knowledge
-- propagation.
mrgTryError ::
  (MonadError e m, TryMerge m, Mergeable a, Mergeable e) =>
  m a ->
  m (Either e a)
mrgTryError :: forall e (m :: * -> *) a.
(MonadError e m, TryMerge m, Mergeable a, Mergeable e) =>
m a -> m (Either e a)
mrgTryError m a
action = ((a -> Either e a) -> m a -> m (Either e a)
forall (f :: * -> *) a b.
(TryMerge f, Mergeable a, Mergeable b, Functor f) =>
(a -> b) -> f a -> f b
mrgFmap a -> Either e a
forall a b. b -> Either a b
Right m a
action) m (Either e a) -> (e -> m (Either e a)) -> m (Either e a)
forall e (m :: * -> *) a.
(MonadError e m, TryMerge m, Mergeable a) =>
m a -> (e -> m a) -> m a
`mrgCatchError` (Either e a -> m (Either e a)
forall (u :: * -> *) a. (MonadTryMerge u, Mergeable a) => a -> u a
mrgReturn (Either e a -> m (Either e a))
-> (e -> Either e a) -> e -> m (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Either e a
forall a b. a -> Either a b
Left)
{-# INLINE mrgTryError #-}

-- | 'Control.Monad.Except.withError' with 'MergingStrategy' knowledge
-- propagation.
mrgWithError ::
  (MonadError e m, TryMerge m, Mergeable a, Mergeable e) =>
  (e -> e) ->
  m a ->
  m a
mrgWithError :: forall e (m :: * -> *) a.
(MonadError e m, TryMerge m, Mergeable a, Mergeable e) =>
(e -> e) -> m a -> m a
mrgWithError e -> e
f m a
action =
  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
$ m a -> m (Either e a)
forall e (m :: * -> *) a.
(MonadError e m, TryMerge m, Mergeable a, Mergeable e) =>
m a -> m (Either e a)
mrgTryError m a
action m (Either e a) -> (Either e a -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (e -> m a) -> (a -> m a) -> Either e a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (e -> m a
forall e (m :: * -> *) a.
(MonadError e m, TryMerge m, Mergeable a) =>
e -> m a
mrgThrowError (e -> m a) -> (e -> e) -> e -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> e
f) a -> m a
forall (u :: * -> *) a. (MonadTryMerge u, Mergeable a) => a -> u a
mrgReturn
{-# INLINE mrgWithError #-}

-- | 'Control.Monad.Except.handleError' with 'MergingStrategy' knowledge
-- propagation.
mrgHandleError ::
  (MonadError e m, TryMerge m, Mergeable a, Mergeable e) =>
  (e -> m a) ->
  m a ->
  m a
mrgHandleError :: forall e (m :: * -> *) a.
(MonadError e m, TryMerge m, Mergeable a, Mergeable e) =>
(e -> m a) -> m a -> m a
mrgHandleError = (m a -> (e -> m a) -> m a) -> (e -> m a) -> m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip m a -> (e -> m a) -> m a
forall e (m :: * -> *) a.
(MonadError e m, TryMerge m, Mergeable a) =>
m a -> (e -> m a) -> m a
mrgCatchError
{-# INLINE mrgHandleError #-}

-- | 'Control.Monad.Except.mapError' with 'MergingStrategy' knowledge
-- propagation.
mrgMapError ::
  ( MonadError e m,
    TryMerge m,
    MonadError e' n,
    TryMerge n,
    Mergeable a,
    Mergeable b,
    Mergeable e,
    Mergeable e'
  ) =>
  (m (Either e a) -> n (Either e' b)) ->
  m a ->
  n b
mrgMapError :: forall e (m :: * -> *) e' (n :: * -> *) a b.
(MonadError e m, TryMerge m, MonadError e' n, TryMerge n,
 Mergeable a, Mergeable b, Mergeable e, Mergeable e') =>
(m (Either e a) -> n (Either e' b)) -> m a -> n b
mrgMapError m (Either e a) -> n (Either e' b)
f m a
action = n (Either e' b) -> n (Either e' b)
forall (m :: * -> *) a. (TryMerge m, Mergeable a) => m a -> m a
tryMerge (m (Either e a) -> n (Either e' b)
f (m a -> m (Either e a)
forall e (m :: * -> *) a.
(MonadError e m, TryMerge m, Mergeable a, Mergeable e) =>
m a -> m (Either e a)
mrgTryError m a
action)) n (Either e' b) -> (Either e' b -> n b) -> n b
forall a b. n a -> (a -> n b) -> n b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either e' b -> n b
forall e (m :: * -> *) a.
(MonadError e m, TryMerge m, Mergeable a, Mergeable e) =>
Either e a -> m a
mrgLiftEither
{-# INLINE mrgMapError #-}

-- | 'Control.Monad.Except.modifyError' with 'MergingStrategy' knowledge
-- propagation.
mrgModifyError ::
  ( MonadError e' m,
    TryMerge m,
    Mergeable a,
    Mergeable e,
    Mergeable e
  ) =>
  (e -> e') ->
  ExceptT e m a ->
  m a
mrgModifyError :: forall e' (m :: * -> *) a e.
(MonadError e' m, TryMerge m, Mergeable a, Mergeable e,
 Mergeable e) =>
(e -> e') -> ExceptT e m a -> m a
mrgModifyError e -> e'
f ExceptT e m a
m =
  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
$ ExceptT e m a -> m (Either e a)
forall (m :: * -> *) e a.
(MonadTryMerge m, Mergeable e, Mergeable a) =>
ExceptT e m a -> m (Either e a)
mrgRunExceptT ExceptT e m a
m m (Either e a) -> (Either e a -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (e -> m a) -> (a -> m a) -> Either e a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (e' -> m a
forall e (m :: * -> *) a.
(MonadError e m, TryMerge m, Mergeable a) =>
e -> m a
mrgThrowError (e' -> m a) -> (e -> e') -> e -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> e'
f) a -> m a
forall (u :: * -> *) a. (MonadTryMerge u, Mergeable a) => a -> u a
mrgReturn
{-# INLINE mrgModifyError #-}