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

#ifndef MIN_VERSION_containers
#define MIN_VERSION_containers(x,y,z) 1
#endif
-----------------------------------------------------------------------------
-- |
-- 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
  , 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 Control.Applicative as Applicative
import Control.Applicative.Backwards
import Control.Category
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.Indexed
import Control.Lens.Internal.Fold
import Control.Lens.Lens
import Control.Lens.Setter (ASetter, AnIndexedSetter, isets, sets)
import Control.Lens.Type
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.Bitraversable
import Data.CallStack
import Data.Functor.Apply
import Data.Functor.Compose
import Data.Functor.Day.Curried
import Data.Functor.Yoneda
import Data.Int
import Data.IntMap as IntMap
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.Map as Map
import Data.Map (Map)
import Data.Sequence (Seq, mapWithIndex)
import Data.Vector as Vector (Vector, imap)
import Data.Monoid (Any (..), Endo (..))
import Data.Profunctor
import Data.Profunctor.Rep
import Data.Profunctor.Sieve
import Data.Profunctor.Unsafe
import Data.Reflection
import Data.Semigroup.Traversable
import Data.Semigroup.Bitraversable
import Data.Traversable
import Data.Tuple (swap)
import GHC.Magic (inline)
import Prelude hiding ((.),id)

#if !(MIN_VERSION_base(4,8,0))
import Data.Foldable (Foldable)
import Data.Monoid (Monoid (..))
#endif

#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup (Semigroup (..))
#endif

-- $setup
-- >>> :set -XNoOverloadedStrings -XFlexibleContexts
-- >>> import Data.Char (toUpper)
-- >>> import Control.Lens
-- >>> import Control.DeepSeq (NFData (..), force)
-- >>> import Control.Exception (evaluate,try,ErrorCall(..))
-- >>> import Data.Maybe (fromMaybe)
-- >>> 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

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

