Safe Haskell | None |
---|---|
Language | Haskell2010 |
An IxTraversal
is an indexed version of an 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 :: IxTraversal 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 t a a -> Int -> IxTraversal Int s t a a
- element :: Traversable f => Int -> IxTraversal' 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]
- data A_Traversal
- 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 (FoldableWithIndex i t, Traversable t) => TraversableWithIndex i t | 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 a 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 :: IxTraversal i s s a b Source #
This is the trivial empty IxTraversal
.
>>>
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 t a a -> Int -> IxTraversal Int s t a a Source #
Traverse the nth element of a Traversal
if it exists.
TODO: the result ideally should be an indexed affine traversal.
element :: Traversable f => Int -> IxTraversal' 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.
Subtyping
data A_Traversal 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 a 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 (FoldableWithIndex i t, Traversable t) => TraversableWithIndex i t | t -> i where Source #
Class for Traversable
s that have an additional read-only index available.
itraverse :: Applicative f => (i -> a -> f b) -> t a -> f (t b) Source #