Safe Haskell | Safe |
---|---|
Language | Haskell2010 |
Synopsis
- class (Functor t, Foldable t) => Traversable (t :: * -> *) where
- for :: (Traversable t, Applicative f) => t a -> (a -> f b) -> f (t b)
- mapAccumL :: Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c)
- mapAccumR :: Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c)
- traverseBy :: Traversable t => (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> (a -> f b) -> t a -> f (t b)
- sequenceBy :: Traversable t => (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> t (f a) -> f (t a)
- class (Foldable1 t, Traversable t) => Traversable1 (t :: * -> *) where
- class (Bifunctor t, Bifoldable t) => Bitraversable (t :: * -> * -> *) where
- bisequence :: (Bitraversable t, Applicative f) => t (f a) (f b) -> f (t a b)
- bifor :: (Bitraversable t, Applicative f) => t a b -> (a -> f c) -> (b -> f d) -> f (t c d)
- bimapAccumL :: Bitraversable t => (a -> b -> (a, c)) -> (a -> d -> (a, e)) -> a -> t b d -> (a, t c e)
- bimapAccumR :: Bitraversable t => (a -> b -> (a, c)) -> (a -> d -> (a, e)) -> a -> t b d -> (a, t c e)
- class (Bifoldable1 t, Bitraversable t) => Bitraversable1 (t :: * -> * -> *) where
- fmapDefault :: Traversable t => (a -> b) -> t a -> t b
- foldMapDefault :: (Traversable t, Monoid m) => (a -> m) -> t a -> m
- bimapDefault :: Bitraversable t => (a -> b) -> (c -> d) -> t a c -> t b d
- bifoldMapDefault :: (Bitraversable t, Monoid m) => (a -> m) -> (b -> m) -> t a b -> m
- bifoldMap1Default :: (Bitraversable1 t, Semigroup m) => (a -> m) -> (b -> m) -> t a b -> m
Traversable
class (Functor t, Foldable t) => Traversable (t :: * -> *) where #
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 transformationtraverse
f =traverse
(t . f)t
- identity
traverse
Identity = Identity- composition
traverse
(Compose .fmap
g . f) = Compose .fmap
(traverse
g) .traverse
f
A definition of sequenceA
must satisfy the following laws:
- naturality
t .
for every applicative transformationsequenceA
=sequenceA
.fmap
tt
- identity
sequenceA
.fmap
Identity = Identity- composition
sequenceA
.fmap
Compose = Compose .fmap
sequenceA
.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:
- In the
Functor
instance,fmap
should be equivalent to traversal with the identity applicative functor (fmapDefault
). - In the
Foldable
instance,foldMap
should be equivalent to traversal with a constant applicative functor (foldMapDefault
).
traverse :: Applicative f => (a -> f b) -> t a -> f (t b) #
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_
.
sequenceA :: Applicative f => t (f a) -> f (t a) #
Evaluate each action in the structure from left to right, and
and collect the results. For a version that ignores the results
see sequenceA_
.
Instances
for :: (Traversable t, Applicative f) => t a -> (a -> f b) -> f (t b) #
mapAccumL :: Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c) #
mapAccumR :: Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c) #
traverseBy :: Traversable t => (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> (a -> f b) -> t a -> f (t b) #
Traverse a container using its Traversable
instance using
explicitly provided Applicative
operations. This is like traverse
where the Applicative
instance can be manually specified.
sequenceBy :: Traversable t => (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> t (f a) -> f (t a) #
Sequence a container using its Traversable
instance using
explicitly provided Applicative
operations. This is like sequence
where the Applicative
instance can be manually specified.
Traversable1
class (Foldable1 t, Traversable t) => Traversable1 (t :: * -> *) where #
Instances
Bitraversable
class (Bifunctor t, Bifoldable t) => Bitraversable (t :: * -> * -> *) where #
Bitraversable
identifies bifunctorial data structures whose elements can
be traversed in order, performing Applicative
or Monad
actions at each
element, and collecting a result structure with the same shape.
As opposed to Traversable
data structures, which have one variety of
element on which an action can be performed, Bitraversable
data structures
have two such varieties of elements.
A definition of bitraverse
must satisfy the following laws:
- naturality
for every applicative transformationbitraverse
(t . f) (t . g) ≡ t .bitraverse
f gt
- identity
bitraverse
Identity
Identity
≡Identity
- composition
Compose
.fmap
(bitraverse
g1 g2) .bitraverse
f1 f2 ≡traverse
(Compose
.fmap
g1 . f1) (Compose
.fmap
g2 . f2)
where an applicative transformation is a function
t :: (Applicative
f,Applicative
g) => f a -> g a
preserving the Applicative
operations:
t (pure
x) =pure
x t (f<*>
x) = t f<*>
t x
and the identity functor Identity
and composition functors Compose
are
defined as
newtype Identity a = Identity { runIdentity :: a } instance Functor Identity where fmap f (Identity x) = Identity (f x) instance Applicative Identity where pure = Identity 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 = Compose . pure . pure Compose f <*> Compose x = Compose ((<*>) <$> f <*> x)
Some simple examples are Either
and '(,)':
instance Bitraversable Either where bitraverse f _ (Left x) = Left <$> f x bitraverse _ g (Right y) = Right <$> g y instance Bitraversable (,) where bitraverse f g (x, y) = (,) <$> f x <*> g y
Bitraversable
relates to its superclasses in the following ways:
bimap
f g ≡runIdentity
.bitraverse
(Identity
. f) (Identity
. g)bifoldMap
f g =getConst
.bitraverse
(Const
. f) (Const
. g)
These are available as bimapDefault
and bifoldMapDefault
respectively.
Since: base-4.10.0.0
bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> t a b -> f (t c d) #
Evaluates the relevant functions at each element in the structure, running the action, and builds a new structure with the same shape, using the results produced from sequencing the actions.
bitraverse
f g ≡bisequenceA
.bimap
f g
For a version that ignores the results, see bitraverse_
.
Since: base-4.10.0.0
Instances
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) # | |
Bitraversable (,) | Since: base-4.10.0.0 |
Defined in Data.Bitraversable bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> (a, b) -> f (c, d) # | |
Bitraversable Arg | Since: base-4.10.0.0 |
Defined in Data.Semigroup bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> Arg a b -> f (Arg c d) # | |
Bitraversable ((,,) x) | Since: base-4.10.0.0 |
Defined in Data.Bitraversable bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> (x, a, b) -> f (x, c, d) # | |
Bitraversable (Const :: * -> * -> *) | Since: base-4.10.0.0 |
Defined in Data.Bitraversable bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> Const a b -> f (Const c d) # | |
Traversable f => Bitraversable (FreeF f) | |
Defined in Control.Monad.Trans.Free bitraverse :: Applicative f0 => (a -> f0 c) -> (b -> f0 d) -> FreeF f a b -> f0 (FreeF f c d) # | |
Traversable f => Bitraversable (CofreeF f) | |
Defined in Control.Comonad.Trans.Cofree bitraverse :: Applicative f0 => (a -> f0 c) -> (b -> f0 d) -> CofreeF f a b -> f0 (CofreeF f c d) # | |
Bitraversable (Tagged :: * -> * -> *) | |
Defined in Data.Tagged bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> Tagged a b -> f (Tagged c d) # | |
Bitraversable (K1 i :: * -> * -> *) | Since: base-4.10.0.0 |
Defined in Data.Bitraversable bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> K1 i a b -> f (K1 i c d) # | |
Bitraversable ((,,,) x y) | Since: base-4.10.0.0 |
Defined in Data.Bitraversable bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> (x, y, a, b) -> f (x, y, c, d) # | |
Bitraversable ((,,,,) x y z) | Since: base-4.10.0.0 |
Defined in Data.Bitraversable bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> (x, y, z, a, b) -> f (x, y, z, c, d) # | |
Bitraversable p => Bitraversable (WrappedBifunctor p) | |
Defined in Data.Bifunctor.Wrapped bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> WrappedBifunctor p a b -> f (WrappedBifunctor p c d) # | |
Traversable g => Bitraversable (Joker g :: * -> * -> *) | |
Defined in Data.Bifunctor.Joker bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> Joker g a b -> f (Joker g c d) # | |
Bitraversable p => Bitraversable (Flip p) | |
Defined in Data.Bifunctor.Flip bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> Flip p a b -> f (Flip p c d) # | |
Traversable f => Bitraversable (Clown f :: * -> * -> *) | |
Defined in Data.Bifunctor.Clown bitraverse :: Applicative f0 => (a -> f0 c) -> (b -> f0 d) -> Clown f a b -> f0 (Clown f c d) # | |
Bitraversable ((,,,,,) x y z w) | Since: base-4.10.0.0 |
Defined in Data.Bitraversable bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> (x, y, z, w, a, b) -> f (x, y, z, w, c, d) # | |
(Bitraversable p, Bitraversable q) => Bitraversable (Sum p q) | |
Defined in Data.Bifunctor.Sum bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> Sum p q a b -> f (Sum p q c d) # | |
(Bitraversable f, Bitraversable g) => Bitraversable (Product f g) | |
Defined in Data.Bifunctor.Product bitraverse :: Applicative f0 => (a -> f0 c) -> (b -> f0 d) -> Product f g a b -> f0 (Product f g c d) # | |
Bitraversable ((,,,,,,) x y z w v) | Since: base-4.10.0.0 |
Defined in Data.Bitraversable bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> (x, y, z, w, v, a, b) -> f (x, y, z, w, v, c, d) # | |
(Traversable f, Bitraversable p) => Bitraversable (Tannen f p) | |
Defined in Data.Bifunctor.Tannen bitraverse :: Applicative f0 => (a -> f0 c) -> (b -> f0 d) -> Tannen f p a b -> f0 (Tannen f p c d) # | |
(Bitraversable p, Traversable f, Traversable g) => Bitraversable (Biff p f g) | |
Defined in Data.Bifunctor.Biff bitraverse :: Applicative f0 => (a -> f0 c) -> (b -> f0 d) -> Biff p f g a b -> f0 (Biff p f g c d) # |
bisequence :: (Bitraversable t, Applicative f) => t (f a) (f b) -> f (t a b) #
Sequences all the actions in a structure, building a new structure with
the same shape using the results of the actions. For a version that ignores
the results, see bisequence_
.
bisequence
≡bitraverse
id
id
Since: base-4.10.0.0
bifor :: (Bitraversable t, Applicative f) => t a b -> (a -> f c) -> (b -> f d) -> f (t c d) #
bifor
is bitraverse
with the structure as the first argument. For a
version that ignores the results, see bifor_
.
Since: base-4.10.0.0
bimapAccumL :: Bitraversable t => (a -> b -> (a, c)) -> (a -> d -> (a, e)) -> a -> t b d -> (a, t c e) #
The bimapAccumL
function behaves like a combination of bimap
and
bifoldl
; it traverses a structure from left to right, threading a state
of type a
and using the given actions to compute new elements for the
structure.
Since: base-4.10.0.0
bimapAccumR :: Bitraversable t => (a -> b -> (a, c)) -> (a -> d -> (a, e)) -> a -> t b d -> (a, t c e) #
The bimapAccumR
function behaves like a combination of bimap
and
bifoldl
; it traverses a structure from right to left, threading a state
of type a
and using the given actions to compute new elements for the
structure.
Since: base-4.10.0.0
Bitraversable1
class (Bifoldable1 t, Bitraversable t) => Bitraversable1 (t :: * -> * -> *) where #
bitraverse1 :: Apply f => (a -> f b) -> (c -> f d) -> t a c -> f (t b d) #
bisequence1 :: Apply f => t (f a) (f b) -> f (t a b) #
Instances
Bitraversable1 Either | |
Defined in Data.Semigroup.Traversable.Class bitraverse1 :: Apply f => (a -> f b) -> (c -> f d) -> Either a c -> f (Either b d) # bisequence1 :: Apply f => Either (f a) (f b) -> f (Either a b) # | |
Bitraversable1 (,) | |
Defined in Data.Semigroup.Traversable.Class bitraverse1 :: Apply f => (a -> f b) -> (c -> f d) -> (a, c) -> f (b, d) # bisequence1 :: Apply f => (f a, f b) -> f (a, b) # | |
Bitraversable1 Arg | |
Defined in Data.Semigroup.Traversable.Class bitraverse1 :: Apply f => (a -> f b) -> (c -> f d) -> Arg a c -> f (Arg b d) # bisequence1 :: Apply f => Arg (f a) (f b) -> f (Arg a b) # | |
Bitraversable1 ((,,) x) | |
Defined in Data.Semigroup.Traversable.Class bitraverse1 :: Apply f => (a -> f b) -> (c -> f d) -> (x, a, c) -> f (x, b, d) # bisequence1 :: Apply f => (x, f a, f b) -> f (x, a, b) # | |
Bitraversable1 (Const :: * -> * -> *) | |
Defined in Data.Semigroup.Traversable.Class bitraverse1 :: Apply f => (a -> f b) -> (c -> f d) -> Const a c -> f (Const b d) # bisequence1 :: Apply f => Const (f a) (f b) -> f (Const a b) # | |
Bitraversable1 (Tagged :: * -> * -> *) | |
Defined in Data.Semigroup.Traversable.Class bitraverse1 :: Apply f => (a -> f b) -> (c -> f d) -> Tagged a c -> f (Tagged b d) # bisequence1 :: Apply f => Tagged (f a) (f b) -> f (Tagged a b) # | |
Bitraversable1 ((,,,) x y) | |
Defined in Data.Semigroup.Traversable.Class bitraverse1 :: Apply f => (a -> f b) -> (c -> f d) -> (x, y, a, c) -> f (x, y, b, d) # bisequence1 :: Apply f => (x, y, f a, f b) -> f (x, y, a, b) # | |
Bitraversable1 ((,,,,) x y z) | |
Defined in Data.Semigroup.Traversable.Class bitraverse1 :: Apply f => (a -> f b) -> (c -> f d) -> (x, y, z, a, c) -> f (x, y, z, b, d) # bisequence1 :: Apply f => (x, y, z, f a, f b) -> f (x, y, z, a, b) # | |
Bitraversable1 p => Bitraversable1 (WrappedBifunctor p) | |
Defined in Data.Semigroup.Traversable.Class bitraverse1 :: Apply f => (a -> f b) -> (c -> f d) -> WrappedBifunctor p a c -> f (WrappedBifunctor p b d) # bisequence1 :: Apply f => WrappedBifunctor p (f a) (f b) -> f (WrappedBifunctor p a b) # | |
Traversable1 g => Bitraversable1 (Joker g :: * -> * -> *) | |
Defined in Data.Semigroup.Traversable.Class bitraverse1 :: Apply f => (a -> f b) -> (c -> f d) -> Joker g a c -> f (Joker g b d) # bisequence1 :: Apply f => Joker g (f a) (f b) -> f (Joker g a b) # | |
Bitraversable1 p => Bitraversable1 (Flip p) | |
Defined in Data.Semigroup.Traversable.Class bitraverse1 :: Apply f => (a -> f b) -> (c -> f d) -> Flip p a c -> f (Flip p b d) # bisequence1 :: Apply f => Flip p (f a) (f b) -> f (Flip p a b) # | |
Traversable1 f => Bitraversable1 (Clown f :: * -> * -> *) | |
Defined in Data.Semigroup.Traversable.Class bitraverse1 :: Apply f0 => (a -> f0 b) -> (c -> f0 d) -> Clown f a c -> f0 (Clown f b d) # bisequence1 :: Apply f0 => Clown f (f0 a) (f0 b) -> f0 (Clown f a b) # | |
(Bitraversable1 f, Bitraversable1 g) => Bitraversable1 (Product f g) | |
Defined in Data.Semigroup.Traversable.Class bitraverse1 :: Apply f0 => (a -> f0 b) -> (c -> f0 d) -> Product f g a c -> f0 (Product f g b d) # bisequence1 :: Apply f0 => Product f g (f0 a) (f0 b) -> f0 (Product f g a b) # | |
(Traversable1 f, Bitraversable1 p) => Bitraversable1 (Tannen f p) | |
Defined in Data.Semigroup.Traversable.Class bitraverse1 :: Apply f0 => (a -> f0 b) -> (c -> f0 d) -> Tannen f p a c -> f0 (Tannen f p b d) # bisequence1 :: Apply f0 => Tannen f p (f0 a) (f0 b) -> f0 (Tannen f p a b) # | |
(Bitraversable1 p, Traversable1 f, Traversable1 g) => Bitraversable1 (Biff p f g) | |
Defined in Data.Semigroup.Traversable.Class bitraverse1 :: Apply f0 => (a -> f0 b) -> (c -> f0 d) -> Biff p f g a c -> f0 (Biff p f g b d) # bisequence1 :: Apply f0 => Biff p f g (f0 a) (f0 b) -> f0 (Biff p f g a b) # |
Default implementations
fmapDefault :: Traversable t => (a -> b) -> t a -> t b #
This function may be used as a value for fmap
in a Functor
instance, provided that traverse
is defined. (Using
fmapDefault
with a Traversable
instance defined only by
sequenceA
will result in infinite recursion.)
fmapDefault
f ≡runIdentity
.traverse
(Identity
. f)
foldMapDefault :: (Traversable t, Monoid m) => (a -> m) -> t a -> m #
bimapDefault :: Bitraversable t => (a -> b) -> (c -> d) -> t a c -> t b d #
A default definition of bimap
in terms of the Bitraversable
operations.
bimapDefault
f g ≡runIdentity
.bitraverse
(Identity
. f) (Identity
. g)
Since: base-4.10.0.0
bifoldMapDefault :: (Bitraversable t, Monoid m) => (a -> m) -> (b -> m) -> t a b -> m #
A default definition of bifoldMap
in terms of the Bitraversable
operations.
bifoldMapDefault
f g ≡getConst
.bitraverse
(Const
. f) (Const
. g)
Since: base-4.10.0.0
bifoldMap1Default :: (Bitraversable1 t, Semigroup m) => (a -> m) -> (b -> m) -> t a b -> m #