{-# LANGUAGE CPP                    #-}
{-# LANGUAGE BangPatterns           #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs                  #-}
{-# LANGUAGE TypeOperators          #-}
{-# LANGUAGE UndecidableInstances   #-}

{-# LANGUAGE CPP         #-}
#if __GLASGOW_HASKELL__ >= 704
{-# LANGUAGE Safe        #-}
#elif __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif

#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE DefaultSignatures      #-}
#endif

#if __GLASGOW_HASKELL__ >= 706
{-# LANGUAGE PolyKinds #-}
#endif
module WithIndex where

import Prelude
       (Either (..), Functor (..), Int, Maybe (..), Monad (..), Num (..), error,
       flip, id, seq, snd, ($!), ($), (.))

import Control.Applicative
       (Applicative (..), Const (..), ZipList (..), (<$>), liftA2)
import Control.Applicative.Backwards (Backwards (..))
import Control.Monad.Trans.Identity  (IdentityT (..))
import Control.Monad.Trans.Reader    (ReaderT (..))
import Data.Array                    (Array)
import Data.Foldable                 (Foldable (..))
import Data.Foldable1                (Foldable1 (..))
import Data.Functor.Compose          (Compose (..))
import Data.Functor.Constant         (Constant (..))
import Data.Functor.Identity         (Identity (..))
import Data.Functor.Product          (Product (..))
import Data.Functor.Reverse          (Reverse (..))
import Data.Functor.Sum              (Sum (..))
import Data.IntMap                   (IntMap)
import Data.Ix                       (Ix (..))
import Data.List.NonEmpty            (NonEmpty (..))
import Data.Map                      (Map)
import Data.Monoid                   (Dual (..), Endo (..), Monoid (..))
import Data.Proxy                    (Proxy (..))
import Data.Semigroup                (Semigroup (..))
import Data.Sequence                 (Seq)
import Data.Traversable              (Traversable (..))
import Data.Tree                     (Tree (..))
import Data.Void                     (Void)

#if __GLASGOW_HASKELL__ >= 702
import GHC.Generics
       (K1 (..), Par1 (..), Rec1 (..), U1 (..), V1, (:*:) (..), (:+:) (..),
       (:.:) (..))
#else
import Generics.Deriving
       (K1 (..), Par1 (..), Rec1 (..), U1 (..), V1, (:*:) (..), (:+:) (..),
       (:.:) (..))
#endif

import qualified Data.Array    as Array
import qualified Data.IntMap   as IntMap
import qualified Data.Map      as Map
import qualified Data.Sequence as Seq

#ifdef MIN_VERSION_base_orphans
import Data.Orphans ()
#endif

import CoerceCompat

-------------------------------------------------------------------------------
-- FunctorWithIndex
-------------------------------------------------------------------------------

-- | A 'Functor' with an additional index.
--
-- Instances must satisfy a modified form of the 'Functor' laws:
--
-- @
-- 'imap' f '.' 'imap' g ≡ 'imap' (\\i -> f i '.' g i)
-- 'imap' (\\_ a -> a) ≡ 'id'
-- @
class Functor f => FunctorWithIndex i f | f -> i where
  -- | Map with access to the index.
  imap :: (i -> a -> b) -> f a -> f b

#if __GLASGOW_HASKELL__ >= 704
  default imap :: TraversableWithIndex i f => (i -> a -> b) -> f a -> f b
  imap = forall i (f :: * -> *) a b.
TraversableWithIndex i f =>
(i -> a -> b) -> f a -> f b
imapDefault
  {-# INLINE imap #-}
#endif

imapDefault :: TraversableWithIndex i f => (i -> a -> b) -> f a -> f b
-- imapDefault f = runIdentity #. itraverse (\i a -> Identity (f i a))
imapDefault :: forall i (f :: * -> *) a b.
TraversableWithIndex i f =>
(i -> a -> b) -> f a -> f b
imapDefault i -> a -> b
f = forall a. Identity a -> a
runIdentity forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse (forall a. a -> Identity a
Identity forall b c i a.
Coercible b c =>
(b -> c) -> (i -> a -> b) -> i -> a -> c
#.. i -> a -> b
f)
{-# INLINE imapDefault #-}

-------------------------------------------------------------------------------
-- FoldableWithIndex
-------------------------------------------------------------------------------

-- | A container that supports folding with an additional index.
class Foldable f => FoldableWithIndex i f | f -> i where
  --
  -- | Fold a container by mapping value to an arbitrary 'Monoid' with access to the index @i@.
  --
  -- When you don't need access to the index then 'foldMap' is more flexible in what it accepts.
  --
  -- @
  -- 'foldMap' ≡ 'ifoldMap' '.' 'const'
  -- @
  ifoldMap :: Monoid m => (i -> a -> m) -> f a -> m

#if __GLASGOW_HASKELL__ >= 704
  default ifoldMap :: (TraversableWithIndex i f, Monoid m) => (i -> a -> m) -> f a -> m
  ifoldMap = forall i (f :: * -> *) m a.
(TraversableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMapDefault
  {-# INLINE ifoldMap #-}
#endif

  -- | A variant of 'ifoldMap' that is strict in the accumulator.
  --
  -- When you don't need access to the index then 'Data.Foldable.foldMap'' is more flexible in what it accepts.
  --
  -- @
  -- 'foldMap'' ≡ 'ifoldMap'' '.' 'const'
  -- @
  ifoldMap' :: Monoid m => (i -> a -> m) -> f a -> m
  ifoldMap' i -> a -> m
f = forall i (f :: * -> *) b a.
FoldableWithIndex i f =>
(i -> b -> a -> b) -> b -> f a -> b
ifoldl' (\i
i m
acc a
a -> forall a. Monoid a => a -> a -> a
mappend m
acc (i -> a -> m
f i
i a
a)) forall a. Monoid a => a
mempty
  {-# INLINE ifoldMap' #-}

  -- | Right-associative fold of an indexed container with access to the index @i@.
  --
  -- When you don't need access to the index then 'Data.Foldable.foldr' is more flexible in what it accepts.
  --
  -- @
  -- 'Data.Foldable.foldr' ≡ 'ifoldr' '.' 'const'
  -- @
  ifoldr   :: (i -> a -> b -> b) -> b -> f a -> b
  ifoldr i -> a -> b -> b
f b
z f a
t = forall a. Endo a -> a -> a
appEndo (forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap (forall a. (a -> a) -> Endo a
Endo forall b c i a.
Coercible b c =>
(b -> c) -> (i -> a -> b) -> i -> a -> c
#.. i -> a -> b -> b
f) f a
t) b
z
  {-# INLINE ifoldr #-}

  -- | Left-associative fold of an indexed container with access to the index @i@.
  --
  -- When you don't need access to the index then 'Data.Foldable.foldl' is more flexible in what it accepts.
  --
  -- @
  -- 'Data.Foldable.foldl' ≡ 'ifoldl' '.' 'const'
  -- @
  ifoldl :: (i -> b -> a -> b) -> b -> f a -> b
  ifoldl i -> b -> a -> b
f b
z f a
t = forall a. Endo a -> a -> a
appEndo (forall a. Dual a -> a
getDual (forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap (\ i
i -> forall a. a -> Dual a
Dual forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall a. (a -> a) -> Endo a
Endo forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall a b c. (a -> b -> c) -> b -> a -> c
flip (i -> b -> a -> b
f i
i)) f a
t)) b
z
  {-# INLINE ifoldl #-}

  -- | /Strictly/ fold right over the elements of a structure with access to the index @i@.
  --
  -- When you don't need access to the index then 'foldr'' is more flexible in what it accepts.
  --
  -- @
  -- 'foldr'' ≡ 'ifoldr'' '.' 'const'
  -- @
  ifoldr' :: (i -> a -> b -> b) -> b -> f a -> b
  ifoldr' i -> a -> b -> b
f b
z0 f a
xs = forall i (f :: * -> *) b a.
FoldableWithIndex i f =>
(i -> b -> a -> b) -> b -> f a -> b
ifoldl i -> (b -> b) -> a -> b -> b
f' forall a. a -> a
id f a
xs b
z0
    where f' :: i -> (b -> b) -> a -> b -> b
f' i
i b -> b
k a
x b
z = b -> b
k forall a b. (a -> b) -> a -> b
$! i -> a -> b -> b
f i
i a
x b
z
  {-# INLINE ifoldr' #-}

  -- | Fold over the elements of a structure with an index, associating to the left, but /strictly/.
  --
  -- When you don't need access to the index then 'Control.Lens.Fold.foldlOf'' is more flexible in what it accepts.
  --
  -- @
  -- 'Data.Foldable.foldl'' l ≡ 'ifoldl'' l '.' 'const'
  -- @
  ifoldl' :: (i -> b -> a -> b) -> b -> f a -> b
  ifoldl' i -> b -> a -> b
f b
z0 f a
xs = forall i (f :: * -> *) a b.
FoldableWithIndex i f =>
(i -> a -> b -> b) -> b -> f a -> b
ifoldr i -> a -> (b -> b) -> b -> b
f' forall a. a -> a
id f a
xs b
z0
    where f' :: i -> a -> (b -> b) -> b -> b
f' i
i a
x b -> b
k b
z = b -> b
k forall a b. (a -> b) -> a -> b
$! i -> b -> a -> b
f i
i b
z a
x
  {-# INLINE ifoldl' #-}

ifoldMapDefault :: (TraversableWithIndex i f, Monoid m) => (i -> a -> m) -> f a -> m
ifoldMapDefault :: forall i (f :: * -> *) m a.
(TraversableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMapDefault i -> a -> m
f = forall {k} a (b :: k). Const a b -> a
getConst forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse (forall {k} a (b :: k). a -> Const a b
Const forall b c i a.
Coercible b c =>
(b -> c) -> (i -> a -> b) -> i -> a -> c
#.. i -> a -> m
f)
{-# INLINE ifoldMapDefault #-}

-------------------------------------------------------------------------------
-- Foldable1WithIndex
-------------------------------------------------------------------------------

-- | A non-empty container that supports folding with an additional index.
class (Foldable1 f, FoldableWithIndex i f) => Foldable1WithIndex i f | f -> i where
  -- | Map each element of the structure to a semigroup, and combine the results.
  ifoldMap1 :: Semigroup m => (i -> a -> m) -> f a -> m
  ifoldMap1 i -> a -> m
f = forall i (f :: * -> *) a b.
Foldable1WithIndex i f =>
(i -> a -> b) -> (i -> a -> b -> b) -> f a -> b
ifoldrMap1 i -> a -> m
f (\i
i a
a m
m -> i -> a -> m
f i
i a
a forall a. Semigroup a => a -> a -> a
<> m
m)

  -- | A variant of 'ifoldMap1' that is strict in the accumulator.
  ifoldMap1' :: Semigroup m => (i -> a -> m) -> f a -> m
  ifoldMap1' i -> a -> m
f = forall i (f :: * -> *) a b.
Foldable1WithIndex i f =>
(i -> a -> b) -> (i -> b -> a -> b) -> f a -> b
ifoldlMap1' i -> a -> m
f (\i
i m
m a
a -> m
m forall a. Semigroup a => a -> a -> a
<> i -> a -> m
f i
i a
a)

  -- | Generalized 'ifoldr1'.
  ifoldrMap1 :: (i -> a -> b) -> (i -> a -> b -> b) -> f a -> b
  ifoldrMap1 i -> a -> b
f i -> a -> b -> b
g f a
xs =
      forall b. FromMaybe b -> Maybe b -> b
appFromMaybe (forall i (f :: * -> *) m a.
(Foldable1WithIndex i f, Semigroup m) =>
(i -> a -> m) -> f a -> m
ifoldMap1 (forall b. (Maybe b -> b) -> FromMaybe b
FromMaybe forall b c i a.
Coercible b c =>
(b -> c) -> (i -> a -> b) -> i -> a -> c
#.. i -> a -> Maybe b -> b
h) f a
xs) forall a. Maybe a
Nothing
    where
      h :: i -> a -> Maybe b -> b
h i
i a
a Maybe b
Nothing  = i -> a -> b
f i
i a
a
      h i
i a
a (Just b
b) = i -> a -> b -> b
g i
i a
a b
b

  -- | Generalized 'ifoldl1''.
  ifoldlMap1' :: (i -> a -> b) -> (i -> b -> a -> b) -> f a -> b
  ifoldlMap1' i -> a -> b
f i -> b -> a -> b
g f a
xs =
      forall i (f :: * -> *) a b.
Foldable1WithIndex i f =>
(i -> a -> b) -> (i -> a -> b -> b) -> f a -> b
ifoldrMap1 i -> a -> SMaybe b -> b
f' i -> a -> (SMaybe b -> b) -> SMaybe b -> b
g' f a
xs forall a. SMaybe a
SNothing
    where
      -- f' :: i -> a -> SMaybe b -> b
      f' :: i -> a -> SMaybe b -> b
f' i
i a
a SMaybe b
SNothing  = i -> a -> b
f i
i a
a
      f' i
i a
a (SJust b
b) = i -> b -> a -> b
g i
i b
b a
a

      -- g' :: i -> a -> (SMaybe b -> b) -> SMaybe b -> b
      g' :: i -> a -> (SMaybe b -> b) -> SMaybe b -> b
g' i
i a
a SMaybe b -> b
x SMaybe b
SNothing  = SMaybe b -> b
x forall a b. (a -> b) -> a -> b
$! forall a. a -> SMaybe a
SJust (i -> a -> b
f i
i a
a)
      g' i
i a
a SMaybe b -> b
x (SJust b
b) = SMaybe b -> b
x forall a b. (a -> b) -> a -> b
$! forall a. a -> SMaybe a
SJust (i -> b -> a -> b
g i
i b
b a
a)

  -- | Generalized 'ifoldl1'.
  ifoldlMap1 :: (i -> a -> b) -> (i -> b -> a -> b) -> f a -> b
  ifoldlMap1 i -> a -> b
f i -> b -> a -> b
g f a
xs =
      forall b. FromMaybe b -> Maybe b -> b
appFromMaybe (forall a. Dual a -> a
getDual (forall i (f :: * -> *) m a.
(Foldable1WithIndex i f, Semigroup m) =>
(i -> a -> m) -> f a -> m
ifoldMap1 ((forall a. a -> Dual a
Dual forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. (Maybe b -> b) -> FromMaybe b
FromMaybe) forall b c i a.
Coercible b c =>
(b -> c) -> (i -> a -> b) -> i -> a -> c
#.. i -> a -> Maybe b -> b
h) f a
xs)) forall a. Maybe a
Nothing
    where
      h :: i -> a -> Maybe b -> b
h i
i a
a Maybe b
Nothing  = i -> a -> b
f i
i a
a
      h i
i a
a (Just b
b) = i -> b -> a -> b
g i
i b
b a
a

  -- | Generalized 'ifoldr1''.
  ifoldrMap1' :: (i -> a -> b) -> (i -> a -> b -> b) -> f a -> b
  ifoldrMap1' i -> a -> b
f i -> a -> b -> b
g f a
xs =
      forall i (f :: * -> *) a b.
Foldable1WithIndex i f =>
(i -> a -> b) -> (i -> b -> a -> b) -> f a -> b
ifoldlMap1 i -> a -> SMaybe b -> b
f' i -> (SMaybe b -> b) -> a -> SMaybe b -> b
g' f a
xs forall a. SMaybe a
SNothing
    where
      f' :: i -> a -> SMaybe b -> b
f' i
i a
a SMaybe b
SNothing  = i -> a -> b
f i
i a
a
      f' i
i a
a (SJust b
b) = i -> a -> b -> b
g i
i a
a b
b

      g' :: i -> (SMaybe b -> b) -> a -> SMaybe b -> b
g' i
i SMaybe b -> b
bb a
a SMaybe b
SNothing  = SMaybe b -> b
bb forall a b. (a -> b) -> a -> b
$! forall a. a -> SMaybe a
SJust (i -> a -> b
f i
i a
a)
      g' i
i SMaybe b -> b
bb a
a (SJust b
b) = SMaybe b -> b
bb forall a b. (a -> b) -> a -> b
$! forall a. a -> SMaybe a
SJust (i -> a -> b -> b
g i
i a
a b
b)

  {-# MINIMAL ifoldMap1 | ifoldrMap1 #-}

-------------------------------------------------------------------------------
-- TraversableWithIndex
-------------------------------------------------------------------------------

-- | A 'Traversable' with an additional index.
--
-- An instance must satisfy a (modified) form of the 'Traversable' laws:
--
-- @
-- 'itraverse' ('const' 'Identity') ≡ 'Identity'
-- 'fmap' ('itraverse' f) '.' 'itraverse' g ≡ 'Data.Functor.Compose.getCompose' '.' 'itraverse' (\\i -> 'Data.Functor.Compose.Compose' '.' 'fmap' (f i) '.' g i)
-- @
class (FunctorWithIndex i t, FoldableWithIndex i t, Traversable t) => TraversableWithIndex i t | t -> i where
  -- | Traverse an indexed container.
  --
  -- @
  -- 'itraverse' ≡ 'itraverseOf' 'itraversed'
  -- @
  itraverse :: Applicative f => (i -> a -> f b) -> t a -> f (t b)

#if __GLASGOW_HASKELL__ >= 704
  default itraverse :: (i ~ Int, Applicative f) => (i -> a -> f b) -> t a -> f (t b)
  itraverse i -> a -> f b
f t a
s = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k).
Indexing f a -> Int -> (Int, f a)
runIndexing (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\a
a -> forall {k} (f :: k -> *) (a :: k).
(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, i -> a -> f b
f Int
i a
a))) t a
s) Int
0
  {-# INLINE itraverse #-}
#endif

-------------------------------------------------------------------------------
-- base
-------------------------------------------------------------------------------

instance FunctorWithIndex r ((->) r) where
  imap :: forall a b. (r -> a -> b) -> (r -> a) -> r -> b
imap r -> a -> b
f r -> a
g r
x = r -> a -> b
f r
x (r -> a
g r
x)
  {-# INLINE imap #-}

instance FunctorWithIndex () Maybe where
  imap :: forall a b. (() -> a -> b) -> Maybe a -> Maybe b
imap () -> a -> b
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> a -> b
f ())
  {-# INLINE imap #-}
instance FoldableWithIndex () Maybe where
  ifoldMap :: forall m a. Monoid m => (() -> a -> m) -> Maybe a -> m
ifoldMap () -> a -> m
f = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (() -> a -> m
f ())
  {-# INLINE ifoldMap #-}
instance TraversableWithIndex () Maybe where
  itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(() -> a -> f b) -> Maybe a -> f (Maybe b)
itraverse () -> a -> f b
f = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (() -> a -> f b
f ())
  {-# INLINE itraverse #-}

instance FunctorWithIndex Void Proxy where
  imap :: forall a b. (Void -> a -> b) -> Proxy a -> Proxy b
imap Void -> a -> b
_ Proxy a
Proxy = forall {k} (t :: k). Proxy t
Proxy
  {-# INLINE imap #-}

instance FoldableWithIndex Void Proxy where
  ifoldMap :: forall m a. Monoid m => (Void -> a -> m) -> Proxy a -> m
ifoldMap Void -> a -> m
_ Proxy a
_ = forall a. Monoid a => a
mempty
  {-# INLINE ifoldMap #-}

instance TraversableWithIndex Void Proxy where
  itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(Void -> a -> f b) -> Proxy a -> f (Proxy b)
itraverse Void -> a -> f b
_ Proxy a
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (t :: k). Proxy t
Proxy
  {-# INLINE itraverse #-}

instance FunctorWithIndex k ((,) k) where
  imap :: forall a b. (k -> a -> b) -> (k, a) -> (k, b)
imap k -> a -> b
f (k
k,a
a) = (k
k, k -> a -> b
f k
k a
a)
  {-# INLINE imap #-}

instance FoldableWithIndex k ((,) k) where
  ifoldMap :: forall m a. Monoid m => (k -> a -> m) -> (k, a) -> m
ifoldMap = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry'
  {-# INLINE ifoldMap #-}

instance TraversableWithIndex k ((,) k) where
  itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(k -> a -> f b) -> (k, a) -> f (k, b)
itraverse k -> a -> f b
f (k
k, a
a) = (,) k
k forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> a -> f b
f k
k a
a
  {-# INLINE itraverse #-}

-- | The position in the list is available as the index.
instance FunctorWithIndex Int [] where
  imap :: forall a b. (Int -> a -> b) -> [a] -> [b]
imap Int -> a -> b
f = Int -> [a] -> [b]
go Int
0 where
    go :: Int -> [a] -> [b]
go !Int
_ []     = []
    go !Int
n (a
x:[a]
xs) = Int -> a -> b
f Int
n a
x forall a. a -> [a] -> [a]
: Int -> [a] -> [b]
go (Int
n forall a. Num a => a -> a -> a
+ Int
1) [a]
xs
  {-# INLINE imap #-}
instance FoldableWithIndex Int [] where
  ifoldMap :: forall m a. Monoid m => (Int -> a -> m) -> [a] -> m
ifoldMap = forall m a. Monoid m => Int -> (Int -> a -> m) -> [a] -> m
ifoldMapListOff Int
0
  {-# INLINE ifoldMap #-}
  ifoldr :: forall a b. (Int -> a -> b -> b) -> b -> [a] -> b
ifoldr = forall a b. Int -> (Int -> a -> b -> b) -> b -> [a] -> b
ifoldrListOff Int
0
  {-# INLINE ifoldr #-}
  ifoldl' :: forall b a. (Int -> b -> a -> b) -> b -> [a] -> b
ifoldl' = forall b a. Int -> (Int -> b -> a -> b) -> b -> [a] -> b
ifoldl'ListOff Int
0
instance TraversableWithIndex Int [] where
  itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(Int -> a -> f b) -> [a] -> f [b]
itraverse = forall (f :: * -> *) a b.
Applicative f =>
Int -> (Int -> a -> f b) -> [a] -> f [b]
itraverseListOff Int
0
  {-# INLINE itraverse #-}

ifoldMapListOff :: Monoid m => Int -> (Int -> a -> m) -> [a] -> m
ifoldMapListOff :: forall m a. Monoid m => Int -> (Int -> a -> m) -> [a] -> m
ifoldMapListOff Int
off Int -> a -> m
f = forall a b. Int -> (Int -> a -> b -> b) -> b -> [a] -> b
ifoldrListOff Int
off (\Int
i a
x m
acc -> forall a. Monoid a => a -> a -> a
mappend (Int -> a -> m
f Int
i a
x) m
acc) forall a. Monoid a => a
mempty

ifoldrListOff :: Int -> (Int -> a -> b -> b) -> b -> [a] -> b
ifoldrListOff :: forall a b. Int -> (Int -> a -> b -> b) -> b -> [a] -> b
ifoldrListOff !Int
_   Int -> a -> b -> b
_ b
z []     = b
z
ifoldrListOff !Int
off Int -> a -> b -> b
f b
z (a
x:[a]
xs) = Int -> a -> b -> b
f Int
off a
x (forall a b. Int -> (Int -> a -> b -> b) -> b -> [a] -> b
ifoldrListOff (Int
off forall a. Num a => a -> a -> a
+ Int
1) Int -> a -> b -> b
f b
z [a]
xs)

ifoldl'ListOff :: Int -> (Int -> b -> a -> b) -> b -> [a] -> b
ifoldl'ListOff :: forall b a. Int -> (Int -> b -> a -> b) -> b -> [a] -> b
ifoldl'ListOff !Int
_   Int -> b -> a -> b
_ !b
z []     = b
z
ifoldl'ListOff !Int
off Int -> b -> a -> b
f !b
z (a
x:[a]
xs) = forall b a. Int -> (Int -> b -> a -> b) -> b -> [a] -> b
ifoldl'ListOff (Int
off forall a. Num a => a -> a -> a
+ Int
1) Int -> b -> a -> b
f (Int -> b -> a -> b
f Int
off b
z a
x) [a]
xs

-- traverse (uncurry' f) . zip [0..] seems to not work well:
-- https://gitlab.haskell.org/ghc/ghc/-/issues/22673
itraverseListOff :: Applicative f => Int -> (Int -> a -> f b) -> [a] -> f [b]
itraverseListOff :: forall (f :: * -> *) a b.
Applicative f =>
Int -> (Int -> a -> f b) -> [a] -> f [b]
itraverseListOff !Int
_   Int -> a -> f b
_ []     = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
itraverseListOff !Int
off Int -> a -> f b
f (a
x:[a]
xs) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) (Int -> a -> f b
f Int
off a
x) (forall (f :: * -> *) a b.
Applicative f =>
Int -> (Int -> a -> f b) -> [a] -> f [b]
itraverseListOff (Int
off forall a. Num a => a -> a -> a
+ Int
1) Int -> a -> f b
f [a]
xs)

-- TODO: we could experiment with streaming framework
-- imapListFB f xs = build (\c n -> ifoldr (\i a -> c (f i a)) n xs)

-- | Same instance as for @[]@.
instance FunctorWithIndex Int ZipList where
  imap :: forall a b. (Int -> a -> b) -> ZipList a -> ZipList b
imap Int -> a -> b
f (ZipList [a]
xs) = forall a. [a] -> ZipList a
ZipList (forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap Int -> a -> b
f [a]
xs)
  {-# INLINE imap #-}
instance FoldableWithIndex Int ZipList where
  ifoldMap :: forall m a. Monoid m => (Int -> a -> m) -> ZipList a -> m
ifoldMap Int -> a -> m
f (ZipList [a]
xs) = forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap Int -> a -> m
f [a]
xs
  {-# INLINE ifoldMap #-}
instance TraversableWithIndex Int ZipList where
  itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(Int -> a -> f b) -> ZipList a -> f (ZipList b)
itraverse Int -> a -> f b
f (ZipList [a]
xs) = forall a. [a] -> ZipList a
ZipList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse Int -> a -> f b
f [a]
xs
  {-# INLINE itraverse #-}

-------------------------------------------------------------------------------
-- (former) semigroups
-------------------------------------------------------------------------------

instance FunctorWithIndex Int NonEmpty where
  imap :: forall a b. (Int -> a -> b) -> NonEmpty a -> NonEmpty b
imap = forall i (f :: * -> *) a b.
TraversableWithIndex i f =>
(i -> a -> b) -> f a -> f b
imapDefault
  {-# INLINE imap #-}
instance FoldableWithIndex Int NonEmpty where
  ifoldMap :: forall m a. Monoid m => (Int -> a -> m) -> NonEmpty a -> m
ifoldMap Int -> a -> m
f (a
x :| [a]
xs) = forall a. Monoid a => a -> a -> a
mappend (Int -> a -> m
f Int
0 a
x) (forall m a. Monoid m => Int -> (Int -> a -> m) -> [a] -> m
ifoldMapListOff Int
1 Int -> a -> m
f [a]
xs)
  ifoldr :: forall a b. (Int -> a -> b -> b) -> b -> NonEmpty a -> b
ifoldr Int -> a -> b -> b
f b
z (a
x :| [a]
xs) = Int -> a -> b -> b
f Int
0 a
x (forall a b. Int -> (Int -> a -> b -> b) -> b -> [a] -> b
ifoldrListOff Int
1 Int -> a -> b -> b
f b
z [a]
xs)
  ifoldl' :: forall b a. (Int -> b -> a -> b) -> b -> NonEmpty a -> b
ifoldl' Int -> b -> a -> b
f b
z (a
x :| [a]
xs) = forall b a. Int -> (Int -> b -> a -> b) -> b -> [a] -> b
ifoldl'ListOff Int
1 Int -> b -> a -> b
f (Int -> b -> a -> b
f Int
0 b
z a
x) [a]
xs
  {-# INLINE ifoldMap #-}
instance Foldable1WithIndex Int NonEmpty where
  ifoldMap1 :: forall m a. Semigroup m => (Int -> a -> m) -> NonEmpty a -> m
ifoldMap1 Int -> a -> m
f (a
x :| [a]
xs) = Int -> m -> [a] -> m
go Int
1 (Int -> a -> m
f Int
0 a
x) [a]
xs where
        go :: Int -> m -> [a] -> m
go Int
_ m
y [] = m
y
        go Int
i m
y (a
z : [a]
zs) = m
y forall a. Semigroup a => a -> a -> a
<> Int -> m -> [a] -> m
go (Int
i forall a. Num a => a -> a -> a
+ Int
1) (Int -> a -> m
f Int
i a
z) [a]
zs
  ifoldMap1' :: forall m a. Semigroup m => (Int -> a -> m) -> NonEmpty a -> m
ifoldMap1' Int -> a -> m
f (a
x :| [a]
xs) = forall b a. Int -> (Int -> b -> a -> b) -> b -> [a] -> b
ifoldl'ListOff Int
1 (\Int
i m
m a
y -> m
m forall a. Semigroup a => a -> a -> a
<> Int -> a -> m
f Int
i a
y) (Int -> a -> m
f Int
0 a
x) [a]
xs
  ifoldrMap1 :: forall a b.
(Int -> a -> b) -> (Int -> a -> b -> b) -> NonEmpty a -> b
ifoldrMap1 Int -> a -> b
f Int -> a -> b -> b
g (a
x :| [a]
xs) = Int -> a -> [a] -> b
go Int
0 a
x [a]
xs where
    go :: Int -> a -> [a] -> b
go Int
i a
y [] = Int -> a -> b
f Int
i a
y
    go Int
i a
y (a
z : [a]
zs) = Int -> a -> b -> b
g Int
i a
y (Int -> a -> [a] -> b
go (Int
i forall a. Num a => a -> a -> a
+ Int
1) a
z [a]
zs)
  ifoldlMap1' :: forall a b.
(Int -> a -> b) -> (Int -> b -> a -> b) -> NonEmpty a -> b
ifoldlMap1' Int -> a -> b
f Int -> b -> a -> b
g (a
x :| [a]
xs) = forall b a. Int -> (Int -> b -> a -> b) -> b -> [a] -> b
ifoldl'ListOff Int
1 Int -> b -> a -> b
g (Int -> a -> b
f Int
0 a
x) [a]
xs
instance TraversableWithIndex Int NonEmpty where
  itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(Int -> a -> f b) -> NonEmpty a -> f (NonEmpty b)
itraverse Int -> a -> f b
f ~(a
a :| [a]
as) =
    forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. a -> [a] -> NonEmpty a
(:|) (Int -> a -> f b
f Int
0 a
a) (forall (f :: * -> *) a b.
Applicative f =>
Int -> (Int -> a -> f b) -> [a] -> f [b]
itraverseListOff Int
1 Int -> a -> f b
f [a]
as)
  {-# INLINE itraverse #-}

-------------------------------------------------------------------------------
-- Functors (formely) from transformers
-------------------------------------------------------------------------------

instance FunctorWithIndex () Identity where
  imap :: forall a b. (() -> a -> b) -> Identity a -> Identity b
imap () -> a -> b
f (Identity a
a) = forall a. a -> Identity a
Identity (() -> a -> b
f () a
a)
  {-# INLINE imap #-}

instance FoldableWithIndex () Identity where
  ifoldMap :: forall m a. Monoid m => (() -> a -> m) -> Identity a -> m
ifoldMap () -> a -> m
f (Identity a
a) = () -> a -> m
f () a
a
  {-# INLINE ifoldMap #-}

instance TraversableWithIndex () Identity where
  itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(() -> a -> f b) -> Identity a -> f (Identity b)
itraverse () -> a -> f b
f (Identity a
a) = forall a. a -> Identity a
Identity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> () -> a -> f b
f () a
a
  {-# INLINE itraverse #-}

instance FunctorWithIndex Void (Const e) where
  imap :: forall a b. (Void -> a -> b) -> Const e a -> Const e b
imap Void -> a -> b
_ (Const e
a) = forall {k} a (b :: k). a -> Const a b
Const e
a
  {-# INLINE imap #-}

instance FoldableWithIndex Void (Const e) where
  ifoldMap :: forall m a. Monoid m => (Void -> a -> m) -> Const e a -> m
ifoldMap Void -> a -> m
_ Const e a
_ = forall a. Monoid a => a
mempty
  {-# INLINE ifoldMap #-}

instance TraversableWithIndex Void (Const e) where
  itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(Void -> a -> f b) -> Const e a -> f (Const e b)
itraverse Void -> a -> f b
_ (Const e
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall {k} a (b :: k). a -> Const a b
Const e
a)
  {-# INLINE itraverse #-}

instance FunctorWithIndex Void (Constant e) where
  imap :: forall a b. (Void -> a -> b) -> Constant e a -> Constant e b
imap Void -> a -> b
_ (Constant e
a) = forall {k} a (b :: k). a -> Constant a b
Constant e
a
  {-# INLINE imap #-}

instance FoldableWithIndex Void (Constant e) where
  ifoldMap :: forall m a. Monoid m => (Void -> a -> m) -> Constant e a -> m
ifoldMap Void -> a -> m
_ Constant e a
_ = forall a. Monoid a => a
mempty
  {-# INLINE ifoldMap #-}

instance TraversableWithIndex Void (Constant e) where
  itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(Void -> a -> f b) -> Constant e a -> f (Constant e b)
itraverse Void -> a -> f b
_ (Constant e
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall {k} a (b :: k). a -> Constant a b
Constant e
a)
  {-# INLINE itraverse #-}

instance (FunctorWithIndex i f, FunctorWithIndex j g) => FunctorWithIndex (i, j) (Compose f g) where
  imap :: forall a b. ((i, j) -> a -> b) -> Compose f g a -> Compose f g b
imap (i, j) -> a -> b
f (Compose f (g a)
fg) = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall a b. (a -> b) -> a -> b
$ forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (\i
k -> forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap ((i, j) -> a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) i
k)) f (g a)
fg
  {-# INLINE imap #-}

instance (FoldableWithIndex i f, FoldableWithIndex j g) => FoldableWithIndex (i, j) (Compose f g) where
  ifoldMap :: forall m a. Monoid m => ((i, j) -> a -> m) -> Compose f g a -> m
ifoldMap (i, j) -> a -> m
f (Compose f (g a)
fg) = forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap (\i
k -> forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap ((i, j) -> a -> m
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) i
k)) f (g a)
fg
  {-# INLINE ifoldMap #-}

instance (TraversableWithIndex i f, TraversableWithIndex j g) => TraversableWithIndex (i, j) (Compose f g) where
  itraverse :: forall (f :: * -> *) a b.
Applicative f =>
((i, j) -> a -> f b) -> Compose f g a -> f (Compose f g b)
itraverse (i, j) -> a -> f b
f (Compose f (g a)
fg) = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse (\i
k -> forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse ((i, j) -> a -> f b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) i
k)) f (g a)
fg
  {-# INLINE itraverse #-}

instance (FunctorWithIndex i f, FunctorWithIndex j g) => FunctorWithIndex (Either i j) (Sum f g) where
  imap :: forall a b. (Either i j -> a -> b) -> Sum f g a -> Sum f g b
imap Either i j -> a -> b
q (InL f a
fa) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL (forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (Either i j -> a -> b
q forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left)  f a
fa)
  imap Either i j -> a -> b
q (InR g a
ga) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR (forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (Either i j -> a -> b
q forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) g a
ga)
  {-# INLINE imap #-}

instance (FoldableWithIndex i f, FoldableWithIndex j g) => FoldableWithIndex (Either i j) (Sum f g) where
  ifoldMap :: forall m a. Monoid m => (Either i j -> a -> m) -> Sum f g a -> m
ifoldMap Either i j -> a -> m
q (InL f a
fa) = forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap (Either i j -> a -> m
q forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left)  f a
fa
  ifoldMap Either i j -> a -> m
q (InR g a
ga) = forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap (Either i j -> a -> m
q forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) g a
ga
  {-# INLINE ifoldMap #-}

instance (TraversableWithIndex i f, TraversableWithIndex j g) => TraversableWithIndex (Either i j) (Sum f g) where
  itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(Either i j -> a -> f b) -> Sum f g a -> f (Sum f g b)
itraverse Either i j -> a -> f b
q (InL f a
fa) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse (Either i j -> a -> f b
q forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left)  f a
fa
  itraverse Either i j -> a -> f b
q (InR g a
ga) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse (Either i j -> a -> f b
q forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) g a
ga
  {-# INLINE itraverse #-}

instance (FunctorWithIndex i f, FunctorWithIndex j g) => FunctorWithIndex (Either i j) (Product f g) where
  imap :: forall a b.
(Either i j -> a -> b) -> Product f g a -> Product f g b
imap Either i j -> a -> b
f (Pair f a
a g a
b) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair (forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (Either i j -> a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) f a
a) (forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (Either i j -> a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) g a
b)
  {-# INLINE imap #-}

instance (FoldableWithIndex i f, FoldableWithIndex j g) => FoldableWithIndex (Either i j) (Product f g) where
  ifoldMap :: forall m a.
Monoid m =>
(Either i j -> a -> m) -> Product f g a -> m
ifoldMap Either i j -> a -> m
f (Pair f a
a g a
b) = forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap (Either i j -> a -> m
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) f a
a forall a. Monoid a => a -> a -> a
`mappend` forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap (Either i j -> a -> m
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) g a
b
  {-# INLINE ifoldMap #-}

instance (TraversableWithIndex i f, TraversableWithIndex j g) => TraversableWithIndex (Either i j) (Product f g) where
  itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(Either i j -> a -> f b) -> Product f g a -> f (Product f g b)
itraverse Either i j -> a -> f b
f (Pair f a
a g a
b) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair (forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse (Either i j -> a -> f b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) f a
a) (forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse (Either i j -> a -> f b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) g a
b)
  {-# INLINE itraverse #-}

-------------------------------------------------------------------------------
-- transformers
-------------------------------------------------------------------------------

instance FunctorWithIndex i m => FunctorWithIndex i (IdentityT m) where
  imap :: forall a b. (i -> a -> b) -> IdentityT m a -> IdentityT m b
imap i -> a -> b
f (IdentityT m a
m) = forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT forall a b. (a -> b) -> a -> b
$ forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap i -> a -> b
f m a
m
  {-# INLINE imap #-}

instance FoldableWithIndex i m => FoldableWithIndex i (IdentityT m) where
  ifoldMap :: forall m a. Monoid m => (i -> a -> m) -> IdentityT m a -> m
ifoldMap i -> a -> m
f (IdentityT m a
m) = forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap i -> a -> m
f m a
m
  {-# INLINE ifoldMap #-}

instance TraversableWithIndex i m => TraversableWithIndex i (IdentityT m) where
  itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(i -> a -> f b) -> IdentityT m a -> f (IdentityT m b)
itraverse i -> a -> f b
f (IdentityT m a
m) = forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse i -> a -> f b
f m a
m
  {-# INLINE itraverse #-}

instance FunctorWithIndex i m => FunctorWithIndex (e, i) (ReaderT e m) where
  imap :: forall a b. ((e, i) -> a -> b) -> ReaderT e m a -> ReaderT e m b
imap (e, i) -> a -> b
f (ReaderT e -> m a
m) = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \e
k -> forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap ((e, i) -> a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) e
k) (e -> m a
m e
k)
  {-# INLINE imap #-}

instance FunctorWithIndex i f => FunctorWithIndex i (Backwards f) where
  imap :: forall a b. (i -> a -> b) -> Backwards f a -> Backwards f b
imap i -> a -> b
f  = forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap i -> a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). Backwards f a -> f a
forwards
  {-# INLINE imap #-}

instance FoldableWithIndex i f => FoldableWithIndex i (Backwards f) where
  ifoldMap :: forall m a. Monoid m => (i -> a -> m) -> Backwards f a -> m
ifoldMap i -> a -> m
f = forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap i -> a -> m
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). Backwards f a -> f a
forwards
  {-# INLINE ifoldMap #-}

instance TraversableWithIndex i f => TraversableWithIndex i (Backwards f) where
  itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(i -> a -> f b) -> Backwards f a -> f (Backwards f b)
itraverse i -> a -> f b
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse i -> a -> f b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). Backwards f a -> f a
forwards
  {-# INLINE itraverse #-}

instance FunctorWithIndex i f => FunctorWithIndex i (Reverse f) where
  imap :: forall a b. (i -> a -> b) -> Reverse f a -> Reverse f b
imap i -> a -> b
f = forall {k} (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap i -> a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). Reverse f a -> f a
getReverse
  {-# INLINE imap #-}

instance FoldableWithIndex i f => FoldableWithIndex i (Reverse f) where
  ifoldMap :: forall m a. Monoid m => (i -> a -> m) -> Reverse f a -> m
ifoldMap i -> a -> m
f = forall a. Dual a -> a
getDual forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap (forall a. a -> Dual a
Dual forall b c i a.
Coercible b c =>
(b -> c) -> (i -> a -> b) -> i -> a -> c
#.. i -> a -> m
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). Reverse f a -> f a
getReverse
  {-# INLINE ifoldMap #-}

instance TraversableWithIndex i f => TraversableWithIndex i (Reverse f) where
  itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(i -> a -> f b) -> Reverse f a -> f (Reverse f b)
itraverse i -> a -> f b
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). Backwards f a -> f a
forwards forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse (forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards forall b c i a.
Coercible b c =>
(b -> c) -> (i -> a -> b) -> i -> a -> c
#.. i -> a -> f b
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). Reverse f a -> f a
getReverse
  {-# INLINE itraverse #-}

-------------------------------------------------------------------------------
-- array
-------------------------------------------------------------------------------

instance Ix i => FunctorWithIndex i (Array i) where
  imap :: forall a b. (i -> a -> b) -> Array i a -> Array i b
imap i -> a -> b
f Array i a
arr = forall i e. Ix i => (i, i) -> [e] -> Array i e
Array.listArray (forall i e. Array i e -> (i, i)
Array.bounds Array i a
arr) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry' i -> a -> b
f) forall a b. (a -> b) -> a -> b
$ forall i e. Ix i => Array i e -> [(i, e)]
Array.assocs Array i a
arr
  {-# INLINE imap #-}

instance Ix i => FoldableWithIndex i (Array i) where
  ifoldMap :: forall m a. Monoid m => (i -> a -> m) -> Array i a -> m
ifoldMap i -> a -> m
f = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry' i -> a -> m
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i e. Ix i => Array i e -> [(i, e)]
Array.assocs
  {-# INLINE ifoldMap #-}

instance Ix i => TraversableWithIndex i (Array i) where
  itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(i -> a -> f b) -> Array i a -> f (Array i b)
itraverse i -> a -> f b
f Array i a
arr = forall i e. Ix i => (i, i) -> [e] -> Array i e
Array.listArray (forall i e. Array i e -> (i, i)
Array.bounds Array i a
arr) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry' i -> a -> f b
f) (forall i e. Ix i => Array i e -> [(i, e)]
Array.assocs Array i a
arr)
  {-# INLINE itraverse #-}

-------------------------------------------------------------------------------
-- containers
-------------------------------------------------------------------------------

instance FunctorWithIndex [Int] Tree where
  imap :: forall a b. ([Int] -> a -> b) -> Tree a -> Tree b
imap [Int] -> a -> b
f (Node a
a [Tree a]
as) = forall a. a -> [Tree a] -> Tree a
Node ([Int] -> a -> b
f [] a
a) forall a b. (a -> b) -> a -> b
$ forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (\Int
i -> forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap ([Int] -> a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Int
i)) [Tree a]
as
  {-# INLINE imap #-}

instance FoldableWithIndex [Int] Tree where
  ifoldMap :: forall m a. Monoid m => ([Int] -> a -> m) -> Tree a -> m
ifoldMap [Int] -> a -> m
f (Node a
a [Tree a]
as) = [Int] -> a -> m
f [] a
a forall a. Monoid a => a -> a -> a
`mappend` forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap (\Int
i -> forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap ([Int] -> a -> m
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Int
i)) [Tree a]
as
  {-# INLINE ifoldMap #-}

instance TraversableWithIndex [Int] Tree where
  itraverse :: forall (f :: * -> *) a b.
Applicative f =>
([Int] -> a -> f b) -> Tree a -> f (Tree b)
itraverse [Int] -> a -> f b
f (Node a
a [Tree a]
as) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. a -> [Tree a] -> Tree a
Node ([Int] -> a -> f b
f [] a
a) (forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse (\Int
i -> forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse ([Int] -> a -> f b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Int
i)) [Tree a]
as)
  {-# INLINE itraverse #-}
--
-- | The position in the 'Seq' is available as the index.
instance FunctorWithIndex Int Seq where
  imap :: forall a b. (Int -> a -> b) -> Seq a -> Seq b
imap = forall a b. (Int -> a -> b) -> Seq a -> Seq b
Seq.mapWithIndex
  {-# INLINE imap #-}
instance FoldableWithIndex Int Seq where
#if MIN_VERSION_containers(0,5,8)
  ifoldMap :: forall m a. Monoid m => (Int -> a -> m) -> Seq a -> m
ifoldMap = forall m a. Monoid m => (Int -> a -> m) -> Seq a -> m
Seq.foldMapWithIndex
#else
  ifoldMap f = Data.Foldable.fold . Seq.mapWithIndex f
#endif
  {-# INLINE ifoldMap #-}
  ifoldr :: forall a b. (Int -> a -> b -> b) -> b -> Seq a -> b
ifoldr = forall a b. (Int -> a -> b -> b) -> b -> Seq a -> b
Seq.foldrWithIndex
  {-# INLINE ifoldr #-}
  ifoldl :: forall b a. (Int -> b -> a -> b) -> b -> Seq a -> b
ifoldl Int -> b -> a -> b
f = forall b a. (b -> Int -> a -> b) -> b -> Seq a -> b
Seq.foldlWithIndex (forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> b -> a -> b
f)
  {-# INLINE ifoldl #-}
instance TraversableWithIndex Int Seq where
#if MIN_VERSION_containers(0,6,0)
  itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(Int -> a -> f b) -> Seq a -> f (Seq b)
itraverse = forall (f :: * -> *) a b.
Applicative f =>
(Int -> a -> f b) -> Seq a -> f (Seq b)
Seq.traverseWithIndex
#else
  -- Much faster than Seq.traverseWithIndex for containers < 0.6.0, see
  -- https://github.com/haskell/containers/issues/603.
  itraverse f = sequenceA . Seq.mapWithIndex f
#endif
  {-# INLINE itraverse #-}

instance FunctorWithIndex Int IntMap where
  imap :: forall a b. (Int -> a -> b) -> IntMap a -> IntMap b
imap = forall a b. (Int -> a -> b) -> IntMap a -> IntMap b
IntMap.mapWithKey
  {-# INLINE imap #-}

instance FoldableWithIndex Int IntMap where
#if MIN_VERSION_containers(0,5,4)
  ifoldMap :: forall m a. Monoid m => (Int -> a -> m) -> IntMap a -> m
ifoldMap = forall m a. Monoid m => (Int -> a -> m) -> IntMap a -> m
IntMap.foldMapWithKey
#else
  ifoldMap = ifoldMapDefault
#endif
  {-# INLINE ifoldMap #-}
#if MIN_VERSION_containers(0,5,0)
  ifoldr :: forall a b. (Int -> a -> b -> b) -> b -> IntMap a -> b
ifoldr   = forall a b. (Int -> a -> b -> b) -> b -> IntMap a -> b
IntMap.foldrWithKey
  ifoldl' :: forall b a. (Int -> b -> a -> b) -> b -> IntMap a -> b
ifoldl'  = forall a b. (a -> Int -> b -> a) -> a -> IntMap b -> a
IntMap.foldlWithKey' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip
  {-# INLINE ifoldr #-}
  {-# INLINE ifoldl' #-}
#endif

instance TraversableWithIndex Int IntMap where
#if MIN_VERSION_containers(0,5,0)
  itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(Int -> a -> f b) -> IntMap a -> f (IntMap b)
itraverse = forall (f :: * -> *) a b.
Applicative f =>
(Int -> a -> f b) -> IntMap a -> f (IntMap b)
IntMap.traverseWithKey
#else
  itraverse f = sequenceA . IntMap.mapWithKey f
#endif
  {-# INLINE itraverse #-}

instance FunctorWithIndex k (Map k) where
  imap :: forall a b. (k -> a -> b) -> Map k a -> Map k b
imap = forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey
  {-# INLINE imap #-}

instance FoldableWithIndex k (Map k) where
#if MIN_VERSION_containers(0,5,4)
  ifoldMap :: forall m a. Monoid m => (k -> a -> m) -> Map k a -> m
ifoldMap = forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey
#else
  ifoldMap = ifoldMapDefault
#endif
  {-# INLINE ifoldMap #-}
#if MIN_VERSION_containers(0,5,0)
  ifoldr :: forall a b. (k -> a -> b -> b) -> b -> Map k a -> b
ifoldr   = forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey
  ifoldl' :: forall b a. (k -> b -> a -> b) -> b -> Map k a -> b
ifoldl'  = forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip
  {-# INLINE ifoldr #-}
  {-# INLINE ifoldl' #-}
#endif

instance TraversableWithIndex k (Map k) where
#if MIN_VERSION_containers(0,5,0)
  itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(k -> a -> f b) -> Map k a -> f (Map k b)
itraverse = forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
Map.traverseWithKey
#else
  itraverse f = sequenceA . Map.mapWithKey f
#endif
  {-# INLINE itraverse #-}

-------------------------------------------------------------------------------
-- GHC.Generics
-------------------------------------------------------------------------------

instance FunctorWithIndex Void V1 where
  imap :: forall a b. (Void -> a -> b) -> V1 a -> V1 b
imap Void -> a -> b
_ V1 a
v = V1 a
v seq :: forall a b. a -> b -> b
`seq` forall a. HasCallStack => [Char] -> a
error [Char]
"imap @V1"
  {-# INLINE imap #-}

instance FoldableWithIndex Void V1 where
  ifoldMap :: forall m a. Monoid m => (Void -> a -> m) -> V1 a -> m
ifoldMap Void -> a -> m
_ V1 a
v = V1 a
v seq :: forall a b. a -> b -> b
`seq` forall a. HasCallStack => [Char] -> a
error [Char]
"ifoldMap @V1"

instance TraversableWithIndex Void V1 where
  itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(Void -> a -> f b) -> V1 a -> f (V1 b)
itraverse Void -> a -> f b
_ V1 a
v = V1 a
v seq :: forall a b. a -> b -> b
`seq` forall a. HasCallStack => [Char] -> a
error [Char]
"itraverse @V1"

instance FunctorWithIndex Void U1 where
  imap :: forall a b. (Void -> a -> b) -> U1 a -> U1 b
imap Void -> a -> b
_ U1 a
U1 = forall k (p :: k). U1 p
U1
  {-# INLINE imap #-}

instance FoldableWithIndex Void U1 where
  ifoldMap :: forall m a. Monoid m => (Void -> a -> m) -> U1 a -> m
ifoldMap Void -> a -> m
_ U1 a
_ = forall a. Monoid a => a
mempty
  {-# INLINE ifoldMap #-}

instance TraversableWithIndex Void U1 where
  itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(Void -> a -> f b) -> U1 a -> f (U1 b)
itraverse Void -> a -> f b
_ U1 a
U1 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall k (p :: k). U1 p
U1
  {-# INLINE itraverse #-}

instance FunctorWithIndex () Par1 where
  imap :: forall a b. (() -> a -> b) -> Par1 a -> Par1 b
imap () -> a -> b
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> a -> b
f ())
  {-# INLINE imap #-}

instance FoldableWithIndex () Par1 where
  ifoldMap :: forall m a. Monoid m => (() -> a -> m) -> Par1 a -> m
ifoldMap () -> a -> m
f (Par1 a
a) = () -> a -> m
f () a
a
  {-# INLINE ifoldMap #-}

instance TraversableWithIndex () Par1 where
  itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(() -> a -> f b) -> Par1 a -> f (Par1 b)
itraverse () -> a -> f b
f (Par1 a
a) = forall p. p -> Par1 p
Par1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> () -> a -> f b
f () a
a
  {-# INLINE itraverse #-}

instance (FunctorWithIndex i f, FunctorWithIndex j g) => FunctorWithIndex (i, j) (f :.: g) where
  imap :: forall a b. ((i, j) -> a -> b) -> (:.:) f g a -> (:.:) f g b
imap (i, j) -> a -> b
q (Comp1 f (g a)
fga) = forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 (forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (\i
k -> forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap ((i, j) -> a -> b
q forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) i
k)) f (g a)
fga)
  {-# INLINE imap #-}

instance (FoldableWithIndex i f, FoldableWithIndex j g) => FoldableWithIndex (i, j) (f :.: g) where
  ifoldMap :: forall m a. Monoid m => ((i, j) -> a -> m) -> (:.:) f g a -> m
ifoldMap (i, j) -> a -> m
q (Comp1 f (g a)
fga) = forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap (\i
k -> forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap ((i, j) -> a -> m
q forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) i
k)) f (g a)
fga
  {-# INLINE ifoldMap #-}

instance (TraversableWithIndex i f, TraversableWithIndex j g) => TraversableWithIndex (i, j) (f :.: g) where
  itraverse :: forall (f :: * -> *) a b.
Applicative f =>
((i, j) -> a -> f b) -> (:.:) f g a -> f ((:.:) f g b)
itraverse (i, j) -> a -> f b
q (Comp1 f (g a)
fga) = forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse (\i
k -> forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse ((i, j) -> a -> f b
q forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) i
k)) f (g a)
fga
  {-# INLINE itraverse #-}

instance (FunctorWithIndex i f, FunctorWithIndex j g) => FunctorWithIndex (Either i j) (f :*: g) where
  imap :: forall a b. (Either i j -> a -> b) -> (:*:) f g a -> (:*:) f g b
imap Either i j -> a -> b
q (f a
fa :*: g a
ga) = forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (Either i j -> a -> b
q forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) f a
fa forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (Either i j -> a -> b
q forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) g a
ga
  {-# INLINE imap #-}

instance (FoldableWithIndex i f, FoldableWithIndex j g) => FoldableWithIndex (Either i j) (f :*: g) where
  ifoldMap :: forall m a. Monoid m => (Either i j -> a -> m) -> (:*:) f g a -> m
ifoldMap Either i j -> a -> m
q (f a
fa :*: g a
ga) = forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap (Either i j -> a -> m
q forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) f a
fa forall a. Monoid a => a -> a -> a
`mappend` forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap (Either i j -> a -> m
q forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) g a
ga
  {-# INLINE ifoldMap #-}

instance (TraversableWithIndex i f, TraversableWithIndex j g) => TraversableWithIndex (Either i j) (f :*: g) where
  itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(Either i j -> a -> f b) -> (:*:) f g a -> f ((:*:) f g b)
itraverse Either i j -> a -> f b
q (f a
fa :*: g a
ga) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse (Either i j -> a -> f b
q forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) f a
fa) (forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse (Either i j -> a -> f b
q forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) g a
ga)
  {-# INLINE itraverse #-}

instance (FunctorWithIndex i f, FunctorWithIndex j g) => FunctorWithIndex (Either i j) (f :+: g) where
  imap :: forall a b. (Either i j -> a -> b) -> (:+:) f g a -> (:+:) f g b
imap Either i j -> a -> b
q (L1 f a
fa) = forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (Either i j -> a -> b
q forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) f a
fa)
  imap Either i j -> a -> b
q (R1 g a
ga) = forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (Either i j -> a -> b
q forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) g a
ga)
  {-# INLINE imap #-}

instance (FoldableWithIndex i f, FoldableWithIndex j g) => FoldableWithIndex (Either i j) (f :+: g) where
  ifoldMap :: forall m a. Monoid m => (Either i j -> a -> m) -> (:+:) f g a -> m
ifoldMap Either i j -> a -> m
q (L1 f a
fa) = forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap (Either i j -> a -> m
q forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) f a
fa
  ifoldMap Either i j -> a -> m
q (R1 g a
ga) = forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap (Either i j -> a -> m
q forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) g a
ga
  {-# INLINE ifoldMap #-}

instance (TraversableWithIndex i f, TraversableWithIndex j g) => TraversableWithIndex (Either i j) (f :+: g) where
  itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(Either i j -> a -> f b) -> (:+:) f g a -> f ((:+:) f g b)
itraverse Either i j -> a -> f b
q (L1 f a
fa) = forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse (Either i j -> a -> f b
q forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) f a
fa
  itraverse Either i j -> a -> f b
q (R1 g a
ga) = forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse (Either i j -> a -> f b
q forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) g a
ga
  {-# INLINE itraverse #-}

instance FunctorWithIndex i f => FunctorWithIndex i (Rec1 f) where
  imap :: forall a b. (i -> a -> b) -> Rec1 f a -> Rec1 f b
imap i -> a -> b
q (Rec1 f a
f) = forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Rec1 (forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap i -> a -> b
q f a
f)
  {-# INLINE imap #-}

instance FoldableWithIndex i f => FoldableWithIndex i (Rec1 f) where
  ifoldMap :: forall m a. Monoid m => (i -> a -> m) -> Rec1 f a -> m
ifoldMap i -> a -> m
q (Rec1 f a
f) = forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap i -> a -> m
q f a
f
  {-# INLINE ifoldMap #-}

instance TraversableWithIndex i f => TraversableWithIndex i (Rec1 f) where
  itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(i -> a -> f b) -> Rec1 f a -> f (Rec1 f b)
itraverse i -> a -> f b
q (Rec1 f a
f) = forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Rec1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse i -> a -> f b
q f a
f
  {-# INLINE itraverse #-}

instance FunctorWithIndex Void (K1 i c) where
  imap :: forall a b. (Void -> a -> b) -> K1 i c a -> K1 i c b
imap Void -> a -> b
_ (K1 c
c) = forall k i c (p :: k). c -> K1 i c p
K1 c
c
  {-# INLINE imap #-}

instance FoldableWithIndex Void (K1 i c) where
  ifoldMap :: forall m a. Monoid m => (Void -> a -> m) -> K1 i c a -> m
ifoldMap Void -> a -> m
_ K1 i c a
_ = forall a. Monoid a => a
mempty
  {-# INLINE ifoldMap #-}

instance TraversableWithIndex Void (K1 i c) where
  itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(Void -> a -> f b) -> K1 i c a -> f (K1 i c b)
itraverse Void -> a -> f b
_ (K1 c
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall k i c (p :: k). c -> K1 i c p
K1 c
a)
  {-# INLINE itraverse #-}

-------------------------------------------------------------------------------
-- Misc.
-------------------------------------------------------------------------------

skip :: a -> ()
skip :: forall a. a -> ()
skip a
_ = ()
{-# INLINE skip #-}

------------------------------------------------------------------------------
-- Traversed
------------------------------------------------------------------------------

-- | Used internally by 'Control.Lens.Traversal.traverseOf_' and the like.
--
-- The argument 'a' of the result should not be used!
newtype Traversed a f = Traversed { forall {k} (a :: k) (f :: k -> *). Traversed a f -> f a
getTraversed :: f a }

-- See 4.16 Changelog entry for the explanation of "why not Apply f =>"?
instance Applicative f => Semigroup (Traversed a f) where
  Traversed f a
ma <> :: Traversed a f -> Traversed a f -> Traversed a f
<> Traversed f a
mb = forall {k} (a :: k) (f :: k -> *). f a -> Traversed a f
Traversed (f a
ma forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f a
mb)
  {-# INLINE (<>) #-}

instance Applicative f => Monoid (Traversed a f) where
  mempty :: Traversed a f
mempty = forall {k} (a :: k) (f :: k -> *). f a -> Traversed a f
Traversed (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. HasCallStack => [Char] -> a
error [Char]
"Traversed: value used"))
  {-# INLINE mempty #-}
  mappend :: Traversed a f -> Traversed a f -> Traversed a f
mappend = forall a. Semigroup a => a -> a -> a
(<>)
  {-# INLINE mappend #-}

------------------------------------------------------------------------------
-- Sequenced
------------------------------------------------------------------------------

-- | Used internally by 'Control.Lens.Traversal.mapM_' and the like.
--
-- The argument 'a' of the result should not be used!
--
-- See 4.16 Changelog entry for the explanation of "why not Apply f =>"?
newtype Sequenced a m = Sequenced { forall {k} (a :: k) (m :: k -> *). Sequenced a m -> m a
getSequenced :: m a }

instance Monad m => Semigroup (Sequenced a m) where
  Sequenced m a
ma <> :: Sequenced a m -> Sequenced a m -> Sequenced a m
<> Sequenced m a
mb = forall {k} (a :: k) (m :: k -> *). m a -> Sequenced a m
Sequenced (m a
ma forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m a
mb)
  {-# INLINE (<>) #-}

instance Monad m => Monoid (Sequenced a m) where
  mempty :: Sequenced a m
mempty = forall {k} (a :: k) (m :: k -> *). m a -> Sequenced a m
Sequenced (forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. HasCallStack => [Char] -> a
error [Char]
"Sequenced: value used"))
  {-# INLINE mempty #-}
  mappend :: Sequenced a m -> Sequenced a m -> Sequenced a m
mappend = forall a. Semigroup a => a -> a -> a
(<>)
  {-# INLINE mappend #-}

------------------------------------------------------------------------------
-- 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 {k} (f :: k -> *) (a :: k).
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 {k} (f :: k -> *) (a :: k).
(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 Applicative f => Applicative (Indexing f) where
  pure :: forall a. a -> Indexing f a
pure a
x = forall {k} (f :: k -> *) (a :: k).
(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 {k} (f :: k -> *) (a :: k).
(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 (<*>) #-}
#if __GLASGOW_HASKELL__ >=821
  liftA2 :: forall a b c.
(a -> b -> c) -> Indexing f a -> Indexing f b -> Indexing f c
liftA2 a -> b -> c
f (Indexing Int -> (Int, f a)
ma) (Indexing Int -> (Int, f b)
mb) = forall {k} (f :: k -> *) (a :: k).
(Int -> (Int, f a)) -> Indexing f a
Indexing forall a b. (a -> b) -> a -> b
$ \ Int
i -> case Int -> (Int, f a)
ma Int
i of
     (Int
j, f a
ja) -> case Int -> (Int, f b)
mb Int
j of
        ~(Int
k, f b
kb) -> (Int
k, forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f f a
ja f b
kb)
  {-# INLINE liftA2 #-}
#endif

-------------------------------------------------------------------------------
-- Strict curry
-------------------------------------------------------------------------------

uncurry' :: (a -> b -> c) -> (a, b) -> c
uncurry' :: forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry' a -> b -> c
f (a
a, b
b) = a -> b -> c
f a
a b
b
{-# INLINE uncurry' #-}

-------------------------------------------------------------------------------
-- FromMaybe & SMaybe
-------------------------------------------------------------------------------

-- | Used for foldrMap1 and foldlMap1 definitions
newtype FromMaybe b = FromMaybe { forall b. FromMaybe b -> Maybe b -> b
appFromMaybe :: Maybe b -> b }

instance Semigroup (FromMaybe b) where
    FromMaybe Maybe b -> b
f <> :: FromMaybe b -> FromMaybe b -> FromMaybe b
<> FromMaybe Maybe b -> b
g = forall b. (Maybe b -> b) -> FromMaybe b
FromMaybe (Maybe b -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe b -> b
g)

-- | Strict maybe, used to implement default foldlMap1' etc.
data SMaybe a = SNothing | SJust !a