{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE ConstraintKinds #-}

#include "lens-common.h"

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

-- |

-- Module      :  Control.Lens.Traversal

-- Copyright   :  (C) 2012-16 Edward Kmett

-- License     :  BSD-style (see the file LICENSE)

-- Maintainer  :  Edward Kmett <ekmett@gmail.com>

-- Stability   :  provisional

-- Portability :  Rank2Types

--

-- A @'Traversal' s t a b@ is a generalization of 'traverse' from

-- 'Traversable'. It allows you to 'traverse' over a structure and change out

-- its contents with monadic or 'Applicative' side-effects. Starting from

--

-- @

-- 'traverse' :: ('Traversable' t, 'Applicative' f) => (a -> f b) -> t a -> f (t b)

-- @

--

-- we monomorphize the contents and result to obtain

--

-- @

-- type 'Traversal' s t a b = forall f. 'Applicative' f => (a -> f b) -> s -> f t

-- @

--

-- A 'Traversal' can be used as a 'Fold'.

-- Any 'Traversal' can be used for 'Control.Lens.Getter.Getting' like a 'Fold',

-- because given a 'Data.Monoid.Monoid' @m@, we have an 'Applicative' for

-- @('Const' m)@. Everything you know how to do with a 'Traversable' container,

-- you can with a 'Traversal', and here we provide combinators that generalize

-- the usual 'Traversable' operations.

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

module Control.Lens.Traversal
  (
  -- * Traversals

    Traversal, Traversal'
  , Traversal1, Traversal1'
  , IndexedTraversal, IndexedTraversal'
  , IndexedTraversal1, IndexedTraversal1'
  , ATraversal, ATraversal'
  , ATraversal1, ATraversal1'
  , AnIndexedTraversal, AnIndexedTraversal'
  , AnIndexedTraversal1, AnIndexedTraversal1'
  , Traversing, Traversing'
  , Traversing1, Traversing1'

  -- * Traversing and Lensing

  , traversal
  , traverseOf, forOf, sequenceAOf
  , mapMOf, forMOf, sequenceOf
  , transposeOf
  , mapAccumLOf, mapAccumROf
  , scanr1Of, scanl1Of
  , failover, ifailover

  -- * Monomorphic Traversals

  , cloneTraversal
  , cloneIndexPreservingTraversal
  , cloneIndexedTraversal
  , cloneTraversal1
  , cloneIndexPreservingTraversal1
  , cloneIndexedTraversal1

  -- * Parts and Holes

  , partsOf, partsOf'
  , unsafePartsOf, unsafePartsOf'
  , holesOf, holes1Of
  , singular, unsafeSingular

  -- * Common Traversals

  , Traversable(traverse)
  , Traversable1(traverse1)
  , both, both1
  , beside
  , taking
  , dropping
  , failing
  , deepOf

  -- * Indexed Traversals


  -- ** Common

  , ignored
  , TraverseMin(..)
  , TraverseMax(..)
  , traversed
  , traversed1
  , traversed64
  , elementOf
  , element
  , elementsOf
  , elements

  -- ** Combinators

  , ipartsOf
  , ipartsOf'
  , iunsafePartsOf
  , iunsafePartsOf'
  , itraverseOf
  , iforOf
  , imapMOf
  , iforMOf
  , imapAccumROf
  , imapAccumLOf

  -- * Reflection

  , traverseBy
  , traverseByOf
  , sequenceBy
  , sequenceByOf

  -- * Implementation Details

  , Bazaar(..), Bazaar'
  , Bazaar1(..), Bazaar1'
  , loci
  , iloci

  -- * Fusion

  , confusing
  ) where

import Prelude ()

import Control.Applicative.Backwards
import qualified Control.Category as C
import Control.Comonad
import Control.Lens.Fold
import Control.Lens.Getter (Getting, IndexedGetting, getting)
import Control.Lens.Internal.Bazaar
import Control.Lens.Internal.Context
import Control.Lens.Internal.Fold
import Control.Lens.Internal.Indexed
import Control.Lens.Internal.Prelude
import Control.Lens.Lens
import Control.Lens.Setter (ASetter, AnIndexedSetter, isets, sets)
import Control.Lens.Type
import Control.Monad.Trans.State.Lazy
import Data.Bitraversable
import Data.CallStack
import Data.Functor.Apply
import Data.Functor.Day.Curried
import Data.Functor.Yoneda
import Data.Int
import qualified Data.IntMap as IntMap
import qualified Data.Map as Map
import Data.Map (Map)
import Data.Monoid (Any (..))
import Data.Sequence (Seq, mapWithIndex)
import Data.Vector as Vector (Vector, imap)
import Data.Profunctor.Rep (Representable (..))
import Data.Reflection
import Data.Semigroup.Traversable
import Data.Semigroup.Bitraversable
import Data.Tuple (swap)
import GHC.Magic (inline)

-- $setup

-- >>> :set -XNoOverloadedStrings -XFlexibleContexts

-- >>> import Data.Char (toUpper)

-- >>> import Control.Applicative

-- >>> import Control.Lens

-- >>> import Control.Lens.Internal.Context

-- >>> import Control.DeepSeq (NFData (..), force)

-- >>> import Control.Exception (evaluate,try,ErrorCall(..))

-- >>> import Data.Maybe (fromMaybe)

-- >>> import Data.List.NonEmpty (NonEmpty (..))

-- >>> import Debug.SimpleReflect.Vars

-- >>> import Data.Void

-- >>> import Data.List (sort)

-- >>> import System.Timeout (timeout)

-- >>> import qualified Data.List.NonEmpty as NonEmpty

-- >>> let timingOut :: NFData a => a -> IO a; timingOut = fmap (fromMaybe (error "timeout")) . timeout (5*10^6) . evaluate . force

-- >>> let firstAndThird :: Traversal (a, x, a) (b, x, b) a b; firstAndThird = traversal go where { go :: Applicative f => (a -> f b) -> (a, x, a) -> f (b, x, b); go focus (a, x, a') = liftA3 (,,) (focus a) (pure x) (focus a') }

-- >>> let selectNested :: Traversal (x, [a]) (x, [b]) a b; selectNested = traversal go where { go :: Applicative f => (a -> f b) -> (x, [a]) -> f (x, [b]); go focus (x, as) = liftA2 (,) (pure x) (traverse focus as) }


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

-- Traversals

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


-- | When you see this as an argument to a function, it expects a 'Traversal'.

type ATraversal s t a b = LensLike (Bazaar (->) a b) s t a b

-- | @

-- type 'ATraversal'' = 'Simple' 'ATraversal'

-- @

type ATraversal' s a = ATraversal s s a a


-- | When you see this as an argument to a function, it expects a 'Traversal1'.

type ATraversal1 s t a b = LensLike (Bazaar1 (->) a b) s t a b

-- | @

-- type 'ATraversal1'' = 'Simple' 'ATraversal1'

-- @

type ATraversal1' s a = ATraversal1 s s a a

-- | When you see this as an argument to a function, it expects an 'IndexedTraversal'.

type AnIndexedTraversal i s t a b = Over (Indexed i) (Bazaar (Indexed i) a b) s t a b

-- | When you see this as an argument to a function, it expects an 'IndexedTraversal1'.

type AnIndexedTraversal1 i s t a b = Over (Indexed i) (Bazaar1 (Indexed i) a b) s t a b

-- | @

-- type 'AnIndexedTraversal'' = 'Simple' ('AnIndexedTraversal' i)

-- @

type AnIndexedTraversal' i s a = AnIndexedTraversal i s s a a

-- | @

-- type 'AnIndexedTraversal1'' = 'Simple' ('AnIndexedTraversal1' i)

-- @

type AnIndexedTraversal1' i s a = AnIndexedTraversal1 i s s a a


-- | When you see this as an argument to a function, it expects

--

--  * to be indexed if @p@ is an instance of 'Indexed' i,

--

--  * to be unindexed if @p@ is @(->)@,

--

--  * a 'Traversal' if @f@ is 'Applicative',

--

--  * a 'Getter' if @f@ is only a 'Functor' and 'Data.Functor.Contravariant.Contravariant',

--

--  * a 'Lens' if @f@ is only a 'Functor',

--

--  * a 'Fold' if @f@ is 'Applicative' and 'Data.Functor.Contravariant.Contravariant'.

type Traversing p f s t a b = Over p (BazaarT p f a b) s t a b

type Traversing1 p f s t a b = Over p (BazaarT1 p f a b) s t a b

-- | @

-- type 'Traversing'' f = 'Simple' ('Traversing' f)

-- @

type Traversing' p f s a = Traversing p f s s a a
type Traversing1' p f s a = Traversing1 p f s s a a

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

-- Traversal Combinators

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


-- | Build a 'Traversal' by providing a function which specifies the elements you wish to

-- focus.

--

-- The caller provides a function of type:

--

-- @

-- Applicative f => (a -> f b) -> s -> f t

-- @

--

-- Which is a higher order function which accepts a "focusing function" and applies

-- it to all desired focuses within @s@, then constructs a @t@ using the Applicative

-- instance of @f@.

--

-- Only elements which are "focused" using the focusing function will be targeted by the

-- resulting traversal.

--

-- For example, we can explicitly write a traversal which targets the first and third elements

-- of a tuple like this:

--

-- @

-- firstAndThird :: Traversal (a, x, a) (b, x, b) a b

-- firstAndThird = traversal go

--   where

--     go :: Applicative f => (a -> f b) -> (a, x, a) -> f (b, x, b)

--     go focus (a, x, a') = liftA3 (,,) (focus a) (pure x) (focus a')

-- @

--

-- >>> (1,"two",3) & firstAndThird *~ 10

-- (10,"two",30)

--

-- >>> over firstAndThird length ("one",2,"three")

-- (3,2,5)

--

-- We can re-use existing 'Traversal's when writing new ones by passing our focusing function

-- along to them. This example re-uses 'traverse' to focus all elements in a list which is

-- embedded in a tuple. This traversal could also be written simply as @_2 . traverse@.

--

-- @

-- selectNested :: Traversal (x, [a]) (x, [b]) a b

-- selectNested = traversal go

--   where

--     go :: Applicative f => (a -> f b) -> (x, [a]) -> f (x, [b])

--     go focus (x, as) = liftA2 (,) (pure x) (traverse focus as)

-- @

--

-- >>> selectNested .~ "hello" $ (1,[2,3,4,5])

-- (1,["hello","hello","hello","hello"])

--

-- >>> (1,[2,3,4,5]) & selectNested *~ 3

-- (1,[6,9,12,15])

--

-- Note that the 'traversal' function actually just returns the same function you pass to

-- it. The function it accepts is in fact a valid traversal all on its own! The use of

-- 'traversal' does nothing except verify that the function it is passed matches the signature

-- of a valid traversal. One could remove the @traversal@ combinator from either of the last

-- two examples and use the definition of @go@ directly with no change in behaviour.

--

-- This function exists for consistency with the 'lens', 'prism' and 'iso' constructors

-- as well as to serve as a touchpoint for beginners who wish to construct their own

-- traversals but are uncertain how to do so.

traversal :: ((a -> f b) -> s -> f t) -> LensLike f s t a b
traversal :: forall a (f :: * -> *) b s t.
((a -> f b) -> s -> f t) -> (a -> f b) -> s -> f t
traversal = forall a. a -> a
id
{-# INLINE traversal #-}

-- | Map each element of a structure targeted by a 'Lens' or 'Traversal',

-- evaluate these actions from left to right, and collect the results.

--

-- This function is only provided for consistency, 'id' is strictly more general.

--

-- >>> traverseOf each print (1,2,3)

-- 1

-- 2

-- 3

-- ((),(),())

--

-- @

-- 'traverseOf' ≡ 'id'

-- 'itraverseOf' l ≡ 'traverseOf' l '.' 'Indexed'

-- 'itraverseOf' 'itraversed' ≡ 'itraverse'

-- @

--

--

-- This yields the obvious law:

--

-- @

-- 'traverse' ≡ 'traverseOf' 'traverse'

-- @

--

-- @

-- 'traverseOf' :: 'Functor' f     => 'Iso' s t a b        -> (a -> f b) -> s -> f t

-- 'traverseOf' :: 'Functor' f     => 'Lens' s t a b       -> (a -> f b) -> s -> f t

-- 'traverseOf' :: 'Apply' f       => 'Traversal1' s t a b -> (a -> f b) -> s -> f t

-- 'traverseOf' :: 'Applicative' f => 'Traversal' s t a b  -> (a -> f b) -> s -> f t

-- @

traverseOf :: LensLike f s t a b -> (a -> f b) -> s -> f t
traverseOf :: forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf = forall a. a -> a
id
{-# INLINE traverseOf #-}

-- | A version of 'traverseOf' with the arguments flipped, such that:

--

-- >>> forOf each (1,2,3) print

-- 1

-- 2

-- 3

-- ((),(),())

--

-- This function is only provided for consistency, 'flip' is strictly more general.

--

-- @

-- 'forOf' ≡ 'flip'

-- 'forOf' ≡ 'flip' . 'traverseOf'

-- @

--

-- @

-- 'for' ≡ 'forOf' 'traverse'

-- 'Control.Lens.Indexed.ifor' l s ≡ 'for' l s '.' 'Indexed'

-- @

--

-- @

-- 'forOf' :: 'Functor' f => 'Iso' s t a b -> s -> (a -> f b) -> f t

-- 'forOf' :: 'Functor' f => 'Lens' s t a b -> s -> (a -> f b) -> f t

-- 'forOf' :: 'Applicative' f => 'Traversal' s t a b -> s -> (a -> f b) -> f t

-- @

forOf :: LensLike f s t a b -> s -> (a -> f b) -> f t
forOf :: forall (f :: * -> *) s t a b.
LensLike f s t a b -> s -> (a -> f b) -> f t
forOf = forall a b c. (a -> b -> c) -> b -> a -> c
flip
{-# INLINE forOf #-}

-- | Evaluate each action in the structure from left to right, and collect

-- the results.

--

-- >>> sequenceAOf both ([1,2],[3,4])

-- [(1,3),(1,4),(2,3),(2,4)]

--

-- @

-- 'sequenceA' ≡ 'sequenceAOf' 'traverse' ≡ 'traverse' 'id'

-- 'sequenceAOf' l ≡ 'traverseOf' l 'id' ≡ l 'id'

-- @

--

-- @

-- 'sequenceAOf' :: 'Functor' f => 'Iso' s t (f b) b       -> s -> f t

-- 'sequenceAOf' :: 'Functor' f => 'Lens' s t (f b) b      -> s -> f t

-- 'sequenceAOf' :: 'Applicative' f => 'Traversal' s t (f b) b -> s -> f t

-- @

sequenceAOf :: LensLike f s t (f b) b -> s -> f t
sequenceAOf :: forall (f :: * -> *) s t b. LensLike f s t (f b) b -> s -> f t
sequenceAOf LensLike f s t (f b) b
l = LensLike f s t (f b) b
l forall a. a -> a
id
{-# INLINE sequenceAOf #-}

-- | Map each element of a structure targeted by a 'Lens' to a monadic action,

-- evaluate these actions from left to right, and collect the results.

--

-- >>> mapMOf both (\x -> [x, x + 1]) (1,3)

-- [(1,3),(1,4),(2,3),(2,4)]

--

-- @

-- 'mapM' ≡ 'mapMOf' 'traverse'

-- 'imapMOf' l ≡ 'forM' l '.' 'Indexed'

-- @

--

-- @

-- 'mapMOf' :: 'Monad' m => 'Iso' s t a b       -> (a -> m b) -> s -> m t

-- 'mapMOf' :: 'Monad' m => 'Lens' s t a b      -> (a -> m b) -> s -> m t

-- 'mapMOf' :: 'Monad' m => 'Traversal' s t a b -> (a -> m b) -> s -> m t

-- @

mapMOf :: LensLike (WrappedMonad m) s t a b -> (a -> m b) -> s -> m t
mapMOf :: forall (m :: * -> *) s t a b.
LensLike (WrappedMonad m) s t a b -> (a -> m b) -> s -> m t
mapMOf = coerce :: forall a b. Coercible a b => a -> b
coerce
{-# INLINE mapMOf #-}

-- | 'forMOf' is a flipped version of 'mapMOf', consistent with the definition of 'forM'.

--

-- >>> forMOf both (1,3) $ \x -> [x, x + 1]

-- [(1,3),(1,4),(2,3),(2,4)]

--

-- @

-- 'forM' ≡ 'forMOf' 'traverse'

-- 'forMOf' l ≡ 'flip' ('mapMOf' l)

-- 'iforMOf' l s ≡ 'forM' l s '.' 'Indexed'

-- @

--

-- @

-- 'forMOf' :: 'Monad' m => 'Iso' s t a b       -> s -> (a -> m b) -> m t

-- 'forMOf' :: 'Monad' m => 'Lens' s t a b      -> s -> (a -> m b) -> m t

-- 'forMOf' :: 'Monad' m => 'Traversal' s t a b -> s -> (a -> m b) -> m t

-- @

forMOf :: LensLike (WrappedMonad m) s t a b -> s -> (a -> m b) -> m t
forMOf :: forall (m :: * -> *) s t a b.
LensLike (WrappedMonad m) s t a b -> s -> (a -> m b) -> m t
forMOf LensLike (WrappedMonad m) s t a b
l s
a a -> m b
cmd = forall (m :: * -> *) a. WrappedMonad m a -> m a
unwrapMonad (LensLike (WrappedMonad m) s t a b
l (forall (m :: * -> *) a. m a -> WrappedMonad m a
WrapMonad forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. a -> m b
cmd) s
a)
{-# INLINE forMOf #-}

-- | Sequence the (monadic) effects targeted by a 'Lens' in a container from left to right.

--

-- >>> sequenceOf each ([1,2],[3,4],[5,6])

-- [(1,3,5),(1,3,6),(1,4,5),(1,4,6),(2,3,5),(2,3,6),(2,4,5),(2,4,6)]

--

-- @

-- 'sequence' ≡ 'sequenceOf' 'traverse'

-- 'sequenceOf' l ≡ 'mapMOf' l 'id'

-- 'sequenceOf' l ≡ 'unwrapMonad' '.' l 'WrapMonad'

-- @

--

-- @

-- 'sequenceOf' :: 'Monad' m => 'Iso' s t (m b) b       -> s -> m t

-- 'sequenceOf' :: 'Monad' m => 'Lens' s t (m b) b      -> s -> m t

-- 'sequenceOf' :: 'Monad' m => 'Traversal' s t (m b) b -> s -> m t

-- @

sequenceOf :: LensLike (WrappedMonad m) s t (m b) b -> s -> m t
sequenceOf :: forall (m :: * -> *) s t b.
LensLike (WrappedMonad m) s t (m b) b -> s -> m t
sequenceOf LensLike (WrappedMonad m) s t (m b) b
l = forall (m :: * -> *) a. WrappedMonad m a -> m a
unwrapMonad forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. LensLike (WrappedMonad m) s t (m b) b
l forall (m :: * -> *) a. m a -> WrappedMonad m a
WrapMonad
{-# 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 traverse [[1,2,3],[4,5,6]]

-- [[1,4],[2,5],[3,6]]

--

-- @

-- 'Data.List.transpose' ≡ 'transposeOf' 'traverse'

-- @

--

-- Since every 'Lens' is a 'Traversal', we can use this as a form of

-- monadic strength as well:

--

-- @

-- 'transposeOf' 'Control.Lens.Tuple._2' :: (b, [a]) -> [(b, a)]

-- @

transposeOf :: LensLike ZipList s t [a] a -> s -> [t]
transposeOf :: forall s t a. LensLike ZipList s t [a] a -> s -> [t]
transposeOf LensLike ZipList s t [a] a
l = forall a. ZipList a -> [a]
getZipList forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. LensLike ZipList s t [a] a
l forall a. [a] -> ZipList a
ZipList
{-# INLINE transposeOf #-}

-- | This generalizes 'Data.Traversable.mapAccumR' to an arbitrary 'Traversal'.

--

-- @

-- 'mapAccumR' ≡ 'mapAccumROf' 'traverse'

-- @

--

-- 'mapAccumROf' accumulates 'State' from right to left.

--

-- @

-- 'mapAccumROf' :: 'Iso' s t a b       -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)

-- 'mapAccumROf' :: 'Lens' s t a b      -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)

-- 'mapAccumROf' :: 'Traversal' s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)

-- @

--

-- @

-- 'mapAccumROf' :: 'LensLike' ('Backwards' ('State' acc)) s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)

-- @

mapAccumROf :: LensLike (Backwards (State acc)) s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
mapAccumROf :: forall acc s t a b.
LensLike (Backwards (State acc)) s t a b
-> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
mapAccumROf = forall acc s t a b.
LensLike (State acc) s t a b
-> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
mapAccumLOf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (q :: * -> * -> *) (f :: * -> *) s t a b.
(Profunctor p, Profunctor q) =>
Optical p q (Backwards f) s t a b -> Optical p q f s t a b
backwards
{-# INLINE mapAccumROf #-}

-- | This generalizes 'Data.Traversable.mapAccumL' to an arbitrary 'Traversal'.

--

-- @

-- 'mapAccumL' ≡ 'mapAccumLOf' 'traverse'

-- @

--

-- 'mapAccumLOf' accumulates 'State' from left to right.

--

-- @

-- 'mapAccumLOf' :: 'Iso' s t a b       -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)

-- 'mapAccumLOf' :: 'Lens' s t a b      -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)

-- 'mapAccumLOf' :: 'Traversal' s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)

-- @

--

-- @

-- 'mapAccumLOf' :: 'LensLike' ('State' acc) s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)

-- 'mapAccumLOf' l f acc0 s = 'swap' ('runState' (l (\a -> 'state' (\acc -> 'swap' (f acc a))) s) acc0)

-- @

--

mapAccumLOf :: LensLike (State acc) s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
mapAccumLOf :: forall acc s t a b.
LensLike (State acc) s t a b
-> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
mapAccumLOf LensLike (State acc) s t a b
l acc -> a -> (acc, b)
f acc
acc0 s
s = forall a b. (a, b) -> (b, a)
swap (forall s a. State s a -> s -> (a, s)
runState (LensLike (State acc) s t a b
l a -> StateT acc Identity b
g s
s) acc
acc0) where
   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 -> forall a b. (a, b) -> (b, a)
swap (acc -> a -> (acc, b)
f acc
acc a
a)
-- This would be much cleaner if the argument order for the function was swapped.

{-# INLINE mapAccumLOf #-}

-- | This permits the use of 'scanr1' over an arbitrary 'Traversal' or 'Lens'.

--

-- @

-- 'scanr1' ≡ 'scanr1Of' 'traverse'

-- @

--

-- @

-- 'scanr1Of' :: 'Iso' s t a a       -> (a -> a -> a) -> s -> t

-- 'scanr1Of' :: 'Lens' s t a a      -> (a -> a -> a) -> s -> t

-- 'scanr1Of' :: 'Traversal' s t a a -> (a -> a -> a) -> s -> t

-- @

scanr1Of :: LensLike (Backwards (State (Maybe a))) s t a a -> (a -> a -> a) -> s -> t
scanr1Of :: forall a s t.
LensLike (Backwards (State (Maybe a))) s t a a
-> (a -> a -> a) -> s -> t
scanr1Of LensLike (Backwards (State (Maybe a))) s t a a
l a -> a -> a
f = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall acc s t a b.
LensLike (Backwards (State acc)) s t a b
-> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
mapAccumROf LensLike (Backwards (State (Maybe a))) s t a a
l Maybe a -> a -> (Maybe a, a)
step forall a. Maybe a
Nothing where
  step :: Maybe a -> a -> (Maybe a, a)
step Maybe a
Nothing a
a  = (forall a. a -> Maybe a
Just a
a, a
a)
  step (Just a
s) a
a = (forall a. a -> Maybe a
Just a
r, a
r) where r :: a
r = a -> a -> a
f a
a a
s
{-# INLINE scanr1Of #-}

-- | This permits the use of 'scanl1' over an arbitrary 'Traversal' or 'Lens'.

--

-- @

-- 'scanl1' ≡ 'scanl1Of' 'traverse'

-- @

--

-- @

-- 'scanl1Of' :: 'Iso' s t a a       -> (a -> a -> a) -> s -> t

-- 'scanl1Of' :: 'Lens' s t a a      -> (a -> a -> a) -> s -> t

-- 'scanl1Of' :: 'Traversal' s t a a -> (a -> a -> a) -> s -> t

-- @

scanl1Of :: LensLike (State (Maybe a)) s t a a -> (a -> a -> a) -> s -> t
scanl1Of :: forall a s t.
LensLike (State (Maybe a)) s t a a -> (a -> a -> a) -> s -> t
scanl1Of LensLike (State (Maybe a)) s t a a
l a -> a -> a
f = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall acc s t a b.
LensLike (State acc) s t a b
-> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
mapAccumLOf LensLike (State (Maybe a)) s t a a
l Maybe a -> a -> (Maybe a, a)
step forall a. Maybe a
Nothing where
  step :: Maybe a -> a -> (Maybe a, a)
step Maybe a
Nothing a
a  = (forall a. a -> Maybe a
Just a
a, a
a)
  step (Just a
s) a
a = (forall a. a -> Maybe a
Just a
r, a
r) where r :: a
r = a -> a -> a
f a
s a
a
{-# INLINE scanl1Of #-}

-- | This 'Traversal' allows you to 'traverse' the individual stores in a 'Bazaar'.

loci :: Traversal (Bazaar (->) a c s) (Bazaar (->) b c s) a b
loci :: forall a c s b.
Traversal (Bazaar (->) a c s) (Bazaar (->) b c s) a b
loci a -> f b
f Bazaar (->) a c s
w = forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (forall (p :: * -> * -> *) a b t.
Bazaar p a b t
-> forall (f :: * -> *). Applicative f => p a (f b) -> f t
runBazaar Bazaar (->) a c s
w (forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f b
f))
{-# INLINE loci #-}

-- | This 'IndexedTraversal' allows you to 'traverse' the individual stores in

-- a 'Bazaar' with access to their indices.

iloci :: IndexedTraversal i (Bazaar (Indexed i) a c s) (Bazaar (Indexed i) b c s) a b
iloci :: forall i a c s b.
IndexedTraversal
  i (Bazaar (Indexed i) a c s) (Bazaar (Indexed i) b c s) a b
iloci p a (f b)
f Bazaar (Indexed i) a c s
w = forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (forall (p :: * -> * -> *) a b t.
Bazaar p a b t
-> forall (f :: * -> *). Applicative f => p a (f b) -> f t
runBazaar Bazaar (Indexed i) a c s
w (forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. forall i a b. (i -> a -> b) -> Indexed i a b
Indexed (\i
i -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell i
i) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p a (f b)
f i
i)))
{-# INLINE iloci #-}

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

-- Parts

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


-- | 'partsOf' turns a 'Traversal' into a 'Lens' that resembles an early version of the 'Data.Data.Lens.uniplate' (or 'Data.Data.Lens.biplate') type.

--

-- /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.

--

-- When applied to a 'Fold' the result is merely a 'Getter'.

--

-- @

-- 'partsOf' :: 'Iso'' s a       -> 'Lens'' s [a]

-- 'partsOf' :: 'Lens'' s a      -> 'Lens'' s [a]

-- 'partsOf' :: 'Traversal'' s a -> 'Lens'' s [a]

-- 'partsOf' :: 'Fold' s a       -> 'Getter' s [a]

-- 'partsOf' :: 'Getter' s a     -> 'Getter' s [a]

-- @

partsOf :: Functor f => Traversing (->) f s t a a -> LensLike f s t [a] [a]
partsOf :: forall (f :: * -> *) s t a.
Functor f =>
Traversing (->) f s t a a -> LensLike f s t [a] [a]
partsOf Traversing (->) f s t a a
l [a] -> f [a]
f s
s = forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a t.
(Bizarre p w, Category p) =>
w a a t -> [a] -> t
outs BazaarT (->) f a a t
b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> f [a]
f (forall (w :: * -> * -> * -> *) a b t.
Bizarre (->) w =>
w a b t -> [a]
ins BazaarT (->) f a a t
b) where b :: BazaarT (->) f a a t
b = Traversing (->) f s t a a
l forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
s
{-# INLINE partsOf #-}

-- | An indexed version of 'partsOf' that receives the entire list of indices as its index.

ipartsOf :: forall i p f s t a. (Indexable [i] p, Functor f) => Traversing (Indexed i) f s t a a -> Over p f s t [a] [a]
ipartsOf :: forall i (p :: * -> * -> *) (f :: * -> *) s t a.
(Indexable [i] p, Functor f) =>
Traversing (Indexed i) f s t a a -> Over p f s t [a] [a]
ipartsOf Traversing (Indexed i) f s t a a
l = forall (p :: * -> * -> *) (q :: * -> * -> *) a b r.
Conjoined p =>
((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r
conjoined
  (\[a] -> f [a]
f s
s -> let b :: BazaarT (Indexed i) f a a t
b = forall a. a -> a
inline Traversing (Indexed i) f s t a a
l forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
s                            in forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a t.
(Bizarre p w, Category p) =>
w a a t -> [a] -> t
outs BazaarT (Indexed i) f a a t
b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> f [a]
f (forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b t.
(Bizarre p w, Corepresentable p, Comonad (Corep p)) =>
w a b t -> [a]
wins BazaarT (Indexed i) f a a t
b))
  (\p [a] (f [a])
f s
s -> let b :: BazaarT (Indexed i) f a a t
b = forall a. a -> a
inline Traversing (Indexed i) f s t a a
l forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
s; ([i]
is, [a]
as) = forall a b. [(a, b)] -> ([a], [b])
unzip (forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b t.
(Bizarre p w, Corepresentable p) =>
w a b t -> [Corep p a]
pins BazaarT (Indexed i) f a a t
b) in forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a t.
(Bizarre p w, Category p) =>
w a a t -> [a] -> t
outs BazaarT (Indexed i) f a a t
b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p [a] (f [a])
f ([i]
is :: [i]) [a]
as)
{-# INLINE ipartsOf #-}

-- | A type-restricted version of 'partsOf' that can only be used with a 'Traversal'.

partsOf' :: ATraversal s t a a -> Lens s t [a] [a]
partsOf' :: forall s t a. ATraversal s t a a -> Lens s t [a] [a]
partsOf' ATraversal s t a a
l [a] -> f [a]
f s
s = forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a t.
(Bizarre p w, Category p) =>
w a a t -> [a] -> t
outs Bazaar (->) a a t
b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> f [a]
f (forall (w :: * -> * -> * -> *) a b t.
Bizarre (->) w =>
w a b t -> [a]
ins Bazaar (->) a a t
b) where b :: Bazaar (->) a a t
b = ATraversal s t a a
l forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
s
{-# INLINE partsOf' #-}

-- | A type-restricted version of 'ipartsOf' that can only be used with an 'IndexedTraversal'.

ipartsOf' :: forall i p f s t a. (Indexable [i] p, Functor f) => Over (Indexed i) (Bazaar' (Indexed i) a) s t a a -> Over p f s t [a] [a]
ipartsOf' :: forall i (p :: * -> * -> *) (f :: * -> *) s t a.
(Indexable [i] p, Functor f) =>
Over (Indexed i) (Bazaar' (Indexed i) a) s t a a
-> Over p f s t [a] [a]
ipartsOf' Over (Indexed i) (Bazaar' (Indexed i) a) s t a a
l = forall (p :: * -> * -> *) (q :: * -> * -> *) a b r.
Conjoined p =>
((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r
conjoined
  (\[a] -> f [a]
f s
s -> let b :: Bazaar' (Indexed i) a t
b = forall a. a -> a
inline Over (Indexed i) (Bazaar' (Indexed i) a) s t a a
l forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
s                            in forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a t.
(Bizarre p w, Category p) =>
w a a t -> [a] -> t
outs Bazaar' (Indexed i) a t
b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> f [a]
f (forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b t.
(Bizarre p w, Corepresentable p, Comonad (Corep p)) =>
w a b t -> [a]
wins Bazaar' (Indexed i) a t
b))
  (\p [a] (f [a])
f s
s -> let b :: Bazaar' (Indexed i) a t
b = forall a. a -> a
inline Over (Indexed i) (Bazaar' (Indexed i) a) s t a a
l forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
s; ([i]
is, [a]
as) = forall a b. [(a, b)] -> ([a], [b])
unzip (forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b t.
(Bizarre p w, Corepresentable p) =>
w a b t -> [Corep p a]
pins Bazaar' (Indexed i) a t
b) in forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a t.
(Bizarre p w, Category p) =>
w a a t -> [a] -> t
outs Bazaar' (Indexed i) a t
b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p [a] (f [a])
f ([i]
is :: [i]) [a]
as)
{-# INLINE ipartsOf' #-}

-- | 'unsafePartsOf' turns a 'Traversal' into a 'Data.Data.Lens.uniplate' (or 'Data.Data.Lens.biplate') family.

--

-- If you do not need the types of @s@ and @t@ to be different, it is recommended that

-- you use 'partsOf'.

--

-- It is generally safer to traverse with the 'Bazaar' rather than use this

-- combinator. However, it is sometimes convenient.

--

-- This is unsafe because if you don't supply at least as many @b@'s as you were

-- given @a@'s, then the reconstruction of @t@ /will/ result in an error!

--

-- When applied to a 'Fold' the result is merely a 'Getter' (and becomes safe).

--

-- @

-- 'unsafePartsOf' :: 'Iso' s t a b       -> 'Lens' s t [a] [b]

-- 'unsafePartsOf' :: 'Lens' s t a b      -> 'Lens' s t [a] [b]

-- 'unsafePartsOf' :: 'Traversal' s t a b -> 'Lens' s t [a] [b]

-- 'unsafePartsOf' :: 'Fold' s a          -> 'Getter' s [a]

-- 'unsafePartsOf' :: 'Getter' s a        -> 'Getter' s [a]

-- @

unsafePartsOf :: Functor f => Traversing (->) f s t a b -> LensLike f s t [a] [b]
unsafePartsOf :: forall (f :: * -> *) s t a b.
Functor f =>
Traversing (->) f s t a b -> LensLike f s t [a] [b]
unsafePartsOf Traversing (->) f s t a b
l [a] -> f [b]
f s
s = forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b t.
(Bizarre p w, Corepresentable p) =>
w a b t -> [b] -> t
unsafeOuts BazaarT (->) f a b t
b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> f [b]
f (forall (w :: * -> * -> * -> *) a b t.
Bizarre (->) w =>
w a b t -> [a]
ins BazaarT (->) f a b t
b) where b :: BazaarT (->) f a b t
b = Traversing (->) f s t a b
l forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
s
{-# INLINE unsafePartsOf #-}

-- | An indexed version of 'unsafePartsOf' that receives the entire list of indices as its index.

iunsafePartsOf :: forall i p f s t a b. (Indexable [i] p, Functor f) => Traversing (Indexed i) f s t a b -> Over p f s t [a] [b]
iunsafePartsOf :: forall i (p :: * -> * -> *) (f :: * -> *) s t a b.
(Indexable [i] p, Functor f) =>
Traversing (Indexed i) f s t a b -> Over p f s t [a] [b]
iunsafePartsOf Traversing (Indexed i) f s t a b
l = forall (p :: * -> * -> *) (q :: * -> * -> *) a b r.
Conjoined p =>
((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r
conjoined
  (\[a] -> f [b]
f s
s -> let b :: BazaarT (Indexed i) f a b t
b = forall a. a -> a
inline Traversing (Indexed i) f s t a b
l forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
s                           in forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b t.
(Bizarre p w, Corepresentable p) =>
w a b t -> [b] -> t
unsafeOuts BazaarT (Indexed i) f a b t
b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> f [b]
f (forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b t.
(Bizarre p w, Corepresentable p, Comonad (Corep p)) =>
w a b t -> [a]
wins BazaarT (Indexed i) f a b t
b))
  (\p [a] (f [b])
f s
s -> let b :: BazaarT (Indexed i) f a b t
b = forall a. a -> a
inline Traversing (Indexed i) f s t a b
l forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
s; ([i]
is,[a]
as) = forall a b. [(a, b)] -> ([a], [b])
unzip (forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b t.
(Bizarre p w, Corepresentable p) =>
w a b t -> [Corep p a]
pins BazaarT (Indexed i) f a b t
b) in forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b t.
(Bizarre p w, Corepresentable p) =>
w a b t -> [b] -> t
unsafeOuts BazaarT (Indexed i) f a b t
b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p [a] (f [b])
f ([i]
is :: [i]) [a]
as)
{-# INLINE iunsafePartsOf #-}

unsafePartsOf' :: ATraversal s t a b -> Lens s t [a] [b]
unsafePartsOf' :: forall s t a b. ATraversal s t a b -> Lens s t [a] [b]
unsafePartsOf' ATraversal s t a b
l [a] -> f [b]
f s
s = forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b t.
(Bizarre p w, Corepresentable p) =>
w a b t -> [b] -> t
unsafeOuts Bazaar (->) a b t
b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> f [b]
f (forall (w :: * -> * -> * -> *) a b t.
Bizarre (->) w =>
w a b t -> [a]
ins Bazaar (->) a b t
b) where b :: Bazaar (->) a b t
b = ATraversal s t a b
l forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
s
{-# INLINE unsafePartsOf' #-}

iunsafePartsOf' :: forall i s t a b. Over (Indexed i) (Bazaar (Indexed i) a b) s t a b -> IndexedLens [i] s t [a] [b]
iunsafePartsOf' :: forall i s t a b.
Over (Indexed i) (Bazaar (Indexed i) a b) s t a b
-> IndexedLens [i] s t [a] [b]
iunsafePartsOf' Over (Indexed i) (Bazaar (Indexed i) a b) s t a b
l = forall (p :: * -> * -> *) (q :: * -> * -> *) a b r.
Conjoined p =>
((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r
conjoined
  (\[a] -> f [b]
f s
s -> let b :: Bazaar (Indexed i) a b t
b = forall a. a -> a
inline Over (Indexed i) (Bazaar (Indexed i) a b) s t a b
l forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
s                            in forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b t.
(Bizarre p w, Corepresentable p) =>
w a b t -> [b] -> t
unsafeOuts Bazaar (Indexed i) a b t
b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> f [b]
f (forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b t.
(Bizarre p w, Corepresentable p, Comonad (Corep p)) =>
w a b t -> [a]
wins Bazaar (Indexed i) a b t
b))
  (\p [a] (f [b])
f s
s -> let b :: Bazaar (Indexed i) a b t
b = forall a. a -> a
inline Over (Indexed i) (Bazaar (Indexed i) a b) s t a b
l forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
s; ([i]
is, [a]
as) = forall a b. [(a, b)] -> ([a], [b])
unzip (forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b t.
(Bizarre p w, Corepresentable p) =>
w a b t -> [Corep p a]
pins Bazaar (Indexed i) a b t
b) in forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b t.
(Bizarre p w, Corepresentable p) =>
w a b t -> [b] -> t
unsafeOuts Bazaar (Indexed i) a b t
b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p [a] (f [b])
f ([i]
is :: [i]) [a]
as)
{-# INLINE iunsafePartsOf' #-}


-- | This converts a 'Traversal' that you \"know\" will target one or more elements to a 'Lens'. It can

-- also be used to transform a non-empty 'Fold' into a 'Getter'.

--

-- The resulting 'Lens' or 'Getter' will be partial if the supplied 'Traversal' returns

-- no results.

--

-- >>> [1,2,3] ^. singular _head

-- 1

--

-- >>> Left (ErrorCall "singular: empty traversal") <- try (evaluate ([] ^. singular _head)) :: IO (Either ErrorCall ())

--

-- >>> Left 4 ^. singular _Left

-- 4

--

-- >>> [1..10] ^. singular (ix 7)

-- 8

--

-- >>> [] & singular traverse .~ 0

-- []

--

-- @

-- 'singular' :: 'Traversal' s t a a          -> 'Lens' s t a a

-- 'singular' :: 'Fold' s a                   -> 'Getter' s a

-- 'singular' :: 'IndexedTraversal' i s t a a -> 'IndexedLens' i s t a a

-- 'singular' :: 'IndexedFold' i s a          -> 'IndexedGetter' i s a

-- @

singular :: (HasCallStack, Conjoined p, Functor f)
         => Traversing p f s t a a
         -> Over p f s t a a
singular :: forall (p :: * -> * -> *) (f :: * -> *) s t a.
(HasCallStack, Conjoined p, Functor f) =>
Traversing p f s t a a -> Over p f s t a a
singular Traversing p f s t a a
l = forall (p :: * -> * -> *) (q :: * -> * -> *) a b r.
Conjoined p =>
((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r
conjoined
  (\a -> f a
afb s
s -> let b :: BazaarT p f a a t
b = Traversing p f s t a a
l forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
s in case forall (w :: * -> * -> * -> *) a b t.
Bizarre (->) w =>
w a b t -> [a]
ins BazaarT p f a a t
b of
    (a
w:[a]
ws) -> forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b t.
(Bizarre p w, Corepresentable p) =>
w a b t -> [b] -> t
unsafeOuts BazaarT p f a a t
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[a]
ws) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
afb a
w
    []     -> forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b t.
(Bizarre p w, Corepresentable p) =>
w a b t -> [b] -> t
unsafeOuts BazaarT p f a a t
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
afb (forall a. HasCallStack => [Char] -> a
error [Char]
"singular: empty traversal"))
  (\p a (f a)
pafb s
s -> let b :: BazaarT p f a a t
b = Traversing p f s t a a
l forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
s in case forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b t.
(Bizarre p w, Corepresentable p) =>
w a b t -> [Corep p a]
pins BazaarT p f a a t
b of
    (Corep p a
w:[Corep p a]
ws) -> forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b t.
(Bizarre p w, Corepresentable p) =>
w a b t -> [b] -> t
unsafeOuts BazaarT p f a a t
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:forall a b. (a -> b) -> [a] -> [b]
map forall (w :: * -> *) a. Comonad w => w a -> a
extract [Corep p a]
ws) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: * -> * -> *) (f :: * -> *) a b.
Cosieve p f =>
p a b -> f a -> b
cosieve p a (f a)
pafb Corep p a
w
    []     -> forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b t.
(Bizarre p w, Corepresentable p) =>
w a b t -> [b] -> t
unsafeOuts BazaarT p f a a t
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return                    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: * -> * -> *) (f :: * -> *) a b.
Cosieve p f =>
p a b -> f a -> b
cosieve p a (f a)
pafb (forall a. HasCallStack => [Char] -> a
error [Char]
"singular: empty traversal"))
{-# INLINE singular #-}

-- | This converts a 'Traversal' that you \"know\" will target only one element to a 'Lens'. It can also be

-- used to transform a 'Fold' into a 'Getter'.

--

-- The resulting 'Lens' or 'Getter' will be partial if the 'Traversal' targets nothing

-- or more than one element.

--

-- >>> Left (ErrorCall "unsafeSingular: empty traversal") <- try (evaluate ([] & unsafeSingular traverse .~ 0)) :: IO (Either ErrorCall [Integer])

--

-- @

-- 'unsafeSingular' :: 'Traversal' s t a b          -> 'Lens' s t a b

-- 'unsafeSingular' :: 'Fold' s a                   -> 'Getter' s a

-- 'unsafeSingular' :: 'IndexedTraversal' i s t a b -> 'IndexedLens' i s t a b

-- 'unsafeSingular' :: 'IndexedFold' i s a          -> 'IndexedGetter' i s a

-- @

unsafeSingular :: (HasCallStack, Conjoined p, Functor f)
               => Traversing p f s t a b
               -> Over p f s t a b
unsafeSingular :: forall (p :: * -> * -> *) (f :: * -> *) s t a b.
(HasCallStack, Conjoined p, Functor f) =>
Traversing p f s t a b -> Over p f s t a b
unsafeSingular Traversing p f s t a b
l = forall (p :: * -> * -> *) (q :: * -> * -> *) a b r.
Conjoined p =>
((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r
conjoined
  (\a -> f b
afb s
s -> let b :: BazaarT p f a b t
b = forall a. a -> a
inline Traversing p f s t a b
l forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
s in case forall (w :: * -> * -> * -> *) a b t.
Bizarre (->) w =>
w a b t -> [a]
ins BazaarT p f a b t
b of
    [a
w] -> forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b t.
(Bizarre p w, Corepresentable p) =>
w a b t -> [b] -> t
unsafeOuts BazaarT p f a b t
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
afb a
w
    []  -> forall a. HasCallStack => [Char] -> a
error [Char]
"unsafeSingular: empty traversal"
    [a]
_   -> forall a. HasCallStack => [Char] -> a
error [Char]
"unsafeSingular: traversing multiple results")
  (\p a (f b)
pafb s
s -> let b :: BazaarT p f a b t
b = forall a. a -> a
inline Traversing p f s t a b
l forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
s in case forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b t.
(Bizarre p w, Corepresentable p) =>
w a b t -> [Corep p a]
pins BazaarT p f a b t
b of
    [Corep p a
w] -> forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b t.
(Bizarre p w, Corepresentable p) =>
w a b t -> [b] -> t
unsafeOuts BazaarT p f a b t
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: * -> * -> *) (f :: * -> *) a b.
Cosieve p f =>
p a b -> f a -> b
cosieve p a (f b)
pafb Corep p a
w
    []  -> forall a. HasCallStack => [Char] -> a
error [Char]
"unsafeSingular: empty traversal"
    [Corep p a]
_   -> forall a. HasCallStack => [Char] -> a
error [Char]
"unsafeSingular: traversing multiple results")
{-# INLINE unsafeSingular #-}

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

-- Internal functions used by 'partsOf', etc.

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


ins :: Bizarre (->) w => w a b t -> [a]
ins :: forall (w :: * -> * -> * -> *) a b t.
Bizarre (->) w =>
w a b t -> [a]
ins = forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf (forall (p :: * -> * -> *) (q :: * -> * -> *) (f :: * -> *) s t a b.
(Profunctor p, Profunctor q, Functor f, Contravariant f) =>
Optical p q f s t a b -> Optical' p q f s a
getting forall (p :: * -> * -> *) (w :: * -> * -> * -> *) (f :: * -> *) a b
       t.
(Bizarre p w, Applicative f) =>
p a (f b) -> w a b t -> f t
bazaar)
{-# INLINE ins #-}

wins :: (Bizarre p w, Corepresentable p, Comonad (Corep p)) => w a b t -> [a]
wins :: forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b t.
(Bizarre p w, Corepresentable p, Comonad (Corep p)) =>
w a b t -> [a]
wins = forall {k} a (b :: k). Const a b -> a
getConst forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. forall (p :: * -> * -> *) (w :: * -> * -> * -> *) (f :: * -> *) a b
       t.
(Bizarre p w, Applicative f) =>
p a (f b) -> w a b t -> f t
bazaar (forall (p :: * -> * -> *) d c.
Corepresentable p =>
(Corep p d -> c) -> p d c
cotabulate forall a b. (a -> b) -> a -> b
$ \Corep p a
ra -> forall {k} a (b :: k). a -> Const a b
Const [forall (w :: * -> *) a. Comonad w => w a -> a
extract Corep p a
ra])
{-# INLINE wins #-}

pins :: (Bizarre p w, Corepresentable p) => w a b t -> [Corep p a]
pins :: forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b t.
(Bizarre p w, Corepresentable p) =>
w a b t -> [Corep p a]
pins = forall {k} a (b :: k). Const a b -> a
getConst forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. forall (p :: * -> * -> *) (w :: * -> * -> * -> *) (f :: * -> *) a b
       t.
(Bizarre p w, Applicative f) =>
p a (f b) -> w a b t -> f t
bazaar (forall (p :: * -> * -> *) d c.
Corepresentable p =>
(Corep p d -> c) -> p d c
cotabulate forall a b. (a -> b) -> a -> b
$ \Corep p a
ra -> forall {k} a (b :: k). a -> Const a b
Const [Corep p a
ra])
{-# INLINE pins #-}

parr :: (Profunctor p, C.Category p) => (a -> b) -> p a b
parr :: forall (p :: * -> * -> *) a b.
(Profunctor p, Category p) =>
(a -> b) -> p a b
parr a -> b
f = forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap a -> b
f forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
C.id
{-# INLINE parr #-}

outs :: (Bizarre p w, C.Category p) => w a a t -> [a] -> t
outs :: forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a t.
(Bizarre p w, Category p) =>
w a a t -> [a] -> t
outs = forall s a. State s a -> s -> a
evalState forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
`rmap` forall (p :: * -> * -> *) (w :: * -> * -> * -> *) (f :: * -> *) a b
       t.
(Bizarre p w, Applicative f) =>
p a (f b) -> w a b t -> f t
bazaar (forall (p :: * -> * -> *) a b.
(Profunctor p, Category p) =>
(a -> b) -> p a b
parr (forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> (a, [a])
unconsWithDefault))
{-# INLINE outs #-}

unsafeOuts :: (Bizarre p w, Corepresentable p) => w a b t -> [b] -> t
unsafeOuts :: forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b t.
(Bizarre p w, Corepresentable p) =>
w a b t -> [b] -> t
unsafeOuts = forall s a. State s a -> s -> a
evalState forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
`rmap` forall (p :: * -> * -> *) (w :: * -> * -> * -> *) (f :: * -> *) a b
       t.
(Bizarre p w, Applicative f) =>
p a (f b) -> w a b t -> f t
bazaar (forall (p :: * -> * -> *) d c.
Corepresentable p =>
(Corep p d -> c) -> p d c
cotabulate (\Corep p a
_ -> forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state (forall a. a -> [a] -> (a, [a])
unconsWithDefault forall {a}. a
fakeVal)))
  where fakeVal :: a
fakeVal = forall a. HasCallStack => [Char] -> a
error [Char]
"unsafePartsOf': not enough elements were supplied"
{-# INLINE unsafeOuts #-}

unconsWithDefault :: a -> [a] -> (a,[a])
unconsWithDefault :: forall a. a -> [a] -> (a, [a])
unconsWithDefault a
d []     = (a
d,[])
unconsWithDefault a
_ (a
x:[a]
xs) = (a
x,[a]
xs)
{-# INLINE unconsWithDefault #-}


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

-- Holes

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


-- | The one-level version of 'Control.Lens.Plated.contextsOf'. This extracts a

-- list of the immediate children according to a given 'Traversal' as editable

-- contexts.

--

-- Given a context you can use 'Control.Comonad.Store.Class.pos' to see the

-- values, 'Control.Comonad.Store.Class.peek' at what the structure would be

-- like with an edited result, or simply 'extract' the original structure.

--

-- @

-- propChildren l x = 'toListOf' l x '==' 'map' 'Control.Comonad.Store.Class.pos' ('holesOf' l x)

-- propId l x = 'all' ('==' x) ['extract' w | w <- 'holesOf' l x]

-- @

--

-- @

-- 'holesOf' :: 'Iso'' s a                -> s -> ['Pretext'' (->) a s]

-- 'holesOf' :: 'Lens'' s a               -> s -> ['Pretext'' (->) a s]

-- 'holesOf' :: 'Traversal'' s a          -> s -> ['Pretext'' (->) a s]

-- 'holesOf' :: 'IndexedLens'' i s a      -> s -> ['Pretext'' ('Indexed' i) a s]

-- 'holesOf' :: 'IndexedTraversal'' i s a -> s -> ['Pretext'' ('Indexed' i) a s]

-- @

holesOf :: Conjoined p
        => Over p (Bazaar p a a) s t a a -> s -> [Pretext p a a t]
holesOf :: forall (p :: * -> * -> *) a s t.
Conjoined p =>
Over p (Bazaar p a a) s t a a -> s -> [Pretext p a a t]
holesOf Over p (Bazaar p a a) s t a a
f s
xs = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Endo a -> a -> a
appEndo [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$
  forall t m x. Holes t m x -> (x -> t) -> (m, x)
runHoles (forall (p :: * -> * -> *) a b t.
Bazaar p a b t
-> forall (f :: * -> *). Applicative f => p a (f b) -> f t
runBazaar (Over p (Bazaar p a a) s t a a
f forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
xs) (forall (p :: * -> * -> *) d c.
Corepresentable p =>
(Corep p d -> c) -> p d c
cotabulate forall (p :: * -> * -> *) a t.
(Corepresentable p, Comonad (Corep p)) =>
Corep p a -> Holes t (Endo [Pretext p a a t]) a
holeInOne)) forall a. a -> a
id
{-# INLINE holesOf #-}

holeInOne :: (Corepresentable p, Comonad (Corep p))
          => Corep p a -> Holes t (Endo [Pretext p a a t]) a
holeInOne :: forall (p :: * -> * -> *) a t.
(Corepresentable p, Comonad (Corep p)) =>
Corep p a -> Holes t (Endo [Pretext p a a t]) a
holeInOne Corep p a
x = forall t m x. ((x -> t) -> (m, x)) -> Holes t m x
Holes forall a b. (a -> b) -> a -> b
$ \a -> t
xt ->
    ( forall a. (a -> a) -> Endo a
Endo (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> t
xt (forall (p :: * -> * -> *) (f :: * -> *) a b.
Cosieve p f =>
p a b -> f a -> b
cosieve forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell Corep p a
x) forall a. a -> [a] -> [a]
:)
    , forall (w :: * -> *) a. Comonad w => w a -> a
extract Corep p a
x)
{-# INLINABLE holeInOne #-}

-- | The non-empty version of 'holesOf'.

-- This extract a non-empty list of immediate children according to a given

-- 'Traversal1' as editable contexts.

--

-- >>> let head1 f s = runPretext (NonEmpty.head $ holes1Of traversed1 s) f

-- >>> ('a' :| "bc") ^. head1

-- 'a'

--

-- >>> ('a' :| "bc") & head1 %~ toUpper

-- 'A' :| "bc"

--

-- @

-- 'holes1Of' :: 'Iso'' s a                 -> s -> 'NonEmpty' ('Pretext'' (->) a s)

-- 'holes1Of' :: 'Lens'' s a                -> s -> 'NonEmpty' ('Pretext'' (->) a s)

-- 'holes1Of' :: 'Traversal1'' s a          -> s -> 'NonEmpty' ('Pretext'' (->) a s)

-- 'holes1Of' :: 'IndexedLens'' i s a       -> s -> 'NonEmpty' ('Pretext'' ('Indexed' i) a s)

-- 'holes1Of' :: 'IndexedTraversal1'' i s a -> s -> 'NonEmpty' ('Pretext'' ('Indexed' i) a s)

-- @

holes1Of :: Conjoined p
         => Over p (Bazaar1 p a a) s t a a -> s -> NonEmpty (Pretext p a a t)
holes1Of :: forall (p :: * -> * -> *) a s t.
Conjoined p =>
Over p (Bazaar1 p a a) s t a a -> s -> NonEmpty (Pretext p a a t)
holes1Of Over p (Bazaar1 p a a) s t a a
f s
xs = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. NonEmptyDList a -> [a] -> NonEmpty a
getNonEmptyDList [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$
  forall t m x. Holes t m x -> (x -> t) -> (m, x)
runHoles (forall (p :: * -> * -> *) a b t.
Bazaar1 p a b t
-> forall (f :: * -> *). Apply f => p a (f b) -> f t
runBazaar1 (Over p (Bazaar1 p a a) s t a a
f forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
xs) (forall (p :: * -> * -> *) d c.
Corepresentable p =>
(Corep p d -> c) -> p d c
cotabulate forall (p :: * -> * -> *) a t.
(Corepresentable p, Category p) =>
Corep p a -> Holes t (NonEmptyDList (Pretext p a a t)) a
holeInOne1)) forall a. a -> a
id
{-# INLINE holes1Of #-}

holeInOne1 :: forall p a t. (Corepresentable p, C.Category p)
          => Corep p a -> Holes t (NonEmptyDList (Pretext p a a t)) a
holeInOne1 :: forall (p :: * -> * -> *) a t.
(Corepresentable p, Category p) =>
Corep p a -> Holes t (NonEmptyDList (Pretext p a a t)) a
holeInOne1 Corep p a
x = forall t m x. ((x -> t) -> (m, x)) -> Holes t m x
Holes forall a b. (a -> b) -> a -> b
$ \a -> t
xt ->
    ( forall a. ([a] -> NonEmpty a) -> NonEmptyDList a
NonEmptyDList (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> t
xt (forall (p :: * -> * -> *) (f :: * -> *) a b.
Cosieve p f =>
p a b -> f a -> b
cosieve forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell Corep p a
x) forall a. a -> [a] -> NonEmpty a
:|)
    , forall (p :: * -> * -> *) (f :: * -> *) a b.
Cosieve p f =>
p a b -> f a -> b
cosieve (forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
C.id :: p a a) Corep p a
x)

-- We are very careful to share as much structure as possible among

-- the results (in the common case where the traversal allows for such).

-- Note in particular the recursive knot in the implementation of <*>

-- for Holes. This sharing magic was inspired by Noah "Rampion" Easterly's

-- implementation of a related holes function: see

-- https://stackoverflow.com/a/49001904/1477667. The Holes type is

-- inspired by Roman Cheplyaka's answer to that same question.


newtype Holes t m x = Holes { forall t m x. Holes t m x -> (x -> t) -> (m, x)
runHoles :: (x -> t) -> (m, x) }

instance Functor (Holes t m) where
  fmap :: forall a b. (a -> b) -> Holes t m a -> Holes t m b
fmap a -> b
f Holes t m a
xs = forall t m x. ((x -> t) -> (m, x)) -> Holes t m x
Holes forall a b. (a -> b) -> a -> b
$ \b -> t
xt ->
    let
      (m
qf, a
qv) = forall t m x. Holes t m x -> (x -> t) -> (m, x)
runHoles Holes t m a
xs (b -> t
xt forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
    in (m
qf, a -> b
f a
qv)

instance Semigroup m => Apply (Holes t m) where
  Holes t m (a -> b)
fs <.> :: forall a b. Holes t m (a -> b) -> Holes t m a -> Holes t m b
<.> Holes t m a
xs = forall t m x. ((x -> t) -> (m, x)) -> Holes t m x
Holes forall a b. (a -> b) -> a -> b
$ \b -> t
xt ->
    let
     (m
pf, a -> b
pv) = forall t m x. Holes t m x -> (x -> t) -> (m, x)
runHoles Holes t m (a -> b)
fs (b -> t
xt forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ a
qv))
     (m
qf, a
qv) = forall t m x. Holes t m x -> (x -> t) -> (m, x)
runHoles Holes t m a
xs (b -> t
xt forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
pv)
    in (m
pf forall a. Semigroup a => a -> a -> a
<> m
qf, a -> b
pv a
qv)

instance Monoid m => Applicative (Holes t m) where
  pure :: forall a. a -> Holes t m a
pure a
x = forall t m x. ((x -> t) -> (m, x)) -> Holes t m x
Holes forall a b. (a -> b) -> a -> b
$ \a -> t
_ -> (forall a. Monoid a => a
mempty, a
x)

  Holes t m (a -> b)
fs <*> :: forall a b. Holes t m (a -> b) -> Holes t m a -> Holes t m b
<*> Holes t m a
xs = forall t m x. ((x -> t) -> (m, x)) -> Holes t m x
Holes forall a b. (a -> b) -> a -> b
$ \b -> t
xt ->
    let
     (m
pf, a -> b
pv) = forall t m x. Holes t m x -> (x -> t) -> (m, x)
runHoles Holes t m (a -> b)
fs (b -> t
xt forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ a
qv))
     (m
qf, a
qv) = forall t m x. Holes t m x -> (x -> t) -> (m, x)
runHoles Holes t m a
xs (b -> t
xt forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
pv)
    in (m
pf forall a. Monoid a => a -> a -> a
`mappend` m
qf, a -> b
pv a
qv)

#if MIN_VERSION_base(4,10,0)
  liftA2 :: forall a b c.
(a -> b -> c) -> Holes t m a -> Holes t m b -> Holes t m c
liftA2 a -> b -> c
f Holes t m a
xs Holes t m b
ys = forall t m x. ((x -> t) -> (m, x)) -> Holes t m x
Holes forall a b. (a -> b) -> a -> b
$ \c -> t
xt ->
    let
      (m
pf, a
pv) = forall t m x. Holes t m x -> (x -> t) -> (m, x)
runHoles Holes t m a
xs (c -> t
xt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> c
f b
qv)
      (m
qf, b
qv) = forall t m x. Holes t m x -> (x -> t) -> (m, x)
runHoles Holes t m b
ys (c -> t
xt forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> c
f a
pv)
    in (m
pf forall a. Monoid a => a -> a -> a
`mappend` m
qf, a -> b -> c
f a
pv b
qv)
#endif


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

-- Traversals

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


-- | Traverse both parts of a 'Bitraversable' container with matching types.

--

-- Usually that type will be a pair. Use 'Control.Lens.Each.each' to traverse

-- the elements of arbitrary homogeneous tuples.

--

-- >>> (1,2) & both *~ 10

-- (10,20)

--

-- >>> over both length ("hello","world")

-- (5,5)

--

-- >>> ("hello","world")^.both

-- "helloworld"

--

-- @

-- 'both' :: 'Traversal' (a, a)       (b, b)       a b

-- 'both' :: 'Traversal' ('Either' a a) ('Either' b b) a b

-- @

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 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 #-}

-- | Traverse both parts of a 'Bitraversable1' container with matching types.

--

-- Usually that type will be a pair.

--

-- @

-- 'both1' :: 'Traversal1' (a, a)       (b, b)       a b

-- 'both1' :: 'Traversal1' ('Either' a a) ('Either' b b) a b

-- @

both1 :: Bitraversable1 r => Traversal1 (r a a) (r b b) a b
both1 :: forall (r :: * -> * -> *) a b.
Bitraversable1 r =>
Traversal1 (r a a) (r b b) a b
both1 a -> f b
f = forall (t :: * -> * -> *) (f :: * -> *) a b c d.
(Bitraversable1 t, Apply f) =>
(a -> f b) -> (c -> f d) -> t a c -> f (t b d)
bitraverse1 a -> f b
f a -> f b
f
{-# INLINE both1 #-}

-- | Apply a different 'Traversal' or 'Fold' to each side of a 'Bitraversable' container.

--

-- @

-- 'beside' :: 'Traversal' s t a b                -> 'Traversal' s' t' a b                -> 'Traversal' (r s s') (r t t') a b

-- 'beside' :: 'IndexedTraversal' i s t a b       -> 'IndexedTraversal' i s' t' a b       -> 'IndexedTraversal' i (r s s') (r t t') a b

-- 'beside' :: 'IndexPreservingTraversal' s t a b -> 'IndexPreservingTraversal' s' t' a b -> 'IndexPreservingTraversal' (r s s') (r t t') a b

-- @

--

-- @

-- 'beside' :: 'Traversal' s t a b                -> 'Traversal' s' t' a b                -> 'Traversal' (s,s') (t,t') a b

-- 'beside' :: 'Lens' s t a b                     -> 'Lens' s' t' a b                     -> 'Traversal' (s,s') (t,t') a b

-- 'beside' :: 'Fold' s a                         -> 'Fold' s' a                          -> 'Fold' (s,s') a

-- 'beside' :: 'Getter' s a                       -> 'Getter' s' a                        -> 'Fold' (s,s') a

-- @

--

-- @

-- 'beside' :: 'IndexedTraversal' i s t a b       -> 'IndexedTraversal' i s' t' a b       -> 'IndexedTraversal' i (s,s') (t,t') a b

-- 'beside' :: 'IndexedLens' i s t a b            -> 'IndexedLens' i s' t' a b            -> 'IndexedTraversal' i (s,s') (t,t') a b

-- 'beside' :: 'IndexedFold' i s a                -> 'IndexedFold' i s' a                 -> 'IndexedFold' i (s,s') a

-- 'beside' :: 'IndexedGetter' i s a              -> 'IndexedGetter' i s' a               -> 'IndexedFold' i (s,s') a

-- @

--

-- @

-- 'beside' :: 'IndexPreservingTraversal' s t a b -> 'IndexPreservingTraversal' s' t' a b -> 'IndexPreservingTraversal' (s,s') (t,t') a b

-- 'beside' :: 'IndexPreservingLens' s t a b      -> 'IndexPreservingLens' s' t' a b      -> 'IndexPreservingTraversal' (s,s') (t,t') a b

-- 'beside' :: 'IndexPreservingFold' s a          -> 'IndexPreservingFold' s' a           -> 'IndexPreservingFold' (s,s') a

-- 'beside' :: 'IndexPreservingGetter' s a        -> 'IndexPreservingGetter' s' a         -> 'IndexPreservingFold' (s,s') a

-- @

--

-- >>> ("hello",["world","!!!"])^..beside id traverse

-- ["hello","world","!!!"]

beside :: (Representable q, Applicative (Rep q), Applicative f, Bitraversable r)
       => Optical p q f s t a b
       -> Optical p q f s' t' a b
       -> Optical p q f (r s s') (r t t') a b
beside :: forall (q :: * -> * -> *) (f :: * -> *) (r :: * -> * -> *)
       (p :: * -> * -> *) s t a b s' t'.
(Representable q, Applicative (Rep q), Applicative f,
 Bitraversable r) =>
Optical p q f s t a b
-> Optical p q f s' t' a b -> Optical p q f (r s s') (r t t') a b
beside Optical p q f s t a b
l Optical p q f s' t' a b
r p a (f b)
f = forall (p :: * -> * -> *) d c.
Representable p =>
(d -> Rep p c) -> p d c
tabulate forall a b. (a -> b) -> a -> b
$ forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. 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 (forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. forall (p :: * -> * -> *) (f :: * -> *) a b.
Sieve p f =>
p a b -> a -> f b
sieve (Optical p q f s t a b
l p a (f b)
f)) (forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. forall (p :: * -> * -> *) (f :: * -> *) a b.
Sieve p f =>
p a b -> a -> f b
sieve (Optical p q f s' t' a b
r p a (f b)
f))
{-# INLINE beside #-}

-- | Visit the first /n/ targets of a 'Traversal', 'Fold', 'Getter' or 'Lens'.

--

-- >>> [("hello","world"),("!!!","!!!")]^.. taking 2 (traverse.both)

-- ["hello","world"]

--

-- >>> timingOut $ [1..] ^.. taking 3 traverse

-- [1,2,3]

--

-- >>> over (taking 5 traverse) succ "hello world"

-- "ifmmp world"

--

-- @

-- 'taking' :: 'Int' -> 'Traversal'' s a                   -> 'Traversal'' s a

-- 'taking' :: 'Int' -> 'Lens'' s a                        -> 'Traversal'' s a

-- 'taking' :: 'Int' -> 'Iso'' s a                         -> 'Traversal'' s a

-- 'taking' :: 'Int' -> 'Prism'' s a                       -> 'Traversal'' s a

-- 'taking' :: 'Int' -> 'Getter' s a                       -> 'Fold' s a

-- 'taking' :: 'Int' -> 'Fold' s a                         -> 'Fold' s a

-- 'taking' :: 'Int' -> 'IndexedTraversal'' i s a          -> 'IndexedTraversal'' i s a

-- 'taking' :: 'Int' -> 'IndexedLens'' i s a               -> 'IndexedTraversal'' i s a

-- 'taking' :: 'Int' -> 'IndexedGetter' i s a              -> 'IndexedFold' i s a

-- 'taking' :: 'Int' -> 'IndexedFold' i s a                -> 'IndexedFold' i s a

-- @

taking :: (Conjoined p, Applicative f)
        => Int
       -> Traversing p f s t a a
       -> Over p f s t a a
taking :: forall (p :: * -> * -> *) (f :: * -> *) s t a.
(Conjoined p, Applicative f) =>
Int -> Traversing p f s t a a -> Over p f s t a a
taking Int
n Traversing p f s t a a
l = forall (p :: * -> * -> *) (q :: * -> * -> *) a b r.
Conjoined p =>
((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r
conjoined
  (\ a -> f a
afb s
s  -> let b :: BazaarT p f a a t
b = forall a. a -> a
inline Traversing p f s t a a
l forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
s in forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a t.
(Bizarre p w, Category p) =>
w a a t -> [a] -> t
outs BazaarT p f a a t
b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f a
afb          (forall a. Int -> [a] -> [a]
take Int
n forall a b. (a -> b) -> a -> b
$ forall (w :: * -> * -> * -> *) a b t.
Bizarre (->) w =>
w a b t -> [a]
ins BazaarT p f a a t
b))
  (\ p a (f a)
pafb s
s -> let b :: BazaarT p f a a t
b = forall a. a -> a
inline Traversing p f s t a a
l forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
s in forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a t.
(Bizarre p w, Category p) =>
w a a t -> [a] -> t
outs BazaarT p f a a t
b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (p :: * -> * -> *) (f :: * -> *) a b.
Cosieve p f =>
p a b -> f a -> b
cosieve p a (f a)
pafb) (forall a. Int -> [a] -> [a]
take Int
n forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b t.
(Bizarre p w, Corepresentable p) =>
w a b t -> [Corep p a]
pins BazaarT p f a a t
b))
{-# INLINE taking #-}

-- | Visit all but the first /n/ targets of a 'Traversal', 'Fold', 'Getter' or 'Lens'.

--

-- >>> ("hello","world") ^? dropping 1 both

-- Just "world"

--

-- Dropping works on infinite traversals as well:

--

-- >>> [1..] ^? dropping 1 folded

-- Just 2

--

-- @

-- 'dropping' :: 'Int' -> 'Traversal'' s a                   -> 'Traversal'' s a

-- 'dropping' :: 'Int' -> 'Lens'' s a                        -> 'Traversal'' s a

-- 'dropping' :: 'Int' -> 'Iso'' s a                         -> 'Traversal'' s a

-- 'dropping' :: 'Int' -> 'Prism'' s a                       -> 'Traversal'' s a

-- 'dropping' :: 'Int' -> 'Getter' s a                       -> 'Fold' s a

-- 'dropping' :: 'Int' -> 'Fold' s a                         -> 'Fold' s a

-- 'dropping' :: 'Int' -> 'IndexedTraversal'' i s a          -> 'IndexedTraversal'' i s a

-- 'dropping' :: 'Int' -> 'IndexedLens'' i s a               -> 'IndexedTraversal'' i s a

-- 'dropping' :: 'Int' -> 'IndexedGetter' i s a              -> 'IndexedFold' i s a

-- 'dropping' :: 'Int' -> 'IndexedFold' i s a                -> 'IndexedFold' i s a

-- @

dropping :: (Conjoined p, Applicative f) => Int -> Over p (Indexing f) s t a a -> Over p f s t a a
dropping :: forall (p :: * -> * -> *) (f :: * -> *) s t a.
(Conjoined p, Applicative f) =>
Int -> Over p (Indexing f) s t a a -> Over p f s t a a
dropping Int
n Over p (Indexing f) s t a a
l p a (f a)
pafb s
s = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Indexing f a -> Int -> (Int, f a)
runIndexing (Over p (Indexing f) s t a a
l p a (Indexing f a)
paifb s
s) Int
0 where
  paifb :: p a (Indexing f a)
paifb = forall (p :: * -> * -> *) d c.
Corepresentable p =>
(Corep p d -> c) -> p d c
cotabulate forall a b. (a -> b) -> a -> b
$ \Corep p a
wa -> forall (f :: * -> *) a. (Int -> (Int, f a)) -> Indexing f a
Indexing forall a b. (a -> b) -> a -> b
$ \Int
i -> let i' :: Int
i' = Int
i forall a. Num a => a -> a -> a
+ Int
1 in Int
i' seq :: forall a b. a -> b -> b
`seq` (Int
i', if Int
i forall a. Ord a => a -> a -> Bool
< Int
n then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (w :: * -> *) a. Comonad w => w a -> a
extract Corep p a
wa) else forall (p :: * -> * -> *) (f :: * -> *) a b.
Cosieve p f =>
p a b -> f a -> b
cosieve p a (f a)
pafb Corep p a
wa)
{-# INLINE dropping #-}

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

-- Cloning Traversals

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


-- | A 'Traversal' is completely characterized by its behavior on a 'Bazaar'.

--

-- Cloning a 'Traversal' is one way to make sure you aren't given

-- something weaker, such as a 'Fold' and can be

-- used as a way to pass around traversals that have to be monomorphic in @f@.

--

-- Note: This only accepts a proper 'Traversal' (or 'Lens'). To clone a 'Lens'

-- as such, use 'Control.Lens.Lens.cloneLens'.

--

-- Note: It is usually better to use 'Control.Lens.Reified.ReifiedTraversal' and

-- 'Control.Lens.Reified.runTraversal' than to 'cloneTraversal'. The

-- former can execute at full speed, while the latter needs to round trip through

-- the 'Bazaar'.

--

-- >>> let foo l a = (view (getting (cloneTraversal l)) a, set (cloneTraversal l) 10 a)

-- >>> foo both ("hello","world")

-- ("helloworld",(10,10))

--

-- @

-- 'cloneTraversal' :: 'LensLike' ('Bazaar' (->) a b) s t a b -> 'Traversal' s t a b

-- @

cloneTraversal :: ATraversal s t a b -> Traversal s t a b
cloneTraversal :: forall s t a b. ATraversal s t a b -> Traversal s t a b
cloneTraversal ATraversal s t a b
l a -> f b
f = forall (p :: * -> * -> *) (w :: * -> * -> * -> *) (f :: * -> *) a b
       t.
(Bizarre p w, Applicative f) =>
p a (f b) -> w a b t -> f t
bazaar a -> f b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. ATraversal s t a b
l forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell
{-# INLINE cloneTraversal #-}

-- | Clone a 'Traversal' yielding an 'IndexPreservingTraversal' that passes through

-- whatever index it is composed with.

cloneIndexPreservingTraversal :: ATraversal s t a b -> IndexPreservingTraversal s t a b
cloneIndexPreservingTraversal :: forall s t a b.
ATraversal s t a b -> IndexPreservingTraversal s t a b
cloneIndexPreservingTraversal ATraversal s t a b
l p a (f b)
pafb = forall (p :: * -> * -> *) d c.
Corepresentable p =>
(Corep p d -> c) -> p d c
cotabulate forall a b. (a -> b) -> a -> b
$ \Corep p s
ws -> forall (p :: * -> * -> *) a b t.
Bazaar p a b t
-> forall (f :: * -> *). Applicative f => p a (f b) -> f t
runBazaar (ATraversal s t a b
l forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell (forall (w :: * -> *) a. Comonad w => w a -> a
extract Corep p s
ws)) forall a b. (a -> b) -> a -> b
$ \a
a -> forall (p :: * -> * -> *) (f :: * -> *) a b.
Cosieve p f =>
p a b -> f a -> b
cosieve p a (f b)
pafb (a
a forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Corep p s
ws)
{-# INLINE cloneIndexPreservingTraversal #-}

-- | Clone an 'IndexedTraversal' yielding an 'IndexedTraversal' with the same index.

cloneIndexedTraversal :: AnIndexedTraversal i s t a b -> IndexedTraversal i s t a b
cloneIndexedTraversal :: forall i s t a b.
AnIndexedTraversal i s t a b -> IndexedTraversal i s t a b
cloneIndexedTraversal AnIndexedTraversal i s t a b
l p a (f b)
f = forall (p :: * -> * -> *) (w :: * -> * -> * -> *) (f :: * -> *) a b
       t.
(Bizarre p w, Applicative f) =>
p a (f b) -> w a b t -> f t
bazaar (forall i a b. (i -> a -> b) -> Indexed i a b
Indexed (forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p a (f b)
f)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnIndexedTraversal i s t a b
l forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell
{-# INLINE cloneIndexedTraversal #-}

-- | A 'Traversal1' is completely characterized by its behavior on a 'Bazaar1'.

cloneTraversal1 :: ATraversal1 s t a b -> Traversal1 s t a b
cloneTraversal1 :: forall s t a b. ATraversal1 s t a b -> Traversal1 s t a b
cloneTraversal1 ATraversal1 s t a b
l a -> f b
f = forall (p :: * -> * -> *) (w :: * -> * -> * -> *) (f :: * -> *) a b
       t.
(Bizarre1 p w, Apply f) =>
p a (f b) -> w a b t -> f t
bazaar1 a -> f b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. ATraversal1 s t a b
l forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell
{-# INLINE cloneTraversal1 #-}

-- | Clone a 'Traversal1' yielding an 'IndexPreservingTraversal1' that passes through

-- whatever index it is composed with.

cloneIndexPreservingTraversal1 :: ATraversal1 s t a b -> IndexPreservingTraversal1 s t a b
cloneIndexPreservingTraversal1 :: forall s t a b.
ATraversal1 s t a b -> IndexPreservingTraversal1 s t a b
cloneIndexPreservingTraversal1 ATraversal1 s t a b
l p a (f b)
pafb = forall (p :: * -> * -> *) d c.
Corepresentable p =>
(Corep p d -> c) -> p d c
cotabulate forall a b. (a -> b) -> a -> b
$ \Corep p s
ws -> forall (p :: * -> * -> *) a b t.
Bazaar1 p a b t
-> forall (f :: * -> *). Apply f => p a (f b) -> f t
runBazaar1 (ATraversal1 s t a b
l forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell (forall (w :: * -> *) a. Comonad w => w a -> a
extract Corep p s
ws)) forall a b. (a -> b) -> a -> b
$ \a
a -> forall (p :: * -> * -> *) (f :: * -> *) a b.
Cosieve p f =>
p a b -> f a -> b
cosieve p a (f b)
pafb (a
a forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Corep p s
ws)
{-# INLINE cloneIndexPreservingTraversal1 #-}

-- | Clone an 'IndexedTraversal1' yielding an 'IndexedTraversal1' with the same index.

cloneIndexedTraversal1 :: AnIndexedTraversal1 i s t a b -> IndexedTraversal1 i s t a b
cloneIndexedTraversal1 :: forall i s t a b.
AnIndexedTraversal1 i s t a b -> IndexedTraversal1 i s t a b
cloneIndexedTraversal1 AnIndexedTraversal1 i s t a b
l p a (f b)
f = forall (p :: * -> * -> *) (w :: * -> * -> * -> *) (f :: * -> *) a b
       t.
(Bizarre1 p w, Apply f) =>
p a (f b) -> w a b t -> f t
bazaar1 (forall i a b. (i -> a -> b) -> Indexed i a b
Indexed (forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p a (f b)
f)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnIndexedTraversal1 i s t a b
l forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell
{-# INLINE cloneIndexedTraversal1 #-}

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

-- Indexed Traversals

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


-- | Traversal with an index.

--

-- /NB:/ When you don't need access to the index then you can just apply your 'IndexedTraversal'

-- directly as a function!

--

-- @

-- 'itraverseOf' ≡ 'Control.Lens.Indexed.withIndex'

-- 'Control.Lens.Traversal.traverseOf' l = 'itraverseOf' l '.' 'const' = 'id'

-- @

--

-- @

-- 'itraverseOf' :: 'Functor' f     => 'IndexedLens' i s t a b       -> (i -> a -> f b) -> s -> f t

-- 'itraverseOf' :: 'Applicative' f => 'IndexedTraversal' i s t a b  -> (i -> a -> f b) -> s -> f t

-- 'itraverseOf' :: 'Apply' f       => 'IndexedTraversal1' i s t a b -> (i -> a -> f b) -> s -> f t

-- @

itraverseOf :: (Indexed i a (f b) -> s -> f t) -> (i -> a -> f b) -> s -> f t
itraverseOf :: forall i a (f :: * -> *) b s t.
(Indexed i a (f b) -> s -> f t) -> (i -> a -> f b) -> s -> f t
itraverseOf Indexed i a (f b) -> s -> f t
l = Indexed i a (f b) -> s -> f t
l forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# forall i a b. (i -> a -> b) -> Indexed i a b
Indexed
{-# INLINE itraverseOf #-}

-- | Traverse with an index (and the arguments flipped).

--

-- @

-- 'Control.Lens.Traversal.forOf' l a ≡ 'iforOf' l a '.' 'const'

-- 'iforOf' ≡ 'flip' '.' 'itraverseOf'

-- @

--

-- @

-- 'iforOf' :: 'Functor' f     => 'IndexedLens' i s t a b       -> s -> (i -> a -> f b) -> f t

-- 'iforOf' :: 'Applicative' f => 'IndexedTraversal' i s t a b  -> s -> (i -> a -> f b) -> f t

-- 'iforOf' :: 'Apply' f       => 'IndexedTraversal1' i s t a b -> s -> (i -> a -> f b) -> f t

-- @

iforOf :: (Indexed i a (f b) -> s -> f t) -> s -> (i -> a -> f b) -> f t
iforOf :: forall i a (f :: * -> *) b s t.
(Indexed i a (f b) -> s -> f t) -> s -> (i -> a -> f b) -> f t
iforOf = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i a (f :: * -> *) b s t.
(Indexed i a (f b) -> s -> f t) -> (i -> a -> f b) -> s -> f t
itraverseOf
{-# INLINE iforOf #-}

-- | Map each element of a structure targeted by a 'Lens' to a monadic action,

-- evaluate these actions from left to right, and collect the results, with access

-- its position.

--

-- When you don't need access to the index 'mapMOf' is more liberal in what it can accept.

--

-- @

-- 'Control.Lens.Traversal.mapMOf' l ≡ 'imapMOf' l '.' 'const'

-- @

--

-- @

-- 'imapMOf' :: 'Monad' m => 'IndexedLens'       i s t a b -> (i -> a -> m b) -> s -> m t

-- 'imapMOf' :: 'Monad' m => 'IndexedTraversal'  i s t a b -> (i -> a -> m b) -> s -> m t

-- 'imapMOf' :: 'Bind'  m => 'IndexedTraversal1' i s t a b -> (i -> a -> m b) -> s -> m t

-- @

imapMOf :: Over (Indexed i) (WrappedMonad m) s t a b  -> (i -> a -> m b) -> s -> m t
imapMOf :: forall i (m :: * -> *) s t a b.
Over (Indexed i) (WrappedMonad m) s t a b
-> (i -> a -> m b) -> s -> m t
imapMOf = coerce :: forall a b. Coercible a b => a -> b
coerce
{-# INLINE imapMOf #-}

-- | Map each element of a structure targeted by a 'Lens' to a monadic action,

-- evaluate these actions from left to right, and collect the results, with access

-- its position (and the arguments flipped).

--

-- @

-- 'Control.Lens.Traversal.forMOf' l a ≡ 'iforMOf' l a '.' 'const'

-- 'iforMOf' ≡ 'flip' '.' 'imapMOf'

-- @

--

-- @

-- 'iforMOf' :: 'Monad' m => 'IndexedLens' i s t a b      -> s -> (i -> a -> m b) -> m t

-- 'iforMOf' :: 'Monad' m => 'IndexedTraversal' i s t a b -> s -> (i -> a -> m b) -> m t

-- @

iforMOf :: (Indexed i a (WrappedMonad m b) -> s -> WrappedMonad m t) -> s -> (i -> a -> m b) -> m t
iforMOf :: forall i a (m :: * -> *) b s t.
(Indexed i a (WrappedMonad m b) -> s -> WrappedMonad m t)
-> s -> (i -> a -> m b) -> m t
iforMOf = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i (m :: * -> *) s t a b.
Over (Indexed i) (WrappedMonad m) s t a b
-> (i -> a -> m b) -> s -> m t
imapMOf
{-# INLINE iforMOf #-}

-- | Generalizes 'Data.Traversable.mapAccumR' to an arbitrary 'IndexedTraversal' with access to the index.

--

-- 'imapAccumROf' accumulates state from right to left.

--

-- @

-- 'Control.Lens.Traversal.mapAccumROf' l ≡ 'imapAccumROf' l '.' 'const'

-- @

--

-- @

-- 'imapAccumROf' :: 'IndexedLens' i s t a b      -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t)

-- 'imapAccumROf' :: 'IndexedTraversal' i s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t)

-- @

imapAccumROf :: Over (Indexed i) (Backwards (State acc)) s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
imapAccumROf :: forall i acc s t a b.
Over (Indexed i) (Backwards (State acc)) s t a b
-> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
imapAccumROf = forall i acc s t a b.
Over (Indexed i) (State acc) s t a b
-> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
imapAccumLOf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (q :: * -> * -> *) (f :: * -> *) s t a b.
(Profunctor p, Profunctor q) =>
Optical p q (Backwards f) s t a b -> Optical p q f s t a b
backwards
{-# INLINE imapAccumROf #-}

-- | Generalizes 'Data.Traversable.mapAccumL' to an arbitrary 'IndexedTraversal' with access to the index.

--

-- 'imapAccumLOf' accumulates state from left to right.

--

-- @

-- 'Control.Lens.Traversal.mapAccumLOf' l ≡ 'imapAccumLOf' l '.' 'const'

-- @

--

-- @

-- 'imapAccumLOf' :: 'IndexedLens' i s t a b      -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t)

-- 'imapAccumLOf' :: 'IndexedTraversal' i s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t)

-- @

imapAccumLOf :: Over (Indexed i) (State acc) s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
imapAccumLOf :: forall i acc s t a b.
Over (Indexed i) (State acc) s t a b
-> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
imapAccumLOf Over (Indexed i) (State acc) s t a b
l i -> acc -> a -> (acc, b)
f acc
acc0 s
s = forall a b. (a, b) -> (b, a)
swap (forall s a. State s a -> s -> (a, s)
runState (Over (Indexed i) (State acc) s t a b
l (forall i a b. (i -> a -> b) -> Indexed i a b
Indexed i -> a -> StateT acc Identity b
g) s
s) acc
acc0) where
  g :: i -> a -> StateT acc Identity b
g i
i 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 -> forall a b. (a, b) -> (b, a)
swap (i -> acc -> a -> (acc, b)
f i
i acc
acc a
a)
{-# INLINE imapAccumLOf #-}

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

-- Common Indexed Traversals

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


-- | Traverse any 'Traversable' container. This is an 'IndexedTraversal' that is indexed by ordinal position.

traversed :: Traversable f => IndexedTraversal Int (f a) (f b) a b
traversed :: forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed = forall (p :: * -> * -> *) (q :: * -> * -> *) a b r.
Conjoined p =>
((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r
conjoined forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (p :: * -> * -> *) a (f :: * -> *) b s t.
Indexable Int p =>
((a -> Indexing f b) -> s -> Indexing f t) -> p a (f b) -> s -> f t
indexing forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse)
{-# INLINE [0] traversed #-}

imapList :: (Int -> a -> b) -> [a] -> [b]
imapList :: forall a b. (Int -> a -> b) -> [a] -> [b]
imapList Int -> a -> b
f = Int -> [a] -> [b]
go Int
0
  where
    go :: Int -> [a] -> [b]
go Int
i (a
x:[a]
xs) = Int -> a -> b
f Int
i a
x forall a. a -> [a] -> [a]
: Int -> [a] -> [b]
go (Int
iforall a. Num a => a -> a -> a
+Int
1) [a]
xs
    go Int
_ []     = []
{-# INLINE imapList #-}

{-# RULES
"traversed -> mapped"     traversed = sets fmap          :: Functor f => ASetter (f a) (f b) a b;
"traversed -> folded"     traversed = folded             :: Foldable f => Getting (Endo r) (f a) a;
"traversed -> ifolded"    traversed = folded             :: Foldable f => IndexedGetting Int (Endo r) (f a) a;
"traversed -> imapList"   traversed = isets imapList     :: AnIndexedSetter Int [a] [b] a b;
"traversed -> imapSeq"    traversed = isets mapWithIndex :: AnIndexedSetter Int (Seq a) (Seq b) a b;
"traversed -> imapVector" traversed = isets Vector.imap  :: AnIndexedSetter Int (Vector a) (Vector b) a b;
 #-}

-- | Traverse any 'Traversable1' container. This is an 'IndexedTraversal1' that is indexed by ordinal position.

traversed1 :: Traversable1 f => IndexedTraversal1 Int (f a) (f b) a b
traversed1 :: forall (f :: * -> *) a b.
Traversable1 f =>
IndexedTraversal1 Int (f a) (f b) a b
traversed1 = forall (p :: * -> * -> *) (q :: * -> * -> *) a b r.
Conjoined p =>
((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r
conjoined forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
traverse1 (forall (p :: * -> * -> *) a (f :: * -> *) b s t.
Indexable Int p =>
((a -> Indexing f b) -> s -> Indexing f t) -> p a (f b) -> s -> f t
indexing forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
traverse1)
{-# INLINE traversed1 #-}

-- | Traverse any 'Traversable' container. This is an 'IndexedTraversal' that is indexed by ordinal position.

traversed64 :: Traversable f => IndexedTraversal Int64 (f a) (f b) a b
traversed64 :: forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int64 (f a) (f b) a b
traversed64 = forall (p :: * -> * -> *) (q :: * -> * -> *) a b r.
Conjoined p =>
((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r
conjoined forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (p :: * -> * -> *) a (f :: * -> *) b s t.
Indexable Int64 p =>
((a -> Indexing64 f b) -> s -> Indexing64 f t)
-> p a (f b) -> s -> f t
indexing64 forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse)
{-# INLINE traversed64 #-}

-- | This is the trivial empty 'Traversal'.

--

-- @

-- 'ignored' :: 'IndexedTraversal' i s s a b

-- @

--

-- @

-- 'ignored' ≡ 'const' 'pure'

-- @

--

-- >>> 6 & ignored %~ absurd

-- 6

ignored :: Applicative f => pafb -> s -> f s
ignored :: forall (f :: * -> *) pafb s. Applicative f => pafb -> s -> f s
ignored pafb
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE ignored #-}

-- | Allows 'IndexedTraversal' the value at the smallest index.

class Ord k => TraverseMin k m | m -> k where
  -- | 'IndexedTraversal' of the element with the smallest index.

  traverseMin :: IndexedTraversal' k (m v) v

instance TraverseMin Int IntMap.IntMap where
  traverseMin :: forall v. IndexedTraversal' Int (IntMap v) v
traverseMin p v (f v)
f IntMap v
m = case forall a. IntMap a -> Maybe ((Int, a), IntMap a)
IntMap.minViewWithKey IntMap v
m of
    Just ((Int
k,v
a), IntMap v
_) -> forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p v (f v)
f Int
k v
a forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \v
v -> forall a. (a -> Maybe a) -> IntMap a -> IntMap a
IntMap.updateMin (forall a b. a -> b -> a
const (forall a. a -> Maybe a
Just v
v)) IntMap v
m
    Maybe ((Int, v), IntMap v)
Nothing     -> forall (f :: * -> *) a. Applicative f => a -> f a
pure IntMap v
m
  {-# INLINE traverseMin #-}

instance Ord k => TraverseMin k (Map k) where
  traverseMin :: forall v. IndexedTraversal' k (Map k v) v
traverseMin p v (f v)
f Map k v
m = case forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.minViewWithKey Map k v
m of
    Just ((k
k, v
a), Map k v
_) -> forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p v (f v)
f k
k v
a forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \v
v -> forall a k. (a -> Maybe a) -> Map k a -> Map k a
Map.updateMin (forall a b. a -> b -> a
const (forall a. a -> Maybe a
Just v
v)) Map k v
m
    Maybe ((k, v), Map k v)
Nothing          -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Map k v
m
  {-# INLINE traverseMin #-}

-- | Allows 'IndexedTraversal' of the value at the largest index.

class Ord k => TraverseMax k m | m -> k where
  -- | 'IndexedTraversal' of the element at the largest index.

  traverseMax :: IndexedTraversal' k (m v) v

instance TraverseMax Int IntMap.IntMap where
  traverseMax :: forall v. IndexedTraversal' Int (IntMap v) v
traverseMax p v (f v)
f IntMap v
m = case forall a. IntMap a -> Maybe ((Int, a), IntMap a)
IntMap.maxViewWithKey IntMap v
m of
    Just ((Int
k,v
a), IntMap v
_) -> forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p v (f v)
f Int
k v
a forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \v
v -> forall a. (a -> Maybe a) -> IntMap a -> IntMap a
IntMap.updateMax (forall a b. a -> b -> a
const (forall a. a -> Maybe a
Just v
v)) IntMap v
m
    Maybe ((Int, v), IntMap v)
Nothing     -> forall (f :: * -> *) a. Applicative f => a -> f a
pure IntMap v
m
  {-# INLINE traverseMax #-}

instance Ord k => TraverseMax k (Map k) where
  traverseMax :: forall v. IndexedTraversal' k (Map k v) v
traverseMax p v (f v)
f Map k v
m = case forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.maxViewWithKey Map k v
m of
    Just ((k
k, v
a), Map k v
_) -> forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p v (f v)
f k
k v
a forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \v
v -> forall a k. (a -> Maybe a) -> Map k a -> Map k a
Map.updateMax (forall a b. a -> b -> a
const (forall a. a -> Maybe a
Just v
v)) Map k v
m
    Maybe ((k, v), Map k v)
Nothing          -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Map k v
m
  {-# INLINE traverseMax #-}

-- | Traverse the /nth/ 'elementOf' a 'Traversal', 'Lens' or

-- 'Iso' if it exists.

--

-- >>> [[1],[3,4]] & elementOf (traverse.traverse) 1 .~ 5

-- [[1],[5,4]]

--

-- >>> [[1],[3,4]] ^? elementOf (folded.folded) 1

-- Just 3

--

-- >>> timingOut $ ['a'..] ^?! elementOf folded 5

-- 'f'

--

-- >>> timingOut $ take 10 $ elementOf traverse 3 .~ 16 $ [0..]

-- [0,1,2,16,4,5,6,7,8,9]

--

-- @

-- 'elementOf' :: 'Traversal'' s a -> 'Int' -> 'IndexedTraversal'' 'Int' s a

-- 'elementOf' :: 'Fold' s a       -> 'Int' -> 'IndexedFold' 'Int' s a

-- @

elementOf :: Applicative f
          => LensLike (Indexing f) s t a a
          -> Int
          -> IndexedLensLike Int f s t a a
elementOf :: forall (f :: * -> *) s t a.
Applicative f =>
LensLike (Indexing f) s t a a
-> Int -> IndexedLensLike Int f s t a a
elementOf LensLike (Indexing f) s t a a
l Int
p = forall (f :: * -> *) s t a.
Applicative f =>
LensLike (Indexing f) s t a a
-> (Int -> Bool) -> IndexedLensLike Int f s t a a
elementsOf LensLike (Indexing f) s t a a
l (Int
p forall a. Eq a => a -> a -> Bool
==)
{-# INLINE elementOf #-}

-- | Traverse the /nth/ element of a 'Traversable' container.

--

-- @

-- 'element' ≡ 'elementOf' 'traverse'

-- @

element :: Traversable t => Int -> IndexedTraversal' Int (t a) a
element :: forall (t :: * -> *) a.
Traversable t =>
Int -> IndexedTraversal' Int (t a) a
element Int
i = forall (f :: * -> *) s t a.
Applicative f =>
LensLike (Indexing f) s t a a
-> Int -> IndexedLensLike Int f s t a a
elementOf forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Int
i
{-# INLINE element #-}

-- | Traverse (or fold) selected elements of a 'Traversal' (or 'Fold') where their ordinal positions match a predicate.

--

-- @

-- 'elementsOf' :: 'Traversal'' s a -> ('Int' -> 'Bool') -> 'IndexedTraversal'' 'Int' s a

-- 'elementsOf' :: 'Fold' s a       -> ('Int' -> 'Bool') -> 'IndexedFold' 'Int' s a

-- @

elementsOf :: Applicative f
           => LensLike (Indexing f) s t a a
           -> (Int -> Bool)
           -> IndexedLensLike Int f s t a a
elementsOf :: forall (f :: * -> *) s t a.
Applicative f =>
LensLike (Indexing f) s t a a
-> (Int -> Bool) -> IndexedLensLike Int f s t a a
elementsOf LensLike (Indexing f) s t a a
l Int -> Bool
p p a (f a)
iafb s
s = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Indexing f a -> Int -> (Int, f a)
runIndexing (LensLike (Indexing f) s t a a
l (\a
a -> forall (f :: * -> *) a. (Int -> (Int, f a)) -> Indexing f a
Indexing (\Int
i -> Int
i seq :: forall a b. a -> b -> b
`seq` (Int
i forall a. Num a => a -> a -> a
+ Int
1, if Int -> Bool
p Int
i then forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p a (f a)
iafb Int
i a
a else forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a))) s
s) Int
0
{-# INLINE elementsOf #-}

-- | Traverse elements of a 'Traversable' container where their ordinal positions match a predicate.

--

-- @

-- 'elements' ≡ 'elementsOf' 'traverse'

-- @

elements :: Traversable t => (Int -> Bool) -> IndexedTraversal' Int (t a) a
elements :: forall (t :: * -> *) a.
Traversable t =>
(Int -> Bool) -> IndexedTraversal' Int (t a) a
elements Int -> Bool
i = forall (f :: * -> *) s t a.
Applicative f =>
LensLike (Indexing f) s t a a
-> (Int -> Bool) -> IndexedLensLike Int f s t a a
elementsOf forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Int -> Bool
i
{-# INLINE elements #-}

-- | Try to map a function over this 'Traversal', failing if the 'Traversal' has no targets.

--

-- >>> failover (element 3) (*2) [1,2] :: Maybe [Int]

-- Nothing

--

-- >>> failover _Left (*2) (Right 4) :: Maybe (Either Int Int)

-- Nothing

--

-- >>> failover _Right (*2) (Right 4) :: Maybe (Either Int Int)

-- Just (Right 8)

--

-- @

-- 'failover' :: Alternative m => Traversal s t a b -> (a -> b) -> s -> m t

-- @

failover :: Alternative m => LensLike ((,) Any) s t a b -> (a -> b) -> s -> m t
failover :: forall (m :: * -> *) s t a b.
Alternative m =>
LensLike ((,) Any) s t a b -> (a -> b) -> s -> m t
failover LensLike ((,) Any) s t a b
l a -> b
afb s
s = case LensLike ((,) Any) s t a b
l ((,) (Bool -> Any
Any Bool
True) forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
afb) s
s of
  (Any Bool
True, t
t)  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure t
t
  (Any Bool
False, t
_) -> forall (f :: * -> *) a. Alternative f => f a
empty
{-# INLINE failover #-}

-- | Try to map a function which uses the index over this 'IndexedTraversal', failing if the 'IndexedTraversal' has no targets.

--

-- @

-- 'ifailover' :: Alternative m => IndexedTraversal i s t a b -> (i -> a -> b) -> s -> m t

-- @

ifailover :: Alternative m => Over (Indexed i) ((,) Any) s t a b -> (i -> a -> b) -> s -> m t
ifailover :: forall (m :: * -> *) i s t a b.
Alternative m =>
Over (Indexed i) ((,) Any) s t a b -> (i -> a -> b) -> s -> m t
ifailover Over (Indexed i) ((,) Any) s t a b
l i -> a -> b
iafb s
s = case Over (Indexed i) ((,) Any) s t a b
l ((,) (Bool -> Any
Any Bool
True) forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
`rmap` forall i a b. (i -> a -> b) -> Indexed i a b
Indexed i -> a -> b
iafb) s
s of
  (Any Bool
True, t
t) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure t
t
  (Any Bool
False, t
_) -> forall (f :: * -> *) a. Alternative f => f a
empty
{-# INLINE ifailover #-}

-- | Try the first 'Traversal' (or 'Fold'), falling back on the second 'Traversal' (or 'Fold') if it returns no entries.

--

-- This is only a valid 'Traversal' if the second 'Traversal' is disjoint from the result of the first or returns

-- exactly the same results. These conditions are trivially met when given a 'Lens', 'Iso', 'Getter', 'Prism' or \"affine\" Traversal -- one that

-- has 0 or 1 target.

--

-- Mutatis mutandis for 'Fold'.

--

-- >>> [0,1,2,3] ^? failing (ix 1) (ix 2)

-- Just 1

--

-- >>> [0,1,2,3] ^? failing (ix 42) (ix 2)

-- Just 2

--

-- @

-- 'failing' :: 'Traversal' s t a b -> 'Traversal' s t a b -> 'Traversal' s t a b

-- 'failing' :: 'Prism' s t a b     -> 'Prism' s t a b     -> 'Traversal' s t a b

-- 'failing' :: 'Fold' s a          -> 'Fold' s a          -> 'Fold' s a

-- @

--

-- These cases are also supported, trivially, but are boring, because the left hand side always succeeds.

--

-- @

-- 'failing' :: 'Lens' s t a b      -> 'Traversal' s t a b -> 'Traversal' s t a b

-- 'failing' :: 'Iso' s t a b       -> 'Traversal' s t a b -> 'Traversal' s t a b

-- 'failing' :: 'Equality' s t a b  -> 'Traversal' s t a b -> 'Traversal' s t a b

-- 'failing' :: 'Getter' s a        -> 'Fold' s a          -> 'Fold' s a

-- @

--

-- If both of the inputs are indexed, the result is also indexed, so you can apply this to a pair of indexed

-- traversals or indexed folds, obtaining an indexed traversal or indexed fold.

--

-- @

-- 'failing' :: 'IndexedTraversal' i s t a b -> 'IndexedTraversal' i s t a b -> 'IndexedTraversal' i s t a b

-- 'failing' :: 'IndexedFold' i s a          -> 'IndexedFold' i s a          -> 'IndexedFold' i s a

-- @

--

-- These cases are also supported, trivially, but are boring, because the left hand side always succeeds.

--

-- @

-- 'failing' :: 'IndexedLens' i s t a b      -> 'IndexedTraversal' i s t a b -> 'IndexedTraversal' i s t a b

-- 'failing' :: 'IndexedGetter' i s a        -> 'IndexedGetter' i s a        -> 'IndexedFold' i s a

-- @

failing :: (Conjoined p, Applicative f) => Traversing p f s t a b -> Over p f s t a b -> Over p f s t a b
failing :: forall (p :: * -> * -> *) (f :: * -> *) s t a b.
(Conjoined p, Applicative f) =>
Traversing p f s t a b -> Over p f s t a b -> Over p f s t a b
failing Traversing p f s t a b
l Over p f s t a b
r p a (f b)
pafb s
s = case forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b t.
(Bizarre p w, Corepresentable p) =>
w a b t -> [Corep p a]
pins BazaarT p f a b t
b of
  [] -> Over p f s t a b
r p a (f b)
pafb s
s
  [Corep p a]
_  -> forall (p :: * -> * -> *) (w :: * -> * -> * -> *) (f :: * -> *) a b
       t.
(Bizarre p w, Applicative f) =>
p a (f b) -> w a b t -> f t
bazaar p a (f b)
pafb BazaarT p f a b t
b
  where b :: BazaarT p f a b t
b = Traversing p f s t a b
l forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
s

infixl 5 `failing`

-- | Try the second traversal. If it returns no entries, try again with all entries from the first traversal, recursively.

--

-- @

-- 'deepOf' :: 'Fold' s s          -> 'Fold' s a                   -> 'Fold' s a

-- 'deepOf' :: 'Traversal'' s s    -> 'Traversal'' s a             -> 'Traversal'' s a

-- 'deepOf' :: 'Traversal' s t s t -> 'Traversal' s t a b          -> 'Traversal' s t a b

-- 'deepOf' :: 'Fold' s s          -> 'IndexedFold' i s a          -> 'IndexedFold' i s a

-- 'deepOf' :: 'Traversal' s t s t -> 'IndexedTraversal' i s t a b -> 'IndexedTraversal' i s t a b

-- @

deepOf :: (Conjoined p, Applicative f) => LensLike f s t s t -> Traversing p f s t a b -> Over p f s t a b
deepOf :: forall (p :: * -> * -> *) (f :: * -> *) s t a b.
(Conjoined p, Applicative f) =>
LensLike f s t s t -> Traversing p f s t a b -> Over p f s t a b
deepOf LensLike f s t s t
r Traversing p f s t a b
l = forall (p :: * -> * -> *) (f :: * -> *) s t a b.
(Conjoined p, Applicative f) =>
Traversing p f s t a b -> Over p f s t a b -> Over p f s t a b
failing Traversing p f s t a b
l (LensLike f s t s t
r forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s t a b.
(Conjoined p, Applicative f) =>
LensLike f s t s t -> Traversing p f s t a b -> Over p f s t a b
deepOf LensLike f s t s t
r Traversing p f s t a b
l)

-- | "Fuse" a 'Traversal' by reassociating all of the @('<*>')@ operations to the

-- left and fusing all of the 'fmap' calls into one. This is particularly

-- useful when constructing a 'Traversal' using operations from "GHC.Generics".

--

-- Given a pair of 'Traversal's 'foo' and 'bar',

--

-- @

-- 'confusing' (foo.bar) = foo.bar

-- @

--

-- However, @foo@ and @bar@ are each going to use the 'Applicative' they are given.

--

-- 'confusing' exploits the 'Yoneda' lemma to merge their separate uses of 'fmap' into a single 'fmap'.

-- and it further exploits an interesting property of the right Kan lift (or 'Curried') to left associate

-- all of the uses of @('<*>')@ to make it possible to fuse together more fmaps.

--

-- This is particularly effective when the choice of functor 'f' is unknown at compile

-- time or when the 'Traversal' @foo.bar@ in the above description is recursive or complex

-- enough to prevent inlining.

--

-- 'Control.Lens.Lens.fusing' is a version of this combinator suitable for fusing lenses.

--

-- @

-- 'confusing' :: 'Traversal' s t a b -> 'Traversal' s t a b

-- @

confusing :: Applicative f => LensLike (Curried (Yoneda f) (Yoneda f)) s t a b -> LensLike f s t a b
confusing :: forall (f :: * -> *) s t a b.
Applicative f =>
LensLike (Curried (Yoneda f) (Yoneda f)) s t a b
-> LensLike f s t a b
confusing LensLike (Curried (Yoneda f) (Yoneda f)) s t a b
t = \a -> f b
f -> forall (f :: * -> *) a. Yoneda f a -> f a
lowerYoneda forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (g :: * -> *) a.
Applicative f =>
Curried f g a -> g a
lowerCurried forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike (Curried (Yoneda f) (Yoneda f)) s t a b
t (forall (f :: * -> *) a.
Applicative f =>
f a -> Curried (Yoneda f) (Yoneda f) a
liftCurriedYoneda forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f b
f)
  where
  liftCurriedYoneda :: Applicative f => f a -> Curried (Yoneda f) (Yoneda f) a
  liftCurriedYoneda :: forall (f :: * -> *) a.
Applicative f =>
f a -> Curried (Yoneda f) (Yoneda f) a
liftCurriedYoneda f a
fa = forall (g :: * -> *) (h :: * -> *) a.
(forall r. g (a -> r) -> h r) -> Curried g h a
Curried (forall (f :: * -> *) a b.
Applicative f =>
Yoneda f (a -> b) -> f a -> Yoneda f b
`yap` f a
fa)
  {-# INLINE liftCurriedYoneda #-}

  yap :: Applicative f => Yoneda f (a -> b) -> f a -> Yoneda f b
  yap :: forall (f :: * -> *) a b.
Applicative f =>
Yoneda f (a -> b) -> f a -> Yoneda f b
yap (Yoneda forall b. ((a -> b) -> b) -> f b
k) f a
fa = forall (f :: * -> *) a. (forall b. (a -> b) -> f b) -> Yoneda f a
Yoneda (\b -> b
ab_r -> forall b. ((a -> b) -> b) -> f b
k (b -> b
ab_r forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
fa)
  {-# INLINE yap #-}

{-# INLINE confusing #-}

-- | Traverse a container using a specified 'Applicative'.

--

-- This is like 'traverseBy' where the 'Traversable' instance can be specified by any 'Traversal'

--

-- @

-- 'traverseByOf' 'traverse' ≡ 'traverseBy'

-- @

traverseByOf :: Traversal s t a b -> (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> (a -> f b) -> s -> f t
traverseByOf :: forall s t a b (f :: * -> *).
Traversal s t a b
-> (forall x. x -> f x)
-> (forall x y. f (x -> y) -> f x -> f y)
-> (a -> f b)
-> s
-> f t
traverseByOf Traversal s t a b
l forall x. x -> f x
pur forall x y. f (x -> y) -> f x -> f y
app a -> f b
f = forall (f :: * -> *) t a.
(forall x. x -> f x)
-> (forall x y. f (x -> y) -> f x -> f y)
-> (forall s.
    Reifies s (ReifiedApplicative f) =>
    t -> ReflectedApplicative f s a)
-> t
-> f a
reifyApplicative forall x. x -> f x
pur forall x y. f (x -> y) -> f x -> f y
app (Traversal s t a b
l (forall {k} {k1} (f :: k -> *) (s :: k1) (a :: k).
f a -> ReflectedApplicative f s a
ReflectedApplicative forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. a -> f b
f))

-- | Sequence a container using a specified 'Applicative'.

--

-- This is like 'traverseBy' where the 'Traversable' instance can be specified by any 'Traversal'

--

-- @

-- 'sequenceByOf' 'traverse' ≡ 'sequenceBy'

-- @

sequenceByOf :: Traversal s t (f b) b -> (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> s -> f t
sequenceByOf :: forall s t (f :: * -> *) b.
Traversal s t (f b) b
-> (forall x. x -> f x)
-> (forall x y. f (x -> y) -> f x -> f y)
-> s
-> f t
sequenceByOf Traversal s t (f b) b
l forall x. x -> f x
pur forall x y. f (x -> y) -> f x -> f y
app = forall (f :: * -> *) t a.
(forall x. x -> f x)
-> (forall x y. f (x -> y) -> f x -> f y)
-> (forall s.
    Reifies s (ReifiedApplicative f) =>
    t -> ReflectedApplicative f s a)
-> t
-> f a
reifyApplicative forall x. x -> f x
pur forall x y. f (x -> y) -> f x -> f y
app (Traversal s t (f b) b
l forall {k} {k1} (f :: k -> *) (s :: k1) (a :: k).
f a -> ReflectedApplicative f s a
ReflectedApplicative)