{-# LANGUAGE CPP #-}

module Mikan.Utils.Monad
    ( -- * Combinators
      (==<<)
    , (<*!>)
    , (<&!>)
      -- * Conditionals and monads
    , when, unless
    , guard
    , whenM, unlessM
    , guardM
    , ifM, ifNotM
    , and2M, andM
    , allM, forallM
    , or2M, orM
    , anyM, existsM
    , findM
    , altM1
    , orEitherM
      -- * Loops
      -- ** Loops gathering results in a Monoid
    , mapM', forM'
      -- ** Variations of Traversable
    , mapMM, forMM
      -- ** Variations of Foldable
    , mapMM_, forMM_
    , concatMapM
    , mapMGood, forMGood, mapMGood_, forMGood_
    , (<++!>)
      -- ** Indexed traversals
    , imapM_, iforM_
    , rangeM_
      -- ** Filters
    , mapMaybeM, mapMaybeMM
    , forMaybeM, forMaybeMM
      -- ** Monadic list functions
    , dropWhileM, dropWhileEndM
    , partitionM
      -- * MonadPlus
    , fromMaybeMP
    , catMaybesMP
    , scatterMP
      -- * MonadError
    , finally
    , tryMaybe, tryCatch
    , guardWithError
    , catchExceptT
      -- * MonadState
    , bracket_
    , localState
      -- * MonadWriter
    , embedWriter
    , tell1
      -- * Re-exports
    , module X
    , (<$>), (<*>) , (<$)
    , tryError, withError
    )
    where

import Control.Monad.Except   ( MonadError(catchError, throwError), ExceptT, runExceptT )
import Control.Monad.Identity ( runIdentity )
import Control.Monad.State    ( MonadState(get, put) )
import Control.Monad.Writer   ( MonadWriter(tell), Writer, WriterT, mapWriterT )

import Data.Bifunctor         ( first, second )
import Data.Bool              ( bool )
import Data.Traversable as Trav hiding (for, sequence)
import Data.Foldable as Fold
import Data.Maybe
import Data.Monoid

import Mikan.Utils.Applicative
import Mikan.Utils.Boolean
import Mikan.Utils.Either
import Mikan.Utils.Null (empty, ifNotNullM)
import Mikan.Utils.Singleton
import Mikan.Utils.ExpandCase

import Mikan.Utils.Impossible
import Mikan.Utils.List ((++!))

-- Reexport Control.Monad
import Control.Applicative as X
  ( liftA2
  )
import Control.Monad as X
  ( MonadPlus(..), (<$!>), (>=>), (<=<)
  , filterM, foldM, forM, forM_
  , join
  , liftM2, liftM3, liftM4
  , msum
  , void
  , zipWithM, zipWithM_
  )
import Control.Monad.Trans as X
  ( MonadTrans, lift
  )


---------------------------------------------------------------------------
-- Vendor some new functions from mtl-2.3.1

#if MIN_VERSION_mtl(2,3,1)
import Control.Monad.Except ( tryError, withError )
#endif

#if !MIN_VERSION_mtl(2,3,1)
-- | 'MonadError' analogue to the 'Control.Exception.try' function.
tryError :: MonadError e m => m a -> m (Either e a)
tryError action = (Right <$> action) `catchError` (pure . Left)

-- | 'MonadError' analogue to the 'withExceptT' function.
-- Modify the value (but not the type) of an error.  The type is
-- fixed because of the functional dependency @m -> e@.  If you need
-- to change the type of @e@ use 'mapError' or 'modifyError'.
withError :: MonadError e m => (e -> e) -> m a -> m a
withError f action = tryError action >>= either (throwError . f) pure
#endif

---------------------------------------------------------------------------

-- | Binary bind.
(==<<) :: Monad m => (a -> b -> m c) -> (m a, m b) -> m c
a -> b -> m c
k ==<< :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c) -> (m a, m b) -> m c
==<< (m a
ma, m b
mb) = m a
ma m a -> (a -> m c) -> m c
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ a
a -> a -> b -> m c
k a
a (b -> m c) -> m b -> m c
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m b
mb

-- | Strict 'Control.Monad.ap'
(<*!>) :: Monad m => m (a -> b) -> m a -> m b
<*!> :: forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
(<*!>) m (a -> b)
mf m a
ma = do
  f <- m (a -> b)
