Safe Haskell | Safe |
---|---|
Language | Haskell2010 |
Synopsis
- type Traversal s t a b = forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
- type Traversal' s a = Traversal s s a a
- 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
- types :: HasTypes s a => Traversal' s a
- class Each s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Ixed m where
- type family Index s :: *
- type family IxValue m :: *
Traversal
type Traversal s t a b = forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t #
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 #
typeTraversal'
=Simple
Traversal
traverseOf :: LensLike f s t a b -> (a -> f b) -> s -> f t #
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 #
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 #
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
types :: HasTypes s a => Traversal' s a #
Each
class Each s t a b | s -> a, t -> b, s b -> t, t a -> s where #
Extract each
element of a (potentially monomorphic) container.
Notably, when applied to a tuple, this generalizes both
to arbitrary homogeneous tuples.
>>>
(1,2,3) & each *~ 10
(10,20,30)
It can also be used on monomorphic containers like Text
or ByteString
.
>>>
over each Char.toUpper ("hello"^.Text.packed)
"HELLO"
>>>
("hello","world") & each.each %~ Char.toUpper
("HELLO","WORLD")
Instances
(a ~ Word8, b ~ Word8) => Each ByteString ByteString a b |
|
Defined in Control.Lens.Each each :: Traversal ByteString ByteString a b # | |
(a ~ Word8, b ~ Word8) => Each ByteString ByteString a b |
|
Defined in Control.Lens.Each each :: Traversal ByteString ByteString a b # | |
(a ~ Char, b ~ Char) => Each Text Text a b |
|
(a ~ Char, b ~ Char) => Each Text Text a b |
|
Each [a] [b] a b |
|
Defined in Control.Lens.Each | |
Each (Maybe a) (Maybe b) a b |
|
Each (Complex a) (Complex b) a b |
|
Each (Identity a) (Identity b) a b |
|
Each (NonEmpty a) (NonEmpty b) a b |
|
Each (IntMap a) (IntMap b) a b |
|
Each (Tree a) (Tree b) a b |
|
Each (Seq a) (Seq b) a b |
|
(Prim a, Prim b) => Each (Vector a) (Vector b) a b |
|
(Storable a, Storable b) => Each (Vector a) (Vector b) a b |
|
(Unbox a, Unbox b) => Each (Vector a) (Vector b) a b |
|
Each (Vector a) (Vector b) a b |
|
(a ~ a', b ~ b') => Each (a, a') (b, b') a b |
|
Defined in Control.Lens.Each | |
c ~ d => Each (HashMap c a) (HashMap d b) a b |
|
c ~ d => Each (Map c a) (Map d b) a b |
|
(Ix i, IArray UArray a, IArray UArray b, i ~ j) => Each (UArray i a) (UArray j b) a b |
|
(Ix i, i ~ j) => Each (Array i a) (Array j b) a b |
|
(a ~ a2, a ~ a3, b ~ b2, b ~ b3) => Each (a, a2, a3) (b, b2, b3) a b |
|
Defined in Control.Lens.Each | |
(a ~ a2, a ~ a3, a ~ a4, b ~ b2, b ~ b3, b ~ b4) => Each (a, a2, a3, a4) (b, b2, b3, b4) a b |
|
Defined in Control.Lens.Each | |
(a ~ a2, a ~ a3, a ~ a4, a ~ a5, b ~ b2, b ~ b3, b ~ b4, b ~ b5) => Each (a, a2, a3, a4, a5) (b, b2, b3, b4, b5) a b |
|
Defined in Control.Lens.Each | |
(a ~ a2, a ~ a3, a ~ a4, a ~ a5, a ~ a6, b ~ b2, b ~ b3, b ~ b4, b ~ b5, b ~ b6) => Each (a, a2, a3, a4, a5, a6) (b, b2, b3, b4, b5, b6) a b |
|
Defined in Control.Lens.Each | |
(a ~ a2, a ~ a3, a ~ a4, a ~ a5, a ~ a6, a ~ a7, b ~ b2, b ~ b3, b ~ b4, b ~ b5, b ~ b6, b ~ b7) => Each (a, a2, a3, a4, a5, a6, a7) (b, b2, b3, b4, b5, b6, b7) a b |
|
Defined in Control.Lens.Each | |
(a ~ a2, a ~ a3, a ~ a4, a ~ a5, a ~ a6, a ~ a7, a ~ a8, b ~ b2, b ~ b3, b ~ b4, b ~ b5, b ~ b6, b ~ b7, b ~ b8) => Each (a, a2, a3, a4, a5, a6, a7, a8) (b, b2, b3, b4, b5, b6, b7, b8) a b |
|
Defined in Control.Lens.Each | |
(a ~ a2, a ~ a3, a ~ a4, a ~ a5, a ~ a6, a ~ a7, a ~ a8, a ~ a9, b ~ b2, b ~ b3, b ~ b4, b ~ b5, b ~ b6, b ~ b7, b ~ b8, b ~ b9) => Each (a, a2, a3, a4, a5, a6, a7, a8, a9) (b, b2, b3, b4, b5, b6, b7, b8, b9) a b |
|
Defined in Control.Lens.Each |
Ixed
Provides a simple Traversal
lets you traverse
the value at a given
key in a Map
or element at an ordinal position in a list or Seq
.
ix :: Index m -> Traversal' m (IxValue m) #
NB: Setting the value of this Traversal
will only set the value in
at
if it is already present.
If you want to be able to insert missing values, you want at
.
>>>
Seq.fromList [a,b,c,d] & ix 2 %~ f
fromList [a,b,f c,d]
>>>
Seq.fromList [a,b,c,d] & ix 2 .~ e
fromList [a,b,e,d]
>>>
Seq.fromList [a,b,c,d] ^? ix 2
Just c
>>>
Seq.fromList [] ^? ix 2
Nothing
Instances
Ixed ByteString | |
Defined in Control.Lens.At ix :: Index ByteString -> Traversal' ByteString (IxValue ByteString) # | |
Ixed ByteString | |
Defined in Control.Lens.At ix :: Index ByteString -> Traversal' ByteString (IxValue ByteString) # | |
Ixed Text | |
Defined in Control.Lens.At | |
Ixed Text | |
Defined in Control.Lens.At | |
Ixed IntSet | |
Defined in Control.Lens.At | |
Ixed [a] | |
Defined in Control.Lens.At ix :: Index [a] -> Traversal' [a] (IxValue [a]) # | |
Ixed (Maybe a) | |
Defined in Control.Lens.At | |
Ixed (Identity a) | |
Defined in Control.Lens.At | |
Ixed (NonEmpty a) | |
Defined in Control.Lens.At | |
Ixed (IntMap a) | |
Defined in Control.Lens.At | |
Ixed (Tree a) | |
Defined in Control.Lens.At | |
Ixed (Seq a) | |
Defined in Control.Lens.At | |
Ord k => Ixed (Set k) | |
Defined in Control.Lens.At | |
Prim a => Ixed (Vector a) | |
Defined in Control.Lens.At | |
Storable a => Ixed (Vector a) | |
Defined in Control.Lens.At | |
Unbox a => Ixed (Vector a) | |
Defined in Control.Lens.At | |
(Eq k, Hashable k) => Ixed (HashSet k) | |
Defined in Control.Lens.At | |
Ixed (Vector a) | |
Defined in Control.Lens.At | |
Eq e => Ixed (e -> a) | |
Defined in Control.Lens.At ix :: Index (e -> a) -> Traversal' (e -> a) (IxValue (e -> a)) # | |
a ~ a2 => Ixed (a, a2) | |
Defined in Control.Lens.At ix :: Index (a, a2) -> Traversal' (a, a2) (IxValue (a, a2)) # | |
(Eq k, Hashable k) => Ixed (HashMap k a) | |
Defined in Control.Lens.At | |
Ord k => Ixed (Map k a) | |
Defined in Control.Lens.At | |
(IArray UArray e, Ix i) => Ixed (UArray i e) | arr |
Defined in Control.Lens.At | |
Ix i => Ixed (Array i e) | arr |
Defined in Control.Lens.At | |
(Eq k, Hashable k) => Ixed (InsOrdHashMap k v) | |
Defined in Data.HashMap.Strict.InsOrd ix :: Index (InsOrdHashMap k v) -> Traversal' (InsOrdHashMap k v) (IxValue (InsOrdHashMap k v)) # | |
(a ~ a2, a ~ a3) => Ixed (a, a2, a3) | |
Defined in Control.Lens.At ix :: Index (a, a2, a3) -> Traversal' (a, a2, a3) (IxValue (a, a2, a3)) # | |
(a ~ a2, a ~ a3, a ~ a4) => Ixed (a, a2, a3, a4) | |
Defined in Control.Lens.At ix :: Index (a, a2, a3, a4) -> Traversal' (a, a2, a3, a4) (IxValue (a, a2, a3, a4)) # | |
(a ~ a2, a ~ a3, a ~ a4, a ~ a5) => Ixed (a, a2, a3, a4, a5) | |
Defined in Control.Lens.At ix :: Index (a, a2, a3, a4, a5) -> Traversal' (a, a2, a3, a4, a5) (IxValue (a, a2, a3, a4, a5)) # | |
(a ~ a2, a ~ a3, a ~ a4, a ~ a5, a ~ a6) => Ixed (a, a2, a3, a4, a5, a6) | |
Defined in Control.Lens.At ix :: Index (a, a2, a3, a4, a5, a6) -> Traversal' (a, a2, a3, a4, a5, a6) (IxValue (a, a2, a3, a4, a5, a6)) # | |
(a ~ a2, a ~ a3, a ~ a4, a ~ a5, a ~ a6, a ~ a7) => Ixed (a, a2, a3, a4, a5, a6, a7) | |
Defined in Control.Lens.At ix :: Index (a, a2, a3, a4, a5, a6, a7) -> Traversal' (a, a2, a3, a4, a5, a6, a7) (IxValue (a, a2, a3, a4, a5, a6, a7)) # | |
(a ~ a2, a ~ a3, a ~ a4, a ~ a5, a ~ a6, a ~ a7, a ~ a8) => Ixed (a, a2, a3, a4, a5, a6, a7, a8) | |
Defined in Control.Lens.At ix :: Index (a, a2, a3, a4, a5, a6, a7, a8) -> Traversal' (a, a2, a3, a4, a5, a6, a7, a8) (IxValue (a, a2, a3, a4, a5, a6, a7, a8)) # | |
(a ~ a2, a ~ a3, a ~ a4, a ~ a5, a ~ a6, a ~ a7, a ~ a8, a ~ a9) => Ixed (a, a2, a3, a4, a5, a6, a7, a8, a9) | |
Defined in Control.Lens.At ix :: Index (a, a2, a3, a4, a5, a6, a7, a8, a9) -> Traversal' (a, a2, a3, a4, a5, a6, a7, a8, a9) (IxValue (a, a2, a3, a4, a5, a6, a7, a8, a9)) # |
Instances
type Index ByteString | |
Defined in Control.Lens.At | |
type Index ByteString | |
Defined in Control.Lens.At | |
type Index Text | |
Defined in Control.Lens.At | |
type Index Value | |
Defined in Data.Aeson.Lens | |
type Index Text | |
Defined in Control.Lens.At | |
type Index IntSet | |
Defined in Control.Lens.At | |
type Index [a] | |
Defined in Control.Lens.At | |
type Index (Maybe a) | |
Defined in Control.Lens.At | |
type Index (Complex a) | |
Defined in Control.Lens.At | |
type Index (Identity a) | |
Defined in Control.Lens.At | |
type Index (NonEmpty a) | |
Defined in Control.Lens.At | |
type Index (IntMap a) | |
Defined in Control.Lens.At | |
type Index (Tree a) | |
Defined in Control.Lens.At | |
type Index (Seq a) | |
Defined in Control.Lens.At | |
type Index (Set a) | |
Defined in Control.Lens.At | |
type Index (Vector a) | |
Defined in Control.Lens.At | |
type Index (Vector a) | |
Defined in Control.Lens.At | |
type Index (Vector a) | |
Defined in Control.Lens.At | |
type Index (HashSet a) | |
Defined in Control.Lens.At | |
type Index (Vector a) | |
Defined in Control.Lens.At | |
type Index (e -> a) | |
Defined in Control.Lens.At type Index (e -> a) = e | |
type Index (a, b) | |
Defined in Control.Lens.At | |
type Index (HashMap k a) | |
Defined in Control.Lens.At | |
type Index (Map k a) | |
Defined in Control.Lens.At | |
type Index (UArray i e) | |
Defined in Control.Lens.At | |
type Index (Array i e) | |
Defined in Control.Lens.At | |
type Index (InsOrdHashMap k v) | |
Defined in Data.HashMap.Strict.InsOrd | |
type Index (a, b, c) | |
Defined in Control.Lens.At | |
type Index (a, b, c, d) | |
Defined in Control.Lens.At | |
type Index (a, b, c, d, e) | |
Defined in Control.Lens.At | |
type Index (a, b, c, d, e, f) | |
Defined in Control.Lens.At | |
type Index (a, b, c, d, e, f, g) | |
Defined in Control.Lens.At | |
type Index (a, b, c, d, e, f, g, h) | |
Defined in Control.Lens.At | |
type Index (a, b, c, d, e, f, g, h, i) | |
Defined in Control.Lens.At |
Instances
type IxValue ByteString | |
Defined in Control.Lens.At | |
type IxValue ByteString | |
Defined in Control.Lens.At | |
type IxValue Text | |
Defined in Control.Lens.At | |
type IxValue Value | |
Defined in Data.Aeson.Lens | |
type IxValue Text | |
Defined in Control.Lens.At | |
type IxValue IntSet | |
Defined in Control.Lens.At | |
type IxValue [a] | |
Defined in Control.Lens.At type IxValue [a] = a | |
type IxValue (Maybe a) | |
Defined in Control.Lens.At | |
type IxValue (Identity a) | |
Defined in Control.Lens.At | |
type IxValue (NonEmpty a) | |
Defined in Control.Lens.At | |
type IxValue (IntMap a) | |
Defined in Control.Lens.At | |
type IxValue (Tree a) | |
Defined in Control.Lens.At | |
type IxValue (Seq a) | |
Defined in Control.Lens.At | |
type IxValue (Set k) | |
Defined in Control.Lens.At | |
type IxValue (Vector a) | |
Defined in Control.Lens.At | |
type IxValue (Vector a) | |
Defined in Control.Lens.At | |
type IxValue (Vector a) | |
Defined in Control.Lens.At | |
type IxValue (HashSet k) | |
Defined in Control.Lens.At | |
type IxValue (Vector a) | |
Defined in Control.Lens.At | |
type IxValue (e -> a) | |
Defined in Control.Lens.At type IxValue (e -> a) = a | |
type IxValue (a, a2) | |
Defined in Control.Lens.At type IxValue (a, a2) = a | |
type IxValue (HashMap k a) | |
Defined in Control.Lens.At | |
type IxValue (Map k a) | |
Defined in Control.Lens.At | |
type IxValue (UArray i e) | |
Defined in Control.Lens.At | |
type IxValue (Array i e) | |
Defined in Control.Lens.At | |
type IxValue (InsOrdHashMap k v) | |
Defined in Data.HashMap.Strict.InsOrd | |
type IxValue (a, a2, a3) | |
Defined in Control.Lens.At type IxValue (a, a2, a3) = a | |
type IxValue (a, a2, a3, a4) | |
Defined in Control.Lens.At type IxValue (a, a2, a3, a4) = a | |
type IxValue (a, a2, a3, a4, a5) | |
Defined in Control.Lens.At type IxValue (a, a2, a3, a4, a5) = a | |
type IxValue (a, a2, a3, a4, a5, a6) | |
Defined in Control.Lens.At type IxValue (a, a2, a3, a4, a5, a6) = a | |
type IxValue (a, a2, a3, a4, a5, a6, a7) | |
Defined in Control.Lens.At type IxValue (a, a2, a3, a4, a5, a6, a7) = a | |
type IxValue (a, a2, a3, a4, a5, a6, a7, a8) | |
Defined in Control.Lens.At type IxValue (a, a2, a3, a4, a5, a6, a7, a8) = a | |
type IxValue (a, a2, a3, a4, a5, a6, a7, a8, a9) | |
Defined in Control.Lens.At type IxValue (a, a2, a3, a4, a5, a6, a7, a8, a9) = a |