module Agda.Utils.Monad
    ( module Agda.Utils.Monad
    , when, unless, MonadPlus(..)
    , (<$>), (<*>)
    , (<$)
    )
    where

import Control.Applicative  (liftA2)
import Control.Monad.Except
import Control.Monad.State

import Data.Traversable as Trav hiding (for, sequence)
import Data.Foldable as Fold
import Data.Maybe
import Data.Monoid

import Agda.Utils.Applicative
import Agda.Utils.Either
import Agda.Utils.Null (ifNotNullM)

import Agda.Utils.Impossible

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

-- | 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 (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

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

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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`unless` m ()
m)

-- | Monadic guard.
guardM :: (Monad m, MonadPlus m) => m Bool -> m ()
guardM :: forall (m :: * -> *). (Monad m, MonadPlus m) => m Bool -> m ()
guardM m Bool
c = Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
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 (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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return Bool
True)

allM :: (Functor f, Foldable f, Monad m) => f a -> (a -> m Bool) -> m Bool
allM :: forall (f :: * -> *) (m :: * -> *) a.
(Functor f, Foldable f, Monad m) =>
f a -> (a -> m Bool) -> m Bool
allM f a
xs a -> m Bool
f = f (m Bool) -> m Bool
forall (f :: * -> *) (m :: * -> *).
(Foldable f, Monad m) =>
f (m Bool) -> m Bool
andM (f (m Bool) -> m Bool) -> f (m Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ (a -> m Bool) -> f a -> f (m Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> m Bool
f 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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return Bool
False)

anyM :: (Functor f, Foldable f, Monad m) => f a -> (a -> m Bool) -> m Bool
anyM :: forall (f :: * -> *) (m :: * -> *) a.
(Functor f, Foldable f, Monad m) =>
f a -> (a -> m Bool) -> m Bool
anyM f a
xs a -> m Bool
f = f (m Bool) -> m Bool
forall (f :: * -> *) (m :: * -> *).
(Foldable f, Monad m) =>
f (m Bool) -> m Bool
orM (f (m Bool) -> m Bool) -> f (m Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ (a -> m Bool) -> f a -> f (m Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> m Bool
f f a
xs

-- | 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 (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, Functor m) => [m (Either e b)] -> m (Either e b)
orEitherM :: forall e (m :: * -> *) b.
(Monoid e, Monad m, Functor m) =>
[m (Either e b)] -> m (Either e b)
orEitherM []       = Either e b -> m (Either e b)
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, Functor m) =>
[m (Either e b)] -> m (Either e b)
orEitherM [m (Either e b)]
ms)
                                   (Either e b -> m (Either e b)
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 (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 (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 (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)
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_

-- Continuation monad -----------------------------------------------------

-- Andreas, 2017-04-11, issue #2543
-- The terribly useful thread function is now UNUSED.  [Sadistic laughter :)]
--
-- type Cont r a = (a -> r) -> r
--
-- -- | 'Control.Monad.mapM' for the continuation monad. Terribly useful.
-- thread :: (a -> Cont r b) -> [a] -> Cont r [b]
-- thread f [] ret = ret []
-- thread f (x:xs) ret =
--     f x $ \y -> thread f xs $ \ys -> ret (y:ys)

-- Lists and monads -------------------------------------------------------

-- | 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]
xs = [Maybe b] -> [b]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe b] -> [b]) -> m [Maybe b] -> m [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> m (Maybe b)) -> [a] -> m [Maybe b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
Trav.mapM a -> m (Maybe b)
f [a]
xs

-- | 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

-- | 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

-- | 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 (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 (m :: * -> *) a. Monad m => a -> m a
return (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs))

-- | A monadic version of @'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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return []) ([a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a
x])

-- | A ``monadic'' version of @'partition' :: (a -> Bool) -> [a] -> ([a],[a])
partitionM :: (Functor m, Applicative m) => (a -> m Bool) -> [a] -> m ([a], [a])
partitionM :: forall (m :: * -> *) a.
(Functor m, Applicative m) =>
(a -> m Bool) -> [a] -> m ([a], [a])
partitionM a -> m Bool
f [a]
xs =
  (a -> m ([a], [a]) -> m ([a], [a]))
-> m ([a], [a]) -> [a] -> m ([a], [a])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
    (\a
x -> m (([a], [a]) -> ([a], [a])) -> m ([a], [a]) -> m ([a], [a])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) ((\Bool
b ([a]
l, [a]
r) -> if Bool
b then (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
l, [a]
r) else ([a]
l, a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
r)) (Bool -> ([a], [a]) -> ([a], [a]))
-> m Bool -> m (([a], [a]) -> ([a], [a]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m Bool
f a
x))
    (([a], [a]) -> m ([a], [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], []))
    [a]
xs

-- 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 (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)


-- Error monad ------------------------------------------------------------

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

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
  Either e a
r <- m (Either e a) -> (e -> m (Either e a)) -> m (Either e 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 (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 (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)
  m ()
after
  case Either e a
r of
    Left e
e  -> e -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError e
e
    Right a
r -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r

-- | Try a computation, return 'Nothing' if an 'Error' occurs.

tryMaybe :: (MonadError e m, Functor m) => m a -> m (Maybe a)
tryMaybe :: forall e (m :: * -> *) a.
(MonadError e m, Functor 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 e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \ e
_ -> Maybe a -> m (Maybe 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.

tryCatch :: (MonadError e m, Functor m) => m () -> m (Maybe e)
tryCatch :: forall e (m :: * -> *).
(MonadError e m, Functor m) =>
m () -> m (Maybe e)
tryCatch m ()
m = (Maybe e
forall a. Maybe a
Nothing Maybe e -> m () -> m (Maybe e)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m ()
m) m (Maybe e) -> (e -> m (Maybe e)) -> m (Maybe e)
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \ e
err -> Maybe e -> m (Maybe e)
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 (m :: * -> *) a. Monad m => a -> m a
return () else e -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError e
e

-- State monad ------------------------------------------------------------

-- | Bracket without failure.  Typically used to preserve state.
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
  a
resource <- m a
acquire
  b
result <- m b
compute
  a -> m ()
release a
resource
  b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
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