Copyright | (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2023 Kowainik |
---|---|
License | MIT |
Maintainer | Kowainik <xrom.xkov@gmail.com> |
Stability | Stable |
Portability | Portable |
Safe Haskell | Safe |
Language | Haskell2010 |
Reexports functions to work with monads.
Synopsis
- newtype ExceptT e (m :: Type -> Type) a = ExceptT (m (Either e a))
- runExceptT :: ExceptT e m a -> m (Either e a)
- newtype ReaderT r (m :: Type -> Type) a = ReaderT {
- runReaderT :: r -> m a
- type Reader r = ReaderT r Identity
- runReader :: Reader r a -> r -> a
- withReader :: (r' -> r) -> Reader r a -> Reader r' a
- withReaderT :: forall r' r (m :: Type -> Type) a. (r' -> r) -> ReaderT r m a -> ReaderT r' m a
- class Monad m => MonadReader r (m :: Type -> Type) | m -> r where
- asks :: MonadReader r m => (r -> a) -> m a
- class Monad m => MonadState s (m :: Type -> Type) | m -> s where
- type State s = StateT s Identity
- runState :: State s a -> s -> (a, s)
- execState :: State s a -> s -> s
- newtype StateT s (m :: Type -> Type) a = StateT {
- runStateT :: s -> m (a, s)
- evalState :: State s a -> s -> a
- withState :: (s -> s) -> State s a -> State s a
- evalStateT :: Monad m => StateT s m a -> s -> m a
- execStateT :: Monad m => StateT s m a -> s -> m s
- modify :: MonadState s m => (s -> s) -> m ()
- modify' :: MonadState s m => (s -> s) -> m ()
- gets :: MonadState s m => (s -> a) -> m a
- module Control.Monad.Trans
- data IdentityT (f :: k -> Type) (a :: k)
- newtype MaybeT (m :: Type -> Type) a = MaybeT {}
- maybeToExceptT :: forall (m :: Type -> Type) e a. Functor m => e -> MaybeT m a -> ExceptT e m a
- exceptToMaybeT :: forall (m :: Type -> Type) e a. Functor m => ExceptT e m a -> MaybeT m a
- class Applicative m => Monad (m :: Type -> Type) where
- join :: Monad m => m (m a) -> m a
- class (Alternative m, Monad m) => MonadPlus (m :: Type -> Type) where
- (=<<) :: Monad m => (a -> m b) -> m a -> m b
- filterM :: Applicative m => (a -> m Bool) -> [a] -> m [a]
- (>=>) :: Monad m => (a -> m b) -> (b -> m c) -> a -> m c
- (<=<) :: Monad m => (b -> m c) -> (a -> m b) -> a -> m c
- forever :: Applicative f => f a -> f b
- mapAndUnzipM :: Applicative m => (a -> m (b, c)) -> [a] -> m ([b], [c])
- zipWithM :: Applicative m => (a -> b -> m c) -> [a] -> [b] -> m [c]
- zipWithM_ :: Applicative m => (a -> b -> m c) -> [a] -> [b] -> m ()
- replicateM :: Applicative m => Int -> m a -> m [a]
- replicateM_ :: Applicative m => Int -> m a -> m ()
- (<$!>) :: Monad m => (a -> b) -> m a -> m b
- mfilter :: MonadPlus m => (a -> Bool) -> m a -> m a
- module Control.Monad.Fail
- data Maybe a
- maybe :: b -> (a -> b) -> Maybe a -> b
- isJust :: Maybe a -> Bool
- isNothing :: Maybe a -> Bool
- fromMaybe :: a -> Maybe a -> a
- maybeToList :: Maybe a -> [a]
- listToMaybe :: [a] -> Maybe a
- catMaybes :: [Maybe a] -> [a]
- mapMaybe :: (a -> Maybe b) -> [a] -> [b]
- data Either a b
- either :: (a -> c) -> (b -> c) -> Either a b -> c
- lefts :: [Either a b] -> [a]
- rights :: [Either a b] -> [b]
- partitionEithers :: [Either a b] -> ([a], [b])
- isLeft :: Either a b -> Bool
- isRight :: Either a b -> Bool
Reexport transformers
newtype ExceptT e (m :: Type -> Type) a #
A monad transformer that adds exceptions to other monads.
ExceptT
constructs a monad parameterized over two things:
- e - The exception type.
- m - The inner monad.
The return
function yields a computation that produces the given
value, while >>=
sequences two subcomputations, exiting on the
first exception.
Instances
MonadRWS r w s m => MonadRWS r w s (ExceptT e m) | Since: mtl-2.2 | ||||
Defined in Control.Monad.RWS.Class | |||||
Functor m => Generic1 (ExceptT e m :: Type -> Type) | |||||
Defined in Control.Monad.Trans.Except
| |||||
MonadAccum w m => MonadAccum w (ExceptT e m) | The accumulated value 'survives' an exception: even if the computation fails to deliver a result, we still have an accumulated value. Since: mtl-2.3 | ||||
Monad m => MonadError e (ExceptT e m) | Since: mtl-2.2 | ||||
Defined in Control.Monad.Error.Class throwError :: e -> ExceptT e m a # catchError :: ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a # | |||||
MonadReader r m => MonadReader r (ExceptT e m) | Since: mtl-2.2 | ||||
MonadSelect r m => MonadSelect r (ExceptT e m) | 'Extends' the possibilities considered by Since: mtl-2.3 | ||||
Defined in Control.Monad.Select | |||||
MonadState s m => MonadState s (ExceptT e m) | Since: mtl-2.2 | ||||
MonadWriter w m => MonadWriter w (ExceptT e m) | Since: mtl-2.2 | ||||
MonadTrans (ExceptT e) | |||||
Defined in Control.Monad.Trans.Except | |||||
MonadIO m => MonadIO (ExceptT e m) | |||||
Defined in Control.Monad.Trans.Except | |||||
MonadZip m => MonadZip (ExceptT e m) | |||||
(Eq e, Eq1 m) => Eq1 (ExceptT e m) | |||||
(Ord e, Ord1 m) => Ord1 (ExceptT e m) | |||||
Defined in Control.Monad.Trans.Except | |||||
(Read e, Read1 m) => Read1 (ExceptT e m) | |||||
Defined in Control.Monad.Trans.Except liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (ExceptT e m a) # liftReadList :: (Int -> ReadS a) -> ReadS [a] -> ReadS [ExceptT e m a] # liftReadPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec (ExceptT e m a) # liftReadListPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec [ExceptT e m a] # | |||||
(Show e, Show1 m) => Show1 (ExceptT e m) | |||||
Contravariant m => Contravariant (ExceptT e m) | |||||
(Functor m, Monad m, Monoid e) => Alternative (ExceptT e m) | |||||
(Functor m, Monad m) => Applicative (ExceptT e m) | |||||
Defined in Control.Monad.Trans.Except | |||||
Functor m => Functor (ExceptT e m) | |||||
Monad m => Monad (ExceptT e m) | |||||
(Monad m, Monoid e) => MonadPlus (ExceptT e m) | |||||
MonadFail m => MonadFail (ExceptT e m) | |||||
Defined in Control.Monad.Trans.Except | |||||
MonadFix m => MonadFix (ExceptT e m) | |||||
Defined in Control.Monad.Trans.Except | |||||
Foldable f => Foldable (ExceptT e f) | |||||
Defined in Control.Monad.Trans.Except fold :: Monoid m => ExceptT e f m -> m # foldMap :: Monoid m => (a -> m) -> ExceptT e f a -> m # foldMap' :: Monoid m => (a -> m) -> ExceptT e f a -> m # foldr :: (a -> b -> b) -> b -> ExceptT e f a -> b # foldr' :: (a -> b -> b) -> b -> ExceptT e f a -> b # foldl :: (b -> a -> b) -> b -> ExceptT e f a -> b # foldl' :: (b -> a -> b) -> b -> ExceptT e f a -> b # foldr1 :: (a -> a -> a) -> ExceptT e f a -> a # foldl1 :: (a -> a -> a) -> ExceptT e f a -> a # toList :: ExceptT e f a -> [a] # null :: ExceptT e f a -> Bool # length :: ExceptT e f a -> Int # elem :: Eq a => a -> ExceptT e f a -> Bool # maximum :: Ord a => ExceptT e f a -> a # minimum :: Ord a => ExceptT e f a -> a # | |||||
Traversable f => Traversable (ExceptT e f) | |||||
Defined in Control.Monad.Trans.Except | |||||
MonadCont m => MonadCont (ExceptT e m) | Since: mtl-2.2 | ||||
Generic (ExceptT e m a) | |||||
Defined in Control.Monad.Trans.Except
| |||||
(Read e, Read1 m, Read a) => Read (ExceptT e m a) | |||||
(Show e, Show1 m, Show a) => Show (ExceptT e m a) | |||||
(Eq e, Eq1 m, Eq a) => Eq (ExceptT e m a) | |||||
(Ord e, Ord1 m, Ord a) => Ord (ExceptT e m a) | |||||
Defined in Control.Monad.Trans.Except compare :: ExceptT e m a -> ExceptT e m a -> Ordering # (<) :: ExceptT e m a -> ExceptT e m a -> Bool # (<=) :: ExceptT e m a -> ExceptT e m a -> Bool # (>) :: ExceptT e m a -> ExceptT e m a -> Bool # (>=) :: ExceptT e m a -> ExceptT e m a -> Bool # | |||||
type Rep1 (ExceptT e m :: Type -> Type) | |||||
Defined in Control.Monad.Trans.Except | |||||
type Rep (ExceptT e m a) | |||||
Defined in Control.Monad.Trans.Except |
runExceptT :: ExceptT e m a -> m (Either e a) #
The inverse of ExceptT
.
newtype ReaderT r (m :: Type -> Type) a #
The reader monad transformer, which adds a read-only environment to the given monad.
The return
function ignores the environment, while m
passes the inherited environment to both subcomputations:>>=
k
ReaderT | |
|
Instances
Generic1 (ReaderT r m :: Type -> Type) | |||||
Defined in Control.Monad.Trans.Reader
| |||||
MonadAccum w m => MonadAccum w (ReaderT r m) | Since: mtl-2.3 | ||||
MonadError e m => MonadError e (ReaderT r m) | |||||
Defined in Control.Monad.Error.Class throwError :: e -> ReaderT r m a # catchError :: ReaderT r m a -> (e -> ReaderT r m a) -> ReaderT r m a # | |||||
Monad m => MonadReader r (ReaderT r m) | |||||
MonadSelect r' m => MonadSelect r' (ReaderT r m) | Provides a read-only environment of type Since: mtl-2.3 | ||||
Defined in Control.Monad.Select | |||||
MonadState s m => MonadState s (ReaderT r m) | |||||
MonadWriter w m => MonadWriter w (ReaderT r m) | |||||
MonadTrans (ReaderT r) | |||||
Defined in Control.Monad.Trans.Reader | |||||
MonadIO m => MonadIO (ReaderT r m) | |||||
Defined in Control.Monad.Trans.Reader | |||||
MonadZip m => MonadZip (ReaderT r m) | |||||
Contravariant m => Contravariant (ReaderT r m) | |||||
Alternative m => Alternative (ReaderT r m) | |||||
Applicative m => Applicative (ReaderT r m) | |||||
Defined in Control.Monad.Trans.Reader | |||||
Functor m => Functor (ReaderT r m) | |||||
Monad m => Monad (ReaderT r m) | |||||
MonadPlus m => MonadPlus (ReaderT r m) | |||||
MonadFail m => MonadFail (ReaderT r m) | |||||
Defined in Control.Monad.Trans.Reader | |||||
MonadFix m => MonadFix (ReaderT r m) | |||||
Defined in Control.Monad.Trans.Reader | |||||
MonadCont m => MonadCont (ReaderT r m) | |||||
Generic (ReaderT r m a) | |||||
Defined in Control.Monad.Trans.Reader
| |||||
type Rep1 (ReaderT r m :: Type -> Type) | |||||
Defined in Control.Monad.Trans.Reader type Rep1 (ReaderT r m :: Type -> Type) = D1 ('MetaData "ReaderT" "Control.Monad.Trans.Reader" "transformers-0.6.1.1-1df5" 'True) (C1 ('MetaCons "ReaderT" 'PrefixI 'True) (S1 ('MetaSel ('Just "runReaderT") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) ((FUN 'Many r :: Type -> Type) :.: Rec1 m))) | |||||
type Rep (ReaderT r m a) | |||||
Defined in Control.Monad.Trans.Reader |
:: Reader r a | A |
-> r | An initial environment. |
-> a |
Runs a Reader
and extracts the final value from it.
(The inverse of reader
.)
:: (r' -> r) | The function to modify the environment. |
-> Reader r a | Computation to run in the modified environment. |
-> Reader r' a |
Execute a computation in a modified environment
(a specialization of withReaderT
).
runReader
(withReader
f m) =runReader
m . f
:: forall r' r (m :: Type -> Type) a. (r' -> r) | The function to modify the environment. |
-> ReaderT r m a | Computation to run in the modified environment. |
-> ReaderT r' m a |
Execute a computation in a modified environment
(a more general version of local
).
runReaderT
(withReaderT
f m) =runReaderT
m . f
class Monad m => MonadReader r (m :: Type -> Type) | m -> r where #
See examples in Control.Monad.Reader.
Note, the partially applied function type (->) r
is a simple reader monad.
See the instance
declaration below.
Retrieves the monad environment.
:: (r -> r) | The function to modify the environment. |
-> m a |
|
-> m a |
Executes a computation in a modified environment.
:: (r -> a) | The selector function to apply to the environment. |
-> m a |
Retrieves a function of the current environment.
Instances
MonadReader r m => MonadReader r (MaybeT m) | |
(Monoid w, MonadReader r m) => MonadReader r (AccumT w m) | Since: mtl-2.3 |
MonadReader r m => MonadReader r (ExceptT e m) | Since: mtl-2.2 |
MonadReader r m => MonadReader r (IdentityT m) | |
Monad m => MonadReader r (ReaderT r m) | |
MonadReader r m => MonadReader r (StateT s m) | |
MonadReader r m => MonadReader r (StateT s m) | |
(Monoid w, MonadReader r m) => MonadReader r (WriterT w m) | Since: mtl-2.3 |
(Monoid w, MonadReader r m) => MonadReader r (WriterT w m) | |
(Monoid w, MonadReader r m) => MonadReader r (WriterT w m) | |
MonadReader r' m => MonadReader r' (SelectT r m) | Since: mtl-2.3 |
MonadReader r ((->) r) | |
MonadReader r' m => MonadReader r' (ContT r m) | |
(Monad m, Monoid w) => MonadReader r (RWST r w s m) | Since: mtl-2.3 |
(Monad m, Monoid w) => MonadReader r (RWST r w s m) | |
(Monad m, Monoid w) => MonadReader r (RWST r w s m) | |
:: MonadReader r m | |
=> (r -> a) | The selector function to apply to the environment. |
-> m a |
Retrieves a function of the current environment.
class Monad m => MonadState s (m :: Type -> Type) | m -> s where #
Minimal definition is either both of get
and put
or just state
Return the state from the internals of the monad.
Replace the state inside the monad.
state :: (s -> (a, s)) -> m a #
Embed a simple state action into the monad.
Instances
MonadState s m => MonadState s (MaybeT m) | |
(Monoid w, MonadState s m) => MonadState s (AccumT w m) | Since: mtl-2.3 |
MonadState s m => MonadState s (ExceptT e m) | Since: mtl-2.2 |
MonadState s m => MonadState s (IdentityT m) | |
MonadState s m => MonadState s (ReaderT r m) | |
MonadState s m => MonadState s (SelectT r m) | Since: mtl-2.3 |
Monad m => MonadState s (StateT s m) | |
Monad m => MonadState s (StateT s m) | |
(Monoid w, MonadState s m) => MonadState s (WriterT w m) | Since: mtl-2.3 |
(Monoid w, MonadState s m) => MonadState s (WriterT w m) | |
(Monoid w, MonadState s m) => MonadState s (WriterT w m) | |
MonadState s m => MonadState s (ContT r m) | |
(Monad m, Monoid w) => MonadState s (RWST r w s m) | Since: mtl-2.3 |
(Monad m, Monoid w) => MonadState s (RWST r w s m) | |
(Monad m, Monoid w) => MonadState s (RWST r w s m) | |
type State s = StateT s Identity #
A state monad parameterized by the type s
of the state to carry.
The return
function leaves the state unchanged, while >>=
uses
the final state of the first computation as the initial state of
the second.
:: State s a | state-passing computation to execute |
-> s | initial state |
-> (a, s) | return value and final state |
Unwrap a state monad computation as a function.
(The inverse of state
.)
:: State s a | state-passing computation to execute |
-> s | initial value |
-> s | final state |
newtype StateT s (m :: Type -> Type) a #
A state transformer monad parameterized by:
s
- The state.m
- The inner monad.
The return
function leaves the state unchanged, while >>=
uses
the final state of the first computation as the initial state of
the second.
Instances
:: State s a | state-passing computation to execute |
-> s | initial value |
-> a | return value of the state computation |
evalStateT :: Monad m => StateT s m a -> s -> m a #
Evaluate a state computation with the given initial state and return the final value, discarding the final state.
evalStateT
m s =liftM
fst
(runStateT
m s)
execStateT :: Monad m => StateT s m a -> s -> m s #
Evaluate a state computation with the given initial state and return the final state, discarding the final value.
execStateT
m s =liftM
snd
(runStateT
m s)
modify :: MonadState s m => (s -> s) -> m () #
Monadic state transformer.
Maps an old state to a new state inside a state monad. The old state is thrown away.
Main> :t modify ((+1) :: Int -> Int) modify (...) :: (MonadState Int a) => a ()
This says that modify (+1)
acts over any
Monad that is a member of the MonadState
class,
with an Int
state.
modify' :: MonadState s m => (s -> s) -> m () #
A variant of modify
in which the computation is strict in the
new state.
Since: mtl-2.2
gets :: MonadState s m => (s -> a) -> m a #
Gets specific component of the state, using a projection function supplied.
module Control.Monad.Trans
data IdentityT (f :: k -> Type) (a :: k) #
The trivial monad transformer, which maps a monad to an equivalent monad.
Instances
MonadRWS r w s m => MonadRWS r w s (IdentityT m) | |||||
Defined in Control.Monad.RWS.Class | |||||
Generic1 (IdentityT f :: k -> Type) | |||||
Defined in Control.Monad.Trans.Identity
| |||||
MonadAccum w m => MonadAccum w (IdentityT m) | Since: mtl-2.3 | ||||
MonadError e m => MonadError e (IdentityT m) | |||||
Defined in Control.Monad.Error.Class throwError :: e -> IdentityT m a # catchError :: IdentityT m a -> (e -> IdentityT m a) -> IdentityT m a # | |||||
MonadReader r m => MonadReader r (IdentityT m) | |||||
MonadSelect r m => MonadSelect r (IdentityT m) | Since: mtl-2.3 | ||||
Defined in Control.Monad.Select | |||||
MonadState s m => MonadState s (IdentityT m) | |||||
MonadWriter w m => MonadWriter w (IdentityT m) | |||||
MonadTrans (IdentityT :: (Type -> Type) -> Type -> Type) | |||||
Defined in Control.Monad.Trans.Identity | |||||
MonadIO m => MonadIO (IdentityT m) | |||||
Defined in Control.Monad.Trans.Identity | |||||
MonadZip m => MonadZip (IdentityT m) | |||||
Foldable1 m => Foldable1 (IdentityT m) | |||||
Defined in Control.Monad.Trans.Identity fold1 :: Semigroup m0 => IdentityT m m0 -> m0 # foldMap1 :: Semigroup m0 => (a -> m0) -> IdentityT m a -> m0 # foldMap1' :: Semigroup m0 => (a -> m0) -> IdentityT m a -> m0 # toNonEmpty :: IdentityT m a -> NonEmpty a # maximum :: Ord a => IdentityT m a -> a # minimum :: Ord a => IdentityT m a -> a # foldrMap1 :: (a -> b) -> (a -> b -> b) -> IdentityT m a -> b # foldlMap1' :: (a -> b) -> (b -> a -> b) -> IdentityT m a -> b # foldlMap1 :: (a -> b) -> (b -> a -> b) -> IdentityT m a -> b # foldrMap1' :: (a -> b) -> (a -> b -> b) -> IdentityT m a -> b # | |||||
Eq1 f => Eq1 (IdentityT f) | |||||
Ord1 f => Ord1 (IdentityT f) | |||||
Defined in Control.Monad.Trans.Identity | |||||
Read1 f => Read1 (IdentityT f) | |||||
Defined in Control.Monad.Trans.Identity liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (IdentityT f a) # liftReadList :: (Int -> ReadS a) -> ReadS [a] -> ReadS [IdentityT f a] # liftReadPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec (IdentityT f a) # liftReadListPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec [IdentityT f a] # | |||||
Show1 f => Show1 (IdentityT f) | |||||
Contravariant f => Contravariant (IdentityT f) | |||||
Alternative m => Alternative (IdentityT m) | |||||
Applicative m => Applicative (IdentityT m) | |||||
Defined in Control.Monad.Trans.Identity | |||||
Functor m => Functor (IdentityT m) | |||||
Monad m => Monad (IdentityT m) | |||||
MonadPlus m => MonadPlus (IdentityT m) | |||||
MonadFail m => MonadFail (IdentityT m) | |||||
Defined in Control.Monad.Trans.Identity | |||||
MonadFix m => MonadFix (IdentityT m) | |||||
Defined in Control.Monad.Trans.Identity | |||||
Foldable f => Foldable (IdentityT f) | |||||
Defined in Control.Monad.Trans.Identity fold :: Monoid m => IdentityT f m -> m # foldMap :: Monoid m => (a -> m) -> IdentityT f a -> m # foldMap' :: Monoid m => (a -> m) -> IdentityT f a -> m # foldr :: (a -> b -> b) -> b -> IdentityT f a -> b # foldr' :: (a -> b -> b) -> b -> IdentityT f a -> b # foldl :: (b -> a -> b) -> b -> IdentityT f a -> b # foldl' :: (b -> a -> b) -> b -> IdentityT f a -> b # foldr1 :: (a -> a -> a) -> IdentityT f a -> a # foldl1 :: (a -> a -> a) -> IdentityT f a -> a # toList :: IdentityT f a -> [a] # null :: IdentityT f a -> Bool # length :: IdentityT f a -> Int # elem :: Eq a => a -> IdentityT f a -> Bool # maximum :: Ord a => IdentityT f a -> a # minimum :: Ord a => IdentityT f a -> a # | |||||
Traversable f => Traversable (IdentityT f) | |||||
Defined in Control.Monad.Trans.Identity | |||||
MonadCont m => MonadCont (IdentityT m) | |||||
Generic (IdentityT f a) | |||||
Defined in Control.Monad.Trans.Identity
| |||||
(Read1 f, Read a) => Read (IdentityT f a) | |||||
(Show1 f, Show a) => Show (IdentityT f a) | |||||
(Eq1 f, Eq a) => Eq (IdentityT f a) | |||||
(Ord1 f, Ord a) => Ord (IdentityT f a) | |||||
Defined in Control.Monad.Trans.Identity compare :: IdentityT f a -> IdentityT f a -> Ordering # (<) :: IdentityT f a -> IdentityT f a -> Bool # (<=) :: IdentityT f a -> IdentityT f a -> Bool # (>) :: IdentityT f a -> IdentityT f a -> Bool # (>=) :: IdentityT f a -> IdentityT f a -> Bool # | |||||
type Rep1 (IdentityT f :: k -> Type) | |||||
Defined in Control.Monad.Trans.Identity | |||||
type Rep (IdentityT f a) | |||||
Defined in Control.Monad.Trans.Identity |
newtype MaybeT (m :: Type -> Type) a #
The parameterizable maybe monad, obtained by composing an arbitrary
monad with the Maybe
monad.
Computations are actions that may produce a value or exit.
The return
function yields a computation that produces that
value, while >>=
sequences two subcomputations, exiting if either
computation does.
Instances
MonadTrans MaybeT | |||||
Defined in Control.Monad.Trans.Maybe | |||||
MonadRWS r w s m => MonadRWS r w s (MaybeT m) | |||||
Defined in Control.Monad.RWS.Class | |||||
Functor m => Generic1 (MaybeT m :: Type -> Type) | |||||
Defined in Control.Monad.Trans.Maybe
| |||||
MonadAccum w m => MonadAccum w (MaybeT m) | The accumulated value 'survives' an error: even if the computation fails to deliver a result, we still have an accumulated value. Since: mtl-2.3 | ||||
MonadError e m => MonadError e (MaybeT m) | |||||
Defined in Control.Monad.Error.Class throwError :: e -> MaybeT m a # catchError :: MaybeT m a -> (e -> MaybeT m a) -> MaybeT m a # | |||||
MonadReader r m => MonadReader r (MaybeT m) | |||||
MonadSelect r m => MonadSelect r (MaybeT m) | 'Extends' the possibilities considered by Since: mtl-2.3 | ||||
Defined in Control.Monad.Select | |||||
MonadState s m => MonadState s (MaybeT m) | |||||
MonadWriter w m => MonadWriter w (MaybeT m) | |||||
MonadIO m => MonadIO (MaybeT m) | |||||
Defined in Control.Monad.Trans.Maybe | |||||
MonadZip m => MonadZip (MaybeT m) | |||||
Eq1 m => Eq1 (MaybeT m) | |||||
Ord1 m => Ord1 (MaybeT m) | |||||
Defined in Control.Monad.Trans.Maybe | |||||
Read1 m => Read1 (MaybeT m) | |||||
Defined in Control.Monad.Trans.Maybe | |||||
Show1 m => Show1 (MaybeT m) | |||||
Contravariant m => Contravariant (MaybeT m) | |||||
(Functor m, Monad m) => Alternative (MaybeT m) | |||||
(Functor m, Monad m) => Applicative (MaybeT m) | |||||
Functor m => Functor (MaybeT m) | |||||
Monad m => Monad (MaybeT m) | |||||
Monad m => MonadPlus (MaybeT m) | |||||
Monad m => MonadFail (MaybeT m) | |||||
Defined in Control.Monad.Trans.Maybe | |||||
MonadFix m => MonadFix (MaybeT m) | |||||
Defined in Control.Monad.Trans.Maybe | |||||
Foldable f => Foldable (MaybeT f) | |||||
Defined in Control.Monad.Trans.Maybe fold :: Monoid m => MaybeT f m -> m # foldMap :: Monoid m => (a -> m) -> MaybeT f a -> m # foldMap' :: Monoid m => (a -> m) -> MaybeT f a -> m # foldr :: (a -> b -> b) -> b -> MaybeT f a -> b # foldr' :: (a -> b -> b) -> b -> MaybeT f a -> b # foldl :: (b -> a -> b) -> b -> MaybeT f a -> b # foldl' :: (b -> a -> b) -> b -> MaybeT f a -> b # foldr1 :: (a -> a -> a) -> MaybeT f a -> a # foldl1 :: (a -> a -> a) -> MaybeT f a -> a # elem :: Eq a => a -> MaybeT f a -> Bool # maximum :: Ord a => MaybeT f a -> a # minimum :: Ord a => MaybeT f a -> a # | |||||
Traversable f => Traversable (MaybeT f) | |||||
Defined in Control.Monad.Trans.Maybe | |||||
MonadCont m => MonadCont (MaybeT m) | |||||
Generic (MaybeT m a) | |||||
Defined in Control.Monad.Trans.Maybe
| |||||
(Read1 m, Read a) => Read (MaybeT m a) | |||||
(Show1 m, Show a) => Show (MaybeT m a) | |||||
(Eq1 m, Eq a) => Eq (MaybeT m a) | |||||
(Ord1 m, Ord a) => Ord (MaybeT m a) | |||||
type Rep1 (MaybeT m :: Type -> Type) | |||||
Defined in Control.Monad.Trans.Maybe | |||||
type Rep (MaybeT m a) | |||||
Defined in Control.Monad.Trans.Maybe |
Reexport monadic functions
class Applicative m => Monad (m :: Type -> Type) where #
The Monad
class defines the basic operations over a monad,
a concept from a branch of mathematics known as category theory.
From the perspective of a Haskell programmer, however, it is best to
think of a monad as an abstract datatype of actions.
Haskell's do
expressions provide a convenient syntax for writing
monadic expressions.
Instances of Monad
should satisfy the following:
- Left identity
return
a>>=
k = k a- Right identity
m
>>=
return
= m- Associativity
m
>>=
(\x -> k x>>=
h) = (m>>=
k)>>=
h
Furthermore, the Monad
and Applicative
operations should relate as follows:
The above laws imply:
and that pure
and (<*>
) satisfy the applicative functor laws.
The instances of Monad
for List
, Maybe
and IO
defined in the Prelude satisfy these laws.
(>>=) :: m a -> (a -> m b) -> m b infixl 1 #
Sequentially compose two actions, passing any value produced by the first as an argument to the second.
'as
' can be understood as the >>=
bsdo
expression
do a <- as bs a
An alternative name for this function is 'bind', but some people may refer to it as 'flatMap', which results from it being equivialent to
\x f ->join
(fmap
f x) :: Monad m => m a -> (a -> m b) -> m b
which can be seen as mapping a value with
Monad m => m a -> m (m b)
and then 'flattening' m (m b)
to m b
using join
.
(>>) :: m a -> m b -> m b infixl 1 #
Sequentially compose two actions, discarding any value produced by the first, like sequencing operators (such as the semicolon) in imperative languages.
'as
' can be understood as the >>
bsdo
expression
do as bs
or in terms of
as(>>=)
as >>= const bs
Inject a value into the monadic type.
This function should not be different from its default implementation
as pure
. The justification for the existence of this function is
merely historic.
Instances
Monad Complex | Since: base-4.9.0.0 |
Monad First | Since: base-4.9.0.0 |
Monad Last | Since: base-4.9.0.0 |
Monad Max | Since: base-4.9.0.0 |
Monad Min | Since: base-4.9.0.0 |
Monad Put | |
Monad Seq | |
Monad Tree | |
Monad NonEmpty | @since base-4.9.0.0 |
Monad STM | @since base-4.3.0.0 |
Monad Identity | @since base-4.8.0.0 |
Monad First | @since base-4.8.0.0 |
Monad Last | @since base-4.8.0.0 |
Monad Down | @since base-4.11.0.0 |
Monad Dual | @since base-4.8.0.0 |
Monad Product | @since base-4.8.0.0 |
Monad Sum | @since base-4.8.0.0 |
Monad Par1 | @since base-4.9.0.0 |
Monad P | @since base-2.01 |
Monad ReadP | @since base-2.01 |
Monad ReadPrec | @since base-2.01 |
Monad IO | @since base-2.01 |
Monad Q | |
Monad Maybe | @since base-2.01 |
Monad Solo | @since base-4.15 |
Monad [] | @since base-2.01 |
Monad m => Monad (WrappedMonad m) | Since: base-4.7.0.0 |
Defined in Control.Applicative (>>=) :: WrappedMonad m a -> (a -> WrappedMonad m b) -> WrappedMonad m b # (>>) :: WrappedMonad m a -> WrappedMonad m b -> WrappedMonad m b # return :: a -> WrappedMonad m a # | |
Monad (SetM s) | |
ArrowApply a => Monad (ArrowMonad a) | @since base-2.01 |
Defined in GHC.Internal.Control.Arrow (>>=) :: ArrowMonad a a0 -> (a0 -> ArrowMonad a b) -> ArrowMonad a b # (>>) :: ArrowMonad a a0 -> ArrowMonad a b -> ArrowMonad a b # return :: a0 -> ArrowMonad a a0 # | |
Monad (Either e) | @since base-4.4.0.0 |
Monad (Proxy :: Type -> Type) | @since base-4.7.0.0 |
Monad (U1 :: Type -> Type) | @since base-4.9.0.0 |
Monad (IParser t) | |
Monad m => Monad (MaybeT m) | |
Monoid a => Monad ((,) a) | @since base-4.9.0.0 |
(Applicative f, Monad f) => Monad (WhenMissing f x) | Equivalent to Since: containers-0.5.9 |
Defined in Data.IntMap.Internal (>>=) :: WhenMissing f x a -> (a -> WhenMissing f x b) -> WhenMissing f x b # (>>) :: WhenMissing f x a -> WhenMissing f x b -> WhenMissing f x b # return :: a -> WhenMissing f x a # | |
Monad m => Monad (Kleisli m a) | @since base-4.14.0.0 |
Monad f => Monad (Ap f) | @since base-4.12.0.0 |
Monad f => Monad (Alt f) | @since base-4.8.0.0 |
Monad f => Monad (Rec1 f) | @since base-4.9.0.0 |
Monad (t m) => Monad (LiftingAccum t m) | Since: mtl-2.3 |
Defined in Control.Monad.Accum (>>=) :: LiftingAccum t m a -> (a -> LiftingAccum t m b) -> LiftingAccum t m b # (>>) :: LiftingAccum t m a -> LiftingAccum t m b -> LiftingAccum t m b # return :: a -> LiftingAccum t m a # | |
Monad (t m) => Monad (LiftingSelect t m) | Since: mtl-2.3 |
Defined in Control.Monad.Select (>>=) :: LiftingSelect t m a -> (a -> LiftingSelect t m b) -> LiftingSelect t m b # (>>) :: LiftingSelect t m a -> LiftingSelect t m b -> LiftingSelect t m b # return :: a -> LiftingSelect t m a # | |
(Monoid w, Functor m, Monad m) => Monad (AccumT w m) | |
Monad m => Monad (ExceptT e m) | |
Monad m => Monad (IdentityT m) | |
Monad m => Monad (ReaderT r m) | |
Monad m => Monad (SelectT r m) | |
Monad m => Monad (StateT s m) | |
Monad m => Monad (StateT s m) | |
Monad m => Monad (WriterT w m) | |
(Monoid w, Monad m) => Monad (WriterT w m) | |
(Monoid w, Monad m) => Monad (WriterT w m) | |
Monad m => Monad (Reverse m) | Derived instance. |
(Monoid a, Monoid b) => Monad ((,,) a b) | @since base-4.14.0.0 |
(Monad f, Monad g) => Monad (Product f g) | Since: base-4.9.0.0 |
(Monad f, Applicative f) => Monad (WhenMatched f x y) | Equivalent to Since: containers-0.5.9 |
Defined in Data.IntMap.Internal (>>=) :: WhenMatched f x y a -> (a -> WhenMatched f x y b) -> WhenMatched f x y b # (>>) :: WhenMatched f x y a -> WhenMatched f x y b -> WhenMatched f x y b # return :: a -> WhenMatched f x y a # | |
(Applicative f, Monad f) => Monad (WhenMissing f k x) | Equivalent to Since: containers-0.5.9 |
Defined in Data.Map.Internal (>>=) :: WhenMissing f k x a -> (a -> WhenMissing f k x b) -> WhenMissing f k x b # (>>) :: WhenMissing f k x a -> WhenMissing f k x b -> WhenMissing f k x b # return :: a -> WhenMissing f k x a # | |
(Monad f, Monad g) => Monad (f :*: g) | @since base-4.9.0.0 |
Monad (ContT r m) | |
(Monoid a, Monoid b, Monoid c) => Monad ((,,,) a b c) | @since base-4.14.0.0 |
Monad ((->) r) | @since base-2.01 |
(Monad f, Applicative f) => Monad (WhenMatched f k x y) | Equivalent to Since: containers-0.5.9 |
Defined in Data.Map.Internal (>>=) :: WhenMatched f k x y a -> (a -> WhenMatched f k x y b) -> WhenMatched f k x y b # (>>) :: WhenMatched f k x y a -> WhenMatched f k x y b -> WhenMatched f k x y b # return :: a -> WhenMatched f k x y a # | |
Monad f => Monad (M1 i c f) | @since base-4.9.0.0 |
Monad m => Monad (RWST r w s m) | |
(Monoid w, Monad m) => Monad (RWST r w s m) | |
(Monoid w, Monad m) => Monad (RWST r w s m) | |
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
class (Alternative m, Monad m) => MonadPlus (m :: Type -> Type) where #
Monads that also support choice and failure.
Nothing
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
MonadPlus Seq | |
MonadPlus STM | Takes the first non- @since base-4.3.0.0 |
MonadPlus P | @since base-2.01 |
Defined in GHC.Internal.Text.ParserCombinators.ReadP | |
MonadPlus ReadP | @since base-2.01 |
MonadPlus ReadPrec | @since base-2.01 |
MonadPlus IO | Takes the first non-throwing @since base-4.9.0.0 |
MonadPlus Maybe | Picks the leftmost @since base-2.01 |
MonadPlus [] | Combines lists by concatenation, starting from the empty list. @since base-2.01 |
Defined in GHC.Internal.Base | |
(ArrowApply a, ArrowPlus a) => MonadPlus (ArrowMonad a) | @since base-4.6.0.0 |
Defined in GHC.Internal.Control.Arrow mzero :: ArrowMonad a a0 # mplus :: ArrowMonad a a0 -> ArrowMonad a a0 -> ArrowMonad a a0 # | |
MonadPlus (Proxy :: Type -> Type) | @since base-4.9.0.0 |
MonadPlus (U1 :: Type -> Type) | @since base-4.9.0.0 |
Monad m => MonadPlus (MaybeT m) | |
MonadPlus m => MonadPlus (Kleisli m a) | @since base-4.14.0.0 |
MonadPlus f => MonadPlus (Ap f) | @since base-4.12.0.0 |
MonadPlus f => MonadPlus (Alt f) | @since base-4.8.0.0 |
MonadPlus f => MonadPlus (Rec1 f) | @since base-4.9.0.0 |
(Monoid w, Functor m, MonadPlus m) => MonadPlus (AccumT w m) | |
(Monad m, Monoid e) => MonadPlus (ExceptT e m) | |
MonadPlus m => MonadPlus (IdentityT m) | |
MonadPlus m => MonadPlus (ReaderT r m) | |
MonadPlus m => MonadPlus (SelectT r m) | |
MonadPlus m => MonadPlus (StateT s m) | |
MonadPlus m => MonadPlus (StateT s m) | |
(Functor m, MonadPlus m) => MonadPlus (WriterT w m) | |
(Monoid w, MonadPlus m) => MonadPlus (WriterT w m) | |
(Monoid w, MonadPlus m) => MonadPlus (WriterT w m) | |
MonadPlus m => MonadPlus (Reverse m) | Derived instance. |
(MonadPlus f, MonadPlus g) => MonadPlus (Product f g) | Since: base-4.9.0.0 |
(MonadPlus f, MonadPlus g) => MonadPlus (f :*: g) | @since base-4.9.0.0 |
MonadPlus f => MonadPlus (M1 i c f) | @since base-4.9.0.0 |
(Functor m, MonadPlus m) => MonadPlus (RWST r w s m) | |
(Monoid w, MonadPlus m) => MonadPlus (RWST r w s m) | |
(Monoid w, MonadPlus m) => MonadPlus (RWST r w s m) | |
(=<<) :: Monad m => (a -> m b) -> m a -> m b infixr 1 #
Same as >>=
, but with the arguments interchanged.
as >>= f == f =<< as
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 -> do
putStrLn ("Keep: " ++ show x ++ "?") answer <- getLine pure (answer == "y")) [1, 2, 3] Keep: 1? y Keep: 2? n Keep: 3? y [1,3]
>>>
filterM (\x -> do
putStr (show x) x' <- readLn pure (x == x')) [1, 2, 3] 12 22 33 [2,3]
forever :: Applicative f => f a -> f b #
Repeat an action indefinitely.
Examples
A common use of forever
is to process input from network sockets,
Handle
s, and channels
(e.g. MVar
and
Chan
).
For example, here is how we might implement an echo
server, using
forever
both to listen for client connections on a network socket
and to echo client input on client connection handles:
echoServer :: Socket -> IO () echoServer socket =forever
$ do client <- accept socketforkFinally
(echo client) (\_ -> hClose client) where echo :: Handle -> IO () echo client =forever
$ hGetLine client >>= hPutStrLn client
Note that "forever" isn't necessarily non-terminating.
If the action is in a
and short-circuits after some number of iterations.
then MonadPlus
actually returns forever
mzero
, effectively short-circuiting its caller.
mapAndUnzipM :: Applicative m => (a -> m (b, c)) -> [a] -> m ([b], [c]) #
The mapAndUnzipM
function maps its first argument over a list, returning
the result as a pair of lists. This function is mainly used with complicated
data structures or a state monad.
zipWithM :: Applicative m => (a -> b -> m c) -> [a] -> [b] -> m [c] #
zipWithM_ :: Applicative m => (a -> b -> m c) -> [a] -> [b] -> m () #
replicateM :: Applicative m => Int -> m a -> m [a] #
performs the action replicateM
n actact
n
times,
and then returns the list of results.
replicateM n (pure x) == replicate
n x
Examples
>>>
replicateM 3 getLine
hi heya hiya ["hi","heya","hiya"]
>>>
import Control.Monad.State
>>>
runState (replicateM 3 $ state $ \s -> (s, s + 1)) 1
([1,2,3],4)
replicateM_ :: Applicative m => Int -> m a -> m () #
module Control.Monad.Fail
Reexport Maybe
The Maybe
type encapsulates an optional value. A value of type
either contains a value of type Maybe
aa
(represented as
),
or it is empty (represented as Just
aNothing
). Using Maybe
is a good way to
deal with errors or exceptional cases without resorting to drastic
measures such as error
.
The Maybe
type is also a monad. It is a simple kind of error
monad, where all errors are represented by Nothing
. A richer
error monad can be built using the Either
type.
Instances
MonadZip Maybe | Since: base-4.8.0.0 | ||||
Eq1 Maybe | Since: base-4.9.0.0 | ||||
Ord1 Maybe | Since: base-4.9.0.0 | ||||
Defined in Data.Functor.Classes | |||||
Read1 Maybe | Since: base-4.9.0.0 | ||||
Defined in Data.Functor.Classes | |||||
Show1 Maybe | Since: base-4.9.0.0 | ||||
NFData1 Maybe | Since: deepseq-1.4.3.0 | ||||
Defined in Control.DeepSeq | |||||
Alternative Maybe | Picks the leftmost @since base-2.01 | ||||
Applicative Maybe | @since base-2.01 | ||||
Functor Maybe | @since base-2.01 | ||||
Monad Maybe | @since base-2.01 | ||||
MonadPlus Maybe | Picks the leftmost @since base-2.01 | ||||
MonadFail Maybe | @since base-4.9.0.0 | ||||
Defined in GHC.Internal.Control.Monad.Fail | |||||
Foldable Maybe | @since base-2.01 | ||||
Defined in GHC.Internal.Data.Foldable fold :: Monoid m => Maybe m -> m # foldMap :: Monoid m => (a -> m) -> Maybe a -> m # foldMap' :: Monoid m => (a -> m) -> Maybe a -> m # foldr :: (a -> b -> b) -> b -> Maybe a -> b # foldr' :: (a -> b -> b) -> b -> Maybe a -> b # foldl :: (b -> a -> b) -> b -> Maybe a -> b # foldl' :: (b -> a -> b) -> b -> Maybe a -> b # foldr1 :: (a -> a -> a) -> Maybe a -> a # foldl1 :: (a -> a -> a) -> Maybe a -> a # elem :: Eq a => a -> Maybe a -> Bool # maximum :: Ord a => Maybe a -> a # minimum :: Ord a => Maybe a -> a # | |||||
Traversable Maybe | @since base-2.01 | ||||
Hashable1 Maybe | |||||
Defined in Data.Hashable.Class | |||||
Generic1 Maybe | |||||
Defined in GHC.Internal.Generics
| |||||
MonadError () Maybe | Since: mtl-2.2.2 | ||||
Defined in Control.Monad.Error.Class throwError :: () -> Maybe a # catchError :: Maybe a -> (() -> Maybe a) -> Maybe a # | |||||
Lift a => Lift (Maybe a :: Type) | |||||
NFData a => NFData (Maybe a) | |||||
Defined in Control.DeepSeq | |||||
Semigroup a => Monoid (Maybe a) | Lift a semigroup into Since 4.11.0: constraint on inner @since base-2.01 | ||||
Semigroup a => Semigroup (Maybe a) | @since base-4.9.0.0 | ||||
Data a => Data (Maybe a) | @since base-4.0.0.0 | ||||
Defined in GHC.Internal.Data.Data gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Maybe a -> c (Maybe a) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Maybe a) # toConstr :: Maybe a -> Constr # dataTypeOf :: Maybe a -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Maybe a)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Maybe a)) # gmapT :: (forall b. Data b => b -> b) -> Maybe a -> Maybe a # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Maybe a -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Maybe a -> r # gmapQ :: (forall d. Data d => d -> u) -> Maybe a -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Maybe a -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Maybe a -> m (Maybe a) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Maybe a -> m (Maybe a) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Maybe a -> m (Maybe a) # | |||||
Generic (Maybe a) | |||||
Defined in GHC.Internal.Generics
| |||||
SingKind a => SingKind (Maybe a) | @since base-4.9.0.0 | ||||
Defined in GHC.Internal.Generics
| |||||
Read a => Read (Maybe a) | @since base-2.01 | ||||
Show a => Show (Maybe a) | @since base-2.01 | ||||
Eq a => Eq (Maybe a) | @since base-2.01 | ||||
Ord a => Ord (Maybe a) | @since base-2.01 | ||||
Hashable a => Hashable (Maybe a) | |||||
Defined in Data.Hashable.Class | |||||
SingI ('Nothing :: Maybe a) | @since base-4.9.0.0 | ||||
Defined in GHC.Internal.Generics | |||||
SingI a2 => SingI ('Just a2 :: Maybe a1) | @since base-4.9.0.0 | ||||
Defined in GHC.Internal.Generics | |||||
type Rep1 Maybe | @since base-4.6.0.0 | ||||
Defined in GHC.Internal.Generics | |||||
type DemoteRep (Maybe a) | |||||
Defined in GHC.Internal.Generics | |||||
type Rep (Maybe a) | @since base-4.6.0.0 | ||||
Defined in GHC.Internal.Generics | |||||
data Sing (b :: Maybe a) | |||||
maybe :: b -> (a -> b) -> Maybe a -> b #
The maybe
function takes a default value, a function, and a Maybe
value. If the Maybe
value is Nothing
, the function returns the
default value. Otherwise, it applies the function to the value inside
the Just
and returns the result.
Examples
Basic usage:
>>>
maybe False odd (Just 3)
True
>>>
maybe False odd Nothing
False
Read an integer from a string using readMaybe
. If we succeed,
return twice the integer; that is, apply (*2)
to it. If instead
we fail to parse an integer, return 0
by default:
>>>
import GHC.Internal.Text.Read ( readMaybe )
>>>
maybe 0 (*2) (readMaybe "5")
10>>>
maybe 0 (*2) (readMaybe "")
0
Apply show
to a Maybe Int
. If we have Just n
, we want to show
the underlying Int
n
. But if we have Nothing
, we return the
empty string instead of (for example) "Nothing":
>>>
maybe "" show (Just 5)
"5">>>
maybe "" show Nothing
""
fromMaybe :: a -> Maybe a -> a #
The fromMaybe
function takes a default value and a Maybe
value. If the Maybe
is Nothing
, it returns the default value;
otherwise, it returns the value contained in the Maybe
.
Examples
Basic usage:
>>>
fromMaybe "" (Just "Hello, World!")
"Hello, World!"
>>>
fromMaybe "" Nothing
""
Read an integer from a string using readMaybe
. If we fail to
parse an integer, we want to return 0
by default:
>>>
import GHC.Internal.Text.Read ( readMaybe )
>>>
fromMaybe 0 (readMaybe "5")
5>>>
fromMaybe 0 (readMaybe "")
0
maybeToList :: Maybe a -> [a] #
The maybeToList
function returns an empty list when given
Nothing
or a singleton list when given Just
.
Examples
Basic usage:
>>>
maybeToList (Just 7)
[7]
>>>
maybeToList Nothing
[]
One can use maybeToList
to avoid pattern matching when combined
with a function that (safely) works on lists:
>>>
import GHC.Internal.Text.Read ( readMaybe )
>>>
sum $ maybeToList (readMaybe "3")
3>>>
sum $ maybeToList (readMaybe "")
0
listToMaybe :: [a] -> Maybe a #
The listToMaybe
function returns Nothing
on an empty list
or
where Just
aa
is the first element of the list.
Examples
Basic usage:
>>>
listToMaybe []
Nothing
>>>
listToMaybe [9]
Just 9
>>>
listToMaybe [1,2,3]
Just 1
Composing maybeToList
with listToMaybe
should be the identity
on singleton/empty lists:
>>>
maybeToList $ listToMaybe [5]
[5]>>>
maybeToList $ listToMaybe []
[]
But not on lists with more than one element:
>>>
maybeToList $ listToMaybe [1,2,3]
[1]
catMaybes :: [Maybe a] -> [a] #
The catMaybes
function takes a list of Maybe
s and returns
a list of all the Just
values.
Examples
Basic usage:
>>>
catMaybes [Just 1, Nothing, Just 3]
[1,3]
When constructing a list of Maybe
values, catMaybes
can be used
to return all of the "success" results (if the list is the result
of a map
, then mapMaybe
would be more appropriate):
>>>
import GHC.Internal.Text.Read ( readMaybe )
>>>
[readMaybe x :: Maybe Int | x <- ["1", "Foo", "3"] ]
[Just 1,Nothing,Just 3]>>>
catMaybes $ [readMaybe x :: Maybe Int | x <- ["1", "Foo", "3"] ]
[1,3]
mapMaybe :: (a -> Maybe b) -> [a] -> [b] #
The mapMaybe
function is a version of map
which can throw
out elements. In particular, the functional argument returns
something of type
. If this is Maybe
bNothing
, no element
is added on to the result list. If it is
, then Just
bb
is
included in the result list.
Examples
Using
is a shortcut for mapMaybe
f x
in most cases:catMaybes
$ map
f x
>>>
import GHC.Internal.Text.Read ( readMaybe )
>>>
let readMaybeInt = readMaybe :: String -> Maybe Int
>>>
mapMaybe readMaybeInt ["1", "Foo", "3"]
[1,3]>>>
catMaybes $ map readMaybeInt ["1", "Foo", "3"]
[1,3]
If we map the Just
constructor, the entire list should be returned:
>>>
mapMaybe Just [1,2,3]
[1,2,3]
Reexport Either
The Either
type represents values with two possibilities: a value of
type
is either Either
a b
or Left
a
.Right
b
The Either
type is sometimes used to represent a value which is
either correct or an error; by convention, the Left
constructor is
used to hold an error value and the Right
constructor is used to
hold a correct value (mnemonic: "right" also means "correct").
Examples
The type
is the type of values which can be either
a Either
String
Int
String
or an Int
. The Left
constructor can be used only on
String
s, and the Right
constructor can be used only on Int
s:
>>>
let s = Left "foo" :: Either String Int
>>>
s
Left "foo">>>
let n = Right 3 :: Either String Int
>>>
n
Right 3>>>
:type s
s :: Either String Int>>>
:type n
n :: Either String Int
The fmap
from our Functor
instance will ignore Left
values, but
will apply the supplied function to values contained in a Right
:
>>>
let s = Left "foo" :: Either String Int
>>>
let n = Right 3 :: Either String Int
>>>
fmap (*2) s
Left "foo">>>
fmap (*2) n
Right 6
The Monad
instance for Either
allows us to chain together multiple
actions which may fail, and fail overall if any of the individual
steps failed. First we'll write a function that can either parse an
Int
from a Char
, or fail.
>>>
import Data.Char ( digitToInt, isDigit )
>>>
:{
let parseEither :: Char -> Either String Int parseEither c | isDigit c = Right (digitToInt c) | otherwise = Left "parse error">>>
:}
The following should work, since both '1'
and '2'
can be
parsed as Int
s.
>>>
:{
let parseMultiple :: Either String Int parseMultiple = do x <- parseEither '1' y <- parseEither '2' return (x + y)>>>
:}
>>>
parseMultiple
Right 3
But the following should fail overall, since the first operation where
we attempt to parse 'm'
as an Int
will fail:
>>>
:{
let parseMultiple :: Either String Int parseMultiple = do x <- parseEither 'm' y <- parseEither '2' return (x + y)>>>
:}
>>>
parseMultiple
Left "parse error"
Instances
Bifoldable Either | Since: base-4.10.0.0 | ||||
Bifoldable1 Either | |||||
Defined in Data.Bifoldable1 | |||||
Bifunctor Either | Since: base-4.8.0.0 | ||||
Bitraversable Either | Since: base-4.10.0.0 | ||||
Defined in Data.Bitraversable bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> Either a b -> f (Either c d) # | |||||
Eq2 Either | Since: base-4.9.0.0 | ||||
Ord2 Either | Since: base-4.9.0.0 | ||||
Defined in Data.Functor.Classes | |||||
Read2 Either | Since: base-4.9.0.0 | ||||
Defined in Data.Functor.Classes liftReadsPrec2 :: (Int -> ReadS a) -> ReadS [a] -> (Int -> ReadS b) -> ReadS [b] -> Int -> ReadS (Either a b) # liftReadList2 :: (Int -> ReadS a) -> ReadS [a] -> (Int -> ReadS b) -> ReadS [b] -> ReadS [Either a b] # liftReadPrec2 :: ReadPrec a -> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec (Either a b) # liftReadListPrec2 :: ReadPrec a -> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec [Either a b] # | |||||
Show2 Either | Since: base-4.9.0.0 | ||||
NFData2 Either | Since: deepseq-1.4.3.0 | ||||
Defined in Control.DeepSeq | |||||
Hashable2 Either | |||||
Defined in Data.Hashable.Class | |||||
Generic1 (Either a :: Type -> Type) | |||||
Defined in GHC.Internal.Generics
| |||||
MonadError e (Either e) | |||||
Defined in Control.Monad.Error.Class throwError :: e -> Either e a # catchError :: Either e a -> (e -> Either e a) -> Either e a # | |||||
(Lift a, Lift b) => Lift (Either a b :: Type) | |||||
Eq a => Eq1 (Either a) | Since: base-4.9.0.0 | ||||
Ord a => Ord1 (Either a) | Since: base-4.9.0.0 | ||||
Defined in Data.Functor.Classes | |||||
Read a => Read1 (Either a) | Since: base-4.9.0.0 | ||||
Defined in Data.Functor.Classes liftReadsPrec :: (Int -> ReadS a0) -> ReadS [a0] -> Int -> ReadS (Either a a0) # liftReadList :: (Int -> ReadS a0) -> ReadS [a0] -> ReadS [Either a a0] # liftReadPrec :: ReadPrec a0 -> ReadPrec [a0] -> ReadPrec (Either a a0) # liftReadListPrec :: ReadPrec a0 -> ReadPrec [a0] -> ReadPrec [Either a a0] # | |||||
Show a => Show1 (Either a) | Since: base-4.9.0.0 | ||||
NFData a => NFData1 (Either a) | Since: deepseq-1.4.3.0 | ||||
Defined in Control.DeepSeq | |||||
Applicative (Either e) | @since base-3.0 | ||||
Functor (Either a) | @since base-3.0 | ||||
Monad (Either e) | @since base-4.4.0.0 | ||||
IsString str => MonadFail (Either str) Source # | For convenient work with Since: 0.1.0 | ||||
Defined in Relude.Monad.Either | |||||
Foldable (Either a) | @since base-4.7.0.0 | ||||
Defined in GHC.Internal.Data.Foldable fold :: Monoid m => Either a m -> m # foldMap :: Monoid m => (a0 -> m) -> Either a a0 -> m # foldMap' :: Monoid m => (a0 -> m) -> Either a a0 -> m # foldr :: (a0 -> b -> b) -> b -> Either a a0 -> b # foldr' :: (a0 -> b -> b) -> b -> Either a a0 -> b # foldl :: (b -> a0 -> b) -> b -> Either a a0 -> b # foldl' :: (b -> a0 -> b) -> b -> Either a a0 -> b # foldr1 :: (a0 -> a0 -> a0) -> Either a a0 -> a0 # foldl1 :: (a0 -> a0 -> a0) -> Either a a0 -> a0 # toList :: Either a a0 -> [a0] # length :: Either a a0 -> Int # elem :: Eq a0 => a0 -> Either a a0 -> Bool # maximum :: Ord a0 => Either a a0 -> a0 # minimum :: Ord a0 => Either a a0 -> a0 # | |||||
Traversable (Either a) | @since base-4.7.0.0 | ||||
Defined in GHC.Internal.Data.Traversable | |||||
Hashable a => Hashable1 (Either a) | |||||
Defined in Data.Hashable.Class | |||||
(NFData a, NFData b) => NFData (Either a b) | |||||
Defined in Control.DeepSeq | |||||
Semigroup (Either a b) | @since base-4.9.0.0 | ||||
(Data a, Data b) => Data (Either a b) | @since base-4.0.0.0 | ||||
Defined in GHC.Internal.Data.Data gfoldl :: (forall d b0. Data d => c (d -> b0) -> d -> c b0) -> (forall g. g -> c g) -> Either a b -> c (Either a b) # gunfold :: (forall b0 r. Data b0 => c (b0 -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Either a b) # toConstr :: Either a b -> Constr # dataTypeOf :: Either a b -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Either a b)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Either a b)) # gmapT :: (forall b0. Data b0 => b0 -> b0) -> Either a b -> Either a b # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Either a b -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Either a b -> r # gmapQ :: (forall d. Data d => d -> u) -> Either a b -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Either a b -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Either a b -> m (Either a b) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Either a b -> m (Either a b) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Either a b -> m (Either a b) # | |||||
Generic (Either a b) | |||||
Defined in GHC.Internal.Generics
| |||||
(Read a, Read b) => Read (Either a b) | @since base-3.0 | ||||
(Show a, Show b) => Show (Either a b) | @since base-3.0 | ||||
(Eq a, Eq b) => Eq (Either a b) | @since base-2.01 | ||||
(Ord a, Ord b) => Ord (Either a b) | @since base-2.01 | ||||
(Hashable a, Hashable b) => Hashable (Either a b) | |||||
Defined in Data.Hashable.Class | |||||
type Rep1 (Either a :: Type -> Type) | @since base-4.6.0.0 | ||||
Defined in GHC.Internal.Generics type Rep1 (Either a :: Type -> Type) = D1 ('MetaData "Either" "GHC.Internal.Data.Either" "ghc-internal" 'False) (C1 ('MetaCons "Left" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 a)) :+: C1 ('MetaCons "Right" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) Par1)) | |||||
type Rep (Either a b) | @since base-4.6.0.0 | ||||
Defined in GHC.Internal.Generics type Rep (Either a b) = D1 ('MetaData "Either" "GHC.Internal.Data.Either" "ghc-internal" 'False) (C1 ('MetaCons "Left" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 a)) :+: C1 ('MetaCons "Right" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 b))) |
either :: (a -> c) -> (b -> c) -> Either a b -> c #
Case analysis for the Either
type.
If the value is
, apply the first function to Left
aa
;
if it is
, apply the second function to Right
bb
.
Examples
We create two values of type
, one using the
Either
String
Int
Left
constructor and another using the Right
constructor. Then
we apply "either" the length
function (if we have a String
)
or the "times-two" function (if we have an Int
):
>>>
let s = Left "foo" :: Either String Int
>>>
let n = Right 3 :: Either String Int
>>>
either length (*2) s
3>>>
either length (*2) n
6
partitionEithers :: [Either a b] -> ([a], [b]) #
Partitions a list of Either
into two lists.
All the Left
elements are extracted, in order, to the first
component of the output. Similarly the Right
elements are extracted
to the second component of the output.
Examples
Basic usage:
>>>
let list = [ Left "foo", Right 3, Left "bar", Right 7, Left "baz" ]
>>>
partitionEithers list
(["foo","bar","baz"],[3,7])
The pair returned by
should be the same
pair as partitionEithers
x(
:lefts
x, rights
x)
>>>
let list = [ Left "foo", Right 3, Left "bar", Right 7, Left "baz" ]
>>>
partitionEithers list == (lefts list, rights list)
True
isLeft :: Either a b -> Bool #
Return True
if the given value is a Left
-value, False
otherwise.
@since base-4.7.0.0
Examples
Basic usage:
>>>
isLeft (Left "foo")
True>>>
isLeft (Right 3)
False
Assuming a Left
value signifies some sort of error, we can use
isLeft
to write a very simple error-reporting function that does
absolutely nothing in the case of success, and outputs "ERROR" if
any error occurred.
This example shows how isLeft
might be used to avoid pattern
matching when one does not care about the value contained in the
constructor:
>>>
import Control.Monad ( when )
>>>
let report e = when (isLeft e) $ putStrLn "ERROR"
>>>
report (Right 1)
>>>
report (Left "parse error")
ERROR
isRight :: Either a b -> Bool #
Return True
if the given value is a Right
-value, False
otherwise.
@since base-4.7.0.0
Examples
Basic usage:
>>>
isRight (Left "foo")
False>>>
isRight (Right 3)
True
Assuming a Left
value signifies some sort of error, we can use
isRight
to write a very simple reporting function that only
outputs "SUCCESS" when a computation has succeeded.
This example shows how isRight
might be used to avoid pattern
matching when one does not care about the value contained in the
constructor:
>>>
import Control.Monad ( when )
>>>
let report e = when (isRight e) $ putStrLn "SUCCESS"
>>>
report (Left "parse error")
>>>
report (Right 1)
SUCCESS