mf
  a <- ma
  pure $! f a
{-# INLINE (<*!>) #-}
infixl 4 <*!>

{-# INLINE (<&!>) #-}
-- | Strict variant of 'Data.Functor.<&>'.
(<&!>) :: Monad m => m a -> (a -> b) -> m b
<&!> :: forall (m :: * -> *) a b. Monad m => m a -> (a -> b) -> m b
(<&!>) = ((a -> b) -> m a -> m b) -> m a -> (a -> b) -> m b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> b) -> m a -> m b
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
(<$!>)

infixl 1 <&!>

--------------------------------------------------------------------------------
-- Conditionals and monads

{-# SPECIALIZE when :: Monad m => Bool -> m () -> m () #-}
when :: (IsBool b, Monad m) => b -> m () -> m ()
when :: forall b (m :: * -> *). (IsBool b, Monad m) => b -> m () -> m ()
when b
b m ()
m = b -> m () -> m () -> m ()
forall b. b -> b -> b -> b
forall a b. IsBool a => a -> b -> b -> b
ifThenElse b
b m ()
m (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

{-# SPECIALIZE unless :: Monad m => Bool -> m () -> m () #-}
unless :: (IsBool b, Monad m) => b -> m () -> m()
unless :: forall b (m :: * -> *). (IsBool b, Monad m) => b -> m () -> m ()
unless b
b m ()
m = b -> m () -> m () -> m ()
forall b. b -> b -> b -> b
forall a b. IsBool a => a -> b -> b -> b
ifThenElse b
b (() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) m ()
m

{-# SPECIALIZE guard :: MonadPlus m => Bool -> m () #-}
guard :: (IsBool b, MonadPlus m) => b -> m ()
guard :: forall b (m :: * -> *). (IsBool b, MonadPlus m) => b -> m ()
guard b
b = b -> m () -> m () -> m ()
forall b. b -> b -> b -> b
forall a b. IsBool a => a -> b -> b -> b
ifThenElse b
b (() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) m ()
forall a. m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

whenM :: Monad m => m Bool -> m () -> m ()
whenM :: forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM m Bool
c m ()
m = m Bool
c m Bool -> (Bool -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool -> m () -> m ()
forall b (m :: * -> *). (IsBool b, Monad m) => b -> m () -> m ()
`when` m ()
m)

unlessM :: Monad m => m Bool -> m () -> m ()
unlessM :: forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM m Bool
c m ()
m = m Bool
c m Bool -> (Bool -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool -> m () -> m ()
forall b (m :: * -> *). (IsBool b, Monad m) => b -> m () -> m ()
`unless` m ()
m)

-- | Monadic guard.
guardM :: (MonadPlus m) => m Bool -> m ()
guardM :: forall (m :: * -> *). MonadPlus m => m Bool -> m ()
guardM m Bool
c = Bool -> m ()
forall b (m :: * -> *). (IsBool b, MonadPlus m) => b -> m ()
guard (Bool -> m ()) -> m Bool -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Bool
c

-- | Monadic if-then-else.
ifM :: Monad m => m Bool -> m a -> m a -> m a
ifM :: forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM m Bool
c m a
m m a
m' = m Bool
c m Bool -> (Bool -> 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
>>= \Bool
b -> if Bool
b then m a
m else m a
m'

-- | @ifNotM mc = ifM (not <$> mc)@
ifNotM :: Monad m => m Bool -> m a -> m a -> m a
ifNotM :: forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifNotM m Bool
c = (m a -> m a -> m a) -> m a -> m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((m a -> m a -> m a) -> m a -> m a -> m a)
-> (m a -> m a -> m a) -> m a -> m a -> m a
forall a b. (a -> b) -> a -> b
$ m Bool -> m a -> m a -> m a
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM m Bool
c

-- | Lazy monadic conjunction.
and2M :: Monad m => m Bool -> m Bool -> m Bool
and2M :: forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
and2M m Bool
ma m Bool
mb = m Bool -> m Bool -> m Bool -> m Bool
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM m Bool
ma m Bool
mb (Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)

andM :: (Foldable f, Monad m) => f (m Bool) -> m Bool
andM :: forall (f :: * -> *) (m :: * -> *).
(Foldable f, Monad m) =>
f (m Bool) -> m Bool
andM = (m Bool -> m Bool -> m Bool) -> m Bool -> f (m Bool) -> m Bool
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Fold.foldl' m Bool -> m Bool -> m Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
and2M (Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)

allM :: (Foldable f, Monad m) => (a -> m Bool) -> f a -> m Bool
allM :: forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Monad m) =>
(a -> m Bool) -> f a -> m Bool
allM a -> m Bool
f = (m Bool -> a -> m Bool) -> m Bool -> f a -> m Bool
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Fold.foldl' (\ m Bool
b -> m Bool -> m Bool -> m Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
and2M m Bool
b (m Bool -> m Bool) -> (a -> m Bool) -> a -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m Bool
f) (Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)

forallM :: (Foldable f, Monad m) => f a -> (a -> m Bool) -> m Bool
forallM :: forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Monad m) =>
f a -> (a -> m Bool) -> m Bool
forallM f a
xs a -> m Bool
f = (m Bool -> a -> m Bool) -> m Bool -> f a -> m Bool
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Fold.foldl' (\m Bool
b -> m Bool -> m Bool -> m Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
and2M m Bool
b (m Bool -> m Bool) -> (a -> m Bool) -> a -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m Bool
f) (Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) f a
xs

-- | Lazy monadic disjunction.
or2M :: Monad m => m Bool -> m Bool -> m Bool
or2M :: forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
or2M m Bool
ma = m Bool -> m Bool -> m Bool -> m Bool
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM m Bool
ma (Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)

orM :: (Foldable f, Monad m) => f (m Bool) -> m Bool
orM :: forall (f :: * -> *) (m :: * -> *).
(Foldable f, Monad m) =>
f (m Bool) -> m Bool
orM = (m Bool -> m Bool -> m Bool) -> m Bool -> f (m Bool) -> m Bool
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Fold.foldl' m Bool -> m Bool -> m Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
or2M (Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)

anyM :: (Foldable f, Monad m) => (a -> m Bool) -> f a -> m Bool
anyM :: forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Monad m) =>
(a -> m Bool) -> f a -> m Bool
anyM a -> m Bool
f = (m Bool -> a -> m Bool) -> m Bool -> f a -> m Bool
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Fold.foldl' (\ m Bool
b -> m Bool -> m Bool -> m Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
or2M m Bool
b (m Bool -> m Bool) -> (a -> m Bool) -> a -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m Bool
f) (Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)

