Copyright | (C) 2012-16 Edward Kmett |
---|---|
License | BSD-style (see the file LICENSE) |
Maintainer | Edward Kmett <ekmett@gmail.com> |
Stability | provisional |
Portability | Rank2Types |
Safe Haskell | Trustworthy |
Language | Haskell2010 |
A
is a generalization of Traversal
s t a btraverse
from
Traversable
. It allows you to traverse
over a structure and change out
its contents with monadic or Applicative
side-effects. Starting from
traverse
:: (Traversable
t,Applicative
f) => (a -> f b) -> t a -> f (t b)
we monomorphize the contents and result to obtain
typeTraversal
s t a b = forall f.Applicative
f => (a -> f b) -> s -> f t
A Traversal
can be used as a Fold
.
Any Traversal
can be used for Getting
like a Fold
,
because given a Monoid
m
, we have an Applicative
for
(
. Everything you know how to do with a Const
m)Traversable
container,
you can with a Traversal
, and here we provide combinators that generalize
the usual Traversable
operations.
Synopsis
- type Traversal s t a b = forall (f :: Type -> Type). Applicative f => (a -> f b) -> s -> f t
- type Traversal' s a = Traversal s s a a
- type Traversal1 s t a b = forall (f :: Type -> Type). Apply f => (a -> f b) -> s -> f t
- type Traversal1' s a = Traversal1 s s a a
- type IndexedTraversal i s t a b = forall (p :: Type -> Type -> Type) (f :: Type -> Type). (Indexable i p, Applicative f) => p a (f b) -> s -> f t
- type IndexedTraversal' i s a = IndexedTraversal i s s a a
- type IndexedTraversal1 i s t a b = forall (p :: Type -> Type -> Type) (f :: Type -> Type). (Indexable i p, Apply f) => p a (f b) -> s -> f t
- type IndexedTraversal1' i s a = IndexedTraversal1 i s s a a
- type ATraversal s t a b = LensLike (Bazaar (->) a b) s t a b
- type ATraversal' s a = ATraversal s s a a
- type ATraversal1 s t a b = LensLike (Bazaar1 (->) a b) s t a b
- type ATraversal1' s a = ATraversal1 s s a a
- type AnIndexedTraversal i s t a b = Over (Indexed i) (Bazaar (Indexed i) a b) s t a b
- type AnIndexedTraversal' i s a = AnIndexedTraversal i s s a a
- type AnIndexedTraversal1 i s t a b = Over (Indexed i) (Bazaar1 (Indexed i) a b) s t a b
- type AnIndexedTraversal1' i s a = AnIndexedTraversal1 i s s a a
- type Traversing (p :: Type -> Type -> Type) (f :: Type -> Type) s t a b = Over p (BazaarT p f a b) s t a b
- type Traversing' (p :: Type -> Type -> Type) (f :: Type -> Type) s a = Traversing p f s s a a
- type Traversing1 (p :: Type -> Type -> Type) (f :: Type -> Type) s t a b = Over p (BazaarT1 p f a b) s t a b
- type Traversing1' (p :: Type -> Type -> Type) (f :: Type -> Type) s a = Traversing1 p f s s a a
- traversal :: ((a -> f b) -> s -> f t) -> LensLike f s t a b
- traverseOf :: LensLike f s t a b -> (a -> f b) -> s -> f t
- forOf :: LensLike f s t a b -> s -> (a -> f b) -> f t
- sequenceAOf :: LensLike f s t (f b) b -> s -> f t
- mapMOf :: LensLike (WrappedMonad m) s t a b -> (a -> m b) -> s -> m t
- forMOf :: LensLike (WrappedMonad m) s t a b -> s -> (a -> m b) -> m t
- sequenceOf :: LensLike (WrappedMonad m) s t (m b) b -> s -> m t
- transposeOf :: LensLike ZipList s t [a] a -> s -> [t]
- mapAccumLOf :: LensLike (State acc) s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
- mapAccumROf :: LensLike (Backwards (State acc)) s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
- scanr1Of :: LensLike (Backwards (State (Maybe a))) s t a a -> (a -> a -> a) -> s -> t
- scanl1Of :: LensLike (State (Maybe a)) s t a a -> (a -> a -> a) -> s -> t
- failover :: Alternative m => LensLike ((,) Any) s t a b -> (a -> b) -> s -> m t
- ifailover :: Alternative m => Over (Indexed i) ((,) Any) s t a b -> (i -> a -> b) -> s -> m t
- cloneTraversal :: ATraversal s t a b -> Traversal s t a b
- cloneIndexPreservingTraversal :: ATraversal s t a b -> IndexPreservingTraversal s t a b
- cloneIndexedTraversal :: AnIndexedTraversal i s t a b -> IndexedTraversal i s t a b
- cloneTraversal1 :: ATraversal1 s t a b -> Traversal1 s t a b
- cloneIndexPreservingTraversal1 :: ATraversal1 s t a b -> IndexPreservingTraversal1 s t a b
- cloneIndexedTraversal1 :: AnIndexedTraversal1 i s t a b -> IndexedTraversal1 i s t a b
- partsOf :: Functor f => Traversing (->) f s t a a -> LensLike f s t [a] [a]
- partsOf' :: ATraversal s t a a -> Lens s t [a] [a]
- unsafePartsOf :: Functor f => Traversing (->) f s t a b -> LensLike f s t [a] [b]
- unsafePartsOf' :: ATraversal s t a b -> Lens s t [a] [b]
- holesOf :: Conjoined p => Over p (Bazaar p a a) s t a a -> s -> [Pretext p a a t]
- holes1Of :: Conjoined p => Over p (Bazaar1 p a a) s t a a -> s -> NonEmpty (Pretext p a a t)
- singular :: (HasCallStack, Conjoined p, Functor f) => Traversing p f s t a a -> Over p f s t a a
- unsafeSingular :: (HasCallStack, Conjoined p, Functor f) => Traversing p f s t a b -> Over p f s t a b
- class (Functor t, Foldable t) => Traversable (t :: Type -> Type) where
- traverse :: Applicative f => (a -> f b) -> t a -> f (t b)
- class (Foldable1 t, Traversable t) => Traversable1 (t :: Type -> Type) where
- both :: forall (r :: Type -> Type -> Type) a b. Bitraversable r => Traversal (r a a) (r b b) a b
- both1 :: forall (r :: Type -> Type -> Type) a b. Bitraversable1 r => Traversal1 (r a a) (r b b) a b
- beside :: (Representable q, Applicative (Rep q), Applicative f, Bitraversable r) => Optical p q f s t a b -> Optical p q f s' t' a b -> Optical p q f (r s s') (r t t') a b
- taking :: (Conjoined p, Applicative f) => Int -> Traversing p f s t a a -> Over p f s t a a
- dropping :: (Conjoined p, Applicative f) => Int -> Over p (Indexing f) s t a a -> Over p f s t a a
- failing :: (Conjoined p, Applicative f) => Traversing p f s t a b -> Over p f s t a b -> Over p f s t a b
- deepOf :: (Conjoined p, Applicative f) => LensLike f s t s t -> Traversing p f s t a b -> Over p f s t a b
- ignored :: Applicative f => pafb -> s -> f s
- class Ord k => TraverseMin k (m :: Type -> Type) | m -> k where
- traverseMin :: IndexedTraversal' k (m v) v
- class Ord k => TraverseMax k (m :: Type -> Type) | m -> k where
- traverseMax :: IndexedTraversal' k (m v) v
- traversed :: forall (f :: Type -> Type) a b. Traversable f => IndexedTraversal Int (f a) (f b) a b
- traversed1 :: forall (f :: Type -> Type) a b. Traversable1 f => IndexedTraversal1 Int (f a) (f b) a b
- traversed64 :: forall (f :: Type -> Type) a b. Traversable f => IndexedTraversal Int64 (f a) (f b) a b
- elementOf :: forall (f :: Type -> Type) s t a. Applicative f => LensLike (Indexing f) s t a a -> Int -> IndexedLensLike Int f s t a a
- element :: forall (t :: Type -> Type) a. Traversable t => Int -> IndexedTraversal' Int (t a) a
- elementsOf :: forall (f :: Type -> Type) s t a. Applicative f => LensLike (Indexing f) s t a a -> (Int -> Bool) -> IndexedLensLike Int f s t a a
- elements :: forall (t :: Type -> Type) a. Traversable t => (Int -> Bool) -> IndexedTraversal' Int (t a) a
- ipartsOf :: (Indexable [i] p, Functor f) => Traversing (Indexed i) f s t a a -> Over p f s t [a] [a]
- ipartsOf' :: forall i p f s t a. (Indexable [i] p, Functor f) => Over (Indexed i) (Bazaar' (Indexed i) a) s t a a -> Over p f s t [a] [a]
- iunsafePartsOf :: (Indexable [i] p, Functor f) => Traversing (Indexed i) f s t a b -> Over p f s t [a] [b]
- iunsafePartsOf' :: forall i s t a b. Over (Indexed i) (Bazaar (Indexed i) a b) s t a b -> IndexedLens [i] s t [a] [b]
- itraverseOf :: (Indexed i a (f b) -> s -> f t) -> (i -> a -> f b) -> s -> f t
- iforOf :: (Indexed i a (f b) -> s -> f t) -> s -> (i -> a -> f b) -> f t
- imapMOf :: Over (Indexed i) (WrappedMonad m) s t a b -> (i -> a -> m b) -> s -> m t
- iforMOf :: (Indexed i a (WrappedMonad m b) -> s -> WrappedMonad m t) -> s -> (i -> a -> m b) -> m t
- imapAccumROf :: Over (Indexed i) (Backwards (State acc)) s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
- imapAccumLOf :: Over (Indexed i) (State acc) s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
- 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)
- traverseByOf :: Traversal s t a b -> (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> (a -> f b) -> s -> f t
- sequenceBy :: Traversable t => (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> t (f a) -> f (t a)
- sequenceByOf :: Traversal s t (f b) b -> (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> s -> f t
- newtype Bazaar (p :: Type -> Type -> Type) a b t = Bazaar {
- runBazaar :: forall (f :: Type -> Type). Applicative f => p a (f b) -> f t
- type Bazaar' (p :: Type -> Type -> Type) a = Bazaar p a a
- newtype Bazaar1 (p :: Type -> Type -> Type) a b t = Bazaar1 {
- runBazaar1 :: forall (f :: Type -> Type). Apply f => p a (f b) -> f t
- type Bazaar1' (p :: Type -> Type -> Type) a = Bazaar1 p a a
- loci :: forall a c s b f. Applicative f => (a -> f b) -> Bazaar (->) a c s -> f (Bazaar (->) b c s)
- iloci :: forall i a c s b p f. (Indexable i p, Applicative f) => p a (f b) -> Bazaar (Indexed i) a c s -> f (Bazaar (Indexed i) b c s)
- confusing :: Applicative f => LensLike (Curried (Yoneda f) (Yoneda f)) s t a b -> LensLike f s t a b
Traversals
type Traversal s t a b = forall (f :: Type -> Type). Applicative f => (a -> f b) -> s -> f t Source #
A Traversal
can be used directly as a Setter
or a Fold
(but not as a Lens
) and provides
the ability to both read and update multiple fields, subject to some relatively weak Traversal
laws.
These have also been known as multilenses, but they have the signature and spirit of
traverse
::Traversable
f =>Traversal
(f a) (f b) a b
and the more evocative name suggests their application.
Most of the time the Traversal
you will want to use is just traverse
, but you can also pass any
Lens
or Iso
as a Traversal
, and composition of a Traversal
(or Lens
or Iso
) with a Traversal
(or Lens
or Iso
)
using (.
) forms a valid Traversal
.
The laws for a Traversal
t
follow from the laws for Traversable
as stated in "The Essence of the Iterator Pattern".
tpure
≡pure
fmap
(t f).
t g ≡getCompose
.
t (Compose
.
fmap
f.
g)
One consequence of this requirement is that a Traversal
needs to leave the same number of elements as a
candidate for subsequent Traversal
that it started with. Another testament to the strength of these laws
is that the caveat expressed in section 5.5 of the "Essence of the Iterator Pattern" about exotic
Traversable
instances that traverse
the same entry multiple times was actually already ruled out by the
second law in that same paper!
type Traversal' s a = Traversal s s a a Source #
typeTraversal'
=Simple
Traversal
type Traversal1 s t a b = forall (f :: Type -> Type). Apply f => (a -> f b) -> s -> f t Source #
A Traversal
which targets at least one element.
Note that since Apply
is not a superclass of Applicative
, a Traversal1
cannot always be used in place of a Traversal
. In such circumstances
cloneTraversal
will convert a Traversal1
into a Traversal
.
type Traversal1' s a = Traversal1 s s a a Source #
type IndexedTraversal i s t a b = forall (p :: Type -> Type -> Type) (f :: Type -> Type). (Indexable i p, Applicative f) => p a (f b) -> s -> f t Source #
Every IndexedTraversal
is a valid Traversal
or
IndexedFold
.
The Indexed
constraint is used to allow an IndexedTraversal
to be used
directly as a Traversal
.
The Traversal
laws are still required to hold.
In addition, the index i
should satisfy the requirement that it stays
unchanged even when modifying the value a
, otherwise traversals like
indices
break the Traversal
laws.
type IndexedTraversal' i s a = IndexedTraversal i s s a a Source #
typeIndexedTraversal'
i =Simple
(IndexedTraversal
i)
type IndexedTraversal1 i s t a b = forall (p :: Type -> Type -> Type) (f :: Type -> Type). (Indexable i p, Apply f) => p a (f b) -> s -> f t Source #
type IndexedTraversal1' i s a = IndexedTraversal1 i s s a a Source #
type ATraversal s t a b = LensLike (Bazaar (->) a b) s t a b Source #
When you see this as an argument to a function, it expects a Traversal
.
type ATraversal' s a = ATraversal s s a a Source #
typeATraversal'
=Simple
ATraversal
type ATraversal1 s t a b = LensLike (Bazaar1 (->) a b) s t a b Source #
When you see this as an argument to a function, it expects a Traversal1
.
type ATraversal1' s a = ATraversal1 s s a a Source #
typeATraversal1'
=Simple
ATraversal1
type AnIndexedTraversal i s t a b = Over (Indexed i) (Bazaar (Indexed i) a b) s t a b Source #
When you see this as an argument to a function, it expects an IndexedTraversal
.
type AnIndexedTraversal' i s a = AnIndexedTraversal i s s a a Source #
typeAnIndexedTraversal'
=Simple
(AnIndexedTraversal
i)
type AnIndexedTraversal1 i s t a b = Over (Indexed i) (Bazaar1 (Indexed i) a b) s t a b Source #
When you see this as an argument to a function, it expects an IndexedTraversal1
.
type AnIndexedTraversal1' i s a = AnIndexedTraversal1 i s s a a Source #
typeAnIndexedTraversal1'
=Simple
(AnIndexedTraversal1
i)
type Traversing (p :: Type -> Type -> Type) (f :: Type -> Type) s t a b = Over p (BazaarT p f a b) s t a b Source #
When you see this as an argument to a function, it expects
- to be indexed if
p
is an instance ofIndexed
i, - to be unindexed if
p
is(->)
, - a
Traversal
iff
isApplicative
, - a
Getter
iff
is only aFunctor
andContravariant
, - a
Lens
iff
is only aFunctor
, - a
Fold
iff
isApplicative
andContravariant
.
type Traversing' (p :: Type -> Type -> Type) (f :: Type -> Type) s a = Traversing p f s s a a Source #
typeTraversing'
f =Simple
(Traversing
f)
type Traversing1 (p :: Type -> Type -> Type) (f :: Type -> Type) s t a b = Over p (BazaarT1 p f a b) s t a b Source #
type Traversing1' (p :: Type -> Type -> Type) (f :: Type -> Type) s a = Traversing1 p f s s a a Source #
Traversing and Lensing
traversal :: ((a -> f b) -> s -> f t) -> LensLike f s t a b Source #
Build a Traversal
by providing a function which specifies the elements you wish to
focus.
The caller provides a function of type:
Applicative f => (a -> f b) -> s -> f t
Which is a higher order function which accepts a "focusing function" and applies
it to all desired focuses within s
, then constructs a t
using the Applicative
instance of f
.
Only elements which are "focused" using the focusing function will be targeted by the resulting traversal.
For example, we can explicitly write a traversal which targets the first and third elements of a tuple like this:
firstAndThird :: Traversal (a, x, a) (b, x, b) a b firstAndThird = traversal go where go :: Applicative f => (a -> f b) -> (a, x, a) -> f (b, x, b) go focus (a, x, a') = liftA3 (,,) (focus a) (pure x) (focus a')
>>>
(1,"two",3) & firstAndThird *~ 10
(10,"two",30)
>>>
over firstAndThird length ("one",2,"three")
(3,2,5)
We can re-use existing Traversal
s when writing new ones by passing our focusing function
along to them. This example re-uses traverse
to focus all elements in a list which is
embedded in a tuple. This traversal could also be written simply as _2 . traverse
.
selectNested :: Traversal (x, [a]) (x, [b]) a b selectNested = traversal go where go :: Applicative f => (a -> f b) -> (x, [a]) -> f (x, [b]) go focus (x, as) = liftA2 (,) (pure x) (traverse focus as)
>>>
selectNested .~ "hello" $ (1,[2,3,4,5])
(1,["hello","hello","hello","hello"])
>>>
(1,[2,3,4,5]) & selectNested *~ 3
(1,[6,9,12,15])
Note that the traversal
function actually just returns the same function you pass to
it. The function it accepts is in fact a valid traversal all on its own! The use of
traversal
does nothing except verify that the function it is passed matches the signature
of a valid traversal. One could remove the traversal
combinator from either of the last
two examples and use the definition of go
directly with no change in behaviour.
This function exists for consistency with the lens
, prism
and iso
constructors
as well as to serve as a touchpoint for beginners who wish to construct their own
traversals but are uncertain how to do so.
traverseOf :: LensLike f s t a b -> (a -> f b) -> s -> f t Source #
Map each element of a structure targeted by a Lens
or Traversal
,
evaluate these actions from left to right, and collect the results.
This function is only provided for consistency, id
is strictly more general.
>>>
traverseOf each print (1,2,3)
1 2 3 ((),(),())
traverseOf
≡id
itraverseOf
l ≡traverseOf
l.
Indexed
itraverseOf
itraversed
≡itraverse
This yields the obvious law:
traverse
≡traverseOf
traverse
traverseOf
::Functor
f =>Iso
s t a b -> (a -> f b) -> s -> f ttraverseOf
::Functor
f =>Lens
s t a b -> (a -> f b) -> s -> f ttraverseOf
::Apply
f =>Traversal1
s t a b -> (a -> f b) -> s -> f ttraverseOf
::Applicative
f =>Traversal
s t a b -> (a -> f b) -> s -> f t
forOf :: LensLike f s t a b -> s -> (a -> f b) -> f t Source #
A version of traverseOf
with the arguments flipped, such that:
>>>
forOf each (1,2,3) print
1 2 3 ((),(),())
This function is only provided for consistency, flip
is strictly more general.
forOf
≡flip
forOf
≡flip
.traverseOf
for
≡forOf
traverse
ifor
l s ≡for
l s.
Indexed
forOf
::Functor
f =>Iso
s t a b -> s -> (a -> f b) -> f tforOf
::Functor
f =>Lens
s t a b -> s -> (a -> f b) -> f tforOf
::Applicative
f =>Traversal
s t a b -> s -> (a -> f b) -> f t
sequenceAOf :: LensLike f s t (f b) b -> s -> f t Source #
Evaluate each action in the structure from left to right, and collect the results.
>>>
sequenceAOf both ([1,2],[3,4])
[(1,3),(1,4),(2,3),(2,4)]
sequenceA
≡sequenceAOf
traverse
≡traverse
id
sequenceAOf
l ≡traverseOf
lid
≡ lid
sequenceAOf
::Functor
f =>Iso
s t (f b) b -> s -> f tsequenceAOf
::Functor
f =>Lens
s t (f b) b -> s -> f tsequenceAOf
::Applicative
f =>Traversal
s t (f b) b -> s -> f t
mapMOf :: LensLike (WrappedMonad m) s t a b -> (a -> m b) -> s -> m t Source #
Map each element of a structure targeted by a Lens
to a monadic action,
evaluate these actions from left to right, and collect the results.
>>>
mapMOf both (\x -> [x, x + 1]) (1,3)
[(1,3),(1,4),(2,3),(2,4)]
mapM
≡mapMOf
traverse
imapMOf
l ≡forM
l.
Indexed
mapMOf
::Monad
m =>Iso
s t a b -> (a -> m b) -> s -> m tmapMOf
::Monad
m =>Lens
s t a b -> (a -> m b) -> s -> m tmapMOf
::Monad
m =>Traversal
s t a b -> (a -> m b) -> s -> m t
forMOf :: LensLike (WrappedMonad m) s t a b -> s -> (a -> m b) -> m t Source #
forMOf
is a flipped version of mapMOf
, consistent with the definition of forM
.
>>>
forMOf both (1,3) $ \x -> [x, x + 1]
[(1,3),(1,4),(2,3),(2,4)]
forM
≡forMOf
traverse
forMOf
l ≡flip
(mapMOf
l)iforMOf
l s ≡forM
l s.
Indexed
forMOf
::Monad
m =>Iso
s t a b -> s -> (a -> m b) -> m tforMOf
::Monad
m =>Lens
s t a b -> s -> (a -> m b) -> m tforMOf
::Monad
m =>Traversal
s t a b -> s -> (a -> m b) -> m t
sequenceOf :: LensLike (WrappedMonad m) s t (m b) b -> s -> m t Source #
Sequence the (monadic) effects targeted by a Lens
in a container from left to right.
>>>
sequenceOf each ([1,2],[3,4],[5,6])
[(1,3,5),(1,3,6),(1,4,5),(1,4,6),(2,3,5),(2,3,6),(2,4,5),(2,4,6)]
sequence
≡sequenceOf
traverse
sequenceOf
l ≡mapMOf
lid
sequenceOf
l ≡unwrapMonad
.
lWrapMonad
sequenceOf
::Monad
m =>Iso
s t (m b) b -> s -> m tsequenceOf
::Monad
m =>Lens
s t (m b) b -> s -> m tsequenceOf
::Monad
m =>Traversal
s t (m b) b -> s -> m t
transposeOf :: LensLike ZipList s t [a] a -> s -> [t] Source #
This generalizes transpose
to an arbitrary Traversal
.
Note: transpose
handles ragged inputs more intelligently, but for non-ragged inputs:
>>>
transposeOf traverse [[1,2,3],[4,5,6]]
[[1,4],[2,5],[3,6]]
transpose
≡transposeOf
traverse
Since every Lens
is a Traversal
, we can use this as a form of
monadic strength as well:
transposeOf
_2
:: (b, [a]) -> [(b, a)]
mapAccumLOf :: LensLike (State acc) s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t) Source #
This generalizes mapAccumL
to an arbitrary Traversal
.
mapAccumL
≡mapAccumLOf
traverse
mapAccumLOf
accumulates State
from left to right.
mapAccumLOf
::Iso
s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)mapAccumLOf
::Lens
s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)mapAccumLOf
::Traversal
s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
mapAccumLOf
::LensLike
(State
acc) s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)mapAccumLOf
l f acc0 s =swap
(runState
(l (a ->state
(acc ->swap
(f acc a))) s) acc0)
mapAccumROf :: LensLike (Backwards (State acc)) s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t) Source #
This generalizes mapAccumR
to an arbitrary Traversal
.
mapAccumR
≡mapAccumROf
traverse
mapAccumROf
accumulates State
from right to left.
mapAccumROf
::Iso
s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)mapAccumROf
::Lens
s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)mapAccumROf
::Traversal
s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
mapAccumROf
::LensLike
(Backwards
(State
acc)) s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
failover :: Alternative m => LensLike ((,) Any) s t a b -> (a -> b) -> s -> m t Source #
Try to map a function over this Traversal
, failing if the Traversal
has no targets.
>>>
failover (element 3) (*2) [1,2] :: Maybe [Int]
Nothing
>>>
failover _Left (*2) (Right 4) :: Maybe (Either Int Int)
Nothing
>>>
failover _Right (*2) (Right 4) :: Maybe (Either Int Int)
Just (Right 8)
failover
:: Alternative m => Traversal s t a b -> (a -> b) -> s -> m t
ifailover :: Alternative m => Over (Indexed i) ((,) Any) s t a b -> (i -> a -> b) -> s -> m t Source #
Try to map a function which uses the index over this IndexedTraversal
, failing if the IndexedTraversal
has no targets.
ifailover
:: Alternative m => IndexedTraversal i s t a b -> (i -> a -> b) -> s -> m t
Monomorphic Traversals
cloneTraversal :: ATraversal s t a b -> Traversal s t a b Source #
A Traversal
is completely characterized by its behavior on a Bazaar
.
Cloning a Traversal
is one way to make sure you aren't given
something weaker, such as a Fold
and can be
used as a way to pass around traversals that have to be monomorphic in f
.
Note: This only accepts a proper Traversal
(or Lens
). To clone a Lens
as such, use cloneLens
.
Note: It is usually better to use ReifiedTraversal
and
runTraversal
than to cloneTraversal
. The
former can execute at full speed, while the latter needs to round trip through
the Bazaar
.
>>>
let foo l a = (view (getting (cloneTraversal l)) a, set (cloneTraversal l) 10 a)
>>>
foo both ("hello","world")
("helloworld",(10,10))
cloneTraversal
::LensLike
(Bazaar
(->) a b) s t a b ->Traversal
s t a b
cloneIndexPreservingTraversal :: ATraversal s t a b -> IndexPreservingTraversal s t a b Source #
Clone a Traversal
yielding an IndexPreservingTraversal
that passes through
whatever index it is composed with.
cloneIndexedTraversal :: AnIndexedTraversal i s t a b -> IndexedTraversal i s t a b Source #
Clone an IndexedTraversal
yielding an IndexedTraversal
with the same index.
cloneTraversal1 :: ATraversal1 s t a b -> Traversal1 s t a b Source #
A Traversal1
is completely characterized by its behavior on a Bazaar1
.
cloneIndexPreservingTraversal1 :: ATraversal1 s t a b -> IndexPreservingTraversal1 s t a b Source #
Clone a Traversal1
yielding an IndexPreservingTraversal1
that passes through
whatever index it is composed with.
cloneIndexedTraversal1 :: AnIndexedTraversal1 i s t a b -> IndexedTraversal1 i s t a b Source #
Clone an IndexedTraversal1
yielding an IndexedTraversal1
with the same index.
Parts and Holes
partsOf :: Functor f => Traversing (->) f s t a a -> LensLike f s t [a] [a] Source #
partsOf
turns a Traversal
into a Lens
that resembles an early version of the uniplate
(or biplate
) type.
Note: You should really try to maintain the invariant of the number of children in the list.
>>>
(a,b,c) & partsOf each .~ [x,y,z]
(x,y,z)
Any extras will be lost. If you do not supply enough, then the remainder will come from the original structure.
>>>
(a,b,c) & partsOf each .~ [w,x,y,z]
(w,x,y)
>>>
(a,b,c) & partsOf each .~ [x,y]
(x,y,c)
>>>
('b', 'a', 'd', 'c') & partsOf each %~ sort
('a','b','c','d')
So technically, this is only a Lens
if you do not change the number of results it returns.
When applied to a Fold
the result is merely a Getter
.
partsOf
::Iso'
s a ->Lens'
s [a]partsOf
::Lens'
s a ->Lens'
s [a]partsOf
::Traversal'
s a ->Lens'
s [a]partsOf
::Fold
s a ->Getter
s [a]partsOf
::Getter
s a ->Getter
s [a]
partsOf' :: ATraversal s t a a -> Lens s t [a] [a] Source #
unsafePartsOf :: Functor f => Traversing (->) f s t a b -> LensLike f s t [a] [b] Source #
unsafePartsOf
turns a Traversal
into a uniplate
(or biplate
) family.
If you do not need the types of s
and t
to be different, it is recommended that
you use partsOf
.
It is generally safer to traverse with the Bazaar
rather than use this
combinator. However, it is sometimes convenient.
This is unsafe because if you don't supply at least as many b
's as you were
given a
's, then the reconstruction of t
will result in an error!
When applied to a Fold
the result is merely a Getter
(and becomes safe).
unsafePartsOf
::Iso
s t a b ->Lens
s t [a] [b]unsafePartsOf
::Lens
s t a b ->Lens
s t [a] [b]unsafePartsOf
::Traversal
s t a b ->Lens
s t [a] [b]unsafePartsOf
::Fold
s a ->Getter
s [a]unsafePartsOf
::Getter
s a ->Getter
s [a]
unsafePartsOf' :: ATraversal s t a b -> Lens s t [a] [b] Source #
holesOf :: Conjoined p => Over p (Bazaar p a a) s t a a -> s -> [Pretext p a a t] Source #
The one-level version of contextsOf
. This extracts a
list of the immediate children according to a given Traversal
as editable
contexts.
Given a context you can use pos
to see the
values, peek
at what the structure would be
like with an edited result, or simply extract
the original structure.
propChildren l x =toListOf
l x==
map
pos
(holesOf
l x) propId l x =all
(==
x) [extract
w | w <-holesOf
l x]
holesOf
::Iso'
s a -> s -> [Pretext'
(->) a s]holesOf
::Lens'
s a -> s -> [Pretext'
(->) a s]holesOf
::Traversal'
s a -> s -> [Pretext'
(->) a s]holesOf
::IndexedLens'
i s a -> s -> [Pretext'
(Indexed
i) a s]holesOf
::IndexedTraversal'
i s a -> s -> [Pretext'
(Indexed
i) a s]
holes1Of :: Conjoined p => Over p (Bazaar1 p a a) s t a a -> s -> NonEmpty (Pretext p a a t) Source #
The non-empty version of holesOf
.
This extract a non-empty list of immediate children according to a given
Traversal1
as editable contexts.
>>>
let head1 f s = runPretext (NonEmpty.head $ holes1Of traversed1 s) f
>>>
('a' :| "bc") ^. head1
'a'
>>>
('a' :| "bc") & head1 %~ toUpper
'A' :| "bc"
holes1Of
::Iso'
s a -> s ->NonEmpty
(Pretext'
(->) a s)holes1Of
::Lens'
s a -> s ->NonEmpty
(Pretext'
(->) a s)holes1Of
::Traversal1'
s a -> s ->NonEmpty
(Pretext'
(->) a s)holes1Of
::IndexedLens'
i s a -> s ->NonEmpty
(Pretext'
(Indexed
i) a s)holes1Of
::IndexedTraversal1'
i s a -> s ->NonEmpty
(Pretext'
(Indexed
i) a s)
singular :: (HasCallStack, Conjoined p, Functor f) => Traversing p f s t a a -> Over p f s t a a Source #
This converts a Traversal
that you "know" will target one or more elements to a Lens
. It can
also be used to transform a non-empty Fold
into a Getter
.
The resulting Lens
or Getter
will be partial if the supplied Traversal
returns
no results.
>>>
[1,2,3] ^. singular _head
1
>>>
Left (ErrorCall "singular: empty traversal") <- try (evaluate ([] ^. singular _head)) :: IO (Either ErrorCall ())
>>>
Left 4 ^. singular _Left
4
>>>
[1..10] ^. singular (ix 7)
8
>>>
[] & singular traverse .~ 0
[]
singular
::Traversal
s t a a ->Lens
s t a asingular
::Fold
s a ->Getter
s asingular
::IndexedTraversal
i s t a a ->IndexedLens
i s t a asingular
::IndexedFold
i s a ->IndexedGetter
i s a
unsafeSingular :: (HasCallStack, Conjoined p, Functor f) => Traversing p f s t a b -> Over p f s t a b Source #
This converts a Traversal
that you "know" will target only one element to a Lens
. It can also be
used to transform a Fold
into a Getter
.
The resulting Lens
or Getter
will be partial if the Traversal
targets nothing
or more than one element.
>>>
Left (ErrorCall "unsafeSingular: empty traversal") <- try (evaluate ([] & unsafeSingular traverse .~ 0)) :: IO (Either ErrorCall [Integer])
unsafeSingular
::Traversal
s t a b ->Lens
s t a bunsafeSingular
::Fold
s a ->Getter
s aunsafeSingular
::IndexedTraversal
i s t a b ->IndexedLens
i s t a bunsafeSingular
::IndexedFold
i s a ->IndexedGetter
i s a
Common Traversals
class (Functor t, Foldable t) => Traversable (t :: Type -> Type) where #
Functors representing data structures that can be transformed to
structures of the same shape by performing an Applicative
(or,
therefore, Monad
) action on each element from left to right.
A more detailed description of what same shape means, the various methods, how traversals are constructed, and example advanced use-cases can be found in the Overview section of Data.Traversable.
For the class laws see the Laws section of Data.Traversable.
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_
.
Examples
Basic usage:
In the first two examples we show each evaluated action mapping to the output structure.
>>>
traverse Just [1,2,3,4]
Just [1,2,3,4]
>>>
traverse id [Right 1, Right 2, Right 3, Right 4]
Right [1,2,3,4]
In the next examples, we show that Nothing
and Left
values short
circuit the created structure.
>>>
traverse (const Nothing) [1,2,3,4]
Nothing
>>>
traverse (\x -> if odd x then Just x else Nothing) [1,2,3,4]
Nothing
>>>
traverse id [Right 1, Right 2, Right 3, Right 4, Left 0]
Left 0
Instances
class (Foldable1 t, Traversable t) => Traversable1 (t :: Type -> Type) where #
Instances
both :: forall (r :: Type -> Type -> Type) a b. Bitraversable r => Traversal (r a a) (r b b) a b Source #
Traverse both parts of a Bitraversable
container with matching types.
Usually that type will be a pair. Use each
to traverse
the elements of arbitrary homogeneous tuples.
>>>
(1,2) & both *~ 10
(10,20)
>>>
over both length ("hello","world")
(5,5)
>>>
("hello","world")^.both
"helloworld"
both
::Traversal
(a, a) (b, b) a bboth
::Traversal
(Either
a a) (Either
b b) a b
both1 :: forall (r :: Type -> Type -> Type) a b. Bitraversable1 r => Traversal1 (r a a) (r b b) a b Source #
Traverse both parts of a Bitraversable1
container with matching types.
Usually that type will be a pair.
both1
::Traversal1
(a, a) (b, b) a bboth1
::Traversal1
(Either
a a) (Either
b b) a b
beside :: (Representable q, Applicative (Rep q), Applicative f, Bitraversable r) => Optical p q f s t a b -> Optical p q f s' t' a b -> Optical p q f (r s s') (r t t') a b Source #
Apply a different Traversal
or Fold
to each side of a Bitraversable
container.
beside
::Traversal
s t a b ->Traversal
s' t' a b ->Traversal
(r s s') (r t t') a bbeside
::IndexedTraversal
i s t a b ->IndexedTraversal
i s' t' a b ->IndexedTraversal
i (r s s') (r t t') a bbeside
::IndexPreservingTraversal
s t a b ->IndexPreservingTraversal
s' t' a b ->IndexPreservingTraversal
(r s s') (r t t') a b
beside
::Traversal
s t a b ->Traversal
s' t' a b ->Traversal
(s,s') (t,t') a bbeside
::Lens
s t a b ->Lens
s' t' a b ->Traversal
(s,s') (t,t') a bbeside
::Fold
s a ->Fold
s' a ->Fold
(s,s') abeside
::Getter
s a ->Getter
s' a ->Fold
(s,s') a
beside
::IndexedTraversal
i s t a b ->IndexedTraversal
i s' t' a b ->IndexedTraversal
i (s,s') (t,t') a bbeside
::IndexedLens
i s t a b ->IndexedLens
i s' t' a b ->IndexedTraversal
i (s,s') (t,t') a bbeside
::IndexedFold
i s a ->IndexedFold
i s' a ->IndexedFold
i (s,s') abeside
::IndexedGetter
i s a ->IndexedGetter
i s' a ->IndexedFold
i (s,s') a
beside
::IndexPreservingTraversal
s t a b ->IndexPreservingTraversal
s' t' a b ->IndexPreservingTraversal
(s,s') (t,t') a bbeside
::IndexPreservingLens
s t a b ->IndexPreservingLens
s' t' a b ->IndexPreservingTraversal
(s,s') (t,t') a bbeside
::IndexPreservingFold
s a ->IndexPreservingFold
s' a ->IndexPreservingFold
(s,s') abeside
::IndexPreservingGetter
s a ->IndexPreservingGetter
s' a ->IndexPreservingFold
(s,s') a
>>>
("hello",["world","!!!"])^..beside id traverse
["hello","world","!!!"]
taking :: (Conjoined p, Applicative f) => Int -> Traversing p f s t a a -> Over p f s t a a Source #
Visit the first n targets of a Traversal
, Fold
, Getter
or Lens
.
>>>
[("hello","world"),("!!!","!!!")]^.. taking 2 (traverse.both)
["hello","world"]
>>>
timingOut $ [1..] ^.. taking 3 traverse
[1,2,3]
>>>
over (taking 5 traverse) succ "hello world"
"ifmmp world"
taking
::Int
->Traversal'
s a ->Traversal'
s ataking
::Int
->Lens'
s a ->Traversal'
s ataking
::Int
->Iso'
s a ->Traversal'
s ataking
::Int
->Prism'
s a ->Traversal'
s ataking
::Int
->Getter
s a ->Fold
s ataking
::Int
->Fold
s a ->Fold
s ataking
::Int
->IndexedTraversal'
i s a ->IndexedTraversal'
i s ataking
::Int
->IndexedLens'
i s a ->IndexedTraversal'
i s ataking
::Int
->IndexedGetter
i s a ->IndexedFold
i s ataking
::Int
->IndexedFold
i s a ->IndexedFold
i s a
dropping :: (Conjoined p, Applicative f) => Int -> Over p (Indexing f) s t a a -> Over p f s t a a Source #
Visit all but the first n targets of a Traversal
, Fold
, Getter
or Lens
.
>>>
("hello","world") ^? dropping 1 both
Just "world"
Dropping works on infinite traversals as well:
>>>
[1..] ^? dropping 1 folded
Just 2
dropping
::Int
->Traversal'
s a ->Traversal'
s adropping
::Int
->Lens'
s a ->Traversal'
s adropping
::Int
->Iso'
s a ->Traversal'
s adropping
::Int
->Prism'
s a ->Traversal'
s adropping
::Int
->Getter
s a ->Fold
s adropping
::Int
->Fold
s a ->Fold
s adropping
::Int
->IndexedTraversal'
i s a ->IndexedTraversal'
i s adropping
::Int
->IndexedLens'
i s a ->IndexedTraversal'
i s adropping
::Int
->IndexedGetter
i s a ->IndexedFold
i s adropping
::Int
->IndexedFold
i s a ->IndexedFold
i s a
failing :: (Conjoined p, Applicative f) => Traversing p f s t a b -> Over p f s t a b -> Over p f s t a b infixl 5 Source #
Try the first Traversal
(or Fold
), falling back on the second Traversal
(or Fold
) if it returns no entries.
This is only a valid Traversal
if the second Traversal
is disjoint from the result of the first or returns
exactly the same results. These conditions are trivially met when given a Lens
, Iso
, Getter
, Prism
or "affine" Traversal -- one that
has 0 or 1 target.
Mutatis mutandis for Fold
.
>>>
[0,1,2,3] ^? failing (ix 1) (ix 2)
Just 1
>>>
[0,1,2,3] ^? failing (ix 42) (ix 2)
Just 2
failing
::Traversal
s t a b ->Traversal
s t a b ->Traversal
s t a bfailing
::Prism
s t a b ->Prism
s t a b ->Traversal
s t a bfailing
::Fold
s a ->Fold
s a ->Fold
s a
These cases are also supported, trivially, but are boring, because the left hand side always succeeds.
failing
::Lens
s t a b ->Traversal
s t a b ->Traversal
s t a bfailing
::Iso
s t a b ->Traversal
s t a b ->Traversal
s t a bfailing
::Equality
s t a b ->Traversal
s t a b ->Traversal
s t a bfailing
::Getter
s a ->Fold
s a ->Fold
s a
If both of the inputs are indexed, the result is also indexed, so you can apply this to a pair of indexed traversals or indexed folds, obtaining an indexed traversal or indexed fold.
failing
::IndexedTraversal
i s t a b ->IndexedTraversal
i s t a b ->IndexedTraversal
i s t a bfailing
::IndexedFold
i s a ->IndexedFold
i s a ->IndexedFold
i s a
These cases are also supported, trivially, but are boring, because the left hand side always succeeds.
failing
::IndexedLens
i s t a b ->IndexedTraversal
i s t a b ->IndexedTraversal
i s t a bfailing
::IndexedGetter
i s a ->IndexedGetter
i s a ->IndexedFold
i s a
deepOf :: (Conjoined p, Applicative f) => LensLike f s t s t -> Traversing p f s t a b -> Over p f s t a b Source #
Try the second traversal. If it returns no entries, try again with all entries from the first traversal, recursively.
deepOf
::Fold
s s ->Fold
s a ->Fold
s adeepOf
::Traversal'
s s ->Traversal'
s a ->Traversal'
s adeepOf
::Traversal
s t s t ->Traversal
s t a b ->Traversal
s t a bdeepOf
::Fold
s s ->IndexedFold
i s a ->IndexedFold
i s adeepOf
::Traversal
s t s t ->IndexedTraversal
i s t a b ->IndexedTraversal
i s t a b
Indexed Traversals
Common
ignored :: Applicative f => pafb -> s -> f s Source #
class Ord k => TraverseMin k (m :: Type -> Type) | m -> k where Source #
Allows IndexedTraversal
the value at the smallest index.
traverseMin :: IndexedTraversal' k (m v) v Source #
IndexedTraversal
of the element with the smallest index.
Instances
TraverseMin Int IntMap Source # | |
Defined in Control.Lens.Traversal traverseMin :: IndexedTraversal' Int (IntMap v) v Source # | |
Ord k => TraverseMin k (Map k) Source # | |
Defined in Control.Lens.Traversal traverseMin :: IndexedTraversal' k (Map k v) v Source # |
class Ord k => TraverseMax k (m :: Type -> Type) | m -> k where Source #
Allows IndexedTraversal
of the value at the largest index.
traverseMax :: IndexedTraversal' k (m v) v Source #
IndexedTraversal
of the element at the largest index.
Instances
TraverseMax Int IntMap Source # | |
Defined in Control.Lens.Traversal traverseMax :: IndexedTraversal' Int (IntMap v) v Source # | |
Ord k => TraverseMax k (Map k) Source # | |
Defined in Control.Lens.Traversal traverseMax :: IndexedTraversal' k (Map k v) v Source # |
traversed :: forall (f :: Type -> Type) a b. Traversable f => IndexedTraversal Int (f a) (f b) a b Source #
Traverse any Traversable
container. This is an IndexedTraversal
that is indexed by ordinal position.
traversed1 :: forall (f :: Type -> Type) a b. Traversable1 f => IndexedTraversal1 Int (f a) (f b) a b Source #
Traverse any Traversable1
container. This is an IndexedTraversal1
that is indexed by ordinal position.
traversed64 :: forall (f :: Type -> Type) a b. Traversable f => IndexedTraversal Int64 (f a) (f b) a b Source #
Traverse any Traversable
container. This is an IndexedTraversal
that is indexed by ordinal position.
elementOf :: forall (f :: Type -> Type) s t a. Applicative f => LensLike (Indexing f) s t a a -> Int -> IndexedLensLike Int f s t a a Source #
Traverse the nth elementOf
a Traversal
, Lens
or
Iso
if it exists.
>>>
[[1],[3,4]] & elementOf (traverse.traverse) 1 .~ 5
[[1],[5,4]]
>>>
[[1],[3,4]] ^? elementOf (folded.folded) 1
Just 3
>>>
timingOut $ ['a'..] ^?! elementOf folded 5
'f'
>>>
timingOut $ take 10 $ elementOf traverse 3 .~ 16 $ [0..]
[0,1,2,16,4,5,6,7,8,9]
elementOf
::Traversal'
s a ->Int
->IndexedTraversal'
Int
s aelementOf
::Fold
s a ->Int
->IndexedFold
Int
s a
element :: forall (t :: Type -> Type) a. Traversable t => Int -> IndexedTraversal' Int (t a) a Source #
Traverse the nth element of a Traversable
container.
element
≡elementOf
traverse
elementsOf :: forall (f :: Type -> Type) s t a. Applicative f => LensLike (Indexing f) s t a a -> (Int -> Bool) -> IndexedLensLike Int f s t a a Source #
Traverse (or fold) selected elements of a Traversal
(or Fold
) where their ordinal positions match a predicate.
elementsOf
::Traversal'
s a -> (Int
->Bool
) ->IndexedTraversal'
Int
s aelementsOf
::Fold
s a -> (Int
->Bool
) ->IndexedFold
Int
s a
elements :: forall (t :: Type -> Type) a. Traversable t => (Int -> Bool) -> IndexedTraversal' Int (t a) a Source #
Traverse elements of a Traversable
container where their ordinal positions match a predicate.
elements
≡elementsOf
traverse
Combinators
ipartsOf :: (Indexable [i] p, Functor f) => Traversing (Indexed i) f s t a a -> Over p f s t [a] [a] Source #
An indexed version of partsOf
that receives the entire list of indices as its index.
ipartsOf' :: forall i p f s t a. (Indexable [i] p, Functor f) => Over (Indexed i) (Bazaar' (Indexed i) a) s t a a -> Over p f s t [a] [a] Source #
A type-restricted version of ipartsOf
that can only be used with an IndexedTraversal
.
iunsafePartsOf :: (Indexable [i] p, Functor f) => Traversing (Indexed i) f s t a b -> Over p f s t [a] [b] Source #
An indexed version of unsafePartsOf
that receives the entire list of indices as its index.
iunsafePartsOf' :: forall i s t a b. Over (Indexed i) (Bazaar (Indexed i) a b) s t a b -> IndexedLens [i] s t [a] [b] Source #
itraverseOf :: (Indexed i a (f b) -> s -> f t) -> (i -> a -> f b) -> s -> f t Source #
Traversal with an index.
NB: When you don't need access to the index then you can just apply your IndexedTraversal
directly as a function!
itraverseOf
≡withIndex
traverseOf
l =itraverseOf
l.
const
=id
itraverseOf
::Functor
f =>IndexedLens
i s t a b -> (i -> a -> f b) -> s -> f titraverseOf
::Applicative
f =>IndexedTraversal
i s t a b -> (i -> a -> f b) -> s -> f titraverseOf
::Apply
f =>IndexedTraversal1
i s t a b -> (i -> a -> f b) -> s -> f t
iforOf :: (Indexed i a (f b) -> s -> f t) -> s -> (i -> a -> f b) -> f t Source #
Traverse with an index (and the arguments flipped).
forOf
l a ≡iforOf
l a.
const
iforOf
≡flip
.
itraverseOf
iforOf
::Functor
f =>IndexedLens
i s t a b -> s -> (i -> a -> f b) -> f tiforOf
::Applicative
f =>IndexedTraversal
i s t a b -> s -> (i -> a -> f b) -> f tiforOf
::Apply
f =>IndexedTraversal1
i s t a b -> s -> (i -> a -> f b) -> f t
imapMOf :: Over (Indexed i) (WrappedMonad m) s t a b -> (i -> a -> m b) -> s -> m t Source #
Map each element of a structure targeted by a Lens
to a monadic action,
evaluate these actions from left to right, and collect the results, with access
its position.
When you don't need access to the index mapMOf
is more liberal in what it can accept.
mapMOf
l ≡imapMOf
l.
const
imapMOf
::Monad
m =>IndexedLens
i s t a b -> (i -> a -> m b) -> s -> m timapMOf
::Monad
m =>IndexedTraversal
i s t a b -> (i -> a -> m b) -> s -> m timapMOf
::Bind
m =>IndexedTraversal1
i s t a b -> (i -> a -> m b) -> s -> m t
iforMOf :: (Indexed i a (WrappedMonad m b) -> s -> WrappedMonad m t) -> s -> (i -> a -> m b) -> m t Source #
Map each element of a structure targeted by a Lens
to a monadic action,
evaluate these actions from left to right, and collect the results, with access
its position (and the arguments flipped).
forMOf
l a ≡iforMOf
l a.
const
iforMOf
≡flip
.
imapMOf
iforMOf
::Monad
m =>IndexedLens
i s t a b -> s -> (i -> a -> m b) -> m tiforMOf
::Monad
m =>IndexedTraversal
i s t a b -> s -> (i -> a -> m b) -> m t
imapAccumROf :: Over (Indexed i) (Backwards (State acc)) s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t) Source #
Generalizes mapAccumR
to an arbitrary IndexedTraversal
with access to the index.
imapAccumROf
accumulates state from right to left.
mapAccumROf
l ≡imapAccumROf
l.
const
imapAccumROf
::IndexedLens
i s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t)imapAccumROf
::IndexedTraversal
i s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
imapAccumLOf :: Over (Indexed i) (State acc) s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t) Source #
Generalizes mapAccumL
to an arbitrary IndexedTraversal
with access to the index.
imapAccumLOf
accumulates state from left to right.
mapAccumLOf
l ≡imapAccumLOf
l.
const
imapAccumLOf
::IndexedLens
i s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t)imapAccumLOf
::IndexedTraversal
i s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
Reflection
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.
traverseByOf :: Traversal s t a b -> (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> (a -> f b) -> s -> f t Source #
Traverse a container using a specified Applicative
.
This is like traverseBy
where the Traversable
instance can be specified by any Traversal
traverseByOf
traverse
≡traverseBy
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.
sequenceByOf :: Traversal s t (f b) b -> (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> s -> f t Source #
Sequence a container using a specified Applicative
.
This is like traverseBy
where the Traversable
instance can be specified by any Traversal
sequenceByOf
traverse
≡sequenceBy
Implementation Details
newtype Bazaar (p :: Type -> Type -> Type) a b t Source #
This is used to characterize a Traversal
.
a.k.a. indexed Cartesian store comonad, indexed Kleene store comonad, or an indexed FunList
.
http://twanvl.nl/blog/haskell/non-regular1
A Bazaar
is like a Traversal
that has already been applied to some structure.
Where a
holds an Context
a b ta
and a function from b
to
t
, a
holds Bazaar
a b tN
a
s and a function from N
b
s to t
, (where N
might be infinite).
Mnemonically, a Bazaar
holds many stores and you can easily add more.
This is a final encoding of Bazaar
.
Bazaar | |
|
Instances
Profunctor p => Bizarre p (Bazaar p) Source # | |
Defined in Control.Lens.Internal.Bazaar bazaar :: Applicative f => p a (f b) -> Bazaar p a b t -> f t Source # | |
Corepresentable p => Sellable p (Bazaar p) Source # | |
Defined in Control.Lens.Internal.Bazaar | |
Conjoined p => IndexedComonad (Bazaar p) Source # | |
IndexedFunctor (Bazaar p) Source # | |
Applicative (Bazaar p a b) Source # | |
Defined in Control.Lens.Internal.Bazaar pure :: a0 -> Bazaar p a b a0 # (<*>) :: Bazaar p a b (a0 -> b0) -> Bazaar p a b a0 -> Bazaar p a b b0 # liftA2 :: (a0 -> b0 -> c) -> Bazaar p a b a0 -> Bazaar p a b b0 -> Bazaar p a b c # (*>) :: Bazaar p a b a0 -> Bazaar p a b b0 -> Bazaar p a b b0 # (<*) :: Bazaar p a b a0 -> Bazaar p a b b0 -> Bazaar p a b a0 # | |
Functor (Bazaar p a b) Source # | |
(a ~ b, Conjoined p) => Comonad (Bazaar p a b) Source # | |
(a ~ b, Conjoined p) => ComonadApply (Bazaar p a b) Source # | |
Apply (Bazaar p a b) Source # | |
Defined in Control.Lens.Internal.Bazaar |
newtype Bazaar1 (p :: Type -> Type -> Type) a b t Source #
This is used to characterize a Traversal
.
a.k.a. indexed Cartesian store comonad, indexed Kleene store comonad, or an indexed FunList
.
http://twanvl.nl/blog/haskell/non-regular1
A Bazaar1
is like a Traversal
that has already been applied to some structure.
Where a
holds an Context
a b ta
and a function from b
to
t
, a
holds Bazaar1
a b tN
a
s and a function from N
b
s to t
, (where N
might be infinite).
Mnemonically, a Bazaar1
holds many stores and you can easily add more.
This is a final encoding of Bazaar1
.
Bazaar1 | |
|
Instances
Profunctor p => Bizarre1 p (Bazaar1 p) Source # | |
Corepresentable p => Sellable p (Bazaar1 p) Source # | |
Defined in Control.Lens.Internal.Bazaar | |
Conjoined p => IndexedComonad (Bazaar1 p) Source # | |
IndexedFunctor (Bazaar1 p) Source # | |
Functor (Bazaar1 p a b) Source # | |
(a ~ b, Conjoined p) => Comonad (Bazaar1 p a b) Source # | |
(a ~ b, Conjoined p) => ComonadApply (Bazaar1 p a b) Source # | |
Apply (Bazaar1 p a b) Source # | |
Defined in Control.Lens.Internal.Bazaar |
loci :: forall a c s b f. Applicative f => (a -> f b) -> Bazaar (->) a c s -> f (Bazaar (->) b c s) Source #
iloci :: forall i a c s b p f. (Indexable i p, Applicative f) => p a (f b) -> Bazaar (Indexed i) a c s -> f (Bazaar (Indexed i) b c s) Source #
This IndexedTraversal
allows you to traverse
the individual stores in
a Bazaar
with access to their indices.
Fusion
confusing :: Applicative f => LensLike (Curried (Yoneda f) (Yoneda f)) s t a b -> LensLike f s t a b Source #
Fuse a Traversal
by reassociating all of the (
operations to the
left and fusing all of the <*>
)fmap
calls into one. This is particularly
useful when constructing a Traversal
using operations from GHC.Generics.
Given a pair of Traversal
s foo
and bar
,
confusing
(foo.bar) = foo.bar
However, foo
and bar
are each going to use the Applicative
they are given.
confusing
exploits the Yoneda
lemma to merge their separate uses of fmap
into a single fmap
.
and it further exploits an interesting property of the right Kan lift (or Curried
) to left associate
all of the uses of (
to make it possible to fuse together more fmaps.<*>
)
This is particularly effective when the choice of functor f
is unknown at compile
time or when the Traversal
foo.bar
in the above description is recursive or complex
enough to prevent inlining.
fusing
is a version of this combinator suitable for fusing lenses.
confusing
::Traversal
s t a b ->Traversal
s t a b