{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE UndecidableInstances #-}
-- |
-- Module: Optics.Traversal
-- Description: Lifts an effectful operation on elements to act on structures.
--
-- A 'Traversal' lifts an effectful operation on elements to act on structures
-- containing those elements.
--
-- That is, given a function @op :: A -> F B@ where @F@ is 'Applicative', a
-- @'Traversal' S T A B@ can produce a function @S -> F T@ that applies @op@ to
-- all the @A@s contained in the @S@.
--
-- This can be seen as a generalisation of 'traverse', where the type @S@ does
-- not need to be a type constructor with @A@ as the last parameter.
--
-- A 'Lens' is a 'Traversal' that acts on a single value.
--
-- A close relative is the 'Optics.AffineTraversal.AffineTraversal', which is a
-- 'Traversal' that acts on at most one value.
--
module Optics.Traversal
  (
  -- * Formation
    Traversal
  , Traversal'

  -- * Introduction
  , traversalVL

  -- * Elimination
  , traverseOf

  -- * Computation
  -- |
  --
  -- @
  -- 'traverseOf' ('traversalVL' f) ≡ f
  -- @

  -- * Well-formedness
  -- |
  --
  -- @
  -- 'traverseOf' o 'pure' ≡ 'pure'
  -- 'fmap' ('traverseOf' o f) . 'traverseOf' o g ≡ 'Data.Functor.Compose.getCompose' . 'traverseOf' o ('Data.Functor.Compose.Compose' . 'fmap' f . g)
  -- @

  -- * Additional introduction forms
  , traversed
  , both

  -- * Additional elimination forms
  , forOf
  , sequenceOf
  , transposeOf
  , mapAccumROf
  , mapAccumLOf
  , scanr1Of
  , scanl1Of
  , failover
  , failover'

    -- * Combinators
  , backwards
  , partsOf
  , singular

  -- * Monoid structure
  -- | 'Traversal' admits a (partial) monoid structure where 'adjoin' combines
  -- non-overlapping traversals, and the identity element is
  -- 'Optics.IxAffineTraversal.ignored' (which traverses no elements).
  --
  -- If you merely need a 'Fold', you can use traversals as folds and combine
  -- them with one of the monoid structures on folds (see
  -- "Optics.Fold#monoids"). In particular, 'summing' can be used to concatenate
  -- results from two traversals, and 'failing' will returns results from the
  -- second traversal only if the first returns no results.
  --
  -- There is no 'Semigroup' or 'Monoid' instance for 'Traversal', 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.
  , adjoin

  -- * Subtyping
  , A_Traversal
  -- | <<diagrams/Traversal.png Traversal in the optics hierarchy>>

  -- * van Laarhoven encoding
  -- | The van Laarhoven representation of a 'Traversal' directly expresses how
  -- it lifts an effectful operation @A -> F B@ on elements to act on structures
  -- @S -> F T@.  Thus 'traverseOf' converts a 'Traversal' to a 'TraversalVL'.
  , 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 synonym for a type-modifying traversal.
type Traversal s t a b = Optic A_Traversal NoIx s t a b

-- | Type synonym for a type-preserving traversal.
type Traversal' s a = Optic' A_Traversal NoIx s a

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

-- | Type synonym for a type-preserving van Laarhoven traversal.
type TraversalVL' s a = TraversalVL s s a a

-- | Build a traversal from the van Laarhoven representation.
--
-- @
-- 'traversalVL' '.' 'traverseOf' ≡ 'id'
-- 'traverseOf' '.' 'traversalVL' ≡ 'id'
-- @
traversalVL :: TraversalVL s t a b -> Traversal s t a b
traversalVL :: TraversalVL s t a b -> Traversal s t a b
traversalVL TraversalVL s t a b
t = (forall (p :: * -> * -> * -> *) i.
 Profunctor p =>
 Optic_ A_Traversal p i (Curry NoIx i) s t a b)
-> Traversal 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 (TraversalVL s t a b -> p i a b -> p i s t
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 #-}

-- | Map each element of a structure targeted by a 'Traversal', evaluate these
-- actions from left to right, and collect the results.
traverseOf
  :: (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 -> (a -> f b) -> s -> f t
traverseOf Optic k is s t a b
o = \a -> f b
f -> Star f (Curry is Any) s t -> s -> f t
forall (f :: * -> *) i a b. Star f i a b -> a -> f b
runStar (Star f (Curry is Any) s t -> s -> f t)
-> Star f (Curry is Any) s t -> s -> f t
forall a b. (a -> b) -> a -> b
$ Optic A_Traversal is s t a b
-> Optic__ (Star f) Any (Curry is Any) 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) ((a -> f b) -> Star f Any a b
forall (f :: * -> *) i a b. (a -> f b) -> Star f i a b
Star a -> f b
f)
{-# INLINE traverseOf #-}

-- | A version of 'traverseOf' with the arguments flipped.
forOf
  :: (Is k A_Traversal, Applicative f)
  => Optic k is s t a b
  -> s -> (a -> f b) -> f t
forOf :: Optic k is s t a b -> s -> (a -> f b) -> f t
forOf = ((a -> f b) -> s -> f t) -> s -> (a -> f b) -> f t
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((a -> f b) -> s -> f t) -> s -> (a -> f b) -> f t)
-> (Optic k is s t a b -> (a -> f b) -> s -> f t)
-> Optic k is s t a b
-> s
-> (a -> f b)
-> f t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic k is s t a b -> (a -> f b) -> s -> 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
{-# INLINE forOf #-}

-- | Evaluate each action in the structure from left to right, and collect the
-- results.
--
-- >>> sequenceOf each ([1,2],[3,4])
-- [(1,3),(1,4),(2,3),(2,4)]
--
-- @
-- 'sequence' ≡ 'sequenceOf' 'traversed' ≡ 'traverse' 'id'
-- 'sequenceOf' o ≡ 'traverseOf' o 'id'
-- @
sequenceOf
  :: (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 -> s -> f t
sequenceOf Optic k is s t (f b) b
o = Optic k is s t (f b) b -> (f b -> f b) -> s -> 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 (f b) b
o f b -> f b
forall a. a -> a
id
{-# INLINE sequenceOf #-}

-- | This generalizes 'Data.List.transpose' to an arbitrary 'Traversal'.
--
-- Note: 'Data.List.transpose' handles ragged inputs more intelligently, but for
-- non-ragged inputs:
--
-- >>> transposeOf traversed [[1,2,3],[4,5,6]]
-- [[1,4],[2,5],[3,6]]
--
-- @
-- 'Data.List.transpose' ≡ 'transposeOf' 'traverse'
-- @
transposeOf
  :: Is k A_Traversal
  => Optic k is s t [a] a
  -> s -> [t]
transposeOf :: Optic k is s t [a] a -> s -> [t]
transposeOf Optic k is s t [a] a
o = ZipList t -> [t]
forall a. ZipList a -> [a]
getZipList (ZipList t -> [t]) -> (s -> ZipList t) -> s -> [t]
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. Optic k is s t [a] a -> ([a] -> ZipList a) -> s -> ZipList 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] -> ZipList a
forall a. [a] -> ZipList a
ZipList
{-# INLINE transposeOf #-}

-- | This generalizes 'Data.Traversable.mapAccumL' to an arbitrary 'Traversal'.
--
-- @
-- 'Data.Traversable.mapAccumL' ≡ 'mapAccumLOf' 'traverse'
-- @
--
-- 'mapAccumLOf' accumulates 'State' from left to right.
mapAccumLOf
  :: 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
-> (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 = (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 -> acc -> a -> (b, acc)
f 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
-> (a -> StateT acc Identity b) -> s -> State acc 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 a -> StateT acc Identity b
g s
s) acc
acc0

{-# INLINE mapAccumLOf #-}

-- | This generalizes 'Data.Traversable.mapAccumR' to an arbitrary 'Traversal'.
--
-- @
-- 'Data.Traversable.mapAccumR' ≡ 'mapAccumROf' 'traversed'
-- @
--
-- 'mapAccumROf' accumulates 'State' from right to left.
mapAccumROf
  :: 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 b
-> (acc -> a -> (b, acc)) -> acc -> s -> (t, acc)
mapAccumROf = Optic A_Traversal NoIx s t a b
-> (acc -> a -> (b, acc)) -> acc -> s -> (t, acc)
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 A_Traversal NoIx s t a b
 -> (acc -> a -> (b, acc)) -> acc -> s -> (t, acc))
-> (Optic k is s t a b -> Optic A_Traversal NoIx s t a b)
-> Optic k is s t a b
-> (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 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
{-# INLINE mapAccumROf #-}

-- | This permits the use of 'scanl1' over an arbitrary 'Traversal'.
--
-- @
-- 'scanl1' ≡ 'scanl1Of' 'traversed'
-- @
scanl1Of
  :: Is k A_Traversal
  => Optic k is s t a a
  -> (a -> a -> a) -> s -> t
scanl1Of :: 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, a -> Maybe 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, 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
-> (Maybe a -> a -> (a, Maybe a)) -> Maybe a -> s -> (t, Maybe a)
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 Maybe a
forall a. Maybe a
Nothing
{-# INLINE scanl1Of #-}

-- | This permits the use of 'scanr1' over an arbitrary 'Traversal'.
--
-- @
-- 'scanr1' ≡ 'scanr1Of' 'traversed'
-- @
scanr1Of
  :: Is k A_Traversal
  => Optic k is s t a a
  -> (a -> a -> a) -> s -> t
scanr1Of :: 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, a -> Maybe 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, 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
-> (Maybe a -> a -> (a, Maybe a)) -> Maybe a -> s -> (t, Maybe a)
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 Maybe a
forall a. Maybe a
Nothing
{-# INLINE scanr1Of #-}

-- | Try to map a function over this 'Traversal', returning Nothing if the
-- traversal has no targets.
--
-- >>> failover (element 3) (*2) [1,2]
-- Nothing
--
-- >>> failover _Left (*2) (Right 4)
-- Nothing
--
-- >>> failover _Right (*2) (Right 4)
-- Just (Right 8)
--
failover
  :: Is k A_Traversal
  => Optic k is s t a b
  -> (a -> b) -> s -> Maybe t
failover :: 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 = Optic k is s t a b -> (a -> OrT Identity b) -> s -> OrT Identity 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 (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
#. a -> b
f) 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 failover #-}

-- | Version of 'failover' strict in the application of @f@.
failover'
  :: Is k A_Traversal
  => Optic k is s t a b
  -> (a -> b) -> s -> Maybe t
failover' :: 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 = Optic k is s t a b
-> (a -> OrT Identity' b) -> s -> OrT Identity' 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 (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
. a -> b
f) 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 failover' #-}

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

-- | Construct a 'Traversal' via the 'Traversable' class.
--
-- @
-- 'traverseOf' 'traversed' = 'traverse'
-- @
--
traversed :: Traversable t => Traversal (t a) (t b) a b
traversed :: Traversal (t a) (t b) a b
traversed = (forall (p :: * -> * -> * -> *) i.
 Profunctor p =>
 Optic_ A_Traversal p i (Curry NoIx i) (t a) (t b) a b)
-> Traversal (t a) (t 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 NoIx i) (t a) (t b) a b
forall (p :: * -> * -> * -> *) (f :: * -> *) i a b.
(Traversing p, Traversable f) =>
Optic__ p i i (f a) (f b) a b
traversed__
{-# INLINE traversed #-}

-- | Traverse both parts of a 'Bitraversable' container with matching types.
--
-- /Note:/ for traversing a pair or an 'Either' it's better to use
-- 'Optics.Each.Core.each' and 'Optics.IxLens.chosen' respectively to reduce
-- potential for bugs due to too much polymorphism.
--
-- >>> (1,2) & both %~ (*10)
-- (10,20)
--
-- >>> over both length ("hello","world")
-- (5,5)
--
-- >>> foldOf both ("hello","world")
-- "helloworld"
--
-- @since 0.4
--
both :: Bitraversable r => Traversal (r a a) (r b b) a b
both :: Traversal (r a a) (r b b) a b
both = TraversalVL (r a a) (r b b) a b -> Traversal (r a a) (r b b) a b
forall s t a b. TraversalVL s t a b -> Traversal s t a b
traversalVL (TraversalVL (r a a) (r b b) a b -> Traversal (r a a) (r b b) a b)
-> TraversalVL (r a a) (r b b) a b -> Traversal (r a a) (r b b) a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f -> (a -> f b) -> (a -> f b) -> r a a -> f (r b b)
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 #-}

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

-- | This allows you to 'traverse' the elements of a traversal in the opposite
-- order.
backwards
  :: Is k A_Traversal
  => Optic k is s t a b
  -> Traversal s t a b
backwards :: Optic k is s t a b -> Traversal s t a b
backwards Optic k is s t a b
o = TraversalVL s t a b -> Traversal s t a b
forall s t a b. TraversalVL s t a b -> Traversal s t a b
traversalVL (TraversalVL s t a b -> Traversal s t a b)
-> TraversalVL s t a b -> Traversal s t a b
forall a b. (a -> b) -> a -> b
$ \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 -> (a -> Backwards f b) -> s -> Backwards 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 b
o (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
#. a -> f b
f)
{-# INLINE backwards #-}

-- | 'partsOf' turns a 'Traversal' into a 'Lens'.
--
-- /Note:/ You should really try to maintain the invariant of the number of
-- children in the list.
--
-- >>> ('a','b','c') & partsOf each .~ ['x','y','z']
-- ('x','y','z')
--
-- Any extras will be lost. If you do not supply enough, then the remainder will
-- come from the original structure.
--
-- >>> ('a','b','c') & partsOf each .~ ['w','x','y','z']
-- ('w','x','y')
--
-- >>> ('a','b','c') & partsOf each .~ ['x','y']
-- ('x','y','c')
--
-- >>> ('b', 'a', 'd', 'c') & partsOf each %~ sort
-- ('a','b','c','d')
--
-- So technically, this is only a 'Lens' if you do not change the number of
-- results it returns.
partsOf
  :: forall k is 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 -> Lens s t [a] [a]
partsOf Optic k is s t a a
o = LensVL s t [a] [a] -> Lens s t [a] [a]
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL s t [a] [a] -> Lens s t [a] [a])
-> LensVL s t [a] [a] -> Lens s t [a] [a]
forall a b. (a -> b) -> a -> b
$ \[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
<$> [a] -> f [a]
f (Optic' A_Fold is s a -> s -> [a]
forall k (is :: IxList) s a.
Is k A_Fold =>
Optic' k is s a -> s -> [a]
toListOf (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
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'
      []       ->            b -> StateT [b] m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a
{-# INLINE partsOf #-}

-- | Convert a traversal to an 'AffineTraversal' that visits the first element
-- of the original traversal.
--
-- For the fold version see 'Optics.Fold.pre'.
--
-- >>> "foo" & singular traversed .~ 'z'
-- "zoo"
--
-- @since 0.3
singular
  :: forall k is s a. Is k A_Traversal
  => Optic' k is s a
  -> AffineTraversal' s a
singular :: Optic' k is s a -> AffineTraversal' s a
singular Optic' k is s a
o = AffineTraversalVL s s a a -> AffineTraversal' s a
forall s t a b.
AffineTraversalVL s t a b -> AffineTraversal s t a b
atraversalVL (AffineTraversalVL s s a a -> AffineTraversal' s a)
-> AffineTraversalVL s s a a -> AffineTraversal' s a
forall a b. (a -> b) -> a -> b
$ \forall r. r -> f r
point a -> f a
f s
s ->
  case Optic' A_Traversal is s a -> s -> Maybe a
forall k (is :: IxList) s a.
Is k A_Fold =>
Optic' k is s a -> s -> Maybe a
headOf (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 a
Nothing -> s -> f s
forall r. r -> f r
point s
s
    Just 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
<$> a -> f a
f 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 singular #-}

-- | Combine two disjoint traversals into one.
--
-- >>> over (_1 % _Just `adjoin` _2 % _Right) not (Just True, Right False)
-- (Just False,Right True)
--
-- /Note:/ if the argument traversals are not disjoint, the result will not
-- respect the 'Traversal' 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.
--
-- >>> view (partsOf (each `adjoin` _1)) ('x','y')
-- "xyx"
-- >>> set (partsOf (each `adjoin` _1)) "abc" ('x','y')
-- ('c','b')
--
-- For the 'Fold' version see 'Optics.Fold.summing'.
--
-- @since 0.4
--
adjoin
  :: (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 -> 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 Traversal s s [a] [a]
-> Optic A_Traversal NoIx [a] [a] a a -> Traversal' 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 NoIx [a] [a] a a
forall (t :: * -> *) a b.
Traversable t =>
Traversal (t a) (t b) a b
traversed
  where
    combined :: Traversal s s [a] [a]
combined = TraversalVL s s [a] [a] -> Traversal s s [a] [a]
forall s t a b. TraversalVL s t a b -> Traversal s t a b
traversalVL (TraversalVL s s [a] [a] -> Traversal s s [a] [a])
-> TraversalVL s s [a] [a] -> Traversal s s [a] [a]
forall a b. (a -> b) -> a -> b
$ \[a] -> f [a]
f s
s0 ->
      (\[a]
r1 [a]
r2 ->
         let s1 :: s
s1 = State [a] s -> [a] -> s
forall s a. State s a -> s -> a
evalState (Optic' k is s a -> (a -> StateT [a] Identity a) -> s -> State [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 [a] Identity a
forall (m :: * -> *) b. Monad m => b -> StateT [b] m b
update s
s0) [a]
r1
             s2 :: s
s2 = State [a] s -> [a] -> s
forall s a. State s a -> s -> a
evalState (Optic' l js s a -> (a -> StateT [a] Identity a) -> s -> State [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 js s a
o2 a -> StateT [a] Identity a
forall (m :: * -> *) b. Monad m => b -> StateT [b] m b
update s
s1) [a]
r2
         in s
s2
      )
      ([a] -> [a] -> s) -> f [a] -> f ([a] -> s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> f [a]
f (Optic' A_Traversal is s a -> s -> [a]
forall k (is :: IxList) s a.
Is k A_Fold =>
Optic' k is s a -> s -> [a]
toListOf (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 ([a] -> s) -> f [a] -> f s
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [a] -> f [a]
f (Optic' A_Traversal js s a -> s -> [a]
forall k (is :: IxList) s a.
Is k A_Fold =>
Optic' k is s a -> s -> [a]
toListOf (Optic' l js s a -> Optic' A_Traversal js 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 js s a
o2) s
s0)

    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
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'
      []       ->            b -> StateT [b] m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a
infixr 6 `adjoin` -- Same as (<>)
{-# 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

#-}

-- | Triple 'adjoin' for optimizing multiple 'adjoin's with rewrite rules.
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 :: 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 Traversal s s [a] [a]
-> Optic A_Traversal NoIx [a] [a] a a -> Traversal' 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 NoIx [a] [a] a a
forall (t :: * -> *) a b.
Traversable t =>
Traversal (t a) (t b) a b
traversed
  where
    combined :: Traversal s s [a] [a]
combined = TraversalVL s s [a] [a] -> Traversal s s [a] [a]
forall s t a b. TraversalVL s t a b -> Traversal s t a b
traversalVL (TraversalVL s s [a] [a] -> Traversal s s [a] [a])
-> TraversalVL s s [a] [a] -> Traversal s s [a] [a]
forall a b. (a -> b) -> a -> b
$ \[a] -> f [a]
f s
s0 ->
      (\[a]
r1 [a]
r2 [a]
r3 ->
         let s1 :: s
s1 = State [a] s -> [a] -> s
forall s a. State s a -> s -> a
evalState (Optic' k1 is1 s a
-> (a -> StateT [a] Identity a) -> s -> State [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 is1 s a
o1 a -> StateT [a] Identity a
forall (m :: * -> *) b. Monad m => b -> StateT [b] m b
update s
s0) [a]
r1
             s2 :: s
s2 = State [a] s -> [a] -> s
forall s a. State s a -> s -> a
evalState (Optic' k2 is2 s a
-> (a -> StateT [a] Identity a) -> s -> State [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 is2 s a
o2 a -> StateT [a] Identity a
forall (m :: * -> *) b. Monad m => b -> StateT [b] m b
update s
s1) [a]
r2
             s3 :: s
s3 = State [a] s -> [a] -> s
forall s a. State s a -> s -> a
evalState (Optic' k3 is3 s a
-> (a -> StateT [a] Identity a) -> s -> State [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 is3 s a
o3 a -> StateT [a] Identity a
forall (m :: * -> *) b. Monad m => b -> StateT [b] m b
update s
s2) [a]
r3
         in s
s3
      )
      ([a] -> [a] -> [a] -> s) -> f [a] -> f ([a] -> [a] -> s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> f [a]
f (Optic' A_Traversal is1 s a -> s -> [a]
forall k (is :: IxList) s a.
Is k A_Fold =>
Optic' k is s a -> s -> [a]
toListOf (Optic' k1 is1 s a -> Optic' A_Traversal is1 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 is1 s a
o1) s
s0)
      f ([a] -> [a] -> s) -> f [a] -> f ([a] -> s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [a] -> f [a]
f (Optic' A_Traversal is2 s a -> s -> [a]
forall k (is :: IxList) s a.
Is k A_Fold =>
Optic' k is s a -> s -> [a]
toListOf (Optic' k2 is2 s a -> Optic' A_Traversal is2 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 is2 s a
o2) s
s0)
      f ([a] -> s) -> f [a] -> f s
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [a] -> f [a]
f (Optic' A_Traversal is3 s a -> s -> [a]
forall k (is :: IxList) s a.
Is k A_Fold =>
Optic' k is s a -> s -> [a]
toListOf (Optic' k3 is3 s a -> Optic' A_Traversal is3 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 is3 s a
o3) s
s0)

    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
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'
      []       ->            b -> StateT [b] m b
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

#-}

-- | Quadruple 'adjoin' for optimizing multiple 'adjoin's with rewrite rules.
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 :: 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 Traversal s s [a] [a]
-> Optic A_Traversal NoIx [a] [a] a a -> Traversal' 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 NoIx [a] [a] a a
forall (t :: * -> *) a b.
Traversable t =>
Traversal (t a) (t b) a b
traversed
  where
    combined :: Traversal s s [a] [a]
combined = TraversalVL s s [a] [a] -> Traversal s s [a] [a]
forall s t a b. TraversalVL s t a b -> Traversal s t a b
traversalVL (TraversalVL s s [a] [a] -> Traversal s s [a] [a])
-> TraversalVL s s [a] [a] -> Traversal s s [a] [a]
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 = State [a] s -> [a] -> s
forall s a. State s a -> s -> a
evalState (Optic' k1 is1 s a
-> (a -> StateT [a] Identity a) -> s -> State [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 is1 s a
o1 a -> StateT [a] Identity a
forall (m :: * -> *) b. Monad m => b -> StateT [b] m b
update s
s0) [a]
r1
             s2 :: s
s2 = State [a] s -> [a] -> s
forall s a. State s a -> s -> a
evalState (Optic' k2 is2 s a
-> (a -> StateT [a] Identity a) -> s -> State [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 is2 s a
o2 a -> StateT [a] Identity a
forall (m :: * -> *) b. Monad m => b -> StateT [b] m b
update s
s1) [a]
r2
             s3 :: s
s3 = State [a] s -> [a] -> s
forall s a. State s a -> s -> a
evalState (Optic' k3 is3 s a
-> (a -> StateT [a] Identity a) -> s -> State [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 is3 s a
o3 a -> StateT [a] Identity a
forall (m :: * -> *) b. Monad m => b -> StateT [b] m b
update s
s2) [a]
r3
             s4 :: s
s4 = State [a] s -> [a] -> s
forall s a. State s a -> s -> a
evalState (Optic' k4 is4 s a
-> (a -> StateT [a] Identity a) -> s -> State [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 is4 s a
o4 a -> StateT [a] Identity a
forall (m :: * -> *) b. Monad m => b -> StateT [b] m b
update s
s3) [a]
r4
         in s
s4
      )
      ([a] -> [a] -> [a] -> [a] -> s)
-> f [a] -> f ([a] -> [a] -> [a] -> s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> f [a]
f (Optic' A_Traversal is1 s a -> s -> [a]
forall k (is :: IxList) s a.
Is k A_Fold =>
Optic' k is s a -> s -> [a]
toListOf (Optic' k1 is1 s a -> Optic' A_Traversal is1 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 is1 s a
o1) s
s0)
      f ([a] -> [a] -> [a] -> s) -> f [a] -> f ([a] -> [a] -> s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [a] -> f [a]
f (Optic' A_Traversal is2 s a -> s -> [a]
forall k (is :: IxList) s a.
Is k A_Fold =>
Optic' k is s a -> s -> [a]
toListOf (Optic' k2 is2 s a -> Optic' A_Traversal is2 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 is2 s a
o2) s
s0)
      f ([a] -> [a] -> s) -> f [a] -> f ([a] -> s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [a] -> f [a]
f (Optic' A_Traversal is3 s a -> s -> [a]
forall k (is :: IxList) s a.
Is k A_Fold =>
Optic' k is s a -> s -> [a]
toListOf (Optic' k3 is3 s a -> Optic' A_Traversal is3 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 is3 s a
o3) s
s0)
      f ([a] -> s) -> f [a] -> f s
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [a] -> f [a]
f (Optic' A_Traversal is4 s a -> s -> [a]
forall k (is :: IxList) s a.
Is k A_Fold =>
Optic' k is s a -> s -> [a]
toListOf (Optic' k4 is4 s a -> Optic' A_Traversal is4 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 is4 s a
o4) s
s0)

    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
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'
      []       ->            b -> StateT [b] m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a
{-# INLINE [1] adjoin4 #-}

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