{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE UndecidableInstances #-}
module Optics.Traversal
(
Traversal
, Traversal'
, traversalVL
, traverseOf
, traversed
, both
, forOf
, sequenceOf
, transposeOf
, mapAccumROf
, mapAccumLOf
, scanr1Of
, scanl1Of
, rewriteMOf
, transformMOf
, failover
, failover'
, backwards
, partsOf
, singular
, adjoin
, A_Traversal
, TraversalVL
, TraversalVL'
)
where
import Control.Applicative
import Control.Applicative.Backwards
import Control.Monad.Trans.State
import Data.Bitraversable
import Data.Functor.Identity
import Data.Profunctor.Indexed
import Optics.AffineTraversal
import Optics.Fold
import Optics.Internal.Optic
import Optics.Internal.Traversal
import Optics.Internal.Utils
import Optics.Lens
import Optics.ReadOnly
type Traversal s t a b = Optic A_Traversal NoIx s t a b
type Traversal' s a = Optic' A_Traversal NoIx s a
type TraversalVL s t a b = forall f. Applicative f => (a -> f b) -> s -> f t
type TraversalVL' s a = TraversalVL s s a a
traversalVL :: TraversalVL s t a b -> Traversal s t a b
traversalVL :: forall s t a b. TraversalVL s t a b -> Traversal s t a b
traversalVL TraversalVL s t a b
t = forall k (is :: IxList) s t a b.
(forall (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_ k p i (Curry is i) s t a b)
-> Optic k is s t a b
Optic (forall (p :: * -> * -> * -> *) a b s t i.
Traversing p =>
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> p i a b -> p i s t
wander TraversalVL s t a b
t)
{-# INLINE traversalVL #-}
traverseOf
:: (Is k A_Traversal, Applicative f)
=> Optic k is s t a b
-> (a -> f b) -> s -> f t
traverseOf :: forall k (f :: * -> *) (is :: IxList) s t a b.
(Is k A_Traversal, Applicative f) =>
Optic k is s t a b -> (a -> f b) -> s -> f t
traverseOf Optic k is s t a b
o = \a -> f b
f -> forall (f :: * -> *) i a b. Star f i a b -> a -> f b
runStar forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> * -> *) k (is :: IxList) s t a b i.
Profunctor p =>
Optic k is s t a b -> Optic_ k p i (Curry is i) s t a b
getOptic (forall destKind srcKind (is :: IxList) s t a b.
Is srcKind destKind =>
Optic srcKind is s t a b -> Optic destKind is s t a b
castOptic @A_Traversal Optic k is s t a b
o) (forall (f :: * -> *) i a b. (a -> f b) -> Star f i a b
Star a -> f b
f)
{-# INLINE traverseOf #-}
forOf
:: (Is k A_Traversal, Applicative f)
=> Optic k is s t a b
-> s -> (a -> f b) -> f t
forOf :: forall k (f :: * -> *) (is :: IxList) s t a b.
(Is k A_Traversal, Applicative f) =>
Optic k is s t a b -> s -> (a -> f b) -> f t
forOf = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (f :: * -> *) (is :: IxList) s t a b.
(Is k A_Traversal, Applicative f) =>
Optic k is s t a b -> (a -> f b) -> s -> f t
traverseOf
{-# INLINE forOf #-}
sequenceOf
:: (Is k A_Traversal, Applicative f)
=> Optic k is s t (f b) b
-> s -> f t
sequenceOf :: forall k (f :: * -> *) (is :: IxList) s t b.
(Is k A_Traversal, Applicative f) =>
Optic k is s t (f b) b -> s -> f t
sequenceOf Optic k is s t (f b) b
o = forall k (f :: * -> *) (is :: IxList) s t a b.
(Is k A_Traversal, Applicative f) =>
Optic k is s t a b -> (a -> f b) -> s -> f t
traverseOf Optic k is s t (f b) b
o forall a. a -> a
id
{-# INLINE sequenceOf #-}
transposeOf
:: Is k A_Traversal
=> Optic k is s t [a] a
-> s -> [t]
transposeOf :: forall k (is :: IxList) s t a.
Is k A_Traversal =>
Optic k is s t [a] a -> s -> [t]
transposeOf Optic k is s t [a] a
o = forall a. ZipList a -> [a]
getZipList forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall k (f :: * -> *) (is :: IxList) s t a b.
(Is k A_Traversal, Applicative f) =>
Optic k is s t a b -> (a -> f b) -> s -> f t
traverseOf Optic k is s t [a] a
o forall a. [a] -> ZipList a
ZipList
{-# INLINE transposeOf #-}
mapAccumLOf
:: Is k A_Traversal
=> Optic k is s t a b
-> (acc -> a -> (b, acc)) -> acc -> s -> (t, acc)
mapAccumLOf :: forall k (is :: IxList) s t a b acc.
Is k A_Traversal =>
Optic k is s t a b
-> (acc -> a -> (b, acc)) -> acc -> s -> (t, acc)
mapAccumLOf Optic k is s t a b
o = \acc -> a -> (b, acc)
f acc
acc0 s
s ->
let g :: a -> StateT acc Identity b
g a
a = forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state forall a b. (a -> b) -> a -> b
$ \acc
acc -> acc -> a -> (b, acc)
f acc
acc a
a
in forall s a. State s a -> s -> (a, s)
runState (forall k (f :: * -> *) (is :: IxList) s t a b.
(Is k A_Traversal, Applicative f) =>
Optic k is s t a b -> (a -> f b) -> s -> f t
traverseOf Optic k is s t a b
o a -> StateT acc Identity b
g s
s) acc
acc0
{-# INLINE mapAccumLOf #-}
mapAccumROf
:: Is k A_Traversal
=> Optic k is s t a b
-> (acc -> a -> (b, acc)) -> acc -> s -> (t, acc)
mapAccumROf :: forall k (is :: IxList) s t a b acc.
Is k A_Traversal =>
Optic k is s t a b
-> (acc -> a -> (b, acc)) -> acc -> s -> (t, acc)
mapAccumROf = forall k (is :: IxList) s t a b acc.
Is k A_Traversal =>
Optic k is s t a b
-> (acc -> a -> (b, acc)) -> acc -> s -> (t, acc)
mapAccumLOf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (is :: IxList) s t a b.
Is k A_Traversal =>
Optic k is s t a b -> Traversal s t a b
backwards
{-# INLINE mapAccumROf #-}
scanl1Of
:: Is k A_Traversal
=> Optic k is s t a a
-> (a -> a -> a) -> s -> t
scanl1Of :: forall k (is :: IxList) s t a.
Is k A_Traversal =>
Optic k is s t a a -> (a -> a -> a) -> s -> t
scanl1Of Optic k is s t a a
o = \a -> a -> a
f ->
let step :: Maybe a -> a -> (a, Maybe a)
step Maybe a
Nothing a
a = (a
a, forall a. a -> Maybe a
Just a
a)
step (Just a
s) a
a = let r :: a
r = a -> a -> a
f a
s a
a in (a
r, forall a. a -> Maybe a
Just a
r)
in forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (is :: IxList) s t a b acc.
Is k A_Traversal =>
Optic k is s t a b
-> (acc -> a -> (b, acc)) -> acc -> s -> (t, acc)
mapAccumLOf Optic k is s t a a
o Maybe a -> a -> (a, Maybe a)
step forall a. Maybe a
Nothing
{-# INLINE scanl1Of #-}
scanr1Of
:: Is k A_Traversal
=> Optic k is s t a a
-> (a -> a -> a) -> s -> t
scanr1Of :: forall k (is :: IxList) s t a.
Is k A_Traversal =>
Optic k is s t a a -> (a -> a -> a) -> s -> t
scanr1Of Optic k is s t a a
o = \a -> a -> a
f ->
let step :: Maybe a -> a -> (a, Maybe a)
step Maybe a
Nothing a
a = (a
a, forall a. a -> Maybe a
Just a
a)
step (Just a
s) a
a = let r :: a
r = a -> a -> a
f a
a a
s in (a
r, forall a. a -> Maybe a
Just a
r)
in forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (is :: IxList) s t a b acc.
Is k A_Traversal =>
Optic k is s t a b
-> (acc -> a -> (b, acc)) -> acc -> s -> (t, acc)
mapAccumROf Optic k is s t a a
o Maybe a -> a -> (a, Maybe a)
step forall a. Maybe a
Nothing
{-# INLINE scanr1Of #-}
rewriteMOf
:: (Is k A_Traversal, Monad m)
=> Optic k is a b a b
-> (b -> m (Maybe a)) -> a -> m b
rewriteMOf :: forall k (m :: * -> *) (is :: IxList) a b.
(Is k A_Traversal, Monad m) =>
Optic k is a b a b -> (b -> m (Maybe a)) -> a -> m b
rewriteMOf Optic k is a b a b
l b -> m (Maybe a)
f = a -> m b
go
where
go :: a -> m b
go = forall k (m :: * -> *) (is :: IxList) a b.
(Is k A_Traversal, Monad m) =>
Optic k is a b a b -> (b -> m b) -> a -> m b
transformMOf Optic k is a b a b
l (\b
x -> b -> m (Maybe a)
f b
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return b
x) a -> m b
go)
{-# INLINE rewriteMOf #-}
transformMOf
:: (Is k A_Traversal, Monad m)
=> Optic k is a b a b
-> (b -> m b) -> a -> m b
transformMOf :: forall k (m :: * -> *) (is :: IxList) a b.
(Is k A_Traversal, Monad m) =>
Optic k is a b a b -> (b -> m b) -> a -> m b
transformMOf Optic k is a b a b
l b -> m b
f = a -> m b
go
where
go :: a -> m b
go a
t = forall k (f :: * -> *) (is :: IxList) s t a b.
(Is k A_Traversal, Applicative f) =>
Optic k is s t a b -> (a -> f b) -> s -> f t
traverseOf Optic k is a b a b
l a -> m b
go a
t forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> m b
f
{-# INLINE transformMOf #-}
failover
:: Is k A_Traversal
=> Optic k is s t a b
-> (a -> b) -> s -> Maybe t
failover :: forall k (is :: IxList) s t a b.
Is k A_Traversal =>
Optic k is s t a b -> (a -> b) -> s -> Maybe t
failover Optic k is s t a b
o = \a -> b
f s
s ->
let OrT Bool
visited Identity t
t = forall k (f :: * -> *) (is :: IxList) s t a b.
(Is k A_Traversal, Applicative f) =>
Optic k is s t a b -> (a -> f b) -> s -> f t
traverseOf Optic k is s t a b
o (forall (f :: * -> *) a. f a -> OrT f a
wrapOrT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Identity a
Identity forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. a -> b
f) s
s
in if Bool
visited
then forall a. a -> Maybe a
Just (forall a. Identity a -> a
runIdentity Identity t
t)
else forall a. Maybe a
Nothing
{-# INLINE failover #-}
failover'
:: Is k A_Traversal
=> Optic k is s t a b
-> (a -> b) -> s -> Maybe t
failover' :: forall k (is :: IxList) s t a b.
Is k A_Traversal =>
Optic k is s t a b -> (a -> b) -> s -> Maybe t
failover' Optic k is s t a b
o = \a -> b
f s
s ->
let OrT Bool
visited Identity' t
t = forall k (f :: * -> *) (is :: IxList) s t a b.
(Is k A_Traversal, Applicative f) =>
Optic k is s t a b -> (a -> f b) -> s -> f t
traverseOf Optic k is s t a b
o (forall (f :: * -> *) a. f a -> OrT f a
wrapOrT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Identity' a
wrapIdentity' forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) s
s
in if Bool
visited
then forall a. a -> Maybe a
Just (forall a. Identity' a -> a
unwrapIdentity' Identity' t
t)
else forall a. Maybe a
Nothing
{-# INLINE failover' #-}
traversed :: Traversable t => Traversal (t a) (t b) a b
traversed :: forall (t :: * -> *) a b.
Traversable t =>
Traversal (t a) (t b) a b
traversed = forall k (is :: IxList) s t a b.
(forall (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_ k p i (Curry is i) s t a b)
-> Optic k is s t a b
Optic forall (p :: * -> * -> * -> *) (f :: * -> *) i a b.
(Traversing p, Traversable f) =>
Optic__ p i i (f a) (f b) a b
traversed__
{-# INLINE traversed #-}
both :: Bitraversable r => Traversal (r a a) (r b b) a b
both :: forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both = forall s t a b. TraversalVL s t a b -> Traversal s t a b
traversalVL forall a b. (a -> b) -> a -> b
$ \a -> f b
f -> forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f b
f a -> f b
f
{-# INLINE both #-}
backwards
:: Is k A_Traversal
=> Optic k is s t a b
-> Traversal s t a b
backwards :: forall k (is :: IxList) s t a b.
Is k A_Traversal =>
Optic k is s t a b -> Traversal s t a b
backwards Optic k is s t a b
o = forall s t a b. TraversalVL s t a b -> Traversal s t a b
traversalVL forall a b. (a -> b) -> a -> b
$ \a -> f b
f -> forall {k} (f :: k -> *) (a :: k). Backwards f a -> f a
forwards forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall k (f :: * -> *) (is :: IxList) s t a b.
(Is k A_Traversal, Applicative f) =>
Optic k is s t a b -> (a -> f b) -> s -> f t
traverseOf Optic k is s t a b
o (forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. a -> f b
f)
{-# INLINE backwards #-}
partsOf
:: forall k is s t a. Is k A_Traversal
=> Optic k is s t a a
-> Lens s t [a] [a]
partsOf :: forall k (is :: IxList) s t a.
Is k A_Traversal =>
Optic k is s t a a -> Lens s t [a] [a]
partsOf Optic k is s t a a
o = forall s t a b. LensVL s t a b -> Lens s t a b
lensVL forall a b. (a -> b) -> a -> b
$ \[a] -> f [a]
f s
s -> forall s a. State s a -> s -> a
evalState (forall k (f :: * -> *) (is :: IxList) s t a b.
(Is k A_Traversal, Applicative f) =>
Optic k is s t a b -> (a -> f b) -> s -> f t
traverseOf Optic k is s t a a
o forall {m :: * -> *} {b}. Monad m => b -> StateT [b] m b
update s
s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> f [a]
f (forall k (is :: IxList) s a.
Is k A_Fold =>
Optic' k is s a -> s -> [a]
toListOf (forall k s t a b (is :: IxList).
ToReadOnly k s t a b =>
Optic k is s t a b -> Optic' (ReadOnlyOptic k) is s a
getting forall a b. (a -> b) -> a -> b
$ forall destKind srcKind (is :: IxList) s t a b.
Is srcKind destKind =>
Optic srcKind is s t a b -> Optic destKind is s t a b
castOptic @A_Traversal Optic k is s t a a
o) s
s)
where
update :: b -> StateT [b] m b
update b
a = forall (m :: * -> *) s. Monad m => StateT s m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
b
a' : [b]
as' -> forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put [b]
as' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a'
[] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a
{-# INLINE partsOf #-}
singular
:: forall k is s a. Is k A_Traversal
=> Optic' k is s a
-> AffineTraversal' s a
singular :: forall k (is :: IxList) s a.
Is k A_Traversal =>
Optic' k is s a -> AffineTraversal' s a
singular Optic' k is s a
o = forall s t a b.
AffineTraversalVL s t a b -> AffineTraversal s t a b
atraversalVL forall a b. (a -> b) -> a -> b
$ \forall r. r -> f r
point a -> f a
f s
s ->
case forall k (is :: IxList) s a.
Is k A_Fold =>
Optic' k is s a -> s -> Maybe a
headOf (forall destKind srcKind (is :: IxList) s t a b.
Is srcKind destKind =>
Optic srcKind is s t a b -> Optic destKind is s t a b
castOptic @A_Traversal Optic' k is s a
o) s
s of
Maybe a
Nothing -> forall r. r -> f r
point s
s
Just a
a -> forall s a. State s a -> s -> a
evalState (forall k (f :: * -> *) (is :: IxList) s t a b.
(Is k A_Traversal, Applicative f) =>
Optic k is s t a b -> (a -> f b) -> s -> f t
traverseOf Optic' k is s a
o forall {m :: * -> *} {b}. Monad m => b -> StateT (Maybe b) m b
update s
s) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
f a
a
where
update :: b -> StateT (Maybe b) m b
update b
a = forall (m :: * -> *) s. Monad m => StateT s m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just b
a' -> forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put forall a. Maybe a
Nothing forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a'
Maybe b
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a
{-# INLINE singular #-}
adjoin
:: (Is k A_Traversal, Is l A_Traversal)
=> Optic' k is s a
-> Optic' l js s a
-> Traversal' s a
adjoin :: forall k l (is :: IxList) s a (js :: IxList).
(Is k A_Traversal, Is l A_Traversal) =>
Optic' k is s a -> Optic' l js s a -> Traversal' s a
adjoin Optic' k is s a
o1 Optic' l js s a
o2 = Traversal s s [a] [a]
combined forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (t :: * -> *) a b.
Traversable t =>
Traversal (t a) (t b) a b
traversed
where
combined :: Traversal s s [a] [a]
combined = forall s t a b. TraversalVL s t a b -> Traversal s t a b
traversalVL forall a b. (a -> b) -> a -> b
$ \[a] -> f [a]
f s
s0 ->
(\[a]
r1 [a]
r2 ->
let s1 :: s
s1 = forall s a. State s a -> s -> a
evalState (forall k (f :: * -> *) (is :: IxList) s t a b.
(Is k A_Traversal, Applicative f) =>
Optic k is s t a b -> (a -> f b) -> s -> f t
traverseOf Optic' k is s a
o1 forall {m :: * -> *} {b}. Monad m => b -> StateT [b] m b
update s
s0) [a]
r1
s2 :: s
s2 = forall s a. State s a -> s -> a
evalState (forall k (f :: * -> *) (is :: IxList) s t a b.
(Is k A_Traversal, Applicative f) =>
Optic k is s t a b -> (a -> f b) -> s -> f t
traverseOf Optic' l js s a
o2 forall {m :: * -> *} {b}. Monad m => b -> StateT [b] m b
update s
s1) [a]
r2
in s
s2
)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> f [a]
f (forall k (is :: IxList) s a.
Is k A_Fold =>
Optic' k is s a -> s -> [a]
toListOf (forall destKind srcKind (is :: IxList) s t a b.
Is srcKind destKind =>
Optic srcKind is s t a b -> Optic destKind is s t a b
castOptic @A_Traversal Optic' k is s a
o1) s
s0)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [a] -> f [a]
f (forall k (is :: IxList) s a.
Is k A_Fold =>
Optic' k is s a -> s -> [a]
toListOf (forall destKind srcKind (is :: IxList) s t a b.
Is srcKind destKind =>
Optic srcKind is s t a b -> Optic destKind is s t a b
castOptic @A_Traversal Optic' l js s a
o2) s
s0)
update :: b -> StateT [b] m b
update b
a = forall (m :: * -> *) s. Monad m => StateT s m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
b
a' : [b]
as' -> forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put [b]
as' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a'
[] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a
infixr 6 `adjoin`
{-# INLINE [1] adjoin #-}
{-# RULES
"adjoin_12_3" forall o1 o2 o3. adjoin o1 (adjoin o2 o3) = adjoin3 o1 o2 o3
"adjoin_21_3" forall o1 o2 o3. adjoin (adjoin o1 o2) o3 = adjoin3 o1 o2 o3
"adjoin_13_4" forall o1 o2 o3 o4. adjoin o1 (adjoin3 o2 o3 o4) = adjoin4 o1 o2 o3 o4
"adjoin_31_4" forall o1 o2 o3 o4. adjoin (adjoin3 o1 o2 o3) o4 = adjoin4 o1 o2 o3 o4
#-}
adjoin3
:: (Is k1 A_Traversal, Is k2 A_Traversal, Is k3 A_Traversal)
=> Optic' k1 is1 s a
-> Optic' k2 is2 s a
-> Optic' k3 is3 s a
-> Traversal' s a
adjoin3 :: forall k1 k2 k3 (is1 :: IxList) s a (is2 :: IxList)
(is3 :: IxList).
(Is k1 A_Traversal, Is k2 A_Traversal, Is k3 A_Traversal) =>
Optic' k1 is1 s a
-> Optic' k2 is2 s a -> Optic' k3 is3 s a -> Traversal' s a
adjoin3 Optic' k1 is1 s a
o1 Optic' k2 is2 s a
o2 Optic' k3 is3 s a
o3 = Traversal s s [a] [a]
combined forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (t :: * -> *) a b.
Traversable t =>
Traversal (t a) (t b) a b
traversed
where
combined :: Traversal s s [a] [a]
combined = forall s t a b. TraversalVL s t a b -> Traversal s t a b
traversalVL forall a b. (a -> b) -> a -> b
$ \[a] -> f [a]
f s
s0 ->
(\[a]
r1 [a]
r2 [a]
r3 ->
let s1 :: s
s1 = forall s a. State s a -> s -> a
evalState (forall k (f :: * -> *) (is :: IxList) s t a b.
(Is k A_Traversal, Applicative f) =>
Optic k is s t a b -> (a -> f b) -> s -> f t
traverseOf Optic' k1 is1 s a
o1 forall {m :: * -> *} {b}. Monad m => b -> StateT [b] m b
update s
s0) [a]
r1
s2 :: s
s2 = forall s a. State s a -> s -> a
evalState (forall k (f :: * -> *) (is :: IxList) s t a b.
(Is k A_Traversal, Applicative f) =>
Optic k is s t a b -> (a -> f b) -> s -> f t
traverseOf Optic' k2 is2 s a
o2 forall {m :: * -> *} {b}. Monad m => b -> StateT [b] m b
update s
s1) [a]
r2
s3 :: s
s3 = forall s a. State s a -> s -> a
evalState (forall k (f :: * -> *) (is :: IxList) s t a b.
(Is k A_Traversal, Applicative f) =>
Optic k is s t a b -> (a -> f b) -> s -> f t
traverseOf Optic' k3 is3 s a
o3 forall {m :: * -> *} {b}. Monad m => b -> StateT [b] m b
update s
s2) [a]
r3
in s
s3
)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> f [a]
f (forall k (is :: IxList) s a.
Is k A_Fold =>
Optic' k is s a -> s -> [a]
toListOf (forall destKind srcKind (is :: IxList) s t a b.
Is srcKind destKind =>
Optic srcKind is s t a b -> Optic destKind is s t a b
castOptic @A_Traversal Optic' k1 is1 s a
o1) s
s0)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [a] -> f [a]
f (forall k (is :: IxList) s a.
Is k A_Fold =>
Optic' k is s a -> s -> [a]
toListOf (forall destKind srcKind (is :: IxList) s t a b.
Is srcKind destKind =>
Optic srcKind is s t a b -> Optic destKind is s t a b
castOptic @A_Traversal Optic' k2 is2 s a
o2) s
s0)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [a] -> f [a]
f (forall k (is :: IxList) s a.
Is k A_Fold =>
Optic' k is s a -> s -> [a]
toListOf (forall destKind srcKind (is :: IxList) s t a b.
Is srcKind destKind =>
Optic srcKind is s t a b -> Optic destKind is s t a b
castOptic @A_Traversal Optic' k3 is3 s a
o3) s
s0)
update :: b -> StateT [b] m b
update b
a = forall (m :: * -> *) s. Monad m => StateT s m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
b
a' : [b]
as' -> forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put [b]
as' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a'
[] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a
{-# INLINE [1] adjoin3 #-}
{-# RULES
"adjoin_211_4" forall o1 o2 o3 o4. adjoin3 (adjoin o1 o2) o3 o4 = adjoin4 o1 o2 o3 o4
"adjoin_121_4" forall o1 o2 o3 o4. adjoin3 o1 (adjoin o2 o3) o4 = adjoin4 o1 o2 o3 o4
"adjoin_112_4" forall o1 o2 o3 o4. adjoin3 o1 o2 (adjoin o3 o4) = adjoin4 o1 o2 o3 o4
#-}
adjoin4
:: (Is k1 A_Traversal, Is k2 A_Traversal, Is k3 A_Traversal, Is k4 A_Traversal)
=> Optic' k1 is1 s a
-> Optic' k2 is2 s a
-> Optic' k3 is3 s a
-> Optic' k4 is4 s a
-> Traversal' s a
adjoin4 :: forall k1 k2 k3 k4 (is1 :: IxList) s a (is2 :: IxList)
(is3 :: IxList) (is4 :: IxList).
(Is k1 A_Traversal, Is k2 A_Traversal, Is k3 A_Traversal,
Is k4 A_Traversal) =>
Optic' k1 is1 s a
-> Optic' k2 is2 s a
-> Optic' k3 is3 s a
-> Optic' k4 is4 s a
-> Traversal' s a
adjoin4 Optic' k1 is1 s a
o1 Optic' k2 is2 s a
o2 Optic' k3 is3 s a
o3 Optic' k4 is4 s a
o4 = Traversal s s [a] [a]
combined forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (t :: * -> *) a b.
Traversable t =>
Traversal (t a) (t b) a b
traversed
where
combined :: Traversal s s [a] [a]
combined = forall s t a b. TraversalVL s t a b -> Traversal s t a b
traversalVL forall a b. (a -> b) -> a -> b
$ \[a] -> f [a]
f s
s0 ->
(\[a]
r1 [a]
r2 [a]
r3 [a]
r4 ->
let s1 :: s
s1 = forall s a. State s a -> s -> a
evalState (forall k (f :: * -> *) (is :: IxList) s t a b.
(Is k A_Traversal, Applicative f) =>
Optic k is s t a b -> (a -> f b) -> s -> f t
traverseOf Optic' k1 is1 s a
o1 forall {m :: * -> *} {b}. Monad m => b -> StateT [b] m b
update s
s0) [a]
r1
s2 :: s
s2 = forall s a. State s a -> s -> a
evalState (forall k (f :: * -> *) (is :: IxList) s t a b.
(Is k A_Traversal, Applicative f) =>
Optic k is s t a b -> (a -> f b) -> s -> f t
traverseOf Optic' k2 is2 s a
o2 forall {m :: * -> *} {b}. Monad m => b -> StateT [b] m b
update s
s1) [a]
r2
s3 :: s
s3 = forall s a. State s a -> s -> a
evalState (forall k (f :: * -> *) (is :: IxList) s t a b.
(Is k A_Traversal, Applicative f) =>
Optic k is s t a b -> (a -> f b) -> s -> f t
traverseOf Optic' k3 is3 s a
o3 forall {m :: * -> *} {b}. Monad m => b -> StateT [b] m b
update s
s2) [a]
r3
s4 :: s
s4 = forall s a. State s a -> s -> a
evalState (forall k (f :: * -> *) (is :: IxList) s t a b.
(Is k A_Traversal, Applicative f) =>
Optic k is s t a b -> (a -> f b) -> s -> f t
traverseOf Optic' k4 is4 s a
o4 forall {m :: * -> *} {b}. Monad m => b -> StateT [b] m b
update s
s3) [a]
r4
in s
s4
)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> f [a]
f (forall k (is :: IxList) s a.
Is k A_Fold =>
Optic' k is s a -> s -> [a]
toListOf (forall destKind srcKind (is :: IxList) s t a b.
Is srcKind destKind =>
Optic srcKind is s t a b -> Optic destKind is s t a b
castOptic @A_Traversal Optic' k1 is1 s a
o1) s
s0)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [a] -> f [a]
f (forall k (is :: IxList) s a.
Is k A_Fold =>
Optic' k is s a -> s -> [a]
toListOf (forall destKind srcKind (is :: IxList) s t a b.
Is srcKind destKind =>
Optic srcKind is s t a b -> Optic destKind is s t a b
castOptic @A_Traversal Optic' k2 is2 s a
o2) s
s0)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [a] -> f [a]
f (forall k (is :: IxList) s a.
Is k A_Fold =>
Optic' k is s a -> s -> [a]
toListOf (forall destKind srcKind (is :: IxList) s t a b.
Is srcKind destKind =>
Optic srcKind is s t a b -> Optic destKind is s t a b
castOptic @A_Traversal Optic' k3 is3 s a
o3) s
s0)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [a] -> f [a]
f (forall k (is :: IxList) s a.
Is k A_Fold =>
Optic' k is s a -> s -> [a]
toListOf (forall destKind srcKind (is :: IxList) s t a b.
Is srcKind destKind =>
Optic srcKind is s t a b -> Optic destKind is s t a b
castOptic @A_Traversal Optic' k4 is4 s a
o4) s
s0)
update :: b -> StateT [b] m b
update b
a = forall (m :: * -> *) s. Monad m => StateT s m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
b
a' : [b]
as' -> forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put [b]
as' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a'
[] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a
{-# INLINE [1] adjoin4 #-}