| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Control.Monad.Constrained
Description
A module for constrained monads. This module is intended to be imported
with the -XRebindableSyntax extension turned on: everything from the
Prelude (that doesn't conflict with the new Functor, Applicative, etc) is
reexported, so these type classes can be used the same way that the Prelude
classes are used.
- class Functor f where
- type Suitable f a :: Constraint
- class (Applicative (Unconstrained f), Functor f) => Applicative f where
- type Unconstrained f :: * -> *
- class Applicative f => Monad f where
- class Applicative f => Alternative f where
- class (Foldable t, Functor t) => Traversable t where
- class Monad f => MonadFail f where
- ap :: (Monad f, Suitable f a) => (a -> f a) -> Ap f a -> f a
- guard :: (Alternative f, Suitable f ()) => Bool -> f ()
- ensure :: (Alternative f, Suitable f a) => Bool -> f a -> f a
- (<**>) :: (Applicative f, Suitable f b) => f a -> f (a -> b) -> f b
- (<$>) :: (Functor f, Suitable f b) => (a -> b) -> f a -> f b
- (=<<) :: (Monad f, Suitable f b) => (a -> f b) -> f a -> f b
- (<=<) :: (Monad f, Suitable f c) => (b -> f c) -> (a -> f b) -> a -> f c
- (>=>) :: (Monad f, Suitable f c) => (a -> f b) -> (b -> f c) -> a -> f c
- foldM :: (Foldable t, Monad m, Suitable m b) => (b -> a -> m b) -> b -> t a -> m b
- traverse_ :: (Applicative f, Foldable t, Suitable f ()) => (a -> f b) -> t a -> f ()
- sequenceA :: (Applicative f, Suitable t a, Suitable f (t a), Traversable t, Suitable f a) => t (f a) -> f (t a)
- sequenceA_ :: (Foldable t, Applicative f, Suitable f ()) => t (f a) -> f ()
- mapAccumL :: (Traversable t, Suitable t c) => (a -> b -> (a, c)) -> a -> t b -> (a, t c)
- replicateM :: (Applicative m, Suitable m [a]) => Int -> m a -> m [a]
- void :: (Functor f, Suitable f ()) => f a -> f ()
- forever :: (Applicative f, Suitable f b) => f a -> f b
- for_ :: (Foldable t, Applicative f, Suitable f ()) => t a -> (a -> f b) -> f ()
- join :: (Monad f, Suitable f a) => f (f a) -> f a
- ifThenElse :: Bool -> a -> a -> a
- (>>) :: (Applicative f, Suitable f b) => f a -> f b -> f b
- return :: (Applicative f, Suitable f a) => a -> f a
Basic Classes
class Functor f where Source #
This is the same class as Functor from the Prelude. Most of the
functions here are simply rewritten versions of those, with one difference:
types can indicate which types they can contain. This allows
Set to be made into a monad, as well as some other exotic types.
(but, to be fair, Set is kind of the poster child for this
technique).
The way that types indicate what they can contain is with the Suitable
associated type.
The default implementation is for types which conform to the Prelude's
Functor. The way to make a standard Functor conform
is by indicating that it has no constraints. For instance, for []:
instance Functor [] where
fmap = map
(<$) = (Prelude.<$)
Monomorphic types can also conform, using GADT aliases. For instance,
if you create an alias for IntSet of kind * -> *:
data IntSet a where IntSet :: IntSet.IntSet-> IntSetInt
It can be made to conform to Functor like so:
instanceFunctorIntSet where typeSuitableIntSet a = a ~Intfmapf (IntSet xs) = IntSet (IntSet.mapf xs) x<$xs = ifnullxs thenemptyelsepurex
It can also be made conform to Foldable, etc. This type is provided in
Control.Monad.Constrained.IntSet.
Minimal complete definition
Associated Types
type Suitable f a :: Constraint Source #
Methods
fmap :: Suitable f b => (a -> b) -> f a -> f b Source #
Maps a function over a functor
(<$) :: Suitable f a => a -> f b -> f a infixl 4 Source #
Replace all values in the input with a default value.
Instances
| Functor [] Source # | |
| Functor Maybe Source # | |
| Functor IO Source # | |
| Functor Identity Source # | |
| Functor ZipList Source # | |
| Functor IntMap Source # | |
| Functor Tree Source # | |
| Functor Seq Source # | |
| Functor Set Source # | |
| Functor IntSet Source # | |
| Functor ((->) a) Source # | |
| Functor (Either e) Source # | |
| Functor ((,) a) Source # | |
| Functor (ST s) Source # | |
| Functor (Map a) Source # | |
| Functor m => Functor (MaybeT m) Source # | |
| Functor (Const * a) Source # | |
| Functor m => Functor (IdentityT * m) Source # | |
| Functor m => Functor (ExceptT e m) Source # | |
| Functor m => Functor (StateT s m) Source # | |
| Functor m => Functor (StateT s m) Source # | |
| Functor m => Functor (WriterT s m) Source # | |
| (Functor f, Functor g) => Functor (Sum * f g) Source # | |
| (Functor f, Functor g) => Functor (Product * f g) Source # | |
| Functor (ContT * r m) Source # | |
| Functor m => Functor (ReaderT * r m) Source # | |
| (Functor f, Functor g) => Functor (Compose * * f g) Source # | |
class (Applicative (Unconstrained f), Functor f) => Applicative f where Source #
A functor with application.
This class is slightly different (although equivalent) to the class provided in the Prelude. This is to facilitate the lifting of functions to arbitrary numbers of arguments.
A minimal complete definition must include implementations of reflect and
reify which convert to and from a law-abiding applicative, such that they
form an isomorphism. Alternatively, you can conform to the standard prelude
classes, and satisfy the following laws:
- identity
pureid<*>v = v- composition
pure(.)<*>u<*>v<*>w = u<*>(v<*>w)- homomorphism
puref<*>purex =pure(f x)- interchange
u
<*>purey =pure($y)<*>u
The other methods have the following default definitions, which may be overridden with equivalent specialized implementations:
As a consequence of these laws, the Functor instance for f will satisfy
If f is also a Monad, it should satisfy
(which implies that pure and <*> satisfy the applicative functor laws).
Associated Types
type Unconstrained f :: * -> * Source #
Methods
reflect :: f a -> Unconstrained f a Source #
reify :: Suitable f a => Unconstrained f a -> f a Source #
pure :: Suitable f a => a -> f a Source #
Lift a value.
(<*>) :: Suitable f b => f (a -> b) -> f a -> f b infixl 4 Source #
Sequential application.
(*>) :: Suitable f b => f a -> f b -> f b infixl 4 Source #
Sequence actions, discarding the value of the first argument.
(<*) :: Suitable f a => f a -> f b -> f a infixl 4 Source #
Sequence actions, discarding the value of the second argument.
liftA2 :: Suitable f c => (a -> b -> c) -> f a -> f b -> f c Source #
liftA3 :: Suitable f d => (a -> b -> c -> d) -> f a -> f b -> f c -> f d Source #
Instances
class Applicative f => Monad f where Source #
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 laws:
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 lists, Maybe and IO
defined in the "Prelude" satisfy these laws.
Minimal complete definition
Methods
(>>=) :: Suitable f b => f a -> (a -> f b) -> f b infixl 1 Source #
Sequentially compose two actions, passing any value produced by the first as an argument to the second.
Instances
| Monad [] Source # | |
| Monad Maybe Source # | |
| Monad IO Source # | |
| Monad Identity Source # | |
| Monad Tree Source # | |
| Monad Seq Source # | |
| Monad Set Source # | |
| Monad IntSet Source # | |
| Monad ((->) a) Source # | |
| Monad (Either a) Source # | |
| Monoid a => Monad ((,) a) Source # | |
| Monad (ST s) Source # | |
| (Monad m, Monad (Unconstrained m)) => Monad (MaybeT m) Source # | |
| Monad m => Monad (IdentityT * m) Source # | |
| (Monad m, Monad (Unconstrained m)) => Monad (ExceptT e m) Source # | |
| (Monad m, Monad (Unconstrained m)) => Monad (StateT s m) Source # | |
| (Monad m, Monad (Unconstrained m)) => Monad (StateT s m) Source # | |
| (Monad m, Monad (Unconstrained m)) => Monad (WriterT s m) Source # | |
| (Monad f, Monad g) => Monad (Product * f g) Source # | |
| Monad (ContT * r m) Source # | |
| Monad m => Monad (ReaderT * r m) Source # | |
class Applicative f => Alternative f where Source #
A monoid on applicative functors.
If defined, some and many should be the least solutions
of the equations:
Methods
empty :: Suitable f a => f a Source #
The identity of <|>
(<|>) :: Suitable f a => f a -> f a -> f a infixl 3 Source #
An associative binary operation
some :: Suitable f [a] => f a -> f [a] Source #
One or more.
many :: Suitable f [a] => f a -> f [a] Source #
Zero or more.
Instances
| Alternative [] Source # | |
| Alternative Maybe Source # | |
| Alternative IO Source # | |
| Alternative Seq Source # | |
| Alternative Set Source # | |
| Alternative IntSet Source # | |
| (Monad m, Monad (Unconstrained m)) => Alternative (MaybeT m) Source # | |
| (Monad m, Monoid e, Monad (Unconstrained m)) => Alternative (ExceptT e m) Source # | |
| (Monad m, Alternative m, Monad (Unconstrained m)) => Alternative (StateT s m) Source # | |
| (Monad m, Alternative m, Monad (Unconstrained m)) => Alternative (StateT s m) Source # | |
| (Alternative f, Alternative g) => Alternative (Product * f g) Source # | |
| Alternative m => Alternative (ReaderT * r m) Source # | |
| (Alternative f, Applicative g) => Alternative (Compose * * f g) Source # | |
class (Foldable t, Functor t) => Traversable t where Source #
Functors representing data structures that can be traversed from left to right.
A definition of traverse must satisfy the following laws:
- naturality
t .for every applicative transformationtraversef =traverse(t . f)t- identity
traverseIdentity = Identity- composition
traverse(Compose .fmapg . f) = Compose .fmap(traverseg) .traversef
A definition of sequenceA must satisfy the following laws:
- naturality
t .for every applicative transformationsequenceA=sequenceA.fmaptt- identity
sequenceA.fmapIdentity = Identity- composition
sequenceA.fmapCompose = Compose .fmapsequenceA.sequenceA
where an applicative transformation is a function
t :: (Applicative f, Applicative g) => f a -> g a
preserving the Applicative operations, i.e.
and the identity functor Identity and composition of functors Compose
are defined as
newtype Identity a = Identity a
instance Functor Identity where
fmap f (Identity x) = Identity (f x)
instance Applicative Identity where
pure x = Identity x
Identity f <*> Identity x = Identity (f x)
newtype Compose f g a = Compose (f (g a))
instance (Functor f, Functor g) => Functor (Compose f g) where
fmap f (Compose x) = Compose (fmap (fmap f) x)
instance (Applicative f, Applicative g) => Applicative (Compose f g) where
pure x = Compose (pure (pure x))
Compose f <*> Compose x = Compose ((<*>) <$> f <*> x)(The naturality law is implied by parametricity.)
Instances are similar to Functor, e.g. given a data type
data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a)
a suitable instance would be
instance Traversable Tree where traverse f Empty = pure Empty traverse f (Leaf x) = Leaf <$> f x traverse f (Node l k r) = Node <$> traverse f l <*> f k <*> traverse f r
This is suitable even for abstract types, as the laws for <*>
imply a form of associativity.
The superclass instances should satisfy the following:
Minimal complete definition
Methods
traverse :: (Suitable t b, Applicative f, Suitable f (t b), Suitable f b) => (a -> f b) -> t a -> f (t b) Source #
Map each element of a structure to an action, evaluate these actions
from left to right, and collect the results. For a version that ignores
the results see traverse_.
Instances
class Monad f => MonadFail f where Source #
See here for more details.
Minimal complete definition
Methods
fail :: Suitable f a => String -> f a Source #
Called when a pattern match fails in do-notation.
Instances
| MonadFail [] Source # | |
| MonadFail Maybe Source # | |
| MonadFail IO Source # | |
| MonadFail Seq Source # | |
| MonadFail Set Source # | |
| IsString a => MonadFail (Either a) Source # | |
| (Monad m, Monad (Unconstrained m)) => MonadFail (MaybeT m) Source # | |
| MonadFail m => MonadFail (IdentityT * m) Source # | |
| (Monad m, IsString e, Monad (Unconstrained m)) => MonadFail (ExceptT e m) Source # | |
| MonadFail m => MonadFail (ReaderT * r m) Source # | |
Unconstrained applicative stuff
ap :: (Monad f, Suitable f a) => (a -> f a) -> Ap f a -> f a Source #
A definition of reify that uses monadic operations. This is actually
the instance of applicative for codensity in disguise.
Useful functions
(<**>) :: (Applicative f, Suitable f b) => f a -> f (a -> b) -> f b infixl 4 Source #
A variant of <*> with the arguments reversed.
(<$>) :: (Functor f, Suitable f b) => (a -> b) -> f a -> f b infixl 4 Source #
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)
(=<<) :: (Monad f, Suitable f b) => (a -> f b) -> f a -> f b infixr 1 Source #
A flipped version of >>=
(>=>) :: (Monad f, Suitable f c) => (a -> f b) -> (b -> f c) -> a -> f c infixl 1 Source #
Left-to-right Kleisli composition of monads.
foldM :: (Foldable t, Monad m, Suitable m b) => (b -> a -> m b) -> b -> t a -> m b Source #
Monadic fold over the elements of a structure, associating to the left, i.e. from left to right.
traverse_ :: (Applicative f, Foldable t, Suitable f ()) => (a -> f b) -> t a -> f () Source #
Map each element of a structure to an action, evaluate these
actions from left to right, and ignore the results. For a version
that doesn't ignore the results see traverse.
sequenceA :: (Applicative f, Suitable t a, Suitable f (t a), Traversable t, Suitable f a) => t (f a) -> f (t a) Source #
Evaluate each action in the structure from left to right, and
and collect the results. For a version that ignores the results
see sequenceA_.
sequenceA_ :: (Foldable t, Applicative f, Suitable f ()) => t (f a) -> f () Source #
Evaluate each action in the structure from left to right, and
ignore the results. For a version that doesn't ignore the results
see sequenceA.
mapAccumL :: (Traversable t, Suitable t c) => (a -> b -> (a, c)) -> a -> t b -> (a, t c) Source #
replicateM :: (Applicative m, Suitable m [a]) => Int -> m a -> m [a] Source #
performs the action replicateM n actn times,
gathering the results.
void :: (Functor f, Suitable f ()) => f a -> f () Source #
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:
>>>traverse print [1,2]1 2 [(),()]>>>void $ traverse print [1,2]1 2
forever :: (Applicative f, Suitable f b) => f a -> f b Source #
repeats the action infinitely.forever act
Syntax
ifThenElse :: Bool -> a -> a -> a Source #
Function to which the if ... then ... else syntax desugars to