Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
An IxTraversal
is an indexed version of a Traversal
.
See the "Indexed optics" section of the overview documentation in the
Optics
module of the main optics
package for more details on indexed
optics.
Synopsis
- type IxTraversal i s t a b = Optic A_Traversal (WithIx i) s t a b
- type IxTraversal' i s a = Optic' A_Traversal (WithIx i) s a
- itraversalVL :: IxTraversalVL i s t a b -> IxTraversal i s t a b
- itraverseOf :: (Is k A_Traversal, Applicative f, is `HasSingleIndex` i) => Optic k is s t a b -> (i -> a -> f b) -> s -> f t
- itraversed :: TraversableWithIndex i f => IxTraversal i (f a) (f b) a b
- ignored :: IxAffineTraversal i s s a b
- elementsOf :: Is k A_Traversal => Optic k is s t a a -> (Int -> Bool) -> IxTraversal Int s t a a
- elements :: Traversable f => (Int -> Bool) -> IxTraversal' Int (f a) a
- elementOf :: Is k A_Traversal => Optic' k is s a -> Int -> IxAffineTraversal' Int s a
- element :: Traversable f => Int -> IxAffineTraversal' Int (f a) a
- iforOf :: (Is k A_Traversal, Applicative f, is `HasSingleIndex` i) => Optic k is s t a b -> s -> (i -> a -> f b) -> f t
- imapAccumLOf :: (Is k A_Traversal, is `HasSingleIndex` i) => Optic k is s t a b -> (i -> acc -> a -> (b, acc)) -> acc -> s -> (t, acc)
- imapAccumROf :: (Is k A_Traversal, is `HasSingleIndex` i) => Optic k is s t a b -> (i -> acc -> a -> (b, acc)) -> acc -> s -> (t, acc)
- iscanl1Of :: (Is k A_Traversal, is `HasSingleIndex` i) => Optic k is s t a a -> (i -> a -> a -> a) -> s -> t
- iscanr1Of :: (Is k A_Traversal, is `HasSingleIndex` i) => Optic k is s t a a -> (i -> a -> a -> a) -> s -> t
- ifailover :: (Is k A_Traversal, is `HasSingleIndex` i) => Optic k is s t a b -> (i -> a -> b) -> s -> Maybe t
- ifailover' :: (Is k A_Traversal, is `HasSingleIndex` i) => Optic k is s t a b -> (i -> a -> b) -> s -> Maybe t
- indices :: (Is k A_Traversal, is `HasSingleIndex` i) => (i -> Bool) -> Optic k is s t a a -> IxTraversal i s t a a
- ibackwards :: (Is k A_Traversal, is `HasSingleIndex` i) => Optic k is s t a b -> IxTraversal i s t a b
- ipartsOf :: forall k is i s t a. (Is k A_Traversal, is `HasSingleIndex` i) => Optic k is s t a a -> IxLens [i] s t [a] [a]
- isingular :: forall k is i s a. (Is k A_Traversal, is `HasSingleIndex` i) => Optic' k is s a -> IxAffineTraversal' i s a
- iadjoin :: (Is k A_Traversal, Is l A_Traversal, is `HasSingleIndex` i) => Optic' k is s a -> Optic' l is s a -> IxTraversal' i s a
- data A_Traversal :: OpticKind
- type IxTraversalVL i s t a b = forall f. Applicative f => (i -> a -> f b) -> s -> f t
- type IxTraversalVL' i s a = IxTraversalVL i s s a a
- class (FunctorWithIndex i t, FoldableWithIndex i t, Traversable t) => TraversableWithIndex i (t :: Type -> Type) | t -> i where
- itraverse :: Applicative f => (i -> a -> f b) -> t a -> f (t b)
Formation
type IxTraversal i s t a b = Optic A_Traversal (WithIx i) s t a b Source #
Type synonym for a type-modifying indexed traversal.
type IxTraversal' i s a = Optic' A_Traversal (WithIx i) s a Source #
Type synonym for a type-preserving indexed traversal.
Introduction
itraversalVL :: IxTraversalVL i s t a b -> IxTraversal i s t a b Source #
Build an indexed traversal from the van Laarhoven representation.
itraversalVL
.
itraverseOf
≡id
itraverseOf
.
itraversalVL
≡id
Elimination
itraverseOf :: (Is k A_Traversal, Applicative f, is `HasSingleIndex` i) => Optic k is s t a b -> (i -> a -> f b) -> s -> f t Source #
Map each element of a structure targeted by an IxTraversal
(supplying the
index), evaluate these actions from left to right, and collect the results.
This yields the van Laarhoven representation of an indexed traversal.
Computation
itraverseOf
(itraversalVL
f) ≡ f
Well-formedness
itraverseOf
o (const
pure
) ≡pure
fmap
(itraverseOf
o f) .itraverseOf
o g ≡getCompose
.itraverseOf
o (\ i ->Compose
.fmap
(f i) . g i)
Additional introduction forms
See also each
, which is an IxTraversal
over each element of a (potentially monomorphic) container.
itraversed :: TraversableWithIndex i f => IxTraversal i (f a) (f b) a b Source #
Indexed traversal via the TraversableWithIndex
class.
itraverseOf
itraversed
≡itraverse
>>>
iover (itraversed <%> itraversed) (,) ["ab", "cd"]
[[((0,0),'a'),((0,1),'b')],[((1,0),'c'),((1,1),'d')]]
ignored :: IxAffineTraversal i s s a b Source #
This is the trivial empty IxAffineTraversal
, i.e. the optic that targets
no substructures.
This is the identity element when a Fold
,
AffineFold
, IxFold
,
IxAffineFold
, Traversal
or
IxTraversal
is viewed as a monoid.
>>>
6 & ignored %~ absurd
6
elementsOf :: Is k A_Traversal => Optic k is s t a a -> (Int -> Bool) -> IxTraversal Int s t a a Source #
Traverse selected elements of a Traversal
where their ordinal positions
match a predicate.
elements :: Traversable f => (Int -> Bool) -> IxTraversal' Int (f a) a Source #
Traverse elements of a Traversable
container where their ordinal
positions match a predicate.
elements
≡elementsOf
traverse
elementOf :: Is k A_Traversal => Optic' k is s a -> Int -> IxAffineTraversal' Int s a Source #
Traverse the nth element of a Traversal
if it exists.
element :: Traversable f => Int -> IxAffineTraversal' Int (f a) a Source #
Traverse the nth element of a Traversable
container.
element
≡elementOf
traversed
Additional elimination forms
iforOf :: (Is k A_Traversal, Applicative f, is `HasSingleIndex` i) => Optic k is s t a b -> s -> (i -> a -> f b) -> f t Source #
A version of itraverseOf
with the arguments flipped.
imapAccumLOf :: (Is k A_Traversal, is `HasSingleIndex` i) => Optic k is s t a b -> (i -> acc -> a -> (b, acc)) -> acc -> s -> (t, acc) Source #
Generalizes mapAccumL
to an arbitrary IxTraversal
.
imapAccumLOf
accumulates state from left to right.
mapAccumLOf
o ≡imapAccumLOf
o.
const
imapAccumROf :: (Is k A_Traversal, is `HasSingleIndex` i) => Optic k is s t a b -> (i -> acc -> a -> (b, acc)) -> acc -> s -> (t, acc) Source #
Generalizes mapAccumR
to an arbitrary IxTraversal
.
imapAccumROf
accumulates state from right to left.
mapAccumROf
o ≡imapAccumROf
o.
const
iscanl1Of :: (Is k A_Traversal, is `HasSingleIndex` i) => Optic k is s t a a -> (i -> a -> a -> a) -> s -> t Source #
This permits the use of scanl1
over an arbitrary IxTraversal
.
iscanr1Of :: (Is k A_Traversal, is `HasSingleIndex` i) => Optic k is s t a a -> (i -> a -> a -> a) -> s -> t Source #
This permits the use of scanr1
over an arbitrary IxTraversal
.
ifailover :: (Is k A_Traversal, is `HasSingleIndex` i) => Optic k is s t a b -> (i -> a -> b) -> s -> Maybe t Source #
Try to map a function which uses the index over this IxTraversal
,
returning Nothing
if the IxTraversal
has no targets.
ifailover' :: (Is k A_Traversal, is `HasSingleIndex` i) => Optic k is s t a b -> (i -> a -> b) -> s -> Maybe t Source #
Version of ifailover
strict in the application of the function.
Combinators
indices :: (Is k A_Traversal, is `HasSingleIndex` i) => (i -> Bool) -> Optic k is s t a a -> IxTraversal i s t a a Source #
Filter results of an IxTraversal
that don't satisfy a predicate on the
indices.
>>>
toListOf (itraversed %& indices even) "foobar"
"foa"
ibackwards :: (Is k A_Traversal, is `HasSingleIndex` i) => Optic k is s t a b -> IxTraversal i s t a b Source #
This allows you to traverse
the elements of an indexed traversal in the
opposite order.
ipartsOf :: forall k is i s t a. (Is k A_Traversal, is `HasSingleIndex` i) => Optic k is s t a a -> IxLens [i] s t [a] [a] Source #
An indexed version of partsOf
that receives the entire list of indices as
its indices.
isingular :: forall k is i s a. (Is k A_Traversal, is `HasSingleIndex` i) => Optic' k is s a -> IxAffineTraversal' i s a Source #
Convert an indexed traversal to an IxAffineTraversal
that visits the
first element of the original traversal.
For the fold version see ipre
.
>>>
[1,2,3] & iover (isingular itraversed) (-)
[-1,2,3]
Since: 0.3
Monoid structure
IxTraversal
admits a (partial) monoid structure where iadjoin
combines non-overlapping indexed traversals, and the identity element is
ignored
(which traverses no elements).
If you merely need an IxFold
, you can use indexed traversals as indexed
folds and combine them with one of the monoid structures on indexed folds
(see Optics.IxFold). In particular, isumming
can be used to
concatenate results from two traversals, and ifailing
will returns
results from the second traversal only if the first returns no results.
There is no Semigroup
or Monoid
instance for IxTraversal
, because
there is not a unique choice of monoid to use that works for all optics,
and the (<>
) operator could not be used to combine optics of different
kinds.
iadjoin :: (Is k A_Traversal, Is l A_Traversal, is `HasSingleIndex` i) => Optic' k is s a -> Optic' l is s a -> IxTraversal' i s a infixr 6 Source #
Combine two disjoint indexed traversals into one.
>>>
iover (_1 % itraversed `iadjoin` _2 % itraversed) (+) ([0, 0, 0], (3, 5))
([0,1,2],(3,8))
Note: if the argument traversals are not disjoint, the result will not
respect the IxTraversal
laws, because it will visit the same element multiple
times. See section 7 of
Understanding Idiomatic Traversals Backwards and Forwards
by Bird et al. for why this is illegal.
>>>
iview (ipartsOf (each `iadjoin` each)) ("x","y")
([0,1,0,1],["x","y","x","y"])>>>
iset (ipartsOf (each `iadjoin` each)) (const ["a","b","c","d"]) ("x","y")
("c","d")
For the IxFold
version see isumming
.
Since: 0.4
Subtyping
data A_Traversal :: OpticKind Source #
Tag for a traversal.
Instances
van Laarhoven encoding
The van Laarhoven representation of an IxTraversal
directly expresses
how it lifts an effectful operation I -> A -> F B
on elements and their
indices to act on structures S -> F T
. Thus itraverseOf
converts an
IxTraversal
to an IxTraversalVL
.
type IxTraversalVL i s t a b = forall f. Applicative f => (i -> a -> f b) -> s -> f t Source #
Type synonym for a type-modifying van Laarhoven indexed traversal.
type IxTraversalVL' i s a = IxTraversalVL i s s a a Source #
Type synonym for a type-preserving van Laarhoven indexed traversal.
Re-exports
class (FunctorWithIndex i t, FoldableWithIndex i t, Traversable t) => TraversableWithIndex i (t :: Type -> Type) | t -> i where #
A Traversable
with an additional index.
An instance must satisfy a (modified) form of the Traversable
laws:
itraverse
(const
Identity
) ≡Identity
fmap
(itraverse
f).
itraverse
g ≡getCompose
.
itraverse
(\i ->Compose
.
fmap
(f i).
g i)
Nothing
itraverse :: Applicative f => (i -> a -> f b) -> t a -> f (t b) #
Traverse an indexed container.
itraverse
≡itraverseOf
itraversed