existsM :: (Foldable f, Monad m) => f a -> (a -> m Bool) -> m Bool
existsM :: forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Monad m) =>
f a -> (a -> m Bool) -> m Bool
existsM f a
xs a -> m Bool
f = (a -> m Bool) -> f a -> m Bool
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Monad m) =>
(a -> m Bool) -> f a -> m Bool
anyM a -> m Bool
f f a
xs

-- https://hackage-content.haskell.org/package/extra-1.8/docs/src/Data.Foldable.Extra.html#findM
findM :: (Foldable f, Monad m) => (a -> m Bool) -> f a -> m (Maybe a)
findM :: forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Monad m) =>
(a -> m Bool) -> f a -> m (Maybe a)
findM a -> m Bool
p = (a -> m (Maybe a) -> m (Maybe a))
-> m (Maybe a) -> f a -> m (Maybe a)
forall a b. (a -> b -> b) -> b -> f a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x -> m Bool -> m (Maybe a) -> m (Maybe a) -> m (Maybe a)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (a -> m Bool
p a
x) (Maybe a -> m (Maybe a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
x)) (Maybe a -> m (Maybe a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing)

-- | Lazy monadic disjunction with @Either@  truth values.
--   Returns the last error message if all fail.
altM1 :: Monad m => (a -> m (Either err b)) -> [a] -> m (Either err b)
altM1 :: forall (m :: * -> *) a err b.
Monad m =>
(a -> m (Either err b)) -> [a] -> m (Either err b)
altM1 a -> m (Either err b)
f []       = m (Either err b)
forall a. HasCallStack => a
__IMPOSSIBLE__
altM1 a -> m (Either err b)
f [a
a]      = a -> m (Either err b)
f a
a
altM1 a -> m (Either err b)
f (a
a : [a]
as) = (err -> m (Either err b))
-> (b -> m (Either err b)) -> Either err b -> m (Either err b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (m (Either err b) -> err -> m (Either err b)
forall a b. a -> b -> a
const (m (Either err b) -> err -> m (Either err b))
-> m (Either err b) -> err -> m (Either err b)
forall a b. (a -> b) -> a -> b
$ (a -> m (Either err b)) -> [a] -> m (Either err b)
forall (m :: * -> *) a err b.
Monad m =>
(a -> m (Either err b)) -> [a] -> m (Either err b)
altM1 a -> m (Either err b)
f [a]
as) (Either err b -> m (Either err b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either err b -> m (Either err b))
-> (b -> Either err b) -> b -> m (Either err b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either err b
forall a b. b -> Either a b
Right) (Either err b -> m (Either err b))
-> m (Either err b) -> m (Either err b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> m (Either err b)
f a
a

-- | Lazy monadic disjunction with accumulation of errors in a monoid.
--   Errors are discarded if we succeed.
orEitherM :: (Monoid e, Monad m) => [m (Either e b)] -> m (Either e b)
orEitherM :: forall e (m :: * -> *) b.
(Monoid e, Monad m) =>
[m (Either e b)] -> m (Either e b)
orEitherM []       = Either e b -> m (Either e b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either e b -> m (Either e b)) -> Either e b -> m (Either e b)
forall a b. (a -> b) -> a -> b
$ e -> Either e b
forall a b. a -> Either a b
Left e
forall a. Monoid a => a
mempty
orEitherM (m (Either e b)
m : [m (Either e b)]
ms) = m (Either e b)
-> (e -> m (Either e b)) -> (b -> m (Either e b)) -> m (Either e b)
forall (m :: * -> *) a b c.
Monad m =>
m (Either a b) -> (a -> m c) -> (b -> m c) -> m c
caseEitherM m (Either e b)
m (\e
e -> (e -> e) -> Either e b -> Either e b
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft (e
e e -> e -> e
forall a. Monoid a => a -> a -> a
`mappend`) (Either e b -> Either e b) -> m (Either e b) -> m (Either e b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [m (Either e b)] -> m (Either e b)
forall e (m :: * -> *) b.
(Monoid e, Monad m) =>
[m (Either e b)] -> m (Either e b)
orEitherM [m (Either e b)]
ms)
                                   (Either e b -> m (Either e b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either e b -> m (Either e b))
-> (b -> Either e b) -> b -> m (Either e b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either e b
forall a b. b -> Either a b
Right)

--------------------------------------------------------------------------------
-- Loops gathering results in a Monoid

-- | Generalized version of @traverse_ :: Applicative m => (a -> m ()) -> [a] -> m ()@
--   Executes effects and collects results in left-to-right order.
--   Works best with left-associative monoids.
--
--   Note that there is an alternative
--
--     @mapM' f t = foldr mappend mempty <$> mapM f t@
--
--   that collects results in right-to-left order
--   (effects still left-to-right).
--   It might be preferable for right associative monoids.
mapM' :: (Foldable t, Applicative m, Monoid b) => (a -> m b) -> t a -> m b
mapM' :: forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Applicative m, Monoid b) =>
(a -> m b) -> t a -> m b
mapM' a -> m b
f = (m b -> a -> m b) -> m b -> t a -> m b
forall b a. (b -> a -> b) -> b -> t a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Fold.foldl (\ m b
mb a
a -> (b -> b -> b) -> m b -> m b -> m b
forall a b c. (a -> b -> c) -> m a -> m b -> m c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> b
forall a. Monoid a => a -> a -> a
mappend m b
mb (a -> m b
f a
a)) (b -> m b
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
forall a. Monoid a => a
mempty)

-- | Generalized version of @for_ :: Applicative m => [a] -> (a -> m ()) -> m ()@
forM' :: (Foldable t, Applicative m, Monoid b) => t a -> (a -> m b) -> m b
forM' :: forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Applicative m, Monoid b) =>
t a -> (a -> m b) -> m b
forM' = ((a -> m b) -> t a -> m b) -> t a -> (a -> m b) -> m b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> m b) -> t a -> m b
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Applicative m, Monoid b) =>
(a -> m b) -> t a -> m b
mapM'

--------------------------------------------------------------------------------
-- Variations of Traversable

mapMM :: (Traversable t, Monad m) => (a -> m b) -> m (t a) -> m (t b)
mapMM :: forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> m (t a) -> m (t b)
mapMM a -> m b
f m (t a)
mxs = (a -> m b) -> t a -> m (t b)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)
Trav.mapM a -> m b
f (t a -> m (t b)) -> m (t a) -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (t a)
mxs

forMM :: (Traversable t, Monad m) => m (t a) -> (a -> m b) -> m (t b)
forMM :: forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
m (t a) -> (a -> m b) -> m (t b)
forMM = ((a -> m b) -> m (t a) -> m (t b))
-> m (t a) -> (a -> m b) -> m (t b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> m b) -> m (t a) -> m (t b)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> m (t a) -> m (t b)
mapMM

-- Variations of Foldable

mapMM_ :: (Foldable t, Monad m) => (a -> m ()) -> m (t a) -> m ()
mapMM_ :: forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> m (t a) -> m ()
mapMM_ a -> m ()
f m (t a)
mxs = (a -> m ()) -> t a -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
Fold.mapM_ a -> m ()
f (t a -> m ()) -> m (t a) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (t a)
mxs

forMM_ :: (Foldable t, Monad m) => m (t a) -> (a -> m ()) -> m ()
forMM_ :: forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
m (t a) -> (a -> m ()) -> m ()
forMM_ = ((a -> m ()) -> m (t a) -> m ()) -> m (t a) -> (a -> m ()) -> m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> m ()) -> m (t a) -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> m (t a) -> m ()
mapMM_

concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM :: forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM a -> m [b]
f [a]
xs = [[b]] -> [b]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[b]] -> [b]) -> m [[b]] -> m [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> m [b]) -> [a] -> m [[b]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
Trav.mapM a -> m [b]
f [a]
xs

{-# INLINE mapMGood #-}
-- | Variant of 'mapM' which gets compiled to good code, assuming that we're mapping over an actual
--   runtime list and don't intend for list fusion to fire.
mapMGood :: (Monad m, ExpandCase rep (m [b])) => (a -> m b) -> [a] -> m [b]
mapMGood :: forall (m :: * -> *) b a.
(Monad m, ExpandCase LiftedRep (m [b])) =>
(a -> m b) -> [a] -> m [b]
mapMGood a -> m b
f = [a] -> m [b]
go where
  go :: [a] -> m [b]
go [a]
as = ((m [b] -> Result rep (m [b])) -> Result rep (m [b])) -> m [b]
forall a.
ExpandCase LiftedRep a =>
((a -> Result LiftedRep a) -> Result LiftedRep a) -> a
expand \m [b] -> Result rep (m [b])
ret -> case [a]
as of
    []   -> m [b] -> Result rep (m [b])
ret (m [b] -> Result rep (m [b])) -> m [b] -> Result rep (m [b])
forall a b. (a -> b) -> a -> b
$ [b] -> m [b]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    a
a:[a]
as -> m [b] -> Result rep (m [b])
ret do b <- a -> m b
f a
a; bs <- go as; pure (b:bs)

{-# INLINE forMGood #-}
forMGood :: (Monad m, ExpandCase rep (m [b])) => [a] -> (a -> m b) -> m [b]
forMGood :: forall (m :: * -> *) b a.
(Monad m, ExpandCase LiftedRep (m [b])) =>
[a] -> (a -> m b) -> m [b]
forMGood = ((a -> m b) -> [a] -> m [b]) -> [a] -> (a -> m b) -> m [b]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> m b) -> [a] -> m [b]
forall (m :: * -> *) b a.
(Monad m, ExpandCase LiftedRep (m [b])) =>
(a -> m b) -> [a] -> m [b]
mapMGood

{-# INLINE mapMGood_ #-}
-- | Variant of 'mapM_' which gets compiled to good code, assuming that we're mapping over an actual
--   runtime list and don't intend for list fusion to fire.
mapMGood_ :: (Monad m, ExpandCase rep (m ())) => (a -> m ()) -> [a] -> m ()
mapMGood_ :: forall (m :: * -> *) a.
(Monad m, ExpandCase LiftedRep (m ())) =>
(a -> m ()) -> [a] -> m ()
mapMGood_ a -> m ()
f = [a] -> m ()
go where
  go :: [a] -> m ()
go [a]
as = ((m () -> Result rep (m ())) -> Result rep (m ())) -> m ()
forall a.
ExpandCase LiftedRep a =>
((a -> Result LiftedRep a) -> Result LiftedRep a) -> a
expand \m () -> Result rep (m ())
ret -> case [a]
as of
    []   -> m () -> Result rep (m ())
ret (m () -> Result rep (m ())) -> m () -> Result rep (m ())
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    a
a:[a]
as -> m () -> Result rep (m ())
ret (m () -> Result rep (m ())) -> m () -> Result rep (m ())
forall a b. (a -> b) -> a -> b
$ a -> m ()
f a
a m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [a] -> m ()
go [a]
as

{-# INLINE forMGood_ #-}
forMGood_ :: (Monad m, ExpandCase rep (m ())) => [a] -> (a -> m ()) -> m ()
forMGood_ :: forall (m :: * -> *) a.
(Monad m, ExpandCase LiftedRep (m ())) =>
[a] -> (a -> m ()) -> m ()
forMGood_ = ((a -> m ()) -> [a] -> m ()) -> [a] -> (a -> m ()) -> m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> m ()) -> [a] -> m ()
forall (m :: * -> *) a.
(Monad m, ExpandCase LiftedRep (m ())) =>
(a -> m ()) -> [a] -> m ()
mapMGood_

-- | Spine-strict concatenation of lists in a monad.
(<++!>) :: Monad m => m [a] -> m [a] -> m [a]
m [a]
x <++!> :: forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
<++!> m [a]
y = [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++!) ([a] -> [a] -> [a]) -> m [a] -> m ([a] -> [a])
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> m [a]
x m ([a] -> [a]) -> m [a] -> m [a]
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> m [a]
y
infixr 3 <++!>

--------------------------------------------------------------------------------
-- Indexed traversals

{-# INLINE imapM_ #-}
-- | Perform a left-to-right indexed monadic traversal of a list.
--
-- 'imapM_' is optimized for mapping over actual runtime lists when
-- we don't intend for list fusion to fire. Users are encouraged to
-- check the resulting core.
imapM_ :: (Monad m, ExpandCase rep (m ())) => (Int -> a -> m ()) -> [a] -> m ()
imapM_ :: forall (m :: * -> *) a.
(Monad m, ExpandCase LiftedRep (m ())) =>
(Int -> a -> m ()) -> [a] -> m ()
imapM_ Int -> a -> m ()
f = Int -> [a] -> m ()
loop Int
0 where
  {-# INLINEABLE loop #-}
  loop :: Int -> [a] -> m ()
loop !Int
i [a]
xs = ((m () -> Result rep (m ())) -> Result rep (m ())) -> m ()
forall a.
ExpandCase LiftedRep a =>
((a -> Result LiftedRep a) -> Result LiftedRep a) -> a
expand \m () -> Result rep (m ())
ret ->
    case [a]
xs of
      [] -> m () -> Result rep (m ())
ret (m () -> Result rep (m ())) -> m () -> Result rep (m ())
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      (a
x:[a]
xs) -> m () -> Result rep (m ())
ret (m () -> Result rep (m ())) -> m () -> Result rep (m ())
forall a b. (a -> b) -> a -> b
$ Int -> a -> m ()
f Int
i a
x m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> [a] -> m ()
loop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [a]
xs

{-# INLINE iforM_ #-}
-- | A flipped variant of 'imapM_' that makes it easier to write
-- multi-line loop bodies.
--
-- The same caveats for list fusion apply, see 'imapM_' for details.
iforM_ :: (Monad m, ExpandCase rep (m ())) => [a] -> (Int -> a -> m ()) -> m ()
iforM_ :: forall (m :: * -> *) a.
(Monad m, ExpandCase LiftedRep (m ())) =>
[a] -> (Int -> a -> m ()) -> m ()
iforM_ = ((Int -> a -> m ()) -> [a] -> m ())
-> [a] -> (Int -> a -> m ()) -> m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> a -> m ()) -> [a] -> m ()
forall (m :: * -> *) a.
(Monad m, ExpandCase LiftedRep (m ())) =>
(Int -> a -> m ()) -> [a] -> m ()
imapM_

{-# INLINE rangeM_ #-}
-- | Performing an action for an inclusive range of 'Int'-s, counting up by one.
rangeM_ :: (Monad m, ExpandCase rep (m ())) => Int -> Int -> (Int -> m ()) -> m ()
rangeM_ :: forall (m :: * -> *).
(Monad m, ExpandCase LiftedRep (m ())) =>
Int -> Int -> (Int -> m ()) -> m ()
rangeM_ Int
lo Int
hi Int -> m ()
f = Int -> Int -> m ()
go Int
lo Int
hi where
  go :: Int -> Int -> m ()
go !Int
lo !Int
hi = ((m () -> Result rep (m ())) -> Result rep (m ())) -> m ()
forall a.
ExpandCase LiftedRep a =>
((a -> Result LiftedRep a) -> Result LiftedRep a) -> a
expand \m () -> Result rep (m ())
ret -> if Int
lo Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
hi
    then m () -> Result rep (m ())
ret (m () -> Result rep (m ())) -> m () -> Result rep (m ())
forall a b. (a -> b) -> a -> b
$ Int -> m ()
f Int
lo m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Int -> m ()
go (Int
lo Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
hi
    else m () -> Result rep (m ())
ret (m () -> Result rep (m ())) -> m () -> Result rep (m ())
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

--------------------------------------------------------------------------------
-- Filters

-- | A monadic version of @'mapMaybe' :: (a -> Maybe b) -> [a] -> [b]@.
mapMaybeM :: Monad m => (a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM a -> m (Maybe b)
f = [a] -> m [b]
go where
  go :: [a] -> m [b]
go []     = [b] -> m [b]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
  go (a
a:[a]
as) = a -> m (Maybe b)
f a
a m (Maybe b) -> (Maybe b -> m [b]) -> m [b]
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe b
Nothing -> [a] -> m [b]
go [a]
as
    Just b
b  -> do {!bs <- [a] -> m [b]
go [a]
as; pure (b : bs)}
{-# INLINE mapMaybeM #-}

-- | A version of @'mapMaybeM'@ with a computation for the input list.
mapMaybeMM :: Monad m => (a -> m (Maybe b)) -> m [a] -> m [b]
mapMaybeMM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> m [a] -> m [b]
mapMaybeMM a -> m (Maybe b)
f m [a]
m = (a -> m (Maybe b)) -> [a] -> m [b]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM a -> m (Maybe b)
f ([a] -> m [b]) -> m [a] -> m [b]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m [a]
m
{-# INLINE mapMaybeMM #-}

-- | The @for@ version of 'mapMaybeM'.
forMaybeM :: Monad m => [a] -> (a -> m (Maybe b)) -> m [b]
forMaybeM :: forall (m :: * -> *) a b.
Monad m =>
[a] -> (a -> m (Maybe b)) -> m [b]
forMaybeM = ((a -> m (Maybe b)) -> [a] -> m [b])
-> [a] -> (a -> m (Maybe b)) -> m [b]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> m (Maybe b)) -> [a] -> m [b]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM

-- | The @for@ version of 'mapMaybeMM'.
forMaybeMM :: Monad m => m [a] -> (a -> m (Maybe b)) -> m [b]
forMaybeMM :: forall (m :: * -> *) a b.
Monad m =>
m [a] -> (a -> m (Maybe b)) -> m [b]
forMaybeMM = ((a -> m (Maybe b)) -> m [a] -> m [b])
-> m [a] -> (a -> m (Maybe b)) -> m [b]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> m (Maybe b)) -> m [a] -> m [b]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> m [a] -> m [b]
mapMaybeMM

--------------------------------------------------------------------------------
-- Monadic list functions

-- | A monadic version of @'dropWhile' :: (a -> Bool) -> [a] -> [a]@.
dropWhileM :: Monad m => (a -> m Bool) -> [a] -> m [a]
dropWhileM :: forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m [a]
dropWhileM a -> m Bool
p []       = [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
dropWhileM a -> m Bool
p (a
x : [a]
xs) = m Bool -> m [a] -> m [a] -> m [a]
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (a -> m Bool
p a
x) ((a -> m Bool) -> [a] -> m [a]
forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m [a]
dropWhileM a -> m Bool
p [a]
xs) ([a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs))

-- | A monadic version of @'Data.List.dropWhileEnd' :: (a -> Bool) -> [a] -> m [a]@.
--   Effects happen starting at the end of the list until @p@ becomes false.
dropWhileEndM :: Monad m => (a -> m Bool) -> [a] -> m [a]
dropWhileEndM :: forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m [a]
dropWhileEndM a -> m Bool
p []       = [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
dropWhileEndM a -> m Bool
p (a
x : [a]
xs) = m [a] -> ([a] -> m [a]) -> m [a] -> m [a]
forall (m :: * -> *) a b.
(Monad m, Null a) =>
m a -> (a -> m b) -> m b -> m b
ifNotNullM ((a -> m Bool) -> [a] -> m [a]
forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m [a]
dropWhileEndM a -> m Bool
p [a]
xs) ([a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> m [a]) -> ([a] -> [a]) -> [a] -> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:)) (m [a] -> m [a]) -> m [a] -> m [a]
forall a b. (a -> b) -> a -> b
$ {-else-}
  m Bool -> m [a] -> m [a] -> m [a]
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (a -> m Bool
p a
x) ([a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []) ([a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [a
x])

-- | A \"monadic\" version of @'Data.List.partition' :: (a -> Bool) -> [a] -> ([a],[a])
partitionM :: (Applicative m) => (a -> m Bool) -> [a] -> m ([a], [a])
partitionM :: forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m ([a], [a])
partitionM a -> m Bool
f =
  (a -> m ([a], [a]) -> m ([a], [a]))
-> m ([a], [a]) -> [a] -> m ([a], [a])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ a
x -> (Bool -> ([a], [a]) -> ([a], [a]))
-> m Bool -> m ([a], [a]) -> m ([a], [a])
forall a b c. (a -> b -> c) -> m a -> m b -> m c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((([a], [a]) -> ([a], [a]))
-> (([a], [a]) -> ([a], [a])) -> Bool -> ([a], [a]) -> ([a], [a])
forall a. a -> a -> Bool -> a
bool (([a] -> [a]) -> ([a], [a]) -> ([a], [a])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:)) (([a] -> [a]) -> ([a], [a]) -> ([a], [a])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:))) (m Bool -> m ([a], [a]) -> m ([a], [a]))
-> m Bool -> m ([a], [a]) -> m ([a], [a])
forall a b. (a -> b) -> a -> b
$ a -> m Bool
f a
x)
        (([a], [a]) -> m ([a], [a])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a], [a])
forall a. Null a => a
empty)

--------------------------------------------------------------------------------
-- MonadPlus

-- | Translates 'Maybe' to 'MonadPlus'.
fromMaybeMP :: MonadPlus m => Maybe a -> m a
fromMaybeMP :: forall (m :: * -> *) a. MonadPlus m => Maybe a -> m a
fromMaybeMP = Maybe a -> m a
forall (f :: * -> *) (t :: * -> *) a.
(Alternative f, Foldable t) =>
t a -> f a
foldA

-- | Generalises the 'catMaybes' function from lists to an arbitrary
-- 'MonadPlus'.
catMaybesMP :: MonadPlus m => m (Maybe a) -> m a
catMaybesMP :: forall (m :: * -> *) a. MonadPlus m => m (Maybe a) -> m a
catMaybesMP = m (Maybe a) -> m a
forall (m :: * -> *) (t :: * -> *) a.
(MonadPlus m, Foldable t) =>
m (t a) -> m a
scatterMP

-- | Branch over elements of a monadic 'Foldable' data structure.
scatterMP :: (MonadPlus m, Foldable t) => m (t a) -> m a
scatterMP :: forall (m :: * -> *) (t :: * -> *) a.
(MonadPlus m, Foldable t) =>
m (t a) -> m a
scatterMP = (m (t a) -> (t 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
>>= t a -> m a
forall (f :: * -> *) (t :: * -> *) a.
(Alternative f, Foldable t) =>
t a -> f a
foldA)


--------------------------------------------------------------------------------
-- MonadError

-- | Finally for the 'MonadError' class. Errors in the finally part take
-- precedence over prior errors.

{-# INLINE finally #-}
-- | A variant of 'Control.Exception.finally' for 'MonadError'.
--
-- __WARNING__: This function is NOT async-exception safe, and
-- should only be used for pure implementations of 'MonadError'.
finally :: MonadError e m => m a -> m () -> m a
m a
first finally :: forall e (m :: * -> *) a. MonadError e m => m a -> m () -> m a
`finally` m ()
after = do
  r <- m (Either e a) -> (e -> m (Either e a)) -> m (Either e 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 ((a -> Either e a) -> m a -> m (Either e a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either e a
forall a b. b -> Either a b
Right m a
first) (Either e a -> m (Either e a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (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)
  after
  case r of
    Left e
e  -> e -> m a
forall a. e -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError e
e
    Right a
r -> a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r

-- | Try a computation, return 'Nothing' if an error occurs.
{-# INLINE tryMaybe #-}
tryMaybe :: (MonadError e m) => m a -> m (Maybe a)
tryMaybe :: forall e (m :: * -> *) a. MonadError e m => m a -> m (Maybe a)
tryMaybe m a
m = (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> m a -> m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
m) m (Maybe a) -> (e -> m (Maybe a)) -> m (Maybe 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` \ e
_ -> Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing

-- | Run a command, catch the exception and return it.
{-# INLINE tryCatch #-}
tryCatch :: (MonadError e m) => m () -> m (Maybe e)
tryCatch :: forall e (m :: * -> *). MonadError e m => m () -> m (Maybe e)
tryCatch m ()
m = (Maybe e
forall a. Maybe a
Nothing Maybe e -> m () -> m (Maybe e)
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m ()
m) m (Maybe e) -> (e -> m (Maybe e)) -> m (Maybe e)
forall a. m a -> (e -> m a) -> m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \ e
err -> Maybe e -> m (Maybe e)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe e -> m (Maybe e)) -> Maybe e -> m (Maybe e)
forall a b. (a -> b) -> a -> b
$ e -> Maybe e
forall a. a -> Maybe a
Just e
err

-- | Like 'guard', but raise given error when condition fails.
guardWithError :: MonadError e m => e -> Bool -> m ()
guardWithError :: forall e (m :: * -> *). MonadError e m => e -> Bool -> m ()
guardWithError e
e Bool
b = if Bool
b then () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return () else e -> m ()
forall a. e -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError e
e

-- | Handle errors thrown in 'ExceptT'.
{-# INLINE catchExceptT #-}
catchExceptT :: Monad m => ExceptT e m a -> (e -> m a) -> m a
catchExceptT :: forall (m :: * -> *) e a.
Monad m =>
ExceptT e m a -> (e -> m a) -> m a
catchExceptT ExceptT e m a
m e -> m a
h = (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
h a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either e a -> m a) -> m (Either e a) -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExceptT e m a -> m (Either e a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT e m a
m

--------------------------------------------------------------------------------
-- MonadState

{-# INLINE bracket_ #-}
-- | Bracket without failure. Typically used to preserve state.
--
-- __WARNING__: Despite the name, this function is NOT exception
-- safe. Users should use 'Control.Exception.bracket_' instead.
bracket_ :: Monad m
         => m a         -- ^ Acquires resource. Run first.
         -> (a -> m ())  -- ^ Releases resource. Run last.
         -> m b         -- ^ Computes result. Run in-between.
         -> m b
bracket_ :: forall (m :: * -> *) a b.
Monad m =>
m a -> (a -> m ()) -> m b -> m b
bracket_ m a
acquire a -> m ()
release m b
compute = do
  resource <- m a
acquire
  result <- compute
  release resource
  return result

-- | Restore state after computation.
localState :: MonadState s m => m a -> m a
localState :: forall s (m :: * -> *) a. MonadState s m => m a -> m a
localState = m s -> (s -> m ()) -> m a -> m a
forall (m :: * -> *) a b.
Monad m =>
m a -> (a -> m ()) -> m b -> m b
bracket_ m s
forall s (m :: * -> *). MonadState s m => m s
get s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put

--------------------------------------------------------------------------------
-- MonadWriter

embedWriter :: (Monad m) => Writer w a -> WriterT w m a
embedWriter :: forall (m :: * -> *) w a. Monad m => Writer w a -> WriterT w m a
embedWriter = (Identity (a, w) -> m (a, w))
-> WriterT w Identity a -> WriterT w m a
forall (m :: * -> *) a w (n :: * -> *) b w'.
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
mapWriterT ((a, w) -> m (a, w)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a, w) -> m (a, w))
-> (Identity (a, w) -> (a, w)) -> Identity (a, w) -> m (a, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (a, w) -> (a, w)
forall a. Identity a -> a
runIdentity)

-- | Output a single value.
tell1 :: (Singleton w ws, MonadWriter ws m) => w -> m ()
tell1 :: forall w ws (m :: * -> *).
(Singleton w ws, MonadWriter ws m) =>
w -> m ()
tell1 = ws -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (ws -> m ()) -> (w -> ws) -> w -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> ws
forall el coll. Singleton el coll => el -> coll
singleton