{-# LANGUAGE DataKinds #-}
-- |
-- Module: Optics.IxTraversal
-- Description: An indexed version of a 'Optics.Traversal.Traversal'.
--
-- An 'IxTraversal' is an indexed version of a 'Optics.Traversal.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.
--
module Optics.IxTraversal
  (
  -- * Formation
    IxTraversal
  , IxTraversal'

  -- * Introduction
  , itraversalVL

  -- * Elimination
  , itraverseOf

  -- * Computation
  -- |
  --
  -- @
  -- 'itraverseOf' ('itraversalVL' f) ≡ f
  -- @

  -- * Well-formedness
  -- |
  --
  -- @
  -- 'itraverseOf' o ('const' 'pure') ≡ 'pure'
  -- 'fmap' ('itraverseOf' o f) . 'itraverseOf' o g ≡ 'Data.Functor.Compose.getCompose' . 'itraverseOf' o (\\ i -> 'Data.Functor.Compose.Compose' . 'fmap' (f i) . g i)
  -- @
  --

  -- * Additional introduction forms
  -- | See also 'Optics.Each.Core.each', which is an 'IxTraversal' over each element of a (potentially monomorphic) container.
  , itraversed
  , ignored
  , elementsOf
  , elements
  , elementOf
  , element

  -- * Additional elimination forms
  , iforOf
  , imapAccumLOf
  , imapAccumROf
  , iscanl1Of
  , iscanr1Of
  , ifailover
  , ifailover'

  -- * Combinators
  , indices
  , ibackwards
  , ipartsOf
  , isingular

  -- * 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#monoids"). 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

  -- * Subtyping
  , A_Traversal

  -- * 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'.
  , IxTraversalVL
  , IxTraversalVL'

  -- * Re-exports
  , TraversableWithIndex(..)
  ) where

import Control.Applicative.Backwards
import Control.Monad.Trans.State
import Data.Functor.Identity

import Data.Profunctor.Indexed

import Optics.Internal.Indexed
import Optics.Internal.Indexed.Classes
import Optics.Internal.IxTraversal
import Optics.Internal.Optic
import Optics.Internal.Utils
import Optics.IxAffineTraversal
import Optics.IxLens
import Optics.IxFold
import Optics.ReadOnly
import Optics.Traversal

-- | Type synonym for a type-modifying indexed traversal.
type IxTraversal i s t a b = Optic A_Traversal (WithIx i) s t a b

-- | Type synonym for a type-preserving indexed traversal.
type IxTraversal' i s a = Optic' A_Traversal (WithIx i) s a

-- | Type synonym for a type-modifying van Laarhoven indexed traversal.
type IxTraversalVL i s t a b =
  forall f. Applicative f => (i -> a -> f b) -> s -> f t

-- | Type synonym for a type-preserving van Laarhoven indexed traversal.
type IxTraversalVL' i s a = IxTraversalVL i s s a a

-- | Build an indexed traversal from the van Laarhoven representation.
--
-- @
-- 'itraversalVL' '.' 'itraverseOf' ≡ 'id'
-- 'itraverseOf' '.' 'itraversalVL' ≡ 'id'
-- @
itraversalVL :: IxTraversalVL i s t a b -> IxTraversal i s t a b
itraversalVL :: IxTraversalVL i s t a b -> IxTraversal i s t a b
itraversalVL IxTraversalVL i s t a b
t = (forall (p :: * -> * -> * -> *) i.
 Profunctor p =>
 Optic_ A_Traversal p i (Curry (WithIx i) i) s t a b)
-> IxTraversal i s t a b
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 (IxTraversalVL i s t a b -> p i a b -> p (i -> i) s t
forall (p :: * -> * -> * -> *) i a b s t j.
Traversing p =>
(forall (f :: * -> *).
 Applicative f =>
 (i -> a -> f b) -> s -> f t)
-> p j a b -> p (i -> j) s t
iwander IxTraversalVL i s t a b
t)
{-# INLINE itraversalVL #-}

----------------------------------------

-- | 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.
itraverseOf
  :: (Is k A_Traversal, Applicative f, is `HasSingleIndex` i)
  => Optic k is s t a b
  -> (i -> a -> f b) -> s -> f t
itraverseOf :: Optic k is s t a b -> (i -> a -> f b) -> s -> f t
itraverseOf Optic k is s t a b
o = \i -> a -> f b
f ->
  IxStar f (i -> i) s t -> (i -> i) -> s -> f t
forall (f :: * -> *) i a b. IxStar f i a b -> i -> a -> f b
runIxStar (Optic A_Traversal is s t a b
-> Optic__ (IxStar f) i (Curry is i) s t 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 (Optic k is s t a b -> Optic A_Traversal is s t 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 b
o) ((i -> a -> f b) -> IxStar f i a b
forall (f :: * -> *) i a b. (i -> a -> f b) -> IxStar f i a b
IxStar i -> a -> f b
f)) i -> i
forall a. a -> a
id
{-# INLINE itraverseOf #-}

-- | A version of 'itraverseOf' with the arguments flipped.
iforOf
  :: (Is k A_Traversal, Applicative f, is `HasSingleIndex` i)
  => Optic k is s t a b
  -> s -> (i -> a -> f b) -> f t
iforOf :: Optic k is s t a b -> s -> (i -> a -> f b) -> f t
iforOf = ((i -> a -> f b) -> s -> f t) -> s -> (i -> a -> f b) -> f t
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((i -> a -> f b) -> s -> f t) -> s -> (i -> a -> f b) -> f t)
-> (Optic k is s t a b -> (i -> a -> f b) -> s -> f t)
-> Optic k is s t a b
-> s
-> (i -> a -> f b)
-> f t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic k is s t a b -> (i -> a -> f b) -> s -> f t
forall k (f :: * -> *) (is :: IxList) i s t a b.
(Is k A_Traversal, Applicative f, HasSingleIndex is i) =>
Optic k is s t a b -> (i -> a -> f b) -> s -> f t
itraverseOf
{-# INLINE iforOf #-}

-- | Generalizes 'Data.Traversable.mapAccumL' to an arbitrary 'IxTraversal'.
--
-- 'imapAccumLOf' accumulates state from left to right.
--
-- @
-- 'Optics.Traversal.mapAccumLOf' o ≡ 'imapAccumLOf' o '.' 'const'
-- @
imapAccumLOf
  :: (Is k A_Traversal, is `HasSingleIndex` i)
  => Optic k is s t a b
  -> (i -> acc -> a -> (b, acc)) -> acc -> s -> (t, acc)
imapAccumLOf :: Optic k is s t a b
-> (i -> acc -> a -> (b, acc)) -> acc -> s -> (t, acc)
imapAccumLOf Optic k is s t a b
o = \i -> acc -> a -> (b, acc)
f acc
acc0 s
s ->
  let g :: i -> a -> StateT acc Identity b
g i
i a
a = (acc -> (b, acc)) -> StateT acc Identity b
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((acc -> (b, acc)) -> StateT acc Identity b)
-> (acc -> (b, acc)) -> StateT acc Identity b
forall a b. (a -> b) -> a -> b
$ \acc
acc -> i -> acc -> a -> (b, acc)
f i
i acc
acc a
a
  in State acc t -> acc -> (t, acc)
forall s a. State s a -> s -> (a, s)
runState (Optic k is s t a b
-> (i -> a -> StateT acc Identity b) -> s -> State acc t
forall k (f :: * -> *) (is :: IxList) i s t a b.
(Is k A_Traversal, Applicative f, HasSingleIndex is i) =>
Optic k is s t a b -> (i -> a -> f b) -> s -> f t
itraverseOf Optic k is s t a b
o i -> a -> StateT acc Identity b
g s
s) acc
acc0
{-# INLINE imapAccumLOf #-}

-- | Generalizes 'Data.Traversable.mapAccumR' to an arbitrary 'IxTraversal'.
--
-- 'imapAccumROf' accumulates state from right to left.
--
-- @
-- 'Optics.Traversal.mapAccumROf' o ≡ 'imapAccumROf' 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)
imapAccumROf :: Optic k is s t a b
-> (i -> acc -> a -> (b, acc)) -> acc -> s -> (t, acc)
imapAccumROf = Optic A_Traversal (WithIx i) s t a b
-> (i -> acc -> a -> (b, acc)) -> acc -> s -> (t, acc)
forall k (is :: IxList) i s t a b acc.
(Is k A_Traversal, HasSingleIndex is i) =>
Optic k is s t a b
-> (i -> acc -> a -> (b, acc)) -> acc -> s -> (t, acc)
imapAccumLOf (Optic A_Traversal (WithIx i) s t a b
 -> (i -> acc -> a -> (b, acc)) -> acc -> s -> (t, acc))
-> (Optic k is s t a b -> Optic A_Traversal (WithIx i) s t a b)
-> Optic k is s t a b
-> (i -> acc -> a -> (b, acc))
-> acc
-> s
-> (t, acc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic k is s t a b -> Optic A_Traversal (WithIx i) s t a b
forall k (is :: IxList) i s t a b.
(Is k A_Traversal, HasSingleIndex is i) =>
Optic k is s t a b -> IxTraversal i s t a b
ibackwards
{-# INLINE imapAccumROf #-}

-- | This permits the use of 'scanl1' over an arbitrary 'IxTraversal'.
iscanl1Of
  :: (Is k A_Traversal, is `HasSingleIndex` i)
  => Optic k is s t a a
  -> (i -> a -> a -> a) -> s -> t
iscanl1Of :: Optic k is s t a a -> (i -> a -> a -> a) -> s -> t
iscanl1Of Optic k is s t a a
o = \i -> a -> a -> a
f ->
  let step :: i -> Maybe a -> a -> (a, Maybe a)
step i
i Maybe a
ms a
a = case Maybe a
ms of
        Maybe a
Nothing -> (a
a, a -> Maybe a
forall a. a -> Maybe a
Just a
a)
        Just a
s  -> let r :: a
r = i -> a -> a -> a
f i
i a
s a
a in (a
r, a -> Maybe a
forall a. a -> Maybe a
Just a
r)
  in (t, Maybe a) -> t
forall a b. (a, b) -> a
fst ((t, Maybe a) -> t) -> (s -> (t, Maybe a)) -> s -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic k is s t a a
-> (i -> Maybe a -> a -> (a, Maybe a))
-> Maybe a
-> s
-> (t, Maybe a)
forall k (is :: IxList) i s t a b acc.
(Is k A_Traversal, HasSingleIndex is i) =>
Optic k is s t a b
-> (i -> acc -> a -> (b, acc)) -> acc -> s -> (t, acc)
imapAccumLOf Optic k is s t a a
o i -> Maybe a -> a -> (a, Maybe a)
step Maybe a
forall a. Maybe a
Nothing
{-# INLINE iscanl1Of #-}

-- | This permits the use of 'scanr1' 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
iscanr1Of :: Optic k is s t a a -> (i -> a -> a -> a) -> s -> t
iscanr1Of Optic k is s t a a
o i -> a -> a -> a
f = (t, Maybe a) -> t
forall a b. (a, b) -> a
fst ((t, Maybe a) -> t) -> (s -> (t, Maybe a)) -> s -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic k is s t a a
-> (i -> Maybe a -> a -> (a, Maybe a))
-> Maybe a
-> s
-> (t, Maybe a)
forall k (is :: IxList) i s t a b acc.
(Is k A_Traversal, HasSingleIndex is i) =>
Optic k is s t a b
-> (i -> acc -> a -> (b, acc)) -> acc -> s -> (t, acc)
imapAccumROf Optic k is s t a a
o i -> Maybe a -> a -> (a, Maybe a)
step Maybe a
forall a. Maybe a
Nothing
  where
    step :: i -> Maybe a -> a -> (a, Maybe a)
step i
i Maybe a
ms a
a = case Maybe a
ms of
      Maybe a
Nothing -> (a
a, a -> Maybe a
forall a. a -> Maybe a
Just a
a)
      Just a
s  -> let r :: a
r = i -> a -> a -> a
f i
i a
a a
s in (a
r, a -> Maybe a
forall a. a -> Maybe a
Just a
r)
{-# INLINE iscanr1Of #-}

-- | 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
ifailover :: Optic k is s t a b -> (i -> a -> b) -> s -> Maybe t
ifailover Optic k is s t a b
o = \i -> a -> b
f s
s ->
  let OrT Bool
visited Identity t
t = Optic k is s t a b
-> (i -> a -> OrT Identity b) -> s -> OrT Identity t
forall k (f :: * -> *) (is :: IxList) i s t a b.
(Is k A_Traversal, Applicative f, HasSingleIndex is i) =>
Optic k is s t a b -> (i -> a -> f b) -> s -> f t
itraverseOf Optic k is s t a b
o (\i
i -> Identity b -> OrT Identity b
forall (f :: * -> *) a. f a -> OrT f a
wrapOrT (Identity b -> OrT Identity b)
-> (a -> Identity b) -> a -> OrT Identity b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> (a -> b) -> a -> Identity b
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. i -> a -> b
f i
i) s
s
  in if Bool
visited
     then t -> Maybe t
forall a. a -> Maybe a
Just (Identity t -> t
forall a. Identity a -> a
runIdentity Identity t
t)
     else Maybe t
forall a. Maybe a
Nothing
{-# INLINE ifailover #-}

-- | Version of 'ifailover' strict in the application of the function.
ifailover'
  :: (Is k A_Traversal, is `HasSingleIndex` i)
  => Optic k is s t a b
  -> (i -> a -> b) -> s -> Maybe t
ifailover' :: Optic k is s t a b -> (i -> a -> b) -> s -> Maybe t
ifailover' Optic k is s t a b
o = \i -> a -> b
f s
s ->
  let OrT Bool
visited Identity' t
t = Optic k is s t a b
-> (i -> a -> OrT Identity' b) -> s -> OrT Identity' t
forall k (f :: * -> *) (is :: IxList) i s t a b.
(Is k A_Traversal, Applicative f, HasSingleIndex is i) =>
Optic k is s t a b -> (i -> a -> f b) -> s -> f t
itraverseOf Optic k is s t a b
o (\i
i -> Identity' b -> OrT Identity' b
forall (f :: * -> *) a. f a -> OrT f a
wrapOrT (Identity' b -> OrT Identity' b)
-> (a -> Identity' b) -> a -> OrT Identity' b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Identity' b
forall a. a -> Identity' a
wrapIdentity' (b -> Identity' b) -> (a -> b) -> a -> Identity' b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> a -> b
f i
i) s
s
  in if Bool
visited
     then t -> Maybe t
forall a. a -> Maybe a
Just (Identity' t -> t
forall a. Identity' a -> a
unwrapIdentity' Identity' t
t)
     else Maybe t
forall a. Maybe a
Nothing
{-# INLINE ifailover' #-}

----------------------------------------
-- Traversals

-- | 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')]]
--
itraversed
  :: TraversableWithIndex i f
  => IxTraversal i (f a) (f b) a b
itraversed :: IxTraversal i (f a) (f b) a b
itraversed = (forall (p :: * -> * -> * -> *) i.
 Profunctor p =>
 Optic_ A_Traversal p i (Curry (WithIx i) i) (f a) (f b) a b)
-> IxTraversal i (f a) (f b) a b
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 :: * -> * -> * -> *) i.
Profunctor p =>
Optic_ A_Traversal p i (Curry (WithIx i) i) (f a) (f b) a b
forall (p :: * -> * -> * -> *) i (f :: * -> *) j a b.
(Traversing p, TraversableWithIndex i f) =>
Optic__ p j (i -> j) (f a) (f b) a b
itraversed__
{-# INLINE itraversed #-}

----------------------------------------
-- Traversal combinators

-- | Filter results of an 'IxTraversal' that don't satisfy a predicate on the
-- indices.
--
-- >>> toListOf (itraversed %& indices even) "foobar"
-- "foa"
--
indices
  :: (Is k A_Traversal, is `HasSingleIndex` i)
  => (i -> Bool)
  -> Optic k is s t a a
  -> IxTraversal i s t a a
indices :: (i -> Bool) -> Optic k is s t a a -> IxTraversal i s t a a
indices i -> Bool
p Optic k is s t a a
o = IxTraversalVL i s t a a -> IxTraversal i s t a a
forall i s t a b. IxTraversalVL i s t a b -> IxTraversal i s t a b
itraversalVL (IxTraversalVL i s t a a -> IxTraversal i s t a a)
-> IxTraversalVL i s t a a -> IxTraversal i s t a a
forall a b. (a -> b) -> a -> b
$ \i -> a -> f a
f ->
  Optic k is s t a a -> (i -> a -> f a) -> s -> f t
forall k (f :: * -> *) (is :: IxList) i s t a b.
(Is k A_Traversal, Applicative f, HasSingleIndex is i) =>
Optic k is s t a b -> (i -> a -> f b) -> s -> f t
itraverseOf Optic k is s t a a
o ((i -> a -> f a) -> s -> f t) -> (i -> a -> f a) -> s -> f t
forall a b. (a -> b) -> a -> b
$ \i
i a
a -> if i -> Bool
p i
i then i -> a -> f a
f i
i a
a else a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
{-# INLINE indices #-}

-- | This allows you to 'traverse' the elements of an indexed traversal in the
-- opposite order.
ibackwards
  :: (Is k A_Traversal, is `HasSingleIndex` i)
  => Optic k is s t a b
  -> IxTraversal i s t a b
ibackwards :: Optic k is s t a b -> IxTraversal i s t a b
ibackwards Optic k is s t a b
o = Optic A_Traversal NoIx s t a b
-> IxTraversal i s t a b -> IxTraversal i s t a b
forall (is :: IxList) i k s t a b.
HasSingleIndex is i =>
Optic k NoIx s t a b -> Optic k is s t a b -> Optic k is s t a b
conjoined (Optic k is s t a b -> Optic A_Traversal NoIx s t a b
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) (IxTraversal i s t a b -> IxTraversal i s t a b)
-> IxTraversal i s t a b -> IxTraversal i s t a b
forall a b. (a -> b) -> a -> b
$ IxTraversalVL i s t a b -> IxTraversal i s t a b
forall i s t a b. IxTraversalVL i s t a b -> IxTraversal i s t a b
itraversalVL (IxTraversalVL i s t a b -> IxTraversal i s t a b)
-> IxTraversalVL i s t a b -> IxTraversal i s t a b
forall a b. (a -> b) -> a -> b
$ \i -> a -> f b
f ->
  Backwards f t -> f t
forall k (f :: k -> *) (a :: k). Backwards f a -> f a
forwards (Backwards f t -> f t) -> (s -> Backwards f t) -> s -> f t
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. Optic k is s t a b
-> (i -> a -> Backwards f b) -> s -> Backwards f t
forall k (f :: * -> *) (is :: IxList) i s t a b.
(Is k A_Traversal, Applicative f, HasSingleIndex is i) =>
Optic k is s t a b -> (i -> a -> f b) -> s -> f t
itraverseOf Optic k is s t a b
o (\i
i -> f b -> Backwards f b
forall k (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards (f b -> Backwards f b) -> (a -> f b) -> a -> Backwards f b
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. i -> a -> f b
f i
i)
{-# INLINE ibackwards #-}

-- | Traverse selected elements of a 'Traversal' where their ordinal positions
-- match a predicate.
elementsOf
  :: Is k A_Traversal
  => Optic k is s t a a
  -> (Int -> Bool)
  -> IxTraversal Int s t a a
elementsOf :: Optic k is s t a a -> (Int -> Bool) -> IxTraversal Int s t a a
elementsOf Optic k is s t a a
o = \Int -> Bool
p -> IxTraversalVL Int s t a a -> IxTraversal Int s t a a
forall i s t a b. IxTraversalVL i s t a b -> IxTraversal i s t a b
itraversalVL (IxTraversalVL Int s t a a -> IxTraversal Int s t a a)
-> IxTraversalVL Int s t a a -> IxTraversal Int s t a a
forall a b. (a -> b) -> a -> b
$ \Int -> a -> f a
f ->
  ((a -> Indexing f a) -> s -> Indexing f t)
-> (Int -> a -> f a) -> s -> f t
forall k a (f :: k -> *) (b :: k) s (t :: k).
((a -> Indexing f b) -> s -> Indexing f t)
-> (Int -> a -> f b) -> s -> f t
indexing (Optic k is s t a a -> (a -> Indexing f a) -> s -> Indexing f 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 a
o) ((Int -> a -> f a) -> s -> f t) -> (Int -> a -> f a) -> s -> f t
forall a b. (a -> b) -> a -> b
$ \Int
i a
a -> if Int -> Bool
p Int
i then Int -> a -> f a
f Int
i a
a else a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
{-# INLINE elementsOf #-}

-- | Traverse elements of a 'Traversable' container where their ordinal
-- positions match a predicate.
--
-- @
-- 'elements' ≡ 'elementsOf' 'traverse'
-- @
elements :: Traversable f => (Int -> Bool) -> IxTraversal' Int (f a) a
elements :: (Int -> Bool) -> IxTraversal' Int (f a) a
elements = Optic A_Traversal NoIx (f a) (f a) a a
-> (Int -> Bool) -> IxTraversal' Int (f a) a
forall k (is :: IxList) s t a.
Is k A_Traversal =>
Optic k is s t a a -> (Int -> Bool) -> IxTraversal Int s t a a
elementsOf Optic A_Traversal NoIx (f a) (f a) a a
forall (t :: * -> *) a b.
Traversable t =>
Traversal (t a) (t b) a b
traversed
{-# INLINE elements #-}

-- | Traverse the /nth/ element of a 'Traversal' if it exists.
elementOf
  :: Is k A_Traversal
  => Optic' k is s a
  -> Int
  -> IxAffineTraversal' Int s a
elementOf :: Optic' k is s a -> Int -> IxAffineTraversal' Int s a
elementOf Optic' k is s a
o = \Int
i -> Optic' A_Traversal (WithIx Int) s a -> IxAffineTraversal' Int s a
forall k (is :: IxList) i s a.
(Is k A_Traversal, HasSingleIndex is i) =>
Optic' k is s a -> IxAffineTraversal' i s a
isingular (Optic' A_Traversal (WithIx Int) s a -> IxAffineTraversal' Int s a)
-> Optic' A_Traversal (WithIx Int) s a
-> IxAffineTraversal' Int s a
forall a b. (a -> b) -> a -> b
$ Optic' k is s a
-> (Int -> Bool) -> Optic' A_Traversal (WithIx Int) s a
forall k (is :: IxList) s t a.
Is k A_Traversal =>
Optic k is s t a a -> (Int -> Bool) -> IxTraversal Int s t a a
elementsOf Optic' k is s a
o (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i)
{-# INLINE elementOf #-}

-- | Traverse the /nth/ element of a 'Traversable' container.
--
-- @
-- 'element' ≡ 'elementOf' 'traversed'
-- @
element :: Traversable f => Int -> IxAffineTraversal' Int (f a) a
element :: Int -> IxAffineTraversal' Int (f a) a
element = Optic' A_Traversal NoIx (f a) a
-> Int -> IxAffineTraversal' Int (f a) a
forall k (is :: IxList) s a.
Is k A_Traversal =>
Optic' k is s a -> Int -> IxAffineTraversal' Int s a
elementOf Optic' A_Traversal NoIx (f a) a
forall (t :: * -> *) a b.
Traversable t =>
Traversal (t a) (t b) a b
traversed
{-# INLINE element #-}

-- | An indexed version of 'partsOf' that receives the entire list of indices as
-- its indices.
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]
ipartsOf :: Optic k is s t a a -> IxLens [i] s t [a] [a]
ipartsOf Optic k is s t a a
o = Optic A_Lens NoIx s t [a] [a]
-> IxLens [i] s t [a] [a] -> IxLens [i] s t [a] [a]
forall (is :: IxList) i k s t a b.
HasSingleIndex is i =>
Optic k NoIx s t a b -> Optic k is s t a b -> Optic k is s t a b
conjoined (Optic k is s t a a -> Optic A_Lens NoIx s t [a] [a]
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) (IxLens [i] s t [a] [a] -> IxLens [i] s t [a] [a])
-> IxLens [i] s t [a] [a] -> IxLens [i] s t [a] [a]
forall a b. (a -> b) -> a -> b
$ IxLensVL [i] s t [a] [a] -> IxLens [i] s t [a] [a]
forall i s t a b. IxLensVL i s t a b -> IxLens i s t a b
ilensVL (IxLensVL [i] s t [a] [a] -> IxLens [i] s t [a] [a])
-> IxLensVL [i] s t [a] [a] -> IxLens [i] s t [a] [a]
forall a b. (a -> b) -> a -> b
$ \[i] -> [a] -> f [a]
f s
s ->
  State [a] t -> [a] -> t
forall s a. State s a -> s -> a
evalState (Optic k is s t a a
-> (a -> StateT [a] Identity a) -> s -> State [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 s t a a
o a -> StateT [a] Identity a
forall (m :: * -> *) b. Monad m => b -> StateT [b] m b
update s
s)
    ([a] -> t) -> f [a] -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([i] -> [a] -> f [a]) -> ([i], [a]) -> f [a]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry' [i] -> [a] -> f [a]
f ([(i, a)] -> ([i], [a])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(i, a)] -> ([i], [a])) -> [(i, a)] -> ([i], [a])
forall a b. (a -> b) -> a -> b
$ Optic' A_Fold is s a -> s -> [(i, a)]
forall k (is :: IxList) i s a.
(Is k A_Fold, HasSingleIndex is i) =>
Optic' k is s a -> s -> [(i, a)]
itoListOf (Optic A_Traversal is s t a a
-> Optic' (ReadOnlyOptic A_Traversal) is s a
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 (Optic A_Traversal is s t a a
 -> Optic' (ReadOnlyOptic A_Traversal) is s a)
-> Optic A_Traversal is s t a a
-> Optic' (ReadOnlyOptic A_Traversal) is s a
forall a b. (a -> b) -> a -> b
$ Optic k is s t a a -> Optic A_Traversal is s t a a
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 = StateT [b] m [b]
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT [b] m [b] -> ([b] -> StateT [b] m b) -> StateT [b] m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      []       ->            b -> StateT [b] m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a
      b
a' : [b]
as' -> [b] -> StateT [b] m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put [b]
as' StateT [b] m () -> StateT [b] m b -> StateT [b] m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> StateT [b] m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a'
{-# INLINE ipartsOf #-}

-- | Convert an indexed traversal to an 'IxAffineTraversal' that visits the
-- first element of the original traversal.
--
-- For the fold version see 'Optics.IxFold.ipre'.
--
-- >>> [1,2,3] & iover (isingular itraversed) (-)
-- [-1,2,3]
--
-- @since 0.3
isingular
  :: forall k is i s a. (Is k A_Traversal, is `HasSingleIndex` i)
  => Optic' k is s a
  -> IxAffineTraversal' i s a
isingular :: Optic' k is s a -> IxAffineTraversal' i s a
isingular Optic' k is s a
o = Optic An_AffineTraversal NoIx s s a a
-> IxAffineTraversal' i s a -> IxAffineTraversal' i s a
forall (is :: IxList) i k s t a b.
HasSingleIndex is i =>
Optic k NoIx s t a b -> Optic k is s t a b -> Optic k is s t a b
conjoined (Optic' k is s a -> Optic An_AffineTraversal NoIx s s a a
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) (IxAffineTraversal' i s a -> IxAffineTraversal' i s a)
-> IxAffineTraversal' i s a -> IxAffineTraversal' i s a
forall a b. (a -> b) -> a -> b
$ IxAffineTraversalVL i s s a a -> IxAffineTraversal' i s a
forall i s t a b.
IxAffineTraversalVL i s t a b -> IxAffineTraversal i s t a b
iatraversalVL (IxAffineTraversalVL i s s a a -> IxAffineTraversal' i s a)
-> IxAffineTraversalVL i s s a a -> IxAffineTraversal' i s a
forall a b. (a -> b) -> a -> b
$ \forall r. r -> f r
point i -> a -> f a
f s
s ->
  case Optic' A_Traversal is s a -> s -> Maybe (i, a)
forall k (is :: IxList) i s a.
(Is k A_Fold, HasSingleIndex is i) =>
Optic' k is s a -> s -> Maybe (i, a)
iheadOf (Optic' k is s a -> Optic' A_Traversal is s a
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 (i, a)
Nothing     -> s -> f s
forall r. r -> f r
point s
s
    Just (i
i, a
a) -> State (Maybe a) s -> Maybe a -> s
forall s a. State s a -> s -> a
evalState (Optic' k is s a
-> (a -> StateT (Maybe a) Identity a) -> s -> State (Maybe a) s
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 a -> StateT (Maybe a) Identity a
forall (m :: * -> *) b. Monad m => b -> StateT (Maybe b) m b
update s
s) (Maybe a -> s) -> (a -> Maybe a) -> a -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just (a -> s) -> f a -> f s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> i -> a -> f a
f i
i a
a
  where
    update :: b -> StateT (Maybe b) m b
update b
a = StateT (Maybe b) m (Maybe b)
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT (Maybe b) m (Maybe b)
-> (Maybe b -> StateT (Maybe b) m b) -> StateT (Maybe b) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just b
a' -> Maybe b -> StateT (Maybe b) m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put Maybe b
forall a. Maybe a
Nothing StateT (Maybe b) m ()
-> StateT (Maybe b) m b -> StateT (Maybe b) m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> StateT (Maybe b) m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a'
      Maybe b
Nothing ->                b -> StateT (Maybe b) m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a
{-# INLINE isingular #-}

-- | 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
-- <https://www.cs.ox.ac.uk/jeremy.gibbons/publications/uitbaf.pdf 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 'Optics.IxFold.isumming'.
--
-- @since 0.4
--
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
iadjoin :: Optic' k is s a -> Optic' l is s a -> IxTraversal' i s a
iadjoin Optic' k is s a
o1 Optic' l is s a
o2 = Optic A_Traversal NoIx s s a a
-> IxTraversal' i s a -> IxTraversal' i s a
forall (is :: IxList) i k s t a b.
HasSingleIndex is i =>
Optic k NoIx s t a b -> Optic k is s t a b -> Optic k is s t a b
conjoined (Optic' k is s a
-> Optic' l is s a -> Optic A_Traversal NoIx s s a a
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 is s a
o2) (Traversal s s [(i, a)] [(i, a)]
combined Traversal s s [(i, a)] [(i, a)]
-> Optic A_Traversal NoIx [(i, a)] [(i, a)] (i, a) (i, a)
-> Optic A_Traversal NoIx s s (i, a) (i, a)
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
% Optic A_Traversal NoIx [(i, a)] [(i, a)] (i, a) (i, a)
forall (t :: * -> *) a b.
Traversable t =>
Traversal (t a) (t b) a b
traversed Optic A_Traversal NoIx s s (i, a) (i, a)
-> Optic A_Traversal (WithIx i) (i, a) (i, a) a a
-> IxTraversal' i s a
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
% Optic A_Traversal (WithIx i) (i, a) (i, a) a a
forall i (f :: * -> *) a b.
TraversableWithIndex i f =>
IxTraversal i (f a) (f b) a b
itraversed)
  where
    combined :: Traversal s s [(i, a)] [(i, a)]
combined = TraversalVL s s [(i, a)] [(i, a)]
-> Traversal s s [(i, a)] [(i, a)]
forall s t a b. TraversalVL s t a b -> Traversal s t a b
traversalVL (TraversalVL s s [(i, a)] [(i, a)]
 -> Traversal s s [(i, a)] [(i, a)])
-> TraversalVL s s [(i, a)] [(i, a)]
-> Traversal s s [(i, a)] [(i, a)]
forall a b. (a -> b) -> a -> b
$ \[(i, a)] -> f [(i, a)]
f s
s0 ->
      (\[(i, a)]
r1 [(i, a)]
r2 ->
         let s1 :: s
s1 = State [(i, a)] s -> [(i, a)] -> s
forall s a. State s a -> s -> a
evalState (Optic' k is s a
-> (a -> StateT [(i, a)] Identity a) -> s -> State [(i, a)] s
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 a -> StateT [(i, a)] Identity a
forall (m :: * -> *) b a. Monad m => b -> StateT [(a, b)] m b
update s
s0) [(i, a)]
r1
             s2 :: s
s2 = State [(i, a)] s -> [(i, a)] -> s
forall s a. State s a -> s -> a
evalState (Optic' l is s a
-> (a -> StateT [(i, a)] Identity a) -> s -> State [(i, a)] s
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 is s a
o2 a -> StateT [(i, a)] Identity a
forall (m :: * -> *) b a. Monad m => b -> StateT [(a, b)] m b
update s
s1) [(i, a)]
r2
         in s
s2
      )
      ([(i, a)] -> [(i, a)] -> s) -> f [(i, a)] -> f ([(i, a)] -> s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(i, a)] -> f [(i, a)]
f (Optic' A_Traversal is s a -> s -> [(i, a)]
forall k (is :: IxList) i s a.
(Is k A_Fold, HasSingleIndex is i) =>
Optic' k is s a -> s -> [(i, a)]
itoListOf (Optic' k is s a -> Optic' A_Traversal is s a
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)
      f ([(i, a)] -> s) -> f [(i, a)] -> f s
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [(i, a)] -> f [(i, a)]
f (Optic' A_Traversal is s a -> s -> [(i, a)]
forall k (is :: IxList) i s a.
(Is k A_Fold, HasSingleIndex is i) =>
Optic' k is s a -> s -> [(i, a)]
itoListOf (Optic' l is s a -> Optic' A_Traversal is s a
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 is s a
o2) s
s0)

    update :: b -> StateT [(a, b)] m b
update b
a = StateT [(a, b)] m [(a, b)]
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT [(a, b)] m [(a, b)]
-> ([(a, b)] -> StateT [(a, b)] m b) -> StateT [(a, b)] m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      (a
_, b
a') : [(a, b)]
as' -> [(a, b)] -> StateT [(a, b)] m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put [(a, b)]
as' StateT [(a, b)] m () -> StateT [(a, b)] m b -> StateT [(a, b)] m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> StateT [(a, b)] m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a'
      []            ->            b -> StateT [(a, b)] m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a
infixr 6 `iadjoin` -- Same as (<>)
{-# INLINE [1] iadjoin #-}

{-# RULES

"iadjoin_12_3" forall o1 o2 o3. iadjoin o1 (iadjoin o2 o3) = iadjoin3 o1 o2 o3
"iadjoin_21_3" forall o1 o2 o3. iadjoin (iadjoin o1 o2) o3 = iadjoin3 o1 o2 o3

"iadjoin_13_4" forall o1 o2 o3 o4. iadjoin o1 (iadjoin3 o2 o3 o4) = iadjoin4 o1 o2 o3 o4
"iadjoin_31_4" forall o1 o2 o3 o4. iadjoin (iadjoin3 o1 o2 o3) o4 = iadjoin4 o1 o2 o3 o4

#-}

-- | Triple 'iadjoin' for optimizing multiple 'iadjoin's with rewrite rules.
iadjoin3
  :: (Is k1 A_Traversal, Is k2 A_Traversal, Is k3 A_Traversal, is `HasSingleIndex` i )
  => Optic' k1 is s a
  -> Optic' k2 is s a
  -> Optic' k3 is s a
  -> IxTraversal' i s a
iadjoin3 :: Optic' k1 is s a
-> Optic' k2 is s a -> Optic' k3 is s a -> IxTraversal' i s a
iadjoin3 Optic' k1 is s a
o1 Optic' k2 is s a
o2 Optic' k3 is s a
o3 = Optic A_Traversal NoIx s s a a
-> IxTraversal' i s a -> IxTraversal' i s a
forall (is :: IxList) i k s t a b.
HasSingleIndex is i =>
Optic k NoIx s t a b -> Optic k is s t a b -> Optic k is s t a b
conjoined (Optic' k1 is s a
o1 Optic' k1 is s a
-> Optic A_Traversal NoIx s s a a -> Optic A_Traversal NoIx s s a a
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' k2 is s a
o2 Optic' k2 is s a
-> Optic' k3 is s a -> Optic A_Traversal NoIx s s a a
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' k3 is s a
o3)
                              (Traversal s s [(i, a)] [(i, a)]
combined Traversal s s [(i, a)] [(i, a)]
-> Optic A_Traversal NoIx [(i, a)] [(i, a)] (i, a) (i, a)
-> Optic A_Traversal NoIx s s (i, a) (i, a)
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
% Optic A_Traversal NoIx [(i, a)] [(i, a)] (i, a) (i, a)
forall (t :: * -> *) a b.
Traversable t =>
Traversal (t a) (t b) a b
traversed Optic A_Traversal NoIx s s (i, a) (i, a)
-> Optic A_Traversal (WithIx i) (i, a) (i, a) a a
-> IxTraversal' i s a
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
% Optic A_Traversal (WithIx i) (i, a) (i, a) a a
forall i (f :: * -> *) a b.
TraversableWithIndex i f =>
IxTraversal i (f a) (f b) a b
itraversed)
  where
    combined :: Traversal s s [(i, a)] [(i, a)]
combined = TraversalVL s s [(i, a)] [(i, a)]
-> Traversal s s [(i, a)] [(i, a)]
forall s t a b. TraversalVL s t a b -> Traversal s t a b
traversalVL (TraversalVL s s [(i, a)] [(i, a)]
 -> Traversal s s [(i, a)] [(i, a)])
-> TraversalVL s s [(i, a)] [(i, a)]
-> Traversal s s [(i, a)] [(i, a)]
forall a b. (a -> b) -> a -> b
$ \[(i, a)] -> f [(i, a)]
f s
s0 ->
      (\[(i, a)]
r1 [(i, a)]
r2 [(i, a)]
r3 ->
         let s1 :: s
s1 = State [(i, a)] s -> [(i, a)] -> s
forall s a. State s a -> s -> a
evalState (Optic' k1 is s a
-> (a -> StateT [(i, a)] Identity a) -> s -> State [(i, a)] s
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 is s a
o1 a -> StateT [(i, a)] Identity a
forall (m :: * -> *) b a. Monad m => b -> StateT [(a, b)] m b
update s
s0) [(i, a)]
r1
             s2 :: s
s2 = State [(i, a)] s -> [(i, a)] -> s
forall s a. State s a -> s -> a
evalState (Optic' k2 is s a
-> (a -> StateT [(i, a)] Identity a) -> s -> State [(i, a)] s
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 is s a
o2 a -> StateT [(i, a)] Identity a
forall (m :: * -> *) b a. Monad m => b -> StateT [(a, b)] m b
update s
s1) [(i, a)]
r2
             s3 :: s
s3 = State [(i, a)] s -> [(i, a)] -> s
forall s a. State s a -> s -> a
evalState (Optic' k3 is s a
-> (a -> StateT [(i, a)] Identity a) -> s -> State [(i, a)] s
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 is s a
o3 a -> StateT [(i, a)] Identity a
forall (m :: * -> *) b a. Monad m => b -> StateT [(a, b)] m b
update s
s2) [(i, a)]
r3
         in s
s3
      )
      ([(i, a)] -> [(i, a)] -> [(i, a)] -> s)
-> f [(i, a)] -> f ([(i, a)] -> [(i, a)] -> s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(i, a)] -> f [(i, a)]
f (Optic' A_Traversal is s a -> s -> [(i, a)]
forall k (is :: IxList) i s a.
(Is k A_Fold, HasSingleIndex is i) =>
Optic' k is s a -> s -> [(i, a)]
itoListOf (Optic' k1 is s a -> Optic' A_Traversal is s a
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 is s a
o1) s
s0)
      f ([(i, a)] -> [(i, a)] -> s) -> f [(i, a)] -> f ([(i, a)] -> s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [(i, a)] -> f [(i, a)]
f (Optic' A_Traversal is s a -> s -> [(i, a)]
forall k (is :: IxList) i s a.
(Is k A_Fold, HasSingleIndex is i) =>
Optic' k is s a -> s -> [(i, a)]
itoListOf (Optic' k2 is s a -> Optic' A_Traversal is s a
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 is s a
o2) s
s0)
      f ([(i, a)] -> s) -> f [(i, a)] -> f s
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [(i, a)] -> f [(i, a)]
f (Optic' A_Traversal is s a -> s -> [(i, a)]
forall k (is :: IxList) i s a.
(Is k A_Fold, HasSingleIndex is i) =>
Optic' k is s a -> s -> [(i, a)]
itoListOf (Optic' k3 is s a -> Optic' A_Traversal is s a
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 is s a
o3) s
s0)

    update :: b -> StateT [(a, b)] m b
update b
a = StateT [(a, b)] m [(a, b)]
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT [(a, b)] m [(a, b)]
-> ([(a, b)] -> StateT [(a, b)] m b) -> StateT [(a, b)] m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      (a
_, b
a') : [(a, b)]
as' -> [(a, b)] -> StateT [(a, b)] m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put [(a, b)]
as' StateT [(a, b)] m () -> StateT [(a, b)] m b -> StateT [(a, b)] m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> StateT [(a, b)] m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a'
      []            ->            b -> StateT [(a, b)] m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a
{-# INLINE [1] iadjoin3 #-}

{-# RULES

"iadjoin_211_4" forall o1 o2 o3 o4. iadjoin3 (iadjoin o1 o2) o3 o4 = iadjoin4 o1 o2 o3 o4
"iadjoin_121_4" forall o1 o2 o3 o4. iadjoin3 o1 (iadjoin o2 o3) o4 = iadjoin4 o1 o2 o3 o4
"iadjoin_112_4" forall o1 o2 o3 o4. iadjoin3 o1 o2 (iadjoin o3 o4) = iadjoin4 o1 o2 o3 o4

#-}

-- | Quadruple 'iadjoin' for optimizing multiple 'iadjoin's with rewrite rules.
iadjoin4
  :: ( Is k1 A_Traversal, Is k2 A_Traversal, Is k3 A_Traversal, Is k4 A_Traversal
     , is `HasSingleIndex` i)
  => Optic' k1 is s a
  -> Optic' k2 is s a
  -> Optic' k3 is s a
  -> Optic' k4 is s a
  -> IxTraversal' i s a
iadjoin4 :: Optic' k1 is s a
-> Optic' k2 is s a
-> Optic' k3 is s a
-> Optic' k4 is s a
-> IxTraversal' i s a
iadjoin4 Optic' k1 is s a
o1 Optic' k2 is s a
o2 Optic' k3 is s a
o3 Optic' k4 is s a
o4 = Optic A_Traversal NoIx s s a a
-> IxTraversal' i s a -> IxTraversal' i s a
forall (is :: IxList) i k s t a b.
HasSingleIndex is i =>
Optic k NoIx s t a b -> Optic k is s t a b -> Optic k is s t a b
conjoined (Optic' k1 is s a
o1 Optic' k1 is s a
-> Optic A_Traversal NoIx s s a a -> Optic A_Traversal NoIx s s a a
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' k2 is s a
o2 Optic' k2 is s a
-> Optic A_Traversal NoIx s s a a -> Optic A_Traversal NoIx s s a a
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' k3 is s a
o3 Optic' k3 is s a
-> Optic' k4 is s a -> Optic A_Traversal NoIx s s a a
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' k4 is s a
o4)
                                 (Traversal s s [(i, a)] [(i, a)]
combined Traversal s s [(i, a)] [(i, a)]
-> Optic A_Traversal NoIx [(i, a)] [(i, a)] (i, a) (i, a)
-> Optic A_Traversal NoIx s s (i, a) (i, a)
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
% Optic A_Traversal NoIx [(i, a)] [(i, a)] (i, a) (i, a)
forall (t :: * -> *) a b.
Traversable t =>
Traversal (t a) (t b) a b
traversed Optic A_Traversal NoIx s s (i, a) (i, a)
-> Optic A_Traversal (WithIx i) (i, a) (i, a) a a
-> IxTraversal' i s a
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
% Optic A_Traversal (WithIx i) (i, a) (i, a) a a
forall i (f :: * -> *) a b.
TraversableWithIndex i f =>
IxTraversal i (f a) (f b) a b
itraversed)
  where
    combined :: Traversal s s [(i, a)] [(i, a)]
combined = TraversalVL s s [(i, a)] [(i, a)]
-> Traversal s s [(i, a)] [(i, a)]
forall s t a b. TraversalVL s t a b -> Traversal s t a b
traversalVL (TraversalVL s s [(i, a)] [(i, a)]
 -> Traversal s s [(i, a)] [(i, a)])
-> TraversalVL s s [(i, a)] [(i, a)]
-> Traversal s s [(i, a)] [(i, a)]
forall a b. (a -> b) -> a -> b
$ \[(i, a)] -> f [(i, a)]
f s
s0 ->
      (\[(i, a)]
r1 [(i, a)]
r2 [(i, a)]
r3 [(i, a)]
r4 ->
         let s1 :: s
s1 = State [(i, a)] s -> [(i, a)] -> s
forall s a. State s a -> s -> a
evalState (Optic' k1 is s a
-> (a -> StateT [(i, a)] Identity a) -> s -> State [(i, a)] s
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 is s a
o1 a -> StateT [(i, a)] Identity a
forall (m :: * -> *) b a. Monad m => b -> StateT [(a, b)] m b
update s
s0) [(i, a)]
r1
             s2 :: s
s2 = State [(i, a)] s -> [(i, a)] -> s
forall s a. State s a -> s -> a
evalState (Optic' k2 is s a
-> (a -> StateT [(i, a)] Identity a) -> s -> State [(i, a)] s
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 is s a
o2 a -> StateT [(i, a)] Identity a
forall (m :: * -> *) b a. Monad m => b -> StateT [(a, b)] m b
update s
s1) [(i, a)]
r2
             s3 :: s
s3 = State [(i, a)] s -> [(i, a)] -> s
forall s a. State s a -> s -> a
evalState (Optic' k3 is s a
-> (a -> StateT [(i, a)] Identity a) -> s -> State [(i, a)] s
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 is s a
o3 a -> StateT [(i, a)] Identity a
forall (m :: * -> *) b a. Monad m => b -> StateT [(a, b)] m b
update s
s2) [(i, a)]
r3
             s4 :: s
s4 = State [(i, a)] s -> [(i, a)] -> s
forall s a. State s a -> s -> a
evalState (Optic' k4 is s a
-> (a -> StateT [(i, a)] Identity a) -> s -> State [(i, a)] s
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 is s a
o4 a -> StateT [(i, a)] Identity a
forall (m :: * -> *) b a. Monad m => b -> StateT [(a, b)] m b
update s
s3) [(i, a)]
r4
         in s
s4
      )
      ([(i, a)] -> [(i, a)] -> [(i, a)] -> [(i, a)] -> s)
-> f [(i, a)] -> f ([(i, a)] -> [(i, a)] -> [(i, a)] -> s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(i, a)] -> f [(i, a)]
f (Optic' A_Traversal is s a -> s -> [(i, a)]
forall k (is :: IxList) i s a.
(Is k A_Fold, HasSingleIndex is i) =>
Optic' k is s a -> s -> [(i, a)]
itoListOf (Optic' k1 is s a -> Optic' A_Traversal is s a
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 is s a
o1) s
s0)
      f ([(i, a)] -> [(i, a)] -> [(i, a)] -> s)
-> f [(i, a)] -> f ([(i, a)] -> [(i, a)] -> s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [(i, a)] -> f [(i, a)]
f (Optic' A_Traversal is s a -> s -> [(i, a)]
forall k (is :: IxList) i s a.
(Is k A_Fold, HasSingleIndex is i) =>
Optic' k is s a -> s -> [(i, a)]
itoListOf (Optic' k2 is s a -> Optic' A_Traversal is s a
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 is s a
o2) s
s0)
      f ([(i, a)] -> [(i, a)] -> s) -> f [(i, a)] -> f ([(i, a)] -> s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [(i, a)] -> f [(i, a)]
f (Optic' A_Traversal is s a -> s -> [(i, a)]
forall k (is :: IxList) i s a.
(Is k A_Fold, HasSingleIndex is i) =>
Optic' k is s a -> s -> [(i, a)]
itoListOf (Optic' k3 is s a -> Optic' A_Traversal is s a
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 is s a
o3) s
s0)
      f ([(i, a)] -> s) -> f [(i, a)] -> f s
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [(i, a)] -> f [(i, a)]
f (Optic' A_Traversal is s a -> s -> [(i, a)]
forall k (is :: IxList) i s a.
(Is k A_Fold, HasSingleIndex is i) =>
Optic' k is s a -> s -> [(i, a)]
itoListOf (Optic' k4 is s a -> Optic' A_Traversal is s a
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 is s a
o4) s
s0)

    update :: b -> StateT [(a, b)] m b
update b
a = StateT [(a, b)] m [(a, b)]
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT [(a, b)] m [(a, b)]
-> ([(a, b)] -> StateT [(a, b)] m b) -> StateT [(a, b)] m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      (a
_, b
a') : [(a, b)]
as' -> [(a, b)] -> StateT [(a, b)] m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put [(a, b)]
as' StateT [(a, b)] m () -> StateT [(a, b)] m b -> StateT [(a, b)] m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> StateT [(a, b)] m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a'
      []            ->            b -> StateT [(a, b)] m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a
{-# INLINE [1] iadjoin4 #-}

-- $setup
-- >>> import Data.Void
-- >>> import Optics.Core