| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Agda.Utils.Monad
Synopsis
- (<*!>) :: Monad m => m (a -> b) -> m a -> m b
- (==<<) :: Monad m => (a -> b -> m c) -> (m a, m b) -> m c
- allM :: (Foldable f, Monad m) => (a -> m Bool) -> f a -> m Bool
- altM1 :: Monad m => (a -> m (Either err b)) -> [a] -> m (Either err b)
- and2M :: Monad m => m Bool -> m Bool -> m Bool
- andM :: (Foldable f, Monad m) => f (m Bool) -> m Bool
- anyM :: (Foldable f, Monad m) => (a -> m Bool) -> f a -> m Bool
- bracket_ :: Monad m => m a -> (a -> m ()) -> m b -> m b
- catMaybesMP :: MonadPlus m => m (Maybe a) -> m a
- concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]
- dropWhileEndM :: Monad m => (a -> m Bool) -> [a] -> m [a]
- dropWhileM :: Monad m => (a -> m Bool) -> [a] -> m [a]
- embedWriter :: forall w (m :: Type -> Type) a. (Monoid w, Monad m) => Writer w a -> WriterT w m a
- existsM :: (Foldable f, Monad m) => f a -> (a -> m Bool) -> m Bool
- finally :: MonadError e m => m a -> m () -> m a
- forM' :: (Foldable t, Applicative m, Monoid b) => t a -> (a -> m b) -> m b
- forMM :: (Traversable t, Monad m) => m (t a) -> (a -> m b) -> m (t b)
- forMM_ :: (Foldable t, Monad m) => m (t a) -> (a -> m ()) -> m ()
- forMaybeM :: Monad m => [a] -> (a -> m (Maybe b)) -> m [b]
- forMaybeMM :: Monad m => m [a] -> (a -> m (Maybe b)) -> m [b]
- forallM :: (Foldable f, Monad m) => f a -> (a -> m Bool) -> m Bool
- fromMaybeMP :: MonadPlus m => Maybe a -> m a
- guard :: (IsBool b, MonadPlus m) => b -> m ()
- guardM :: (Monad m, MonadPlus m) => m Bool -> m ()
- guardWithError :: MonadError e m => e -> Bool -> m ()
- ifM :: Monad m => m Bool -> m a -> m a -> m a
- ifNotM :: Monad m => m Bool -> m a -> m a -> m a
- localState :: MonadState s m => m a -> m a
- mapM' :: (Foldable t, Applicative m, Monoid b) => (a -> m b) -> t a -> m b
- mapMM :: (Traversable t, Monad m) => (a -> m b) -> m (t a) -> m (t b)
- mapMM_ :: (Foldable t, Monad m) => (a -> m ()) -> m (t a) -> m ()
- mapMaybeM :: Monad m => (a -> m (Maybe b)) -> [a] -> m [b]
- mapMaybeMM :: Monad m => (a -> m (Maybe b)) -> m [a] -> m [b]
- or2M :: Monad m => m Bool -> m Bool -> m Bool
- orEitherM :: (Monoid e, Monad m, Functor m) => [m (Either e b)] -> m (Either e b)
- orM :: (Foldable f, Monad m) => f (m Bool) -> m Bool
- partitionM :: (Functor m, Applicative m) => (a -> m Bool) -> [a] -> m ([a], [a])
- scatterMP :: (MonadPlus m, Foldable t) => m (t a) -> m a
- tell1 :: (Monoid ws, Singleton w ws, MonadWriter ws m) => w -> m ()
- tryCatch :: (MonadError e m, Functor m) => m () -> m (Maybe e)
- tryMaybe :: (MonadError e m, Functor m) => m a -> m (Maybe a)
- unless :: (IsBool b, Monad m) => b -> m () -> m ()
- unlessM :: Monad m => m Bool -> m () -> m ()
- when :: (IsBool b, Monad m) => b -> m () -> m ()
- whenM :: Monad m => m Bool -> m () -> m ()
- join :: Monad m => m (m a) -> m a
- liftM2 :: Monad m => (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
- liftM3 :: Monad m => (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
- liftM4 :: Monad m => (a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
- (<$!>) :: Monad m => (a -> b) -> m a -> m b
- (<=<) :: Monad m => (b -> m c) -> (a -> m b) -> a -> m c
- (>=>) :: Monad m => (a -> m b) -> (b -> m c) -> a -> m c
- filterM :: Applicative m => (a -> m Bool) -> [a] -> m [a]
- foldM :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m b
- zipWithM :: Applicative m => (a -> b -> m c) -> [a] -> [b] -> m [c]
- zipWithM_ :: Applicative m => (a -> b -> m c) -> [a] -> [b] -> m ()
- forM_ :: (Foldable t, Monad m) => t a -> (a -> m b) -> m ()
- msum :: (Foldable t, MonadPlus m) => t (m a) -> m a
- void :: Functor f => f a -> f ()
- forM :: (Traversable t, Monad m) => t a -> (a -> m b) -> m (t b)
- tryError :: MonadError e m => m a -> m (Either e a)
- withError :: MonadError e m => (e -> e) -> m a -> m a
- liftA2 :: Applicative f => (a -> b -> c) -> f a -> f b -> f c
- class (Alternative m, Monad m) => MonadPlus (m :: Type -> Type) where
- class (forall (m :: Type -> Type). Monad m => Monad (t m)) => MonadTrans (t :: (Type -> Type) -> Type -> Type) where
- (<$>) :: Functor f => (a -> b) -> f a -> f b
- (<*>) :: Applicative f => f (a -> b) -> f a -> f b
- (<$) :: Functor f => a -> f b -> f a
Documentation
altM1 :: Monad m => (a -> m (Either err b)) -> [a] -> m (Either err b) Source #
Lazy monadic disjunction with Either truth values.
Returns the last error message if all fail.
Arguments
| :: Monad m | |
| => m a | Acquires resource. Run first. |
| -> (a -> m ()) | Releases resource. Run last. |
| -> m b | Computes result. Run in-between. |
| -> m b |
Bracket without failure. Typically used to preserve state.
catMaybesMP :: MonadPlus m => m (Maybe a) -> m a Source #
concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b] Source #
dropWhileEndM :: Monad m => (a -> m Bool) -> [a] -> m [a] Source #
A monadic version of .
Effects happen starting at the end of the list until dropWhileEnd :: (a -> Bool) -> [a] -> m [a]p becomes false.
dropWhileM :: Monad m => (a -> m Bool) -> [a] -> m [a] Source #
A monadic version of .dropWhile :: (a -> Bool) -> [a] -> [a]
embedWriter :: forall w (m :: Type -> Type) a. (Monoid w, Monad m) => Writer w a -> WriterT w m a Source #
finally :: MonadError e m => m a -> m () -> m a Source #
Finally for the Error class. Errors in the finally part take
precedence over prior errors.
forM' :: (Foldable t, Applicative m, Monoid b) => t a -> (a -> m b) -> m b Source #
Generalized version of for_ :: Applicative m => [a] -> (a -> m ()) -> m ()
forMM :: (Traversable t, Monad m) => m (t a) -> (a -> m b) -> m (t b) Source #
forMaybeMM :: Monad m => m [a] -> (a -> m (Maybe b)) -> m [b] Source #
The for version of mapMaybeMM.
guardWithError :: MonadError e m => e -> Bool -> m () Source #
Like guard, but raise given error when condition fails.
localState :: MonadState s m => m a -> m a Source #
Restore state after computation.
mapM' :: (Foldable t, Applicative m, Monoid b) => (a -> m b) -> t a -> m b Source #
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.
mapMM :: (Traversable t, Monad m) => (a -> m b) -> m (t a) -> m (t b) Source #
mapMaybeM :: Monad m => (a -> m (Maybe b)) -> [a] -> m [b] Source #
A monadic version of .mapMaybe :: (a -> Maybe b) -> [a] -> [b]
mapMaybeMM :: Monad m => (a -> m (Maybe b)) -> m [a] -> m [b] Source #
A version of with a computation for the input list.mapMaybeM
orEitherM :: (Monoid e, Monad m, Functor m) => [m (Either e b)] -> m (Either e b) Source #
Lazy monadic disjunction with accumulation of errors in a monoid. Errors are discarded if we succeed.
partitionM :: (Functor m, Applicative m) => (a -> m Bool) -> [a] -> m ([a], [a]) Source #
A `monadic' version of @partition :: (a -> Bool) -> [a] -> ([a],[a])
scatterMP :: (MonadPlus m, Foldable t) => m (t a) -> m a Source #
Branch over elements of a monadic Foldable data structure.
tryCatch :: (MonadError e m, Functor m) => m () -> m (Maybe e) Source #
Run a command, catch the exception and return it.
tryMaybe :: (MonadError e m, Functor m) => m a -> m (Maybe a) Source #
Try a computation, return Nothing if an Error occurs.
join :: Monad m => m (m a) -> m a #
The join function is the conventional monad join operator. It
is used to remove one level of monadic structure, projecting its
bound argument into the outer level.
'' can be understood as the join bssdo expression
do bs <- bss bs
Examples
>>>join [[1, 2, 3], [4, 5, 6], [7, 8, 9]][1,2,3,4,5,6,7,8,9]
>>>join (Just (Just 3))Just 3
A common use of join is to run an IO computation returned from
an STM transaction, since STM transactions
can't perform IO directly. Recall that
atomically :: STM a -> IO a
is used to run STM transactions atomically. So, by
specializing the types of atomically and join to
atomically:: STM (IO b) -> IO (IO b)join:: IO (IO b) -> IO b
we can compose them as
join.atomically:: STM (IO b) -> IO b
liftM2 :: Monad m => (a1 -> a2 -> r) -> m a1 -> m a2 -> m r #
Promote a function to a monad, scanning the monadic arguments from left to right.
Examples
>>>liftM2 (+) [0,1] [0,2][0,2,1,3]
>>>liftM2 (+) (Just 1) NothingNothing
>>>liftM2 (+) (+ 3) (* 2) 518
liftM3 :: Monad m => (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r #
Promote a function to a monad, scanning the monadic arguments from
left to right (cf. liftM2).
liftM4 :: Monad m => (a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r #
Promote a function to a monad, scanning the monadic arguments from
left to right (cf. liftM2).
filterM :: Applicative m => (a -> m Bool) -> [a] -> m [a] #
This generalizes the list-based filter function.
runIdentity (filterM (Identity . p) xs) == filter p xs
Examples
>>>filterM (\x -> doputStrLn ("Keep: " ++ show x ++ "?") answer <- getLine pure (answer == "y")) [1, 2, 3] Keep: 1? y Keep: 2? n Keep: 3? y [1,3]
>>>filterM (\x -> doputStr (show x) x' <- readLn pure (x == x')) [1, 2, 3] 12 22 33 [2,3]
foldM :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m b #
The foldM function is analogous to foldl, except that its result is
encapsulated in a monad. Note that foldM works from left-to-right over
the list arguments. This could be an issue where ( and the `folded
function' are not commutative.>>)
foldM f a1 [x1, x2, ..., xm] == do a2 <- f a1 x1 a3 <- f a2 x2 ... f am xm
If right-to-left evaluation is required, the input list should be reversed.
zipWithM :: Applicative m => (a -> b -> m c) -> [a] -> [b] -> m [c] #
zipWithM_ :: Applicative m => (a -> b -> m c) -> [a] -> [b] -> m () #
void :: Functor f => f a -> f () #
discards or ignores the result of evaluation, such
as the return value of an void valueIO action.
Examples
Replace the contents of a with unit:Maybe Int
>>>void NothingNothing
>>>void (Just 3)Just ()
Replace the contents of an
with unit, resulting in an Either Int Int:Either Int ()
>>>void (Left 8675309)Left 8675309
>>>void (Right 8675309)Right ()
Replace every element of a list with unit:
>>>void [1,2,3][(),(),()]
Replace the second element of a pair with unit:
>>>void (1,2)(1,())
Discard the result of an IO action:
>>>mapM print [1,2]1 2 [(),()]
>>>void $ mapM print [1,2]1 2
forM :: (Traversable t, Monad m) => t a -> (a -> m b) -> m (t b) #
tryError :: MonadError e m => m a -> m (Either e a) #
MonadError analogue to the try function.
withError :: MonadError e m => (e -> e) -> m a -> m a #
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.
liftA2 :: Applicative f => (a -> b -> c) -> f a -> f b -> f c #
Lift a binary function to actions.
Some functors support an implementation of liftA2 that is more
efficient than the default one. In particular, if fmap is an
expensive operation, it is likely better to use liftA2 than to
fmap over the structure and then use <*>.
This became a typeclass method in 4.10.0.0. Prior to that, it was
a function defined in terms of <*> and fmap.
Example
>>>liftA2 (,) (Just 3) (Just 5)Just (3,5)
>>>liftA2 (+) [1, 2, 3] [4, 5, 6][5,6,7,6,7,8,7,8,9]
class (Alternative m, Monad m) => MonadPlus (m :: Type -> Type) where #
Monads that also support choice and failure.
Minimal complete definition
Nothing
Methods
The identity of mplus. It should also satisfy the equations
mzero >>= f = mzero v >> mzero = mzero
The default definition is
mzero = empty
An associative operation. The default definition is
mplus = (<|>)
Instances
class (forall (m :: Type -> Type). Monad m => Monad (t m)) => MonadTrans (t :: (Type -> Type) -> Type -> Type) where #
The class of monad transformers.
For any monad m, the result t m should also be a monad,
and lift should be a monad transformation from m to t m,
i.e. it should satisfy the following laws:
Since 0.6.0.0 and for GHC 8.6 and later, the requirement that t m
be a Monad is enforced by the implication constraint
forall m. enabled by the
Monad m => Monad (t m)QuantifiedConstraints extension.
Ambiguity error with GHC 9.0 to 9.2.2
These versions of GHC have a bug (https://gitlab.haskell.org/ghc/ghc/-/issues/20582) which causes constraints like
(MonadTrans t, forall m. Monad m => Monad (t m)) => ...
to be reported as ambiguous. For transformers 0.6 and later, this can be fixed by removing the second constraint, which is implied by the first.
Methods
lift :: Monad m => m a -> t m a #
Lift a computation from the argument monad to the constructed monad.
Instances
(<$>) :: Functor f => (a -> b) -> f a -> f b infixl 4 #
An infix synonym for fmap.
The name of this operator is an allusion to $.
Note the similarities between their types:
($) :: (a -> b) -> a -> b (<$>) :: Functor f => (a -> b) -> f a -> f b
Whereas $ is function application, <$> is function
application lifted over a Functor.
Examples
Convert from a to a Maybe Int using Maybe
Stringshow:
>>>show <$> NothingNothing
>>>show <$> Just 3Just "3"
Convert from an to an
Either Int IntEither IntString using show:
>>>show <$> Left 17Left 17
>>>show <$> Right 17Right "17"
Double each element of a list:
>>>(*2) <$> [1,2,3][2,4,6]
Apply even to the second element of a pair:
>>>even <$> (2,2)(2,True)
(<*>) :: Applicative f => f (a -> b) -> f a -> f b infixl 4 #
Sequential application.
A few functors support an implementation of <*> that is more
efficient than the default one.
Example
Used in combination with , (<$>) can be used to build a record.(<*>)
>>>data MyState = MyState {arg1 :: Foo, arg2 :: Bar, arg3 :: Baz}
>>>produceFoo :: Applicative f => f Foo>>>produceBar :: Applicative f => f Bar>>>produceBaz :: Applicative f => f Baz
>>>mkState :: Applicative f => f MyState>>>mkState = MyState <$> produceFoo <*> produceBar <*> produceBaz