{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Trustworthy #-}

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

-- |

-- Module      :  Control.Lens.Internal.Indexed

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

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

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

-- Stability   :  experimental

-- Portability :  non-portable

--

-- Internal implementation details for 'Indexed' lens-likes

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

module Control.Lens.Internal.Indexed
  (
  -- * An Indexed Profunctor

    Indexed(..)
  -- * Classes

  , Conjoined(..)
  , Indexable(..)
  -- * Indexing

  , Indexing(..)
  , indexing
  -- * 64-bit Indexing

  , Indexing64(..)
  , indexing64
  -- * Converting to Folds

  , withIndex
  , asIndex
  ) where

import Prelude ()

import Control.Arrow as Arrow
import qualified Control.Category as C
import Control.Comonad
import Control.Lens.Internal.Prelude
import Control.Lens.Internal.Instances ()
import Control.Monad.Fix
import Data.Distributive
import Data.Functor.Bind
import Data.Int
import Data.Profunctor.Closed
import Data.Profunctor.Rep

-- $setup

-- >>> :set -XNoOverloadedStrings

-- >>> import Control.Lens

-- >>> import Numeric.Lens

-- >>> import Data.Semigroup (Semigroup (..))

--

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

-- Conjoined

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


-- | This is a 'Profunctor' that is both 'Corepresentable' by @f@ and 'Representable' by @g@ such

-- that @f@ is left adjoint to @g@. From this you can derive a lot of structure due

-- to the preservation of limits and colimits.

class
  ( Choice p, Corepresentable p, Comonad (Corep p), Traversable (Corep p)
  , Strong p, Representable p, Monad (Rep p), MonadFix (Rep p), Distributive (Rep p)
  , Costrong p, ArrowLoop p, ArrowApply p, ArrowChoice p, Closed p
  ) => Conjoined p where

  -- | 'Conjoined' is strong enough to let us distribute every 'Conjoined'

  -- 'Profunctor' over every Haskell 'Functor'. This is effectively a

  -- generalization of 'fmap'.

  distrib :: Functor f => p a b -> p (f a) (f b)
  distrib = forall (p :: * -> * -> *) d c.
Representable p =>
(d -> Rep p c) -> p d c
tabulate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (g :: * -> *) (f :: * -> *) a b.
(Distributive g, Functor f) =>
(a -> g b) -> f a -> g (f b)
collect forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) a b.
Sieve p f =>
p a b -> a -> f b
sieve
  {-# INLINE distrib #-}

  -- | This permits us to make a decision at an outermost point about whether or not we use an index.

  --

  -- Ideally any use of this function should be done in such a way so that you compute the same answer,

  -- but this cannot be enforced at the type level.

  conjoined :: ((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r
  conjoined (p ~ (->)) => q (a -> b) r
_ q (p a b) r
r = q (p a b) r
r
  {-# INLINE conjoined #-}

instance Conjoined (->) where
  distrib :: forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
distrib = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  {-# INLINE distrib #-}
  conjoined :: forall (q :: * -> * -> *) a b r.
(((->) ~ (->)) => q (a -> b) r) -> q (a -> b) r -> q (a -> b) r
conjoined ((->) ~ (->)) => q (a -> b) r
l q (a -> b) r
_ = ((->) ~ (->)) => q (a -> b) r
l
  {-# INLINE conjoined #-}

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

-- Indexable

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


-- | This class permits overloading of function application for things that

-- also admit a notion of a key or index.

class Conjoined p => Indexable i p where
  -- | Build a function from an 'indexed' function.

  indexed :: p a b -> i -> a -> b

instance Indexable i (->) where
  indexed :: forall a b. (a -> b) -> i -> a -> b
indexed = forall a b. a -> b -> a
const
  {-# INLINE indexed #-}

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

-- Indexed Internals

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


-- | A function with access to a index. This constructor may be useful when you need to store

-- an 'Indexable' in a container to avoid @ImpredicativeTypes@.

--

-- @index :: Indexed i a b -> i -> a -> b@

newtype Indexed i a b = Indexed { forall i a b. Indexed i a b -> i -> a -> b
runIndexed :: i -> a -> b }

instance Functor (Indexed i a) where
  fmap :: forall a b. (a -> b) -> Indexed i a a -> Indexed i a b
fmap a -> b
g (Indexed i -> a -> a
f) = forall i a b. (i -> a -> b) -> Indexed i a b
Indexed forall a b. (a -> b) -> a -> b
$ \i
i a
a -> a -> b
g (i -> a -> a
f i
i a
a)
  {-# INLINE fmap #-}

instance Apply (Indexed i a) where
  Indexed i -> a -> a -> b
f <.> :: forall a b. Indexed i a (a -> b) -> Indexed i a a -> Indexed i a b
<.> Indexed i -> a -> a
g = forall i a b. (i -> a -> b) -> Indexed i a b
Indexed forall a b. (a -> b) -> a -> b
$ \i
i a
a -> i -> a -> a -> b
f i
i a
a (i -> a -> a
g i
i a
a)
  {-# INLINE (<.>) #-}

instance Applicative (Indexed i a) where
  pure :: forall a. a -> Indexed i a a
pure a
b = forall i a b. (i -> a -> b) -> Indexed i a b
Indexed forall a b. (a -> b) -> a -> b
$ \i
_ a
_ -> a
b
  {-# INLINE pure #-}
  Indexed i -> a -> a -> b
f <*> :: forall a b. Indexed i a (a -> b) -> Indexed i a a -> Indexed i a b
<*> Indexed i -> a -> a
g = forall i a b. (i -> a -> b) -> Indexed i a b
Indexed forall a b. (a -> b) -> a -> b
$ \i
i a
a -> i -> a -> a -> b
f i
i a
a (i -> a -> a
g i
i a
a)
  {-# INLINE (<*>) #-}

instance Bind (Indexed i a) where
  Indexed i -> a -> a
f >>- :: forall a b. Indexed i a a -> (a -> Indexed i a b) -> Indexed i a b
>>- a -> Indexed i a b
k = forall i a b. (i -> a -> b) -> Indexed i a b
Indexed forall a b. (a -> b) -> a -> b
$ \i
i a
a -> forall i a b. Indexed i a b -> i -> a -> b
runIndexed (a -> Indexed i a b
k (i -> a -> a
f i
i a
a)) i
i a
a
  {-# INLINE (>>-) #-}

instance Monad (Indexed i a) where
  return :: forall a. a -> Indexed i a a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# INLINE return #-}
  Indexed i -> a -> a
f >>= :: forall a b. Indexed i a a -> (a -> Indexed i a b) -> Indexed i a b
>>= a -> Indexed i a b
k = forall i a b. (i -> a -> b) -> Indexed i a b
Indexed forall a b. (a -> b) -> a -> b
$ \i
i a
a -> forall i a b. Indexed i a b -> i -> a -> b
runIndexed (a -> Indexed i a b
k (i -> a -> a
f i
i a
a)) i
i a
a
  {-# INLINE (>>=) #-}

instance MonadFix (Indexed i a) where
  mfix :: forall a. (a -> Indexed i a a) -> Indexed i a a
mfix a -> Indexed i a a
f = forall i a b. (i -> a -> b) -> Indexed i a b
Indexed forall a b. (a -> b) -> a -> b
$ \ i
i a
a -> let o :: a
o = forall i a b. Indexed i a b -> i -> a -> b
runIndexed (a -> Indexed i a a
f a
o) i
i a
a in a
o
  {-# INLINE mfix #-}

instance Profunctor (Indexed i) where
  dimap :: forall a b c d.
(a -> b) -> (c -> d) -> Indexed i b c -> Indexed i a d
dimap a -> b
ab c -> d
cd Indexed i b c
ibc = forall i a b. (i -> a -> b) -> Indexed i a b
Indexed forall a b. (a -> b) -> a -> b
$ \i
i -> c -> d
cd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i a b. Indexed i a b -> i -> a -> b
runIndexed Indexed i b c
ibc i
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
ab
  {-# INLINE dimap #-}
  lmap :: forall a b c. (a -> b) -> Indexed i b c -> Indexed i a c
lmap a -> b
ab Indexed i b c
ibc = forall i a b. (i -> a -> b) -> Indexed i a b
Indexed forall a b. (a -> b) -> a -> b
$ \i
i -> forall i a b. Indexed i a b -> i -> a -> b
runIndexed Indexed i b c
ibc i
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
ab
  {-# INLINE lmap #-}
  rmap :: forall b c a. (b -> c) -> Indexed i a b -> Indexed i a c
rmap b -> c
bc Indexed i a b
iab = forall i a b. (i -> a -> b) -> Indexed i a b
Indexed forall a b. (a -> b) -> a -> b
$ \i
i -> b -> c
bc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i a b. Indexed i a b -> i -> a -> b
runIndexed Indexed i a b
iab i
i
  {-# INLINE rmap #-}
  .# :: forall a b c (q :: * -> * -> *).
Coercible b a =>
Indexed i b c -> q a b -> Indexed i a c
(.#) Indexed i b c
ibc q a b
_ = coerce :: forall a b. Coercible a b => a -> b
coerce Indexed i b c
ibc
  {-# INLINE (.#) #-}
  #. :: forall a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> Indexed i a b -> Indexed i a c
(#.) q b c
_ = coerce :: forall a b. Coercible a b => a -> b
coerce
  {-# INLINE (#.) #-}

instance Closed (Indexed i) where
  closed :: forall a b x. Indexed i a b -> Indexed i (x -> a) (x -> b)
closed (Indexed i -> a -> b
iab) = forall i a b. (i -> a -> b) -> Indexed i a b
Indexed forall a b. (a -> b) -> a -> b
$ \i
i x -> a
xa x
x -> i -> a -> b
iab i
i (x -> a
xa x
x)

instance Costrong (Indexed i) where
  unfirst :: forall a d b. Indexed i (a, d) (b, d) -> Indexed i a b
unfirst (Indexed i -> (a, d) -> (b, d)
iadbd) = forall i a b. (i -> a -> b) -> Indexed i a b
Indexed forall a b. (a -> b) -> a -> b
$ \i
i a
a -> let
      (b
b, d
d) = i -> (a, d) -> (b, d)
iadbd i
i (a
a, d
d)
    in b
b

instance Sieve (Indexed i) ((->) i) where
  sieve :: forall a b. Indexed i a b -> a -> i -> b
sieve = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i a b. Indexed i a b -> i -> a -> b
runIndexed
  {-# INLINE sieve #-}

instance Representable (Indexed i) where
  type Rep (Indexed i) = (->) i
  tabulate :: forall d c. (d -> Rep (Indexed i) c) -> Indexed i d c
tabulate = forall i a b. (i -> a -> b) -> Indexed i a b
Indexed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip
  {-# INLINE tabulate #-}

instance Cosieve (Indexed i) ((,) i) where
  cosieve :: forall a b. Indexed i a b -> (i, a) -> b
cosieve = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i a b. Indexed i a b -> i -> a -> b
runIndexed
  {-# INLINE cosieve #-}

instance Corepresentable (Indexed i) where
  type Corep (Indexed i) = (,) i
  cotabulate :: forall d c. (Corep (Indexed i) d -> c) -> Indexed i d c
cotabulate = forall i a b. (i -> a -> b) -> Indexed i a b
Indexed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. ((a, b) -> c) -> a -> b -> c
curry
  {-# INLINE cotabulate #-}

instance Choice (Indexed i) where
  right' :: forall a b c. Indexed i a b -> Indexed i (Either c a) (Either c b)
right' = forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either d b) (Either d c)
right
  {-# INLINE right' #-}

instance Strong (Indexed i) where
  second' :: forall a b c. Indexed i a b -> Indexed i (c, a) (c, b)
second' = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second
  {-# INLINE second' #-}

instance C.Category (Indexed i) where
  id :: forall a. Indexed i a a
id = forall i a b. (i -> a -> b) -> Indexed i a b
Indexed (forall a b. a -> b -> a
const forall a. a -> a
id)
  {-# INLINE id #-}
  Indexed i -> b -> c
f . :: forall b c a. Indexed i b c -> Indexed i a b -> Indexed i a c
. Indexed i -> a -> b
g = forall i a b. (i -> a -> b) -> Indexed i a b
Indexed forall a b. (a -> b) -> a -> b
$ \i
i -> i -> b -> c
f i
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> a -> b
g i
i
  {-# INLINE (.) #-}

instance Arrow (Indexed i) where
  arr :: forall b c. (b -> c) -> Indexed i b c
arr b -> c
f = forall i a b. (i -> a -> b) -> Indexed i a b
Indexed (\i
_ -> b -> c
f)
  {-# INLINE arr #-}
  first :: forall b c d. Indexed i b c -> Indexed i (b, d) (c, d)
first Indexed i b c
f = forall i a b. (i -> a -> b) -> Indexed i a b
Indexed (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Arrow.first forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i a b. Indexed i a b -> i -> a -> b
runIndexed Indexed i b c
f)
  {-# INLINE first #-}
  second :: forall b c d. Indexed i b c -> Indexed i (d, b) (d, c)
second Indexed i b c
f = forall i a b. (i -> a -> b) -> Indexed i a b
Indexed (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Arrow.second forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i a b. Indexed i a b -> i -> a -> b
runIndexed Indexed i b c
f)
  {-# INLINE second #-}
  Indexed i -> b -> c
f *** :: forall b c b' c'.
Indexed i b c -> Indexed i b' c' -> Indexed i (b, b') (c, c')
*** Indexed i -> b' -> c'
g = forall i a b. (i -> a -> b) -> Indexed i a b
Indexed forall a b. (a -> b) -> a -> b
$ \i
i -> i -> b -> c
f i
i forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** i -> b' -> c'
g i
i
  {-# INLINE (***) #-}
  Indexed i -> b -> c
f &&& :: forall b c c'.
Indexed i b c -> Indexed i b c' -> Indexed i b (c, c')
&&& Indexed i -> b -> c'
g = forall i a b. (i -> a -> b) -> Indexed i a b
Indexed forall a b. (a -> b) -> a -> b
$ \i
i -> i -> b -> c
f i
i forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& i -> b -> c'
g i
i
  {-# INLINE (&&&) #-}

instance ArrowChoice (Indexed i) where
  left :: forall b c d. Indexed i b c -> Indexed i (Either b d) (Either c d)
left Indexed i b c
f = forall i a b. (i -> a -> b) -> Indexed i a b
Indexed (forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i a b. Indexed i a b -> i -> a -> b
runIndexed Indexed i b c
f)
  {-# INLINE left #-}
  right :: forall b c d. Indexed i b c -> Indexed i (Either d b) (Either d c)
right Indexed i b c
f = forall i a b. (i -> a -> b) -> Indexed i a b
Indexed (forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either d b) (Either d c)
right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i a b. Indexed i a b -> i -> a -> b
runIndexed Indexed i b c
f)
  {-# INLINE right #-}
  Indexed i -> b -> c
f +++ :: forall b c b' c'.
Indexed i b c
-> Indexed i b' c' -> Indexed i (Either b b') (Either c c')
+++ Indexed i -> b' -> c'
g = forall i a b. (i -> a -> b) -> Indexed i a b
Indexed forall a b. (a -> b) -> a -> b
$ \i
i -> i -> b -> c
f i
i forall (a :: * -> * -> *) b c b' c'.
ArrowChoice a =>
a b c -> a b' c' -> a (Either b b') (Either c c')
+++ i -> b' -> c'
g i
i
  {-# INLINE (+++)  #-}
  Indexed i -> b -> d
f ||| :: forall b d c.
Indexed i b d -> Indexed i c d -> Indexed i (Either b c) d
||| Indexed i -> c -> d
g = forall i a b. (i -> a -> b) -> Indexed i a b
Indexed forall a b. (a -> b) -> a -> b
$ \i
i -> i -> b -> d
f i
i forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| i -> c -> d
g i
i
  {-# INLINE (|||) #-}

instance ArrowApply (Indexed i) where
  app :: forall b c. Indexed i (Indexed i b c, b) c
app = forall i a b. (i -> a -> b) -> Indexed i a b
Indexed forall a b. (a -> b) -> a -> b
$ \ i
i (Indexed i b c
f, b
b) -> forall i a b. Indexed i a b -> i -> a -> b
runIndexed Indexed i b c
f i
i b
b
  {-# INLINE app #-}

instance ArrowLoop (Indexed i) where
  loop :: forall b d c. Indexed i (b, d) (c, d) -> Indexed i b c
loop (Indexed i -> (b, d) -> (c, d)
f) = forall i a b. (i -> a -> b) -> Indexed i a b
Indexed forall a b. (a -> b) -> a -> b
$ \i
i b
b -> let (c
c,d
d) = i -> (b, d) -> (c, d)
f i
i (b
b, d
d) in c
c
  {-# INLINE loop #-}

instance Conjoined (Indexed i) where
  distrib :: forall (f :: * -> *) a b.
Functor f =>
Indexed i a b -> Indexed i (f a) (f b)
distrib (Indexed i -> a -> b
iab) = forall i a b. (i -> a -> b) -> Indexed i a b
Indexed forall a b. (a -> b) -> a -> b
$ \i
i f a
fa -> i -> a -> b
iab i
i forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
fa
  {-# INLINE distrib #-}

instance i ~ j => Indexable i (Indexed j) where
  indexed :: forall a b. Indexed j a b -> i -> a -> b
indexed = forall i a b. Indexed i a b -> i -> a -> b
runIndexed
  {-# INLINE indexed #-}

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

-- Indexing

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


-- | 'Applicative' composition of @'Control.Monad.Trans.State.Lazy.State' 'Int'@ with a 'Functor', used

-- by 'Control.Lens.Indexed.indexed'.

newtype Indexing f a = Indexing { forall (f :: * -> *) a. Indexing f a -> Int -> (Int, f a)
runIndexing :: Int -> (Int, f a) }

instance Functor f => Functor (Indexing f) where
  fmap :: forall a b. (a -> b) -> Indexing f a -> Indexing f b
fmap a -> b
f (Indexing Int -> (Int, f a)
m) = forall (f :: * -> *) a. (Int -> (Int, f a)) -> Indexing f a
Indexing forall a b. (a -> b) -> a -> b
$ \Int
i -> case Int -> (Int, f a)
m Int
i of
    (Int
j, f a
x) -> (Int
j, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f f a
x)
  {-# INLINE fmap #-}

instance Apply f => Apply (Indexing f) where
  Indexing Int -> (Int, f (a -> b))
mf <.> :: forall a b. Indexing f (a -> b) -> Indexing f a -> Indexing f b
<.> Indexing Int -> (Int, f a)
ma = forall (f :: * -> *) a. (Int -> (Int, f a)) -> Indexing f a
Indexing forall a b. (a -> b) -> a -> b
$ \Int
i -> case Int -> (Int, f (a -> b))
mf Int
i of
    (Int
j, f (a -> b)
ff) -> case Int -> (Int, f a)
ma Int
j of
       ~(Int
k, f a
fa) -> (Int
k, f (a -> b)
ff forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> f a
fa)
  {-# INLINE (<.>) #-}

instance Applicative f => Applicative (Indexing f) where
  pure :: forall a. a -> Indexing f a
pure a
x = forall (f :: * -> *) a. (Int -> (Int, f a)) -> Indexing f a
Indexing forall a b. (a -> b) -> a -> b
$ \Int
i -> (Int
i, forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
  {-# INLINE pure #-}
  Indexing Int -> (Int, f (a -> b))
mf <*> :: forall a b. Indexing f (a -> b) -> Indexing f a -> Indexing f b
<*> Indexing Int -> (Int, f a)
ma = forall (f :: * -> *) a. (Int -> (Int, f a)) -> Indexing f a
Indexing forall a b. (a -> b) -> a -> b
$ \Int
i -> case Int -> (Int, f (a -> b))
mf Int
i of
    (Int
j, f (a -> b)
ff) -> case Int -> (Int, f a)
ma Int
j of
       ~(Int
k, f a
fa) -> (Int
k, f (a -> b)
ff forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
fa)
  {-# INLINE (<*>) #-}

instance Contravariant f => Contravariant (Indexing f) where
  contramap :: forall a' a. (a' -> a) -> Indexing f a -> Indexing f a'
contramap a' -> a
f (Indexing Int -> (Int, f a)
m) = forall (f :: * -> *) a. (Int -> (Int, f a)) -> Indexing f a
Indexing forall a b. (a -> b) -> a -> b
$ \Int
i -> case Int -> (Int, f a)
m Int
i of
    (Int
j, f a
ff) -> (Int
j, forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap a' -> a
f f a
ff)
  {-# INLINE contramap #-}

instance Semigroup (f a) => Semigroup (Indexing f a) where
    Indexing Int -> (Int, f a)
mx <> :: Indexing f a -> Indexing f a -> Indexing f a
<> Indexing Int -> (Int, f a)
my = forall (f :: * -> *) a. (Int -> (Int, f a)) -> Indexing f a
Indexing forall a b. (a -> b) -> a -> b
$ \Int
i -> case Int -> (Int, f a)
mx Int
i of
      (Int
j, f a
x) -> case Int -> (Int, f a)
my Int
j of
         ~(Int
k, f a
y) -> (Int
k, f a
x forall a. Semigroup a => a -> a -> a
<> f a
y)
    {-# INLINE (<>) #-}

-- |

--

-- >>> "cat" ^@.. (folded <> folded)

-- [(0,'c'),(1,'a'),(2,'t'),(0,'c'),(1,'a'),(2,'t')]

--

-- >>> "cat" ^@.. indexing (folded <> folded)

-- [(0,'c'),(1,'a'),(2,'t'),(3,'c'),(4,'a'),(5,'t')]

instance Monoid (f a) => Monoid (Indexing f a) where
    mempty :: Indexing f a
mempty = forall (f :: * -> *) a. (Int -> (Int, f a)) -> Indexing f a
Indexing forall a b. (a -> b) -> a -> b
$ \Int
i -> (Int
i, forall a. Monoid a => a
mempty)
    {-# INLINE mempty #-}

#if !(MIN_VERSION_base(4,11,0))
    mappend (Indexing mx) (Indexing my) = Indexing $ \i -> case mx i of
      (j, x) -> case my j of
         ~(k, y) -> (k, mappend x y)
    {-# INLINE mappend #-}
#endif

-- | Transform a 'Control.Lens.Traversal.Traversal' into an 'Control.Lens.Traversal.IndexedTraversal' or

-- a 'Control.Lens.Fold.Fold' into an 'Control.Lens.Fold.IndexedFold', etc.

--

-- @

-- 'indexing' :: 'Control.Lens.Type.Traversal' s t a b -> 'Control.Lens.Type.IndexedTraversal' 'Int' s t a b

-- 'indexing' :: 'Control.Lens.Type.Prism' s t a b     -> 'Control.Lens.Type.IndexedTraversal' 'Int' s t a b

-- 'indexing' :: 'Control.Lens.Type.Lens' s t a b      -> 'Control.Lens.Type.IndexedLens' 'Int'  s t a b

-- 'indexing' :: 'Control.Lens.Type.Iso' s t a b       -> 'Control.Lens.Type.IndexedLens' 'Int' s t a b

-- 'indexing' :: 'Control.Lens.Type.Fold' s a          -> 'Control.Lens.Type.IndexedFold' 'Int' s a

-- 'indexing' :: 'Control.Lens.Type.Getter' s a        -> 'Control.Lens.Type.IndexedGetter' 'Int' s a

-- @

--

-- @'indexing' :: 'Indexable' 'Int' p => 'Control.Lens.Type.LensLike' ('Indexing' f) s t a b -> 'Control.Lens.Type.Over' p f s t a b@

indexing :: Indexable Int p => ((a -> Indexing f b) -> s -> Indexing f t) -> p a (f b) -> s -> f t
indexing :: 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) -> s -> Indexing f t
l p a (f b)
iafb s
s = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Indexing f a -> Int -> (Int, f a)
runIndexing ((a -> Indexing f b) -> s -> Indexing f t
l (\a
a -> forall (f :: * -> *) a. (Int -> (Int, f a)) -> Indexing f a
Indexing (\Int
i -> Int
i seq :: forall a b. a -> b -> b
`seq` (Int
i forall a. Num a => a -> a -> a
+ Int
1, forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p a (f b)
iafb Int
i a
a))) s
s) Int
0
{-# INLINE indexing #-}

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

-- Indexing64

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


-- | 'Applicative' composition of @'Control.Monad.Trans.State.Lazy.State' 'Int64'@ with a 'Functor', used

-- by 'Control.Lens.Indexed.indexed64'.

newtype Indexing64 f a = Indexing64 { forall (f :: * -> *) a. Indexing64 f a -> Int64 -> (Int64, f a)
runIndexing64 :: Int64 -> (Int64, f a) }

instance Functor f => Functor (Indexing64 f) where
  fmap :: forall a b. (a -> b) -> Indexing64 f a -> Indexing64 f b
fmap a -> b
f (Indexing64 Int64 -> (Int64, f a)
m) = forall (f :: * -> *) a. (Int64 -> (Int64, f a)) -> Indexing64 f a
Indexing64 forall a b. (a -> b) -> a -> b
$ \Int64
i -> case Int64 -> (Int64, f a)
m Int64
i of
    (Int64
j, f a
x) -> (Int64
j, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f f a
x)
  {-# INLINE fmap #-}

instance Apply f => Apply (Indexing64 f) where
  Indexing64 Int64 -> (Int64, f (a -> b))
mf <.> :: forall a b.
Indexing64 f (a -> b) -> Indexing64 f a -> Indexing64 f b
<.> Indexing64 Int64 -> (Int64, f a)
ma = forall (f :: * -> *) a. (Int64 -> (Int64, f a)) -> Indexing64 f a
Indexing64 forall a b. (a -> b) -> a -> b
$ \Int64
i -> case Int64 -> (Int64, f (a -> b))
mf Int64
i of
    (Int64
j, f (a -> b)
ff) -> case Int64 -> (Int64, f a)
ma Int64
j of
       ~(Int64
k, f a
fa) -> (Int64
k, f (a -> b)
ff forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> f a
fa)
  {-# INLINE (<.>) #-}

instance Applicative f => Applicative (Indexing64 f) where
  pure :: forall a. a -> Indexing64 f a
pure a
x = forall (f :: * -> *) a. (Int64 -> (Int64, f a)) -> Indexing64 f a
Indexing64 forall a b. (a -> b) -> a -> b
$ \Int64
i -> (Int64
i, forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
  {-# INLINE pure #-}
  Indexing64 Int64 -> (Int64, f (a -> b))
mf <*> :: forall a b.
Indexing64 f (a -> b) -> Indexing64 f a -> Indexing64 f b
<*> Indexing64 Int64 -> (Int64, f a)
ma = forall (f :: * -> *) a. (Int64 -> (Int64, f a)) -> Indexing64 f a
Indexing64 forall a b. (a -> b) -> a -> b
$ \Int64
i -> case Int64 -> (Int64, f (a -> b))
mf Int64
i of
    (Int64
j, f (a -> b)
ff) -> case Int64 -> (Int64, f a)
ma Int64
j of
       ~(Int64
k, f a
fa) -> (Int64
k, f (a -> b)
ff forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
fa)
  {-# INLINE (<*>) #-}

instance Contravariant f => Contravariant (Indexing64 f) where
  contramap :: forall a' a. (a' -> a) -> Indexing64 f a -> Indexing64 f a'
contramap a' -> a
f (Indexing64 Int64 -> (Int64, f a)
m) = forall (f :: * -> *) a. (Int64 -> (Int64, f a)) -> Indexing64 f a
Indexing64 forall a b. (a -> b) -> a -> b
$ \Int64
i -> case Int64 -> (Int64, f a)
m Int64
i of
    (Int64
j, f a
ff) -> (Int64
j, forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap a' -> a
f f a
ff)
  {-# INLINE contramap #-}

-- | Transform a 'Control.Lens.Traversal.Traversal' into an 'Control.Lens.Traversal.IndexedTraversal' or

-- a 'Control.Lens.Fold.Fold' into an 'Control.Lens.Fold.IndexedFold', etc.

--

-- This combinator is like 'indexing' except that it handles large traversals and folds gracefully.

--

-- @

-- 'indexing64' :: 'Control.Lens.Type.Traversal' s t a b -> 'Control.Lens.Type.IndexedTraversal' 'Int64' s t a b

-- 'indexing64' :: 'Control.Lens.Type.Prism' s t a b     -> 'Control.Lens.Type.IndexedTraversal' 'Int64' s t a b

-- 'indexing64' :: 'Control.Lens.Type.Lens' s t a b      -> 'Control.Lens.Type.IndexedLens' 'Int64' s t a b

-- 'indexing64' :: 'Control.Lens.Type.Iso' s t a b       -> 'Control.Lens.Type.IndexedLens' 'Int64' s t a b

-- 'indexing64' :: 'Control.Lens.Type.Fold' s a          -> 'Control.Lens.Type.IndexedFold' 'Int64' s a

-- 'indexing64' :: 'Control.Lens.Type.Getter' s a        -> 'Control.Lens.Type.IndexedGetter' 'Int64' s a

-- @

--

-- @'indexing64' :: 'Indexable' 'Int64' p => 'Control.Lens.Type.LensLike' ('Indexing64' f) s t a b -> 'Control.Lens.Type.Over' p f s t a b@

indexing64 :: Indexable Int64 p => ((a -> Indexing64 f b) -> s -> Indexing64 f t) -> p a (f b) -> s -> f t
indexing64 :: 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) -> s -> Indexing64 f t
l p a (f b)
iafb s
s = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Indexing64 f a -> Int64 -> (Int64, f a)
runIndexing64 ((a -> Indexing64 f b) -> s -> Indexing64 f t
l (\a
a -> forall (f :: * -> *) a. (Int64 -> (Int64, f a)) -> Indexing64 f a
Indexing64 (\Int64
i -> Int64
i seq :: forall a b. a -> b -> b
`seq` (Int64
i forall a. Num a => a -> a -> a
+ Int64
1, forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p a (f b)
iafb Int64
i a
a))) s
s) Int64
0
{-# INLINE indexing64 #-}

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

-- Converting to Folds

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


-- | Fold a container with indices returning both the indices and the values.

--

-- The result is only valid to compose in a 'Traversal', if you don't edit the

-- index as edits to the index have no effect.

--

-- >>> [10, 20, 30] ^.. ifolded . withIndex

-- [(0,10),(1,20),(2,30)]

--

-- >>> [10, 20, 30] ^.. ifolded . withIndex . alongside negated (re _Show)

-- [(0,"10"),(-1,"20"),(-2,"30")]

--

withIndex :: (Indexable i p, Functor f) => p (i, s) (f (j, t)) -> Indexed i s (f t)
withIndex :: forall i (p :: * -> * -> *) (f :: * -> *) s j t.
(Indexable i p, Functor f) =>
p (i, s) (f (j, t)) -> Indexed i s (f t)
withIndex p (i, s) (f (j, t))
f = forall i a b. (i -> a -> b) -> Indexed i a b
Indexed forall a b. (a -> b) -> a -> b
$ \i
i s
a -> forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p (i, s) (f (j, t))
f i
i (i
i, s
a)
{-# INLINE withIndex #-}

-- | When composed with an 'IndexedFold' or 'IndexedTraversal' this yields an

-- ('Indexed') 'Fold' of the indices.

asIndex :: (Indexable i p, Contravariant f, Functor f) => p i (f i) -> Indexed i s (f s)
asIndex :: forall i (p :: * -> * -> *) (f :: * -> *) s.
(Indexable i p, Contravariant f, Functor f) =>
p i (f i) -> Indexed i s (f s)
asIndex p i (f i)
f = forall i a b. (i -> a -> b) -> Indexed i a b
Indexed forall a b. (a -> b) -> a -> b
$ \i
i s
_ -> forall (f :: * -> *) a b.
(Functor f, Contravariant f) =>
f a -> f b
phantom (forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p i (f i)
f i
i i
i)
{-# INLINE asIndex #-}