-- | 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 :: LensLike f s t a b -> LensLike f s t a b
traverseOf = LensLike f s t a b -> LensLike f s t a b
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat 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 :: LensLike f s t a b -> s -> (a -> f b) -> f t
forOf = LensLike f s t a b -> s -> (a -> f b) -> f t
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 :: LensLike f s t (f b) b -> s -> f t
sequenceAOf l :: LensLike f s t (f b) b
l = LensLike f s t (f b) b
l f b -> f b
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat 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 :: LensLike (WrappedMonad m) s t a b -> (a -> m b) -> s -> m t
mapMOf l :: LensLike (WrappedMonad m) s t a b
l cmd :: a -> m b
cmd = WrappedMonad m t -> m t
forall (m :: * -> *) a. WrappedMonad m a -> m a
unwrapMonad (WrappedMonad m t -> m t) -> (s -> WrappedMonad m t) -> s -> m t
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 a b
l (m b -> WrappedMonad m b
forall (m :: * -> *) a. m a -> WrappedMonad m a
WrapMonad (m b -> WrappedMonad m b) -> (a -> m b) -> a -> WrappedMonad m b
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. a -> m b
cmd)
{-# 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 :: LensLike (WrappedMonad m) s t a b -> s -> (a -> m b) -> m t
forMOf l :: LensLike (WrappedMonad m) s t a b
l a :: s
a cmd :: a -> m b
cmd = WrappedMonad m t -> m t
forall (m :: * -> *) a. WrappedMonad m a -> m a
unwrapMonad (LensLike (WrappedMonad m) s t a b
l (m b -> WrappedMonad m b
forall (m :: * -> *) a. m a -> WrappedMonad m a
WrapMonad (m b -> WrappedMonad m b) -> (a -> m b) -> a -> WrappedMonad m b
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 :: LensLike (WrappedMonad m) s t (m b) b -> s -> m t
sequenceOf l :: LensLike (WrappedMonad m) s t (m b) b
l = WrappedMonad m t -> m t
forall (m :: * -> *) a. WrappedMonad m a -> m a
unwrapMonad (WrappedMonad m t -> m t) -> (s -> WrappedMonad m t) -> s -> m t
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 m b -> WrappedMonad m b
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 :: LensLike ZipList s t [a] a -> s -> [t]
transposeOf l :: LensLike ZipList s t [a] a
l = ZipList t -> [t]
forall a. ZipList a -> [a]
getZipList (ZipList t -> [t]) -> (s -> ZipList t) -> s -> [t]
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 [a] -> ZipList a
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 :: LensLike (Backwards (State acc)) s t a b
-> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
mapAccumROf = LensLike (State acc) s t a b
-> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
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
 -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t))
-> (LensLike (Backwards (State acc)) s t a b
    -> LensLike (State acc) s t a b)
-> LensLike (Backwards (State acc)) s t a b
-> (acc -> a -> (acc, b))
-> acc
-> s
-> (acc, t)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. LensLike (Backwards (State acc)) s t a b
-> LensLike (State acc) s t a b
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 :: LensLike (State acc) s t a b
-> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
mapAccumLOf l :: LensLike (State acc) s t a b
l f :: acc -> a -> (acc, b)
f acc0 :: acc
acc0 s :: s
s = (t, acc) -> (acc, t)
forall a b. (a, b) -> (b, a)
swap (State acc t -> acc -> (t, acc)
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
a = (acc -> (b, acc)) -> StateT acc Identity b
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((acc -> (b, acc)) -> StateT acc Identity b)
-> (acc -> (b, acc)) -> StateT acc Identity b
forall a b. (a -> b) -> a -> b
$ \acc :: acc
acc -> (acc, b) -> (b, 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 :: LensLike (Backwards (State (Maybe a))) s t a a
-> (a -> a -> a) -> s -> t
scanr1Of l :: LensLike (Backwards (State (Maybe a))) s t a a
l f :: a -> a -> a
f = (Maybe a, t) -> t
forall a b. (a, b) -> b
snd ((Maybe a, t) -> t) -> (s -> (Maybe a, t)) -> s -> t
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. LensLike (Backwards (State (Maybe a))) s t a a
-> (Maybe a -> a -> (Maybe a, a)) -> Maybe a -> s -> (Maybe a, t)
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 Maybe a
forall a. Maybe a
Nothing where
  step :: Maybe a -> a -> (Maybe a, a)
step Nothing a :: a
a  = (a -> Maybe a
forall a. a -> Maybe a
Just a
a, a
a)
  step (Just s :: a
s) a :: a
a = (a -> Maybe 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 :: LensLike (State (Maybe a)) s t a a -> (a -> a -> a) -> s -> t
scanl1Of l :: LensLike (State (Maybe a)) s t a a
l f :: a -> a -> a
f = (Maybe a, t) -> t
forall a b. (a, b) -> b
snd ((Maybe a, t) -> t) -> (s -> (Maybe a, t)) -> s -> t
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. LensLike (State (Maybe a)) s t a a
-> (Maybe a -> a -> (Maybe a, a)) -> Maybe a -> s -> (Maybe a, t)
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 Maybe a
forall a. Maybe a
Nothing where
  step :: Maybe a -> a -> (Maybe a, a)
step Nothing a :: a
a  = (a -> Maybe a
forall a. a -> Maybe a
Just a
a, a
a)
  step (Just s :: a
s) a :: a
a = (a -> Maybe 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 :: (a -> f b) -> Bazaar (->) a c s -> f (Bazaar (->) b c s)
loci f :: a -> f b
f w :: Bazaar (->) a c s
w = Compose f (Bazaar (->) b c) s -> f (Bazaar (->) b c s)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Bazaar (->) a c s
-> (a -> Compose f (Bazaar (->) b c) c)
-> Compose f (Bazaar (->) b c) s
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 (f (Bazaar (->) b c c) -> Compose f (Bazaar (->) b c) c
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (Bazaar (->) b c c) -> Compose f (Bazaar (->) b c) c)
-> (a -> f (Bazaar (->) b c c))
-> a
-> Compose f (Bazaar (->) b c) c
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. (b -> Bazaar (->) b c c) -> f b -> f (Bazaar (->) b c c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Bazaar (->) b c c
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell (f b -> f (Bazaar (->) b c c))
-> (a -> f b) -> a -> f (Bazaar (->) b c c)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 :: p a (f b)
-> Bazaar (Indexed i) a c s -> f (Bazaar (Indexed i) b c s)
iloci f :: p a (f b)
f w :: Bazaar (Indexed i) a c s
w = Compose f (Bazaar (Indexed i) b c) s
-> f (Bazaar (Indexed i) b c s)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Bazaar (Indexed i) a c s
-> Indexed i a (Compose f (Bazaar (Indexed i) b c) c)
-> Compose f (Bazaar (Indexed i) b c) s
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 (f (Bazaar (Indexed i) b c c)
-> Compose f (Bazaar (Indexed i) b c) c
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (Bazaar (Indexed i) b c c)
 -> Compose f (Bazaar (Indexed i) b c) c)
-> Indexed i a (f (Bazaar (Indexed i) b c c))
-> Indexed i a (Compose f (Bazaar (Indexed i) b c) c)
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. (i -> a -> f (Bazaar (Indexed i) b c c))
-> Indexed i a (f (Bazaar (Indexed i) b c c))
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed (\i :: i
i -> (b -> Bazaar (Indexed i) b c c)
-> f b -> f (Bazaar (Indexed i) b c c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Indexed i b (Bazaar (Indexed i) b c c)
-> i -> b -> Bazaar (Indexed i) b c c
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed Indexed i b (Bazaar (Indexed i) b c c)
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell i
i) (f b -> f (Bazaar (Indexed i) b c c))
-> (a -> f b) -> a -> f (Bazaar (Indexed i) b c c)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. p a (f b) -> i -> a -> f b
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 :: Traversing (->) f s t a a -> LensLike f s t [a] [a]
partsOf l :: Traversing (->) f s t a a
l f :: [a] -> f [a]
f s :: s
s = BazaarT (->) f a a t -> [a] -> t
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a t.
(Bizarre p w, Category p) =>
w a a t -> [a] -> t
outs BazaarT (->) f a a t
b ([a] -> t) -> f [a] -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> f [a]
f (BazaarT (->) f a a t -> [a]
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 a -> BazaarT (->) f a a a
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 :: Traversing (Indexed i) f s t a a -> Over p f s t [a] [a]
ipartsOf l :: Traversing (Indexed i) f s t a a
l = ((p ~ (->)) => ([a] -> f [a]) -> s -> f t)
-> Over p f s t [a] [a] -> Over p f s t [a] [a]
forall (p :: * -> * -> *) (q :: * -> * -> *) a b r.
Conjoined p =>
((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r
conjoined
  (\f :: [a] -> f [a]
f s :: s
s -> let b :: BazaarT (Indexed i) f a a t
b = Traversing (Indexed i) f s t a a
-> Traversing (Indexed i) f s t a a
forall a. a -> a
inline Traversing (Indexed i) f s t a a
l Indexed i a (BazaarT (Indexed i) f a a a)
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
s                            in BazaarT (Indexed i) f a a t -> [a] -> t
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 ([a] -> t) -> f [a] -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> f [a]
f (BazaarT (Indexed i) f a a t -> [a]
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))
  (\f :: p [a] (f [a])
f s :: s
s -> let b :: BazaarT (Indexed i) f a a t
b = Traversing (Indexed i) f s t a a
-> Traversing (Indexed i) f s t a a
forall a. a -> a
inline Traversing (Indexed i) f s t a a
l Indexed i a (BazaarT (Indexed i) f a a a)
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
s; (is :: [i]
is, as :: [a]
as) = [(i, a)] -> ([i], [a])
forall a b. [(a, b)] -> ([a], [b])
unzip (BazaarT (Indexed i) f a a t -> [Corep (Indexed i) a]
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 BazaarT (Indexed i) f a a t -> [a] -> t
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 ([a] -> t) -> f [a] -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p [a] (f [a]) -> [i] -> [a] -> f [a]
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' :: ATraversal s t a a -> Lens s t [a] [a]
partsOf' l :: ATraversal s t a a
l f :: [a] -> f [a]
f s :: s
s = Bazaar (->) a a t -> [a] -> t
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a t.
(Bizarre p w, Category p) =>
w a a t -> [a] -> t
outs Bazaar (->) a a t
b ([a] -> t) -> f [a] -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> f [a]
f (Bazaar (->) a a t -> [a]
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 a -> Bazaar (->) a a a
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' :: Over (Indexed i) (Bazaar' (Indexed i) a) s t a a
-> Over p f s t [a] [a]
ipartsOf' l :: Over (Indexed i) (Bazaar' (Indexed i) a) s t a a
l = ((p ~ (->)) => ([a] -> f [a]) -> s -> f t)
-> Over p f s t [a] [a] -> Over p f s t [a] [a]
forall (p :: * -> * -> *) (q :: * -> * -> *) a b r.
Conjoined p =>
((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r
conjoined
  (\f :: [a] -> f [a]
f s :: s
s -> let b :: Bazaar' (Indexed i) a t
b = Over (Indexed i) (Bazaar' (Indexed i) a) s t a a
-> Over (Indexed i) (Bazaar' (Indexed i) a) s t a a
forall a. a -> a
inline Over (Indexed i) (Bazaar' (Indexed i) a) s t a a
l Indexed i a (Bazaar (Indexed i) a a a)
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
s                            in Bazaar' (Indexed i) a t -> [a] -> t
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a t.
(Bizarre p w, Category p) =>
w a a t -> [a] -> t
outs Bazaar' (Indexed i) a t
b ([a] -> t) -> f [a] -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> f [a]
f (Bazaar' (Indexed i) a t -> [a]
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))
  (\f :: p [a] (f [a])
f s :: s
s -> let b :: Bazaar' (Indexed i) a t
b = Over (Indexed i) (Bazaar' (Indexed i) a) s t a a
-> Over (Indexed i) (Bazaar' (Indexed i) a) s t a a
forall a. a -> a
inline Over (Indexed i) (Bazaar' (Indexed i) a) s t a a
l Indexed i a (Bazaar (Indexed i) a a a)
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
s; (is :: [i]
is, as :: [a]
as) = [(i, a)] -> ([i], [a])
forall a b. [(a, b)] -> ([a], [b])
unzip (Bazaar' (Indexed i) a t -> [Corep (Indexed i) a]
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 Bazaar' (Indexed i) a t -> [a] -> t
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a t.
(Bizarre p w, Category p) =>
w a a t -> [a] -> t
outs Bazaar' (Indexed i) a t
b ([a] -> t) -> f [a] -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p [a] (f [a]) -> [i] -> [a] -> f [a]
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 :: Traversing (->) f s t a b -> LensLike f s t [a] [b]
unsafePartsOf l :: Traversing (->) f s t a b
l f :: [a] -> f [b]
f s :: s
s = BazaarT (->) f a b t -> [b] -> t
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b t.
(Bizarre p w, Corepresentable p) =>
w a b t -> [b] -> t
unsafeOuts BazaarT (->) f a b t
b ([b] -> t) -> f [b] -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> f [b]
f (BazaarT (->) f a b t -> [a]
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 a -> BazaarT (->) f a b b
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 :: Traversing (Indexed i) f s t a b -> Over p f s t [a] [b]
iunsafePartsOf l :: Traversing (Indexed i) f s t a b
l = ((p ~ (->)) => ([a] -> f [b]) -> s -> f t)
-> Over p f s t [a] [b] -> Over p f s t [a] [b]
forall (p :: * -> * -> *) (q :: * -> * -> *) a b r.
Conjoined p =>
((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r
conjoined
  (\f :: [a] -> f [b]
f s :: s
s -> let b :: BazaarT (Indexed i) f a b t
b = Traversing (Indexed i) f s t a b
-> Traversing (Indexed i) f s t a b
forall a. a -> a
inline Traversing (Indexed i) f s t a b
l Indexed i a (BazaarT (Indexed i) f a b b)
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
s                           in BazaarT (Indexed i) f a b t -> [b] -> t
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 ([b] -> t) -> f [b] -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> f [b]
f (BazaarT (Indexed i) f a b t -> [a]
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))
  (\f :: p [a] (f [b])
f s :: s
s -> let b :: BazaarT (Indexed i) f a b t
b = Traversing (Indexed i) f s t a b
-> Traversing (Indexed i) f s t a b
forall a. a -> a
inline Traversing (Indexed i) f s t a b
l Indexed i a (BazaarT (Indexed i) f a b b)
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
s; (is :: [i]
is,as :: [a]
as) = [(i, a)] -> ([i], [a])
forall a b. [(a, b)] -> ([a], [b])
unzip (BazaarT (Indexed i) f a b t -> [Corep (Indexed i) a]
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 BazaarT (Indexed i) f a b t -> [b] -> t
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 ([b] -> t) -> f [b] -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p [a] (f [b]) -> [i] -> [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' :: ATraversal s t a b -> Lens s t [a] [b]
unsafePartsOf' l :: ATraversal s t a b
l f :: [a] -> f [b]
f s :: s
s = Bazaar (->) a b t -> [b] -> t
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b t.
(Bizarre p w, Corepresentable p) =>
w a b t -> [b] -> t
unsafeOuts Bazaar (->) a b t
b ([b] -> t) -> f [b] -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> f [b]
f (Bazaar (->) a b t -> [a]
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 a -> Bazaar (->) a b b
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' :: Over (Indexed i) (Bazaar (Indexed i) a b) s t a b
-> IndexedLens [i] s t [a] [b]
iunsafePartsOf' l :: Over (Indexed i) (Bazaar (Indexed i) a b) s t a b
l = ((p ~ (->)) => ([a] -> f [b]) -> s -> f t)
-> (p [a] (f [b]) -> s -> f t) -> p [a] (f [b]) -> s -> f t
forall (p :: * -> * -> *) (q :: * -> * -> *) a b r.
Conjoined p =>
((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r
conjoined
  (\f :: [a] -> f [b]
f s :: s
s -> let b :: Bazaar (Indexed i) a b t
b = Over (Indexed i) (Bazaar (Indexed i) a b) s t a b
-> Over (Indexed i) (Bazaar (Indexed i) a b) s t a b
forall a. a -> a
inline Over (Indexed i) (Bazaar (Indexed i) a b) s t a b
l Indexed i a (Bazaar (Indexed i) a b b)
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
s                            in Bazaar (Indexed i) a b t -> [b] -> t
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 ([b] -> t) -> f [b] -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> f [b]
f (Bazaar (Indexed i) a b t -> [a]
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))
  (\f :: p [a] (f [b])
f s :: s
s -> let b :: Bazaar (Indexed i) a b t
b = Over (Indexed i) (Bazaar (Indexed i) a b) s t a b
-> Over (Indexed i) (Bazaar (Indexed i) a b) s t a b
forall a. a -> a
inline Over (Indexed i) (Bazaar (Indexed i) a b) s t a b
l Indexed i a (Bazaar (Indexed i) a b b)
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
s; (is :: [i]
is, as :: [a]
as) = [(i, a)] -> ([i], [a])
forall a b. [(a, b)] -> ([a], [b])
unzip (Bazaar (Indexed i) a b t -> [Corep (Indexed i) a]
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 Bazaar (Indexed i) a b t -> [b] -> t
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 ([b] -> t) -> f [b] -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p [a] (f [b]) -> [i] -> [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 :: Traversing p f s t a a -> Over p f s t a a
singular l :: Traversing p f s t a a
l = ((p ~ (->)) => (a -> f a) -> s -> f t)
-> Over p f s t a a -> Over p f s t a a
forall (p :: * -> * -> *) (q :: * -> * -> *) a b r.
Conjoined p =>
((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r
conjoined
  (\afb :: a -> f a
afb s :: s
s -> let b :: BazaarT p f a a t
b = Traversing p f s t a a
l p a (BazaarT p f a a a)
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
s in case BazaarT p f a a t -> [a]
forall (w :: * -> * -> * -> *) a b t.
Bizarre (->) w =>
w a b t -> [a]
ins BazaarT p f a a t
b of
    (w :: a
w:ws :: [a]
ws) -> BazaarT p f a a t -> [a] -> t
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 ([a] -> t) -> (a -> [a]) -> a -> t
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ws) (a -> t) -> f a -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
afb a
w
    []     -> BazaarT p f a a t -> [a] -> t
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 ([a] -> t) -> (a -> [a]) -> a -> t
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> t) -> f a -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
afb ([Char] -> a
forall a. HasCallStack => [Char] -> a
error "singular: empty traversal"))
  (\pafb :: p a (f a)
pafb s :: s
s -> let b :: BazaarT p f a a t
b = Traversing p f s t a a
l p a (BazaarT p f a a a)
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
s in case BazaarT p f a a t -> [Corep p a]
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
    (w :: Corep p a
w:ws :: [Corep p a]
ws) -> BazaarT p f a a t -> [a] -> t
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 ([a] -> t) -> (a -> [a]) -> a -> t
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> [a] -> [a]
forall a. a -> [a] -> [a]
:(Corep p a -> a) -> [Corep p a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map Corep p a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract [Corep p a]
ws) (a -> t) -> f a -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p a (f a) -> Corep p a -> f a
forall (p :: * -> * -> *) (f :: * -> *) a b.
Cosieve p f =>
p a b -> f a -> b
cosieve p a (f a)
pafb Corep p a
w
    []     -> BazaarT p f a a t -> [a] -> t
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 ([a] -> t) -> (a -> [a]) -> a -> t
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return                    (a -> t) -> f a -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p a (f a) -> Corep p a -> f a
forall (p :: * -> * -> *) (f :: * -> *) a b.
Cosieve p f =>
p a b -> f a -> b
cosieve p a (f a)
pafb ([Char] -> Corep p a
forall a. HasCallStack => [Char] -> a
error "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 :: Traversing p f s t a b -> Over p f s t a b
unsafeSingular l :: Traversing p f s t a b
l = ((p ~ (->)) => (a -> f b) -> s -> f t)
-> Over p f s t a b -> Over p f s t a b
forall (p :: * -> * -> *) (q :: * -> * -> *) a b r.
Conjoined p =>
((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r
conjoined
  (\afb :: a -> f b
afb s :: s
s -> let b :: BazaarT p f a b t
b = Traversing p f s t a b -> Traversing p f s t a b
forall a. a -> a
inline Traversing p f s t a b
l p a (BazaarT p f a b b)
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
s in case BazaarT p f a b t -> [a]
forall (w :: * -> * -> * -> *) a b t.
Bizarre (->) w =>
w a b t -> [a]
ins BazaarT p f a b t
b of
    [w :: a
w] -> BazaarT p f a b t -> [b] -> t
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 ([b] -> t) -> (b -> [b]) -> b -> t
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> [b]
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> t) -> f b -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
afb a
w
    []  -> [Char] -> f t
forall a. HasCallStack => [Char] -> a
error "unsafeSingular: empty traversal"
    _   -> [Char] -> f t
forall a. HasCallStack => [Char] -> a
error "unsafeSingular: traversing multiple results")
  (\pafb :: p a (f b)
pafb s :: s
s -> let b :: BazaarT p f a b t
b = Traversing p f s t a b -> Traversing p f s t a b
forall a. a -> a
inline Traversing p f s t a b
l p a (BazaarT p f a b b)
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
s in case BazaarT p f a b t -> [Corep p a]
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
    [w :: Corep p a
w] -> BazaarT p f a b t -> [b] -> t
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 ([b] -> t) -> (b -> [b]) -> b -> t
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> [b]
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> t) -> f b -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p a (f b) -> Corep p 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
    []  -> [Char] -> f t
forall a. HasCallStack => [Char] -> a
error "unsafeSingular: empty traversal"
    _   -> [Char] -> f t
forall a. HasCallStack => [Char] -> a
error "unsafeSingular: traversing multiple results")
{-# INLINE unsafeSingular #-}

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

ins :: Bizarre (->) w => w a b t -> [a]
ins :: w a b t -> [a]
ins = Getting (Endo [a]) (w a b t) a -> w a b t -> [a]
forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf (Optical (->) (->) (Const (Endo [a])) (w a b t) t a b
-> Getting (Endo [a]) (w a b t) a
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 Optical (->) (->) (Const (Endo [a])) (w a b t) t a b
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 :: w a b t -> [a]
wins = Const [a] t -> [a]
forall a k (b :: k). Const a b -> a
getConst (Const [a] t -> [a]) -> (w a b t -> Const [a] t) -> w a b t -> [a]
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. p a (Const [a] b) -> w a b t -> Const [a] t
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) (f :: * -> *) a b
       t.
(Bizarre p w, Applicative f) =>
p a (f b) -> w a b t -> f t
bazaar ((Corep p a -> Const [a] b) -> p a (Const [a] b)
forall (p :: * -> * -> *) d c.
Corepresentable p =>
(Corep p d -> c) -> p d c
cotabulate ((Corep p a -> Const [a] b) -> p a (Const [a] b))
-> (Corep p a -> Const [a] b) -> p a (Const [a] b)
forall a b. (a -> b) -> a -> b
$ \ra :: Corep p a
ra -> [a] -> Const [a] b
forall k a (b :: k). a -> Const a b
Const [Corep p a -> a
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 :: w a b t -> [Corep p a]
pins = Const [Corep p a] t -> [Corep p a]
forall a k (b :: k). Const a b -> a
getConst (Const [Corep p a] t -> [Corep p a])
-> (w a b t -> Const [Corep p a] t) -> w a b t -> [Corep p a]
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. p a (Const [Corep p a] b) -> w a b t -> Const [Corep p a] t
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) (f :: * -> *) a b
       t.
(Bizarre p w, Applicative f) =>
p a (f b) -> w a b t -> f t
bazaar ((Corep p a -> Const [Corep p a] b) -> p a (Const [Corep p a] b)
forall (p :: * -> * -> *) d c.
Corepresentable p =>
(Corep p d -> c) -> p d c
cotabulate ((Corep p a -> Const [Corep p a] b) -> p a (Const [Corep p a] b))
-> (Corep p a -> Const [Corep p a] b) -> p a (Const [Corep p a] b)
forall a b. (a -> b) -> a -> b
$ \ra :: Corep p a
ra -> [Corep p a] -> Const [Corep p a] b
forall k a (b :: k). a -> Const a b
Const [Corep p a
ra])
{-# INLINE pins #-}

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

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

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

unconsWithDefault :: a -> [a] -> (a,[a])
unconsWithDefault :: a -> [a] -> (a, [a])
unconsWithDefault d :: a
d []     = (a
d,[])
unconsWithDefault _ (x :: a
x:xs :: [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 :: Over p (Bazaar p a a) s t a a -> s -> [Pretext p a a t]
holesOf f :: Over p (Bazaar p a a) s t a a
f xs :: s
xs = (Endo [Pretext p a a t] -> [Pretext p a a t] -> [Pretext p a a t])
-> [Pretext p a a t] -> Endo [Pretext p a a t] -> [Pretext p a a t]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Endo [Pretext p a a t] -> [Pretext p a a t] -> [Pretext p a a t]
forall a. Endo a -> a -> a
appEndo [] (Endo [Pretext p a a t] -> [Pretext p a a t])
-> ((Endo [Pretext p a a t], t) -> Endo [Pretext p a a t])
-> (Endo [Pretext p a a t], t)
-> [Pretext p a a t]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Endo [Pretext p a a t], t) -> Endo [Pretext p a a t]
forall a b. (a, b) -> a
fst ((Endo [Pretext p a a t], t) -> [Pretext p a a t])
-> (Endo [Pretext p a a t], t) -> [Pretext p a a t]
forall a b. (a -> b) -> a -> b
$
  Holes t (Endo [Pretext p a a t]) t
-> (t -> t) -> (Endo [Pretext p a a t], t)
forall t m x. Holes t m x -> (x -> t) -> (m, x)
runHoles (Bazaar p a a t
-> p a (Holes t (Endo [Pretext p a a t]) a)
-> Holes t (Endo [Pretext p a a t]) t
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 p a (Bazaar p a a a)
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
xs) ((Corep p a -> Holes t (Endo [Pretext p a a t]) a)
-> p a (Holes t (Endo [Pretext p a a t]) a)
forall (p :: * -> * -> *) d c.
Corepresentable p =>
(Corep p d -> c) -> p d c
cotabulate Corep p a -> Holes t (Endo [Pretext p a a t]) a
forall (p :: * -> * -> *) a t.
(Corepresentable p, Comonad (Corep p)) =>
Corep p a -> Holes t (Endo [Pretext p a a t]) a
holeInOne)) t -> t
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
{-# INLINE holesOf #-}

holeInOne :: (Corepresentable p, Comonad (Corep p))
          => Corep p a -> Holes t (Endo [Pretext p a a t]) a
holeInOne :: Corep p a -> Holes t (Endo [Pretext p a a t]) a
holeInOne x :: Corep p a
x = ((a -> t) -> (Endo [Pretext p a a t], a))
-> Holes t (Endo [Pretext p a a t]) a
forall t m x. ((x -> t) -> (m, x)) -> Holes t m x
Holes (((a -> t) -> (Endo [Pretext p a a t], a))
 -> Holes t (Endo [Pretext p a a t]) a)
-> ((a -> t) -> (Endo [Pretext p a a t], a))
-> Holes t (Endo [Pretext p a a t]) a
forall a b. (a -> b) -> a -> b
$ \xt :: a -> t
xt ->
    ( ([Pretext p a a t] -> [Pretext p a a t]) -> Endo [Pretext p a a t]
forall a. (a -> a) -> Endo a
Endo ((a -> t) -> Pretext p a a a -> Pretext p a a t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> t
xt (p a (Pretext p a a a) -> Corep p a -> Pretext p a a a
forall (p :: * -> * -> *) (f :: * -> *) a b.
Cosieve p f =>
p a b -> f a -> b
cosieve p a (Pretext p a a a)
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell Corep p a
x) Pretext p a a t -> [Pretext p a a t] -> [Pretext p a a t]
forall a. a -> [a] -> [a]
:)
    , Corep p 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 accroding 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 :: Over p (Bazaar1 p a a) s t a a -> s -> NonEmpty (Pretext p a a t)
holes1Of f :: Over p (Bazaar1 p a a) s t a a
f xs :: s
xs = (NonEmptyDList (Pretext p a a t)
 -> [Pretext p a a t] -> NonEmpty (Pretext p a a t))
-> [Pretext p a a t]
-> NonEmptyDList (Pretext p a a t)
-> NonEmpty (Pretext p a a t)
forall a b c. (a -> b -> c) -> b -> a -> c
flip NonEmptyDList (Pretext p a a t)
-> [Pretext p a a t] -> NonEmpty (Pretext p a a t)
forall a. NonEmptyDList a -> [a] -> NonEmpty a
getNonEmptyDList [] (NonEmptyDList (Pretext p a a t) -> NonEmpty (Pretext p a a t))
-> ((NonEmptyDList (Pretext p a a t), t)
    -> NonEmptyDList (Pretext p a a t))
-> (NonEmptyDList (Pretext p a a t), t)
-> NonEmpty (Pretext p a a t)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (NonEmptyDList (Pretext p a a t), t)
-> NonEmptyDList (Pretext p a a t)
forall a b. (a, b) -> a
fst ((NonEmptyDList (Pretext p a a t), t)
 -> NonEmpty (Pretext p a a t))
-> (NonEmptyDList (Pretext p a a t), t)
-> NonEmpty (Pretext p a a t)
forall a b. (a -> b) -> a -> b
$
  Holes t (NonEmptyDList (Pretext p a a t)) t
-> (t -> t) -> (NonEmptyDList (Pretext p a a t), t)
forall t m x. Holes t m x -> (x -> t) -> (m, x)
runHoles (Bazaar1 p a a t
-> p a (Holes t (NonEmptyDList (Pretext p a a t)) a)
-> Holes t (NonEmptyDList (Pretext p a a t)) t
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 p a (Bazaar1 p a a a)
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
xs) ((Corep p a -> Holes t (NonEmptyDList (Pretext p a a t)) a)
-> p a (Holes t (NonEmptyDList (Pretext p a a t)) a)
forall (p :: * -> * -> *) d c.
Corepresentable p =>
(Corep p d -> c) -> p d c
cotabulate Corep p a -> Holes t (NonEmptyDList (Pretext p a a t)) a
forall (p :: * -> * -> *) a t.
(Corepresentable p, Category p) =>
Corep p a -> Holes t (NonEmptyDList (Pretext p a a t)) a
holeInOne1)) t -> t
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
{-# INLINE holes1Of #-}

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

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

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

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

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

#if MIN_VERSION_base(4,10,0)
  liftA2 :: (a -> b -> c) -> Holes t m a -> Holes t m b -> Holes t m c
liftA2 f :: a -> b -> c
f xs :: Holes t m a
xs ys :: Holes t m b
ys = ((c -> t) -> (m, c)) -> Holes t m c
forall t m x. ((x -> t) -> (m, x)) -> Holes t m x
Holes (((c -> t) -> (m, c)) -> Holes t m c)
-> ((c -> t) -> (m, c)) -> Holes t m c
forall a b. (a -> b) -> a -> b
$ \xt :: c -> t
xt ->
    let
      (pf :: m
pf, pv :: a
pv) = Holes t m a -> (a -> t) -> (m, a)
forall t m x. Holes t m x -> (x -> t) -> (m, x)
runHoles Holes t m a
xs (c -> t
xt (c -> t) -> (a -> c) -> a -> t
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> b -> c) -> b -> a -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> c
f b
qv)
      (qf :: m
qf, qv :: b
qv) = Holes t m b -> (b -> t) -> (m, b)
forall t m x. Holes t m x -> (x -> t) -> (m, x)
runHoles Holes t m b
ys (c -> t
xt (c -> t) -> (b -> c) -> b -> t
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> b -> c
f a
pv)
    in (m
pf m -> m -> m
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 :: Traversal (r a a) (r b b) a b
both f :: a -> f b
f = (a -> f b) -> (a -> f b) -> r a a -> f (r b b)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f b
f a -> f b
f
{-# INLINE both #-}

-- | 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 :: Traversal1 (r a a) (r b b) a b
both1 f :: a -> f b
f = (a -> f b) -> (a -> f b) -> r a a -> f (r b b)
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 :: 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 l :: Optical p q f s t a b
l r :: Optical p q f s' t' a b
r f :: p a (f b)
f = (r s s' -> Rep q (f (r t t'))) -> q (r s s') (f (r t t'))
forall (p :: * -> * -> *) d c.
Representable p =>
(d -> Rep p c) -> p d c
tabulate ((r s s' -> Rep q (f (r t t'))) -> q (r s s') (f (r t t')))
-> (r s s' -> Rep q (f (r t t'))) -> q (r s s') (f (r t t'))
forall a b. (a -> b) -> a -> b
$ Compose (Rep q) f (r t t') -> Rep q (f (r t t'))
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Compose (Rep q) f (r t t') -> Rep q (f (r t t')))
-> (r s s' -> Compose (Rep q) f (r t t'))
-> r s s'
-> Rep q (f (r t t'))
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. (s -> Compose (Rep q) f t)
-> (s' -> Compose (Rep q) f t')
-> r s s'
-> Compose (Rep q) f (r t t')
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 (Rep q (f t) -> Compose (Rep q) f t
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Rep q (f t) -> Compose (Rep q) f t)
-> (s -> Rep q (f t)) -> s -> Compose (Rep q) f t
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. q s (f t) -> s -> Rep q (f t)
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)) (Rep q (f t') -> Compose (Rep q) f t'
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Rep q (f t') -> Compose (Rep q) f t')
-> (s' -> Rep q (f t')) -> s' -> Compose (Rep q) f t'
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. q s' (f t') -> s' -> Rep q (f t')
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 :: Int -> Traversing p f s t a a -> Over p f s t a a
taking n :: Int
n l :: Traversing p f s t a a
l = ((p ~ (->)) => (a -> f a) -> s -> f t)
-> Over p f s t a a -> Over p f s t a a
forall (p :: * -> * -> *) (q :: * -> * -> *) a b r.
Conjoined p =>
((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r
conjoined
  (\ afb :: a -> f a
afb s :: s
s  -> let b :: BazaarT p f a a t
b = Traversing p f s t a a -> Traversing p f s t a a
forall a. a -> a
inline Traversing p f s t a a
l p a (BazaarT p f a a a)
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
s in BazaarT p f a a t -> [a] -> t
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a t.
(Bizarre p w, Category p) =>
w a a t -> [a] -> t
outs BazaarT p f a a t
b ([a] -> t) -> f [a] -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f a) -> [a] -> f [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f a
afb          (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ BazaarT p f a a t -> [a]
forall (w :: * -> * -> * -> *) a b t.
Bizarre (->) w =>
w a b t -> [a]
ins BazaarT p f a a t
b))
  (\ pafb :: p a (f a)
pafb s :: s
s -> let b :: BazaarT p f a a t
b = Traversing p f s t a a -> Traversing p f s t a a
forall a. a -> a
inline Traversing p f s t a a
l p a (BazaarT p f a a a)
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
s in BazaarT p f a a t -> [a] -> t
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a t.
(Bizarre p w, Category p) =>
w a a t -> [a] -> t
outs BazaarT p f a a t
b ([a] -> t) -> f [a] -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Corep p a -> f a) -> [Corep p a] -> f [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (p a (f a) -> Corep p a -> f a
forall (p :: * -> * -> *) (f :: * -> *) a b.
Cosieve p f =>
p a b -> f a -> b
cosieve p a (f a)
pafb) (Int -> [Corep p a] -> [Corep p a]
forall a. Int -> [a] -> [a]
take Int
n ([Corep p a] -> [Corep p a]) -> [Corep p a] -> [Corep p a]
forall a b. (a -> b) -> a -> b
$ BazaarT p f a a t -> [Corep p a]
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 :: Int -> Over p (Indexing f) s t a a -> Over p f s t a a
dropping n :: Int
n l :: Over p (Indexing f) s t a a
l pafb :: p a (f a)
pafb s :: s
s = (Int, f t) -> f t
forall a b. (a, b) -> b
snd ((Int, f t) -> f t) -> (Int, f t) -> f t
forall a b. (a -> b) -> a -> b
$ Indexing f t -> Int -> (Int, f t)
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) 0 where
  paifb :: p a (Indexing f a)
paifb = (Corep p a -> Indexing f a) -> p a (Indexing f a)
forall (p :: * -> * -> *) d c.
Corepresentable p =>
(Corep p d -> c) -> p d c
cotabulate ((Corep p a -> Indexing f a) -> p a (Indexing f a))
-> (Corep p a -> Indexing f a) -> p a (Indexing f a)
forall a b. (a -> b) -> a -> b
$ \wa :: Corep p a
wa -> (Int -> (Int, f a)) -> Indexing f a
forall (f :: * -> *) a. (Int -> (Int, f a)) -> Indexing f a
Indexing ((Int -> (Int, f a)) -> Indexing f a)
-> (Int -> (Int, f a)) -> Indexing f a
forall a b. (a -> b) -> a -> b
$ \i :: Int
i -> let i' :: Int
i' = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 in Int
i' Int -> (Int, f a) -> (Int, f a)
forall a b. a -> b -> b
`seq` (Int
i', if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n then a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Corep p a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract Corep p a
wa) else p a (f a) -> Corep p a -> f a
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 :: ATraversal s t a b -> Traversal s t a b
cloneTraversal l :: ATraversal s t a b
l f :: a -> f b
f = (a -> f b) -> Bazaar (->) a b t -> f t
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 (Bazaar (->) a b t -> f t) -> (s -> Bazaar (->) a b t) -> s -> f t
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ATraversal s t a b
l a -> Bazaar (->) a b b
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 :: ATraversal s t a b -> IndexPreservingTraversal s t a b
cloneIndexPreservingTraversal l :: ATraversal s t a b
l pafb :: p a (f b)
pafb = (Corep p s -> f t) -> p s (f t)
forall (p :: * -> * -> *) d c.
Corepresentable p =>
(Corep p d -> c) -> p d c
cotabulate ((Corep p s -> f t) -> p s (f t))
-> (Corep p s -> f t) -> p s (f t)
forall a b. (a -> b) -> a -> b
$ \ws :: Corep p s
ws -> Bazaar (->) a b t
-> forall (f :: * -> *). Applicative f => (a -> f b) -> f t
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 a -> Bazaar (->) a b b
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell (Corep p s -> s
forall (w :: * -> *) a. Comonad w => w a -> a
extract Corep p s
ws)) ((a -> f b) -> f t) -> (a -> f b) -> f t
forall a b. (a -> b) -> a -> b
$ \a :: a
a -> p a (f b) -> Corep p a -> f b
forall (p :: * -> * -> *) (f :: * -> *) a b.
Cosieve p f =>
p a b -> f a -> b
cosieve p a (f b)
pafb (a
a a -> Corep p s -> Corep p 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 :: AnIndexedTraversal i s t a b -> IndexedTraversal i s t a b
cloneIndexedTraversal l :: AnIndexedTraversal i s t a b
l f :: p a (f b)
f = Indexed i a (f b) -> Bazaar (Indexed i) a b t -> f t
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) (f :: * -> *) a b
       t.
(Bizarre p w, Applicative f) =>
p a (f b) -> w a b t -> f t
bazaar ((i -> a -> f b) -> Indexed i a (f b)
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed (p a (f b) -> i -> a -> f b
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p a (f b)
f)) (Bazaar (Indexed i) a b t -> f t)
-> (s -> Bazaar (Indexed i) a b t) -> s -> f t
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AnIndexedTraversal i s t a b
l Indexed i a (Bazaar (Indexed i) a b b)
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 :: ATraversal1 s t a b -> Traversal1 s t a b
cloneTraversal1 l :: ATraversal1 s t a b
l f :: a -> f b
f = (a -> f b) -> Bazaar1 (->) a b t -> f t
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 (Bazaar1 (->) a b t -> f t)
-> (s -> Bazaar1 (->) a b t) -> s -> f t
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ATraversal1 s t a b
l a -> Bazaar1 (->) a b b
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 :: ATraversal1 s t a b -> IndexPreservingTraversal1 s t a b
cloneIndexPreservingTraversal1 l :: ATraversal1 s t a b
l pafb :: p a (f b)
pafb = (Corep p s -> f t) -> p s (f t)
forall (p :: * -> * -> *) d c.
Corepresentable p =>
(Corep p d -> c) -> p d c
cotabulate ((Corep p s -> f t) -> p s (f t))
-> (Corep p s -> f t) -> p s (f t)
forall a b. (a -> b) -> a -> b
$ \ws :: Corep p s
ws -> Bazaar1 (->) a b t
-> forall (f :: * -> *). Apply f => (a -> f b) -> f t
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 a -> Bazaar1 (->) a b b
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell (Corep p s -> s
forall (w :: * -> *) a. Comonad w => w a -> a
extract Corep p s
ws)) ((a -> f b) -> f t) -> (a -> f b) -> f t
forall a b. (a -> b) -> a -> b
$ \a :: a
a -> p a (f b) -> Corep p a -> f b
forall (p :: * -> * -> *) (f :: * -> *) a b.
Cosieve p f =>
p a b -> f a -> b
cosieve p a (f b)
pafb (a
a a -> Corep p s -> Corep p 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 :: AnIndexedTraversal1 i s t a b -> IndexedTraversal1 i s t a b
cloneIndexedTraversal1 l :: AnIndexedTraversal1 i s t a b
l f :: p a (f b)
f = Indexed i a (f b) -> Bazaar1 (Indexed i) a b t -> f t
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) (f :: * -> *) a b
       t.
(Bizarre1 p w, Apply f) =>
p a (f b) -> w a b t -> f t
bazaar1 ((i -> a -> f b) -> Indexed i a (f b)
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed (p a (f b) -> i -> a -> f b
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p a (f b)
f)) (Bazaar1 (Indexed i) a b t -> f t)
-> (s -> Bazaar1 (Indexed i) a b t) -> s -> f t
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AnIndexedTraversal1 i s t a b
l Indexed i a (Bazaar1 (Indexed i) a b b)
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 :: (Indexed i a (f b) -> s -> f t) -> (i -> a -> f b) -> s -> f t
itraverseOf l :: Indexed i a (f b) -> s -> f t
l = Indexed i a (f b) -> s -> f t
l (Indexed i a (f b) -> s -> f t)
-> ((i -> a -> f b) -> Indexed i a (f b))
-> (i -> a -> f b)
-> s
-> f t
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# (i -> a -> f b) -> Indexed i a (f b)
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 :: (Indexed i a (f b) -> s -> f t) -> s -> (i -> a -> f b) -> f t
iforOf = ((i -> a -> f b) -> s -> f t) -> s -> (i -> a -> f b) -> f t
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((i -> a -> f b) -> s -> f t) -> s -> (i -> a -> f b) -> f t)
-> ((Indexed i a (f b) -> s -> f t) -> (i -> a -> f b) -> s -> f t)
-> (Indexed i a (f b) -> s -> f t)
-> s
-> (i -> a -> f b)
-> f t
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Indexed i a (f b) -> s -> f t) -> (i -> a -> f b) -> s -> f t
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 :: Over (Indexed i) (WrappedMonad m) s t a b
-> (i -> a -> m b) -> s -> m t
imapMOf l :: Over (Indexed i) (WrappedMonad m) s t a b
l cmd :: i -> a -> m b
cmd = WrappedMonad m t -> m t
forall (m :: * -> *) a. WrappedMonad m a -> m a
unwrapMonad (WrappedMonad m t -> m t) -> (s -> WrappedMonad m t) -> s -> m t
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. Over (Indexed i) (WrappedMonad m) s t a b
l (m b -> WrappedMonad m b
forall (m :: * -> *) a. m a -> WrappedMonad m a
WrapMonad (m b -> WrappedMonad m b)
-> Indexed i a (m b) -> Indexed i a (WrappedMonad m b)
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. (i -> a -> m b) -> Indexed i a (m b)
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed i -> a -> m b
cmd)
{-# 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 :: (Indexed i a (WrappedMonad m b) -> s -> WrappedMonad m t)
-> s -> (i -> a -> m b) -> m t
iforMOf = ((i -> a -> m b) -> s -> m t) -> s -> (i -> a -> m b) -> m t
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((i -> a -> m b) -> s -> m t) -> s -> (i -> a -> m b) -> m t)
-> ((Indexed i a (WrappedMonad m b) -> s -> WrappedMonad m t)
    -> (i -> a -> m b) -> s -> m t)
-> (Indexed i a (WrappedMonad m b) -> s -> WrappedMonad m t)
-> s
-> (i -> a -> m b)
-> m t
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Indexed i a (WrappedMonad m b) -> s -> WrappedMonad m t)
-> (i -> a -> m b) -> s -> m t
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 :: Over (Indexed i) (Backwards (State acc)) s t a b
-> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
imapAccumROf = Over (Indexed i) (State acc) s t a b
-> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
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
 -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t))
-> (Over (Indexed i) (Backwards (State acc)) s t a b
    -> Over (Indexed i) (State acc) s t a b)
-> Over (Indexed i) (Backwards (State acc)) s t a b
-> (i -> acc -> a -> (acc, b))
-> acc
-> s
-> (acc, t)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Over (Indexed i) (Backwards (State acc)) s t a b
-> Over (Indexed i) (State acc) s t a b
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 :: Over (Indexed i) (State acc) s t a b
-> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
imapAccumLOf l :: Over (Indexed i) (State acc) s t a b
l f :: i -> acc -> a -> (acc, b)
f acc0 :: acc
acc0 s :: s
s = (t, acc) -> (acc, t)
forall a b. (a, b) -> (b, a)
swap (State acc t -> acc -> (t, acc)
forall s a. State s a -> s -> (a, s)
runState (Over (Indexed i) (State acc) s t a b
l ((i -> a -> StateT acc Identity b)
-> Indexed i a (StateT acc Identity b)
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
i a :: a
a = (acc -> (b, acc)) -> StateT acc Identity b
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((acc -> (b, acc)) -> StateT acc Identity b)
-> (acc -> (b, acc)) -> StateT acc Identity b
forall a b. (a -> b) -> a -> b
$ \acc :: acc
acc -> (acc, b) -> (b, 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 :: IndexedTraversal Int (f a) (f b) a b
traversed = ((p ~ (->)) => (a -> f b) -> f a -> f (f b))
-> (p a (f b) -> f a -> f (f b)) -> p a (f b) -> f a -> f (f b)
forall (p :: * -> * -> *) (q :: * -> * -> *) a b r.
Conjoined p =>
((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r
conjoined (p ~ (->)) => (a -> f b) -> f a -> f (f b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (((a -> Indexing f b) -> f a -> Indexing f (f b))
-> p a (f b) -> f a -> f (f b)
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 (a -> Indexing f b) -> f a -> Indexing f (f b)
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 :: (Int -> a -> b) -> [a] -> [b]
imapList f :: Int -> a -> b
f = Int -> [a] -> [b]
go 0
  where
    go :: Int -> [a] -> [b]
go i :: Int
i (x :: a
x:xs :: [a]
xs) = Int -> a -> b
f Int
i a
x b -> [b] -> [b]
forall a. a -> [a] -> [a]
: Int -> [a] -> [b]
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) [a]
xs
    go _ []     = []
{-# 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 :: IndexedTraversal1 Int (f a) (f b) a b
traversed1 = ((p ~ (->)) => (a -> f b) -> f a -> f (f b))
-> (p a (f b) -> f a -> f (f b)) -> p a (f b) -> f a -> f (f b)
forall (p :: * -> * -> *) (q :: * -> * -> *) a b r.
Conjoined p =>
((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r
conjoined (p ~ (->)) => (a -> f b) -> f a -> f (f b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
traverse1 (((a -> Indexing f b) -> f a -> Indexing f (f b))
-> p a (f b) -> f a -> f (f b)
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 (a -> Indexing f b) -> f a -> Indexing f (f b)
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 :: IndexedTraversal Int64 (f a) (f b) a b
traversed64 = ((p ~ (->)) => (a -> f b) -> f a -> f (f b))
-> (p a (f b) -> f a -> f (f b)) -> p a (f b) -> f a -> f (f b)
forall (p :: * -> * -> *) (q :: * -> * -> *) a b r.
Conjoined p =>
((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r
conjoined (p ~ (->)) => (a -> f b) -> f a -> f (f b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (((a -> Indexing64 f b) -> f a -> Indexing64 f (f b))
-> p a (f b) -> f a -> f (f b)
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 (a -> Indexing64 f b) -> f a -> Indexing64 f (f b)
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 :: pafb -> s -> f s
ignored _ = s -> f s
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 where
  traverseMin :: p v (f v) -> IntMap v -> f (IntMap v)
traverseMin f :: p v (f v)
f m :: IntMap v
m = case IntMap v -> Maybe ((Int, v), IntMap v)
forall a. IntMap a -> Maybe ((Int, a), IntMap a)
IntMap.minViewWithKey IntMap v
m of
#if MIN_VERSION_containers(0,5,0)
    Just ((k :: Int
k,a :: v
a), _) -> p v (f v) -> Int -> v -> f 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 f v -> (v -> IntMap v) -> f (IntMap v)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \v :: v
v -> (v -> Maybe v) -> IntMap v -> IntMap v
forall a. (a -> Maybe a) -> IntMap a -> IntMap a
IntMap.updateMin (Maybe v -> v -> Maybe v
forall a b. a -> b -> a
const (v -> Maybe v
forall a. a -> Maybe a
Just v
v)) IntMap v
m
#else
    Just ((k,a), _) -> indexed f k a <&> \v -> IntMap.updateMin (const v) m
#endif
    Nothing     -> IntMap v -> f (IntMap v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure IntMap v
m
  {-# INLINE traverseMin #-}

instance Ord k => TraverseMin k (Map k) where
  traverseMin :: p v (f v) -> Map k v -> f (Map k v)
traverseMin f :: p v (f v)
f m :: Map k v
m = case Map k v -> Maybe ((k, v), Map k v)
forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.minViewWithKey Map k v
m of
    Just ((k :: k
k, a :: v
a), _) -> p v (f v) -> k -> v -> f 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 f v -> (v -> Map k v) -> f (Map k v)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \v :: v
v -> (v -> Maybe v) -> Map k v -> Map k v
forall a k. (a -> Maybe a) -> Map k a -> Map k a
Map.updateMin (Maybe v -> v -> Maybe v
forall a b. a -> b -> a
const (v -> Maybe v
forall a. a -> Maybe a
Just v
v)) Map k v
m
    Nothing          -> Map k v -> f (Map k v)
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 where
  traverseMax :: p v (f v) -> IntMap v -> f (IntMap v)
traverseMax f :: p v (f v)
f m :: IntMap v
m = case IntMap v -> Maybe ((Int, v), IntMap v)
forall a. IntMap a -> Maybe ((Int, a), IntMap a)
IntMap.maxViewWithKey IntMap v
m of
#if MIN_VERSION_containers(0,5,0)
    Just ((k :: Int
k,a :: v
a), _) -> p v (f v) -> Int -> v -> f 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 f v -> (v -> IntMap v) -> f (IntMap v)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \v :: v
v -> (v -> Maybe v) -> IntMap v -> IntMap v
forall a. (a -> Maybe a) -> IntMap a -> IntMap a
IntMap.updateMax (Maybe v -> v -> Maybe v
forall a b. a -> b -> a
const (v -> Maybe v
forall a. a -> Maybe a
Just v
v)) IntMap v
m
#else
    Just ((k,a), _) -> indexed f k a <&> \v -> IntMap.updateMax (const v) m
#endif
    Nothing     -> IntMap v -> f (IntMap v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure IntMap v
m
  {-# INLINE traverseMax #-}

instance Ord k => TraverseMax k (Map k) where
  traverseMax :: p v (f v) -> Map k v -> f (Map k v)
traverseMax f :: p v (f v)
f m :: Map k v
m = case Map k v -> Maybe ((k, v), Map k v)
forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.maxViewWithKey Map k v
m of
    Just ((k :: k
k, a :: v
a), _) -> p v (f v) -> k -> v -> f 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 f v -> (v -> Map k v) -> f (Map k v)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \v :: v
v -> (v -> Maybe v) -> Map k v -> Map k v
forall a k. (a -> Maybe a) -> Map k a -> Map k a
Map.updateMax (Maybe v -> v -> Maybe v
forall a b. a -> b -> a
const (v -> Maybe v
forall a. a -> Maybe a
Just v
v)) Map k v
m
    Nothing          -> Map k v -> f (Map k v)
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 :: LensLike (Indexing f) s t a a
-> Int -> IndexedLensLike Int f s t a a
elementOf l :: LensLike (Indexing f) s t a a
l p :: Int
p = LensLike (Indexing f) s t a a
-> (Int -> Bool) -> IndexedLensLike Int f s t a a
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 Int -> Int -> Bool
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 :: Int -> IndexedTraversal' Int (t a) a
element = LensLike (Indexing f) (t a) (t a) a a
-> Int -> IndexedLensLike Int f (t a) (t a) a a
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) (t a) (t a) a a
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
{-# 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 :: LensLike (Indexing f) s t a a
-> (Int -> Bool) -> IndexedLensLike Int f s t a a
elementsOf l :: LensLike (Indexing f) s t a a
l p :: Int -> Bool
p iafb :: p a (f a)
iafb s :: s
s = (Int, f t) -> f t
forall a b. (a, b) -> b
snd ((Int, f t) -> f t) -> (Int, f t) -> f t
forall a b. (a -> b) -> a -> b
$ Indexing f t -> Int -> (Int, f t)
forall (f :: * -> *) a. Indexing f a -> Int -> (Int, f a)
runIndexing (LensLike (Indexing f) s t a a
l (\a :: a
a -> (Int -> (Int, f a)) -> Indexing f a
forall (f :: * -> *) a. (Int -> (Int, f a)) -> Indexing f a
Indexing (\i :: Int
i -> Int
i Int -> (Int, f a) -> (Int, f a)
forall a b. a -> b -> b
`seq` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1, if Int -> Bool
p Int
i then p a (f a) -> Int -> a -> f a
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 a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a))) s
s) 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 :: (Int -> Bool) -> IndexedTraversal' Int (t a) a
elements = LensLike (Indexing f) (t a) (t a) a a
-> (Int -> Bool) -> IndexedLensLike Int f (t a) (t a) a a
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) (t a) (t a) a a
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
{-# 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 :: LensLike ((,) Any) s t a b -> (a -> b) -> s -> m t
failover l :: LensLike ((,) Any) s t a b
l afb :: a -> b
afb s :: s
s = case LensLike ((,) Any) s t a b
l ((,) (Bool -> Any
Any Bool
True) (b -> (Any, b)) -> (a -> b) -> a -> (Any, b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> b
afb) s
s of
  (Any True, t :: t
t)  -> t -> m t
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
t
  (Any False, _) -> m t
forall (f :: * -> *) a. Alternative f => f a
Applicative.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 :: Over (Indexed i) ((,) Any) s t a b -> (i -> a -> b) -> s -> m t
ifailover l :: Over (Indexed i) ((,) Any) s t a b
l iafb :: i -> a -> b
iafb s :: s
s = case Over (Indexed i) ((,) Any) s t a b
l ((,) (Bool -> Any
Any Bool
True) (b -> (Any, b)) -> Indexed i a b -> Indexed i a (Any, b)
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
`rmap` (i -> a -> b) -> Indexed i a b
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed i -> a -> b
iafb) s
s of
  (Any True, t :: t
t) -> t -> m t
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
t
  (Any False, _) -> m t
forall (f :: * -> *) a. Alternative f => f a
Applicative.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 :: Traversing p f s t a b -> Over p f s t a b -> Over p f s t a b
failing l :: Traversing p f s t a b
l r :: Over p f s t a b
r pafb :: p a (f b)
pafb s :: s
s = case BazaarT p f a b t -> [Corep p a]
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
  _  -> p a (f b) -> BazaarT p f a b t -> f t
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 p a (BazaarT p f a b b)
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 :: LensLike f s t s t -> Traversing p f s t a b -> Over p f s t a b
deepOf r :: LensLike f s t s t
r l :: Traversing p f s t a b
l = Traversing p f s t a b -> Over p f s t a b -> Over p f s t a b
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 LensLike f s t s t -> Over p f s t a b -> Over p f s t a b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. LensLike f s t s t -> Traversing p f s t a b -> Over p f s t a b
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 :: LensLike (Curried (Yoneda f) (Yoneda f)) s t a b
-> LensLike f s t a b
confusing t :: LensLike (Curried (Yoneda f) (Yoneda f)) s t a b
t = \f :: a -> f b
f -> Yoneda f t -> f t
forall (f :: * -> *) a. Yoneda f a -> f a
lowerYoneda (Yoneda f t -> f t) -> (s -> Yoneda f t) -> s -> f t
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Curried (Yoneda f) (Yoneda f) t -> Yoneda f t
forall (f :: * -> *) (g :: * -> *) a.
Applicative f =>
Curried f g a -> g a
lowerCurried (Curried (Yoneda f) (Yoneda f) t -> Yoneda f t)
-> (s -> Curried (Yoneda f) (Yoneda f) t) -> s -> Yoneda f t
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. LensLike (Curried (Yoneda f) (Yoneda f)) s t a b
t (f b -> Curried (Yoneda f) (Yoneda f) b
forall (f :: * -> *) a.
Applicative f =>
f a -> Curried (Yoneda f) (Yoneda f) a
liftCurriedYoneda (f b -> Curried (Yoneda f) (Yoneda f) b)
-> (a -> f b) -> a -> Curried (Yoneda f) (Yoneda f) b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> f b
f)
  where
  liftCurriedYoneda :: Applicative f => f a -> Curried (Yoneda f) (Yoneda f) a
  liftCurriedYoneda :: f a -> Curried (Yoneda f) (Yoneda f) a
liftCurriedYoneda fa :: f a
fa = (forall r. Yoneda f (a -> r) -> Yoneda f r)
-> Curried (Yoneda f) (Yoneda f) a
forall (g :: * -> *) (h :: * -> *) a.
(forall r. g (a -> r) -> h r) -> Curried g h a
Curried (Yoneda f (a -> r) -> f a -> Yoneda f r
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 :: Yoneda f (a -> b) -> f a -> Yoneda f b
yap (Yoneda k :: forall b. ((a -> b) -> b) -> f b
k) fa :: f a
fa = (forall b. (b -> b) -> f b) -> Yoneda f b
forall (f :: * -> *) a. (forall b. (a -> b) -> f b) -> Yoneda f a
Yoneda (\ab_r :: b -> b
ab_r -> ((a -> b) -> a -> b) -> f (a -> b)
forall b. ((a -> b) -> b) -> f b
k (b -> b
ab_r (b -> b) -> (a -> b) -> a -> b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.) f (a -> b) -> f a -> f b
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 :: 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 l :: Traversal s t a b
l pur :: forall x. x -> f x
pur app :: forall x y. f (x -> y) -> f x -> f y
app f :: a -> f b
f = (forall x. x -> f x)
-> (forall x y. f (x -> y) -> f x -> f y)
-> (forall s.
    Reifies s (ReifiedApplicative f) =>
    s -> ReflectedApplicative f s t)
-> s
-> f t
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 ((a -> ReflectedApplicative f s b)
-> s -> ReflectedApplicative f s t
Traversal s t a b
l (f b -> ReflectedApplicative f s b
forall k k1 (f :: k -> *) (s :: k1) (a :: k).
f a -> ReflectedApplicative f s a
ReflectedApplicative (f b -> ReflectedApplicative f s b)
-> (a -> f b) -> a -> ReflectedApplicative f s b
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 :: 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 l :: Traversal s t (f b) b
l pur :: forall x. x -> f x
pur app :: forall x y. f (x -> y) -> f x -> f y
app = (forall x. x -> f x)
-> (forall x y. f (x -> y) -> f x -> f y)
-> (forall s.
    Reifies s (ReifiedApplicative f) =>
    s -> ReflectedApplicative f s t)
-> s
-> f t
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 ((f b -> ReflectedApplicative f s b)
-> s -> ReflectedApplicative f s t
Traversal s t (f b) b
l f b -> ReflectedApplicative f s b
forall k k1 (f :: k -> *) (s :: k1) (a :: k).
f a -> ReflectedApplicative f s a
ReflectedApplicative)