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

#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy            #-}
{-# 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, ($!), ($), (.), zip)

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

#if __GLASGOW_HASKELL__ >=708
import Data.Coerce (Coercible, coerce)
#else
import Unsafe.Coerce (unsafeCoerce)
#endif

-------------------------------------------------------------------------------
-- 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 = (i -> a -> b) -> f a -> f b
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 :: (i -> a -> b) -> f a -> f b
imapDefault i -> a -> b
f = Identity (f b) -> f b
forall a. Identity a -> a
runIdentity (Identity (f b) -> f b) -> (f a -> Identity (f b)) -> f a -> f b
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (i -> a -> Identity b) -> f a -> Identity (f b)
forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse (b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> (i -> a -> b) -> i -> a -> Identity b
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 = (i -> a -> m) -> f a -> m
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 = (i -> m -> a -> m) -> m -> f a -> m
forall i (f :: * -> *) b a.
FoldableWithIndex i f =>
(i -> b -> a -> b) -> b -> f a -> b
ifoldl' (\i
i m
acc a
a -> m -> m -> m
forall a. Monoid a => a -> a -> a
mappend m
acc (i -> a -> m
f i
i a
a)) m
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 = Endo b -> b -> b
forall a. Endo a -> a -> a
appEndo ((i -> a -> Endo b) -> f a -> Endo b
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap ((b -> b) -> Endo b
forall a. (a -> a) -> Endo a
Endo ((b -> b) -> Endo b) -> (i -> a -> b -> b) -> i -> a -> Endo b
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 = Endo b -> b -> b
forall a. Endo a -> a -> a
appEndo (Dual (Endo b) -> Endo b
forall a. Dual a -> a
getDual ((i -> a -> Dual (Endo b)) -> f a -> Dual (Endo b)
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap (\ i
i -> Endo b -> Dual (Endo b)
forall a. a -> Dual a
Dual (Endo b -> Dual (Endo b)) -> (a -> Endo b) -> a -> Dual (Endo b)
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (b -> b) -> Endo b
forall a. (a -> a) -> Endo a
Endo ((b -> b) -> Endo b) -> (a -> b -> b) -> a -> Endo b
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (b -> a -> b) -> a -> b -> b
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 = (i -> (b -> b) -> a -> b -> b) -> (b -> b) -> f a -> b -> b
forall i (f :: * -> *) b a.
FoldableWithIndex i f =>
(i -> b -> a -> b) -> b -> f a -> b
ifoldl i -> (b -> b) -> a -> b -> b
f' b -> b
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 (b -> b) -> b -> b
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 = (i -> a -> (b -> b) -> b -> b) -> (b -> b) -> f a -> b -> b
forall i (f :: * -> *) a b.
FoldableWithIndex i f =>
(i -> a -> b -> b) -> b -> f a -> b
ifoldr i -> a -> (b -> b) -> b -> b
f' b -> b
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 (b -> b) -> b -> b
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 :: (i -> a -> m) -> f a -> m
ifoldMapDefault i -> a -> m
f = Const m (f Any) -> m
forall a k (b :: k). Const a b -> a
getConst (Const m (f Any) -> m) -> (f a -> Const m (f Any)) -> f a -> m
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (i -> a -> Const m Any) -> f a -> Const m (f Any)
forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse (m -> Const m Any
forall k a (b :: k). a -> Const a b
Const (m -> Const m Any) -> (i -> a -> m) -> i -> a -> Const m Any
forall b c i a.
Coercible b c =>
(b -> c) -> (i -> a -> b) -> i -> a -> c
#.. i -> a -> m
f)
{-# INLINE ifoldMapDefault #-}

-------------------------------------------------------------------------------
-- 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 = (Int, f (t b)) -> f (t b)
forall a b. (a, b) -> b
snd ((Int, f (t b)) -> f (t b)) -> (Int, f (t b)) -> f (t b)
forall a b. (a -> b) -> a -> b
$ Indexing f (t b) -> Int -> (Int, f (t b))
forall k (f :: k -> *) (a :: k). Indexing f a -> Int -> (Int, f a)
runIndexing ((a -> Indexing f b) -> t a -> Indexing f (t b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\a
a -> (Int -> (Int, f b)) -> Indexing f b
forall k (f :: k -> *) (a :: k).
(Int -> (Int, f a)) -> Indexing f a
Indexing (\Int
i -> Int
i Int -> (Int, f b) -> (Int, f b)
`seq` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, i -> a -> f b
f i
Int
i a
a))) t a
s) Int
0
  {-# INLINE itraverse #-}
#endif

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

instance FunctorWithIndex r ((->) r) where
  imap :: (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 :: (() -> a -> b) -> Maybe a -> Maybe b
imap () -> a -> b
f = (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> a -> b
f ())
  {-# INLINE imap #-}
instance FoldableWithIndex () Maybe where
  ifoldMap :: (() -> a -> m) -> Maybe a -> m
ifoldMap () -> a -> m
f = (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (() -> a -> m
f ())
  {-# INLINE ifoldMap #-}
instance TraversableWithIndex () Maybe where
  itraverse :: (() -> a -> f b) -> Maybe a -> f (Maybe b)
itraverse () -> a -> f b
f = (a -> f b) -> Maybe a -> f (Maybe b)
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 :: (Void -> a -> b) -> Proxy a -> Proxy b
imap Void -> a -> b
_ Proxy a
Proxy = Proxy b
forall k (t :: k). Proxy t
Proxy
  {-# INLINE imap #-}

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

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

instance FunctorWithIndex k ((,) k) where
  imap :: (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 :: (k -> a -> m) -> (k, a) -> m
ifoldMap = (k -> a -> m) -> (k, a) -> m
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry'
  {-# INLINE ifoldMap #-}

instance TraversableWithIndex k ((,) k) where
  itraverse :: (k -> a -> f b) -> (k, a) -> f (k, b)
itraverse k -> a -> f b
f (k
k, a
a) = (,) k
k (b -> (k, b)) -> f b -> f (k, b)
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 :: (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 b -> [b] -> [b]
forall a. a -> [a] -> [a]
: Int -> [a] -> [b]
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [a]
xs
  {-# INLINE imap #-}
instance FoldableWithIndex Int [] where
  ifoldMap :: (Int -> a -> m) -> [a] -> m
ifoldMap = (Int -> a -> m) -> [a] -> m
forall i (f :: * -> *) m a.
(TraversableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMapDefault
  {-# INLINE ifoldMap #-}
  ifoldr :: (Int -> a -> b -> b) -> b -> [a] -> b
ifoldr Int -> a -> b -> b
f b
z = Int -> [a] -> b
go Int
0 where
    go :: Int -> [a] -> b
go !Int
_ []     = b
z
    go !Int
n (a
x:[a]
xs) = Int -> a -> b -> b
f Int
n a
x (Int -> [a] -> b
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [a]
xs)
  {-# INLINE ifoldr #-}
instance TraversableWithIndex Int [] where
  itraverse :: (Int -> a -> f b) -> [a] -> f [b]
itraverse Int -> a -> f b
f = ((Int, a) -> f b) -> [(Int, a)] -> f [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Int -> a -> f b) -> (Int, a) -> f b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry' Int -> a -> f b
f) ([(Int, a)] -> f [b]) -> ([a] -> [(Int, a)]) -> [a] -> f [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..]
  {-# INLINE itraverse #-}

-- 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 :: (Int -> a -> b) -> ZipList a -> ZipList b
imap Int -> a -> b
f (ZipList [a]
xs) = [b] -> ZipList b
forall a. [a] -> ZipList a
ZipList ((Int -> a -> b) -> [a] -> [b]
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 :: (Int -> a -> m) -> ZipList a -> m
ifoldMap Int -> a -> m
f (ZipList [a]
xs) = (Int -> a -> m) -> [a] -> m
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 :: (Int -> a -> f b) -> ZipList a -> f (ZipList b)
itraverse Int -> a -> f b
f (ZipList [a]
xs) = [b] -> ZipList b
forall a. [a] -> ZipList a
ZipList ([b] -> ZipList b) -> f [b] -> f (ZipList b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> a -> f b) -> [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 :: (Int -> a -> b) -> NonEmpty a -> NonEmpty b
imap = (Int -> a -> b) -> NonEmpty a -> NonEmpty b
forall i (f :: * -> *) a b.
TraversableWithIndex i f =>
(i -> a -> b) -> f a -> f b
imapDefault
  {-# INLINE imap #-}
instance FoldableWithIndex Int NonEmpty where
  ifoldMap :: (Int -> a -> m) -> NonEmpty a -> m
ifoldMap = (Int -> a -> m) -> NonEmpty a -> m
forall i (f :: * -> *) m a.
(TraversableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMapDefault
  {-# INLINE ifoldMap #-}
instance TraversableWithIndex Int NonEmpty where
  itraverse :: (Int -> a -> f b) -> NonEmpty a -> f (NonEmpty b)
itraverse Int -> a -> f b
f ~(a
a :| [a]
as) =
    (b -> [b] -> NonEmpty b) -> f b -> f [b] -> f (NonEmpty b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> [b] -> NonEmpty b
forall a. a -> [a] -> NonEmpty a
(:|) (Int -> a -> f b
f Int
0 a
a) (((Int, a) -> f b) -> [(Int, a)] -> f [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Int -> a -> f b) -> (Int, a) -> f b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry' Int -> a -> f b
f) ([Int] -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [a]
as))
  {-# INLINE itraverse #-}

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

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

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

instance TraversableWithIndex () Identity where
  itraverse :: (() -> a -> f b) -> Identity a -> f (Identity b)
itraverse () -> a -> f b
f (Identity a
a) = b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> f b -> f (Identity b)
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 :: (Void -> a -> b) -> Const e a -> Const e b
imap Void -> a -> b
_ (Const e
a) = e -> Const e b
forall k a (b :: k). a -> Const a b
Const e
a
  {-# INLINE imap #-}

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

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

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

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

instance TraversableWithIndex Void (Constant e) where
  itraverse :: (Void -> a -> f b) -> Constant e a -> f (Constant e b)
itraverse Void -> a -> f b
_ (Constant e
a) = Constant e b -> f (Constant e b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (e -> Constant e b
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 :: ((i, j) -> a -> b) -> Compose f g a -> Compose f g b
imap (i, j) -> a -> b
f (Compose f (g a)
fg) = f (g b) -> Compose f g b
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (g b) -> Compose f g b) -> f (g b) -> Compose f g b
forall a b. (a -> b) -> a -> b
$ (i -> g a -> g b) -> f (g a) -> f (g b)
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (\i
k -> (j -> a -> b) -> g a -> g b
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap ((i, j) -> a -> b
f ((i, j) -> a -> b) -> (j -> (i, j)) -> j -> a -> b
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 :: ((i, j) -> a -> m) -> Compose f g a -> m
ifoldMap (i, j) -> a -> m
f (Compose f (g a)
fg) = (i -> g a -> m) -> f (g a) -> m
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap (\i
k -> (j -> a -> m) -> g a -> m
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap ((i, j) -> a -> m
f ((i, j) -> a -> m) -> (j -> (i, j)) -> j -> a -> m
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 :: ((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) = f (g b) -> Compose f g b
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (g b) -> Compose f g b) -> f (f (g b)) -> f (Compose f g b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (i -> g a -> f (g b)) -> f (g a) -> f (f (g b))
forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse (\i
k -> (j -> a -> f b) -> g a -> f (g b)
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 ((i, j) -> a -> f b) -> (j -> (i, j)) -> j -> a -> f b
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 :: (Either i j -> a -> b) -> Sum f g a -> Sum f g b
imap Either i j -> a -> b
q (InL f a
fa) = f b -> Sum f g b
forall k (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL ((i -> a -> b) -> f a -> f b
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (Either i j -> a -> b
q (Either i j -> a -> b) -> (i -> Either i j) -> i -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Either i j
forall a b. a -> Either a b
Left)  f a
fa)
  imap Either i j -> a -> b
q (InR g a
ga) = g b -> Sum f g b
forall k (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR ((j -> a -> b) -> g a -> g b
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (Either i j -> a -> b
q (Either i j -> a -> b) -> (j -> Either i j) -> j -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. j -> Either i j
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 :: (Either i j -> a -> m) -> Sum f g a -> m
ifoldMap Either i j -> a -> m
q (InL f a
fa) = (i -> a -> m) -> f a -> m
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap (Either i j -> a -> m
q (Either i j -> a -> m) -> (i -> Either i j) -> i -> a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Either i j
forall a b. a -> Either a b
Left)  f a
fa
  ifoldMap Either i j -> a -> m
q (InR g a
ga) = (j -> a -> m) -> g a -> m
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap (Either i j -> a -> m
q (Either i j -> a -> m) -> (j -> Either i j) -> j -> a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. j -> Either i j
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 :: (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) = f b -> Sum f g b
forall k (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL (f b -> Sum f g b) -> f (f b) -> f (Sum f g b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (i -> a -> f b) -> f a -> f (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 (Either i j -> a -> f b) -> (i -> Either i j) -> i -> a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Either i j
forall a b. a -> Either a b
Left)  f a
fa
  itraverse Either i j -> a -> f b
q (InR g a
ga) = g b -> Sum f g b
forall k (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR (g b -> Sum f g b) -> f (g b) -> f (Sum f g b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (j -> a -> f b) -> g a -> f (g 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 (Either i j -> a -> f b) -> (j -> Either i j) -> j -> a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. j -> Either i j
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 :: (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) = f b -> g b -> Product f g b
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair ((i -> a -> b) -> f a -> f b
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (Either i j -> a -> b
f (Either i j -> a -> b) -> (i -> Either i j) -> i -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Either i j
forall a b. a -> Either a b
Left) f a
a) ((j -> a -> b) -> g a -> g b
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (Either i j -> a -> b
f (Either i j -> a -> b) -> (j -> Either i j) -> j -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. j -> Either i j
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 :: (Either i j -> a -> m) -> Product f g a -> m
ifoldMap Either i j -> a -> m
f (Pair f a
a g a
b) = (i -> a -> m) -> f a -> m
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap (Either i j -> a -> m
f (Either i j -> a -> m) -> (i -> Either i j) -> i -> a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Either i j
forall a b. a -> Either a b
Left) f a
a m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (j -> a -> m) -> g a -> m
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap (Either i j -> a -> m
f (Either i j -> a -> m) -> (j -> Either i j) -> j -> a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. j -> Either i j
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 :: (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) = (f b -> g b -> Product f g b)
-> f (f b) -> f (g b) -> f (Product f g b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 f b -> g b -> Product f g b
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair ((i -> a -> f b) -> f a -> f (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
f (Either i j -> a -> f b) -> (i -> Either i j) -> i -> a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Either i j
forall a b. a -> Either a b
Left) f a
a) ((j -> a -> f b) -> g a -> f (g 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
f (Either i j -> a -> f b) -> (j -> Either i j) -> j -> a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. j -> Either i j
forall a b. b -> Either a b
Right) g a
b)
  {-# INLINE itraverse #-}

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

instance FunctorWithIndex i m => FunctorWithIndex i (IdentityT m) where
  imap :: (i -> a -> b) -> IdentityT m a -> IdentityT m b
imap i -> a -> b
f (IdentityT m a
m) = m b -> IdentityT m b
forall k (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (m b -> IdentityT m b) -> m b -> IdentityT m b
forall a b. (a -> b) -> a -> b
$ (i -> a -> b) -> m a -> m 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 :: (i -> a -> m) -> IdentityT m a -> m
ifoldMap i -> a -> m
f (IdentityT m a
m) = (i -> a -> m) -> 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 :: (i -> a -> f b) -> IdentityT m a -> f (IdentityT m b)
itraverse i -> a -> f b
f (IdentityT m a
m) = m b -> IdentityT m b
forall k (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (m b -> IdentityT m b) -> f (m b) -> f (IdentityT m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (i -> a -> f b) -> m a -> f (m 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 :: ((e, i) -> a -> b) -> ReaderT e m a -> ReaderT e m b
imap (e, i) -> a -> b
f (ReaderT e -> m a
m) = (e -> m b) -> ReaderT e m b
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((e -> m b) -> ReaderT e m b) -> (e -> m b) -> ReaderT e m b
forall a b. (a -> b) -> a -> b
$ \e
k -> (i -> a -> b) -> m a -> m b
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap ((e, i) -> a -> b
f ((e, i) -> a -> b) -> (i -> (e, i)) -> i -> a -> b
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 :: (i -> a -> b) -> Backwards f a -> Backwards f b
imap i -> a -> b
f  = f b -> Backwards f b
forall k (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards (f b -> Backwards f b)
-> (Backwards f a -> f b) -> Backwards f a -> Backwards f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> a -> b) -> f a -> f b
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap i -> a -> b
f (f a -> f b) -> (Backwards f a -> f a) -> Backwards f a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Backwards f a -> f a
forall k (f :: k -> *) (a :: k). Backwards f a -> f a
forwards
  {-# INLINE imap #-}

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

instance TraversableWithIndex i f => TraversableWithIndex i (Backwards f) where
  itraverse :: (i -> a -> f b) -> Backwards f a -> f (Backwards f b)
itraverse i -> a -> f b
f = (f b -> Backwards f b) -> f (f b) -> f (Backwards f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f b -> Backwards f b
forall k (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards (f (f b) -> f (Backwards f b))
-> (Backwards f a -> f (f b)) -> Backwards f a -> f (Backwards f b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> a -> f b) -> f a -> f (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 (f a -> f (f b))
-> (Backwards f a -> f a) -> Backwards f a -> f (f b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Backwards f a -> f a
forall k (f :: k -> *) (a :: k). Backwards f a -> f a
forwards
  {-# INLINE itraverse #-}

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

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

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

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

instance Ix i => FunctorWithIndex i (Array i) where
  imap :: (i -> a -> b) -> Array i a -> Array i b
imap i -> a -> b
f Array i a
arr = (i, i) -> [b] -> Array i b
forall i e. Ix i => (i, i) -> [e] -> Array i e
Array.listArray (Array i a -> (i, i)
forall i e. Array i e -> (i, i)
Array.bounds Array i a
arr) ([b] -> Array i b) -> ([(i, a)] -> [b]) -> [(i, a)] -> Array i b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((i, a) -> b) -> [(i, a)] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((i -> a -> b) -> (i, a) -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry' i -> a -> b
f) ([(i, a)] -> Array i b) -> [(i, a)] -> Array i b
forall a b. (a -> b) -> a -> b
$ Array i a -> [(i, a)]
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 :: (i -> a -> m) -> Array i a -> m
ifoldMap i -> a -> m
f = ((i, a) -> m) -> [(i, a)] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((i -> a -> m) -> (i, a) -> m
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry' i -> a -> m
f) ([(i, a)] -> m) -> (Array i a -> [(i, a)]) -> Array i a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array i a -> [(i, a)]
forall i e. Ix i => Array i e -> [(i, e)]
Array.assocs
  {-# INLINE ifoldMap #-}

instance Ix i => TraversableWithIndex i (Array i) where
  itraverse :: (i -> a -> f b) -> Array i a -> f (Array i b)
itraverse i -> a -> f b
f Array i a
arr = (i, i) -> [b] -> Array i b
forall i e. Ix i => (i, i) -> [e] -> Array i e
Array.listArray (Array i a -> (i, i)
forall i e. Array i e -> (i, i)
Array.bounds Array i a
arr) ([b] -> Array i b) -> f [b] -> f (Array i b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((i, a) -> f b) -> [(i, a)] -> f [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((i -> a -> f b) -> (i, a) -> f b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry' i -> a -> f b
f) (Array i a -> [(i, a)]
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 :: ([Int] -> a -> b) -> Tree a -> Tree b
imap [Int] -> a -> b
f (Node a
a Forest a
as) = b -> Forest b -> Tree b
forall a. a -> Forest a -> Tree a
Node ([Int] -> a -> b
f [] a
a) (Forest b -> Tree b) -> Forest b -> Tree b
forall a b. (a -> b) -> a -> b
$ (Int -> Tree a -> Tree b) -> Forest a -> Forest b
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (\Int
i -> ([Int] -> a -> b) -> Tree a -> Tree b
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap ([Int] -> a -> b
f ([Int] -> a -> b) -> ([Int] -> [Int]) -> [Int] -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Int
i)) Forest a
as
  {-# INLINE imap #-}

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

instance TraversableWithIndex [Int] Tree where
  itraverse :: ([Int] -> a -> f b) -> Tree a -> f (Tree b)
itraverse [Int] -> a -> f b
f (Node a
a Forest a
as) = (b -> Forest b -> Tree b) -> f b -> f (Forest b) -> f (Tree b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> Forest b -> Tree b
forall a. a -> Forest a -> Tree a
Node ([Int] -> a -> f b
f [] a
a) ((Int -> Tree a -> f (Tree b)) -> Forest a -> f (Forest b)
forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse (\Int
i -> ([Int] -> a -> f b) -> Tree a -> f (Tree 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 ([Int] -> a -> f b) -> ([Int] -> [Int]) -> [Int] -> a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Int
i)) Forest a
as)
  {-# INLINE itraverse #-}
--
-- | The position in the 'Seq' is available as the index.
instance FunctorWithIndex Int Seq where
  imap :: (Int -> a -> b) -> Seq a -> Seq b
imap = (Int -> a -> b) -> Seq a -> Seq b
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 :: (Int -> a -> m) -> Seq a -> m
ifoldMap = (Int -> a -> m) -> Seq a -> m
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 :: (Int -> a -> b -> b) -> b -> Seq a -> b
ifoldr = (Int -> a -> b -> b) -> b -> Seq a -> b
forall a b. (Int -> a -> b -> b) -> b -> Seq a -> b
Seq.foldrWithIndex
  {-# INLINE ifoldr #-}
  ifoldl :: (Int -> b -> a -> b) -> b -> Seq a -> b
ifoldl Int -> b -> a -> b
f = (b -> Int -> a -> b) -> b -> Seq a -> b
forall b a. (b -> Int -> a -> b) -> b -> Seq a -> b
Seq.foldlWithIndex ((Int -> b -> a -> b) -> b -> Int -> a -> b
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 :: (Int -> a -> f b) -> Seq a -> f (Seq b)
itraverse = (Int -> a -> f b) -> Seq a -> f (Seq b)
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 :: (Int -> a -> b) -> IntMap a -> IntMap b
imap = (Int -> a -> b) -> IntMap a -> IntMap b
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 :: (Int -> a -> m) -> IntMap a -> m
ifoldMap = (Int -> a -> m) -> IntMap a -> m
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 :: (Int -> a -> b -> b) -> b -> IntMap a -> b
ifoldr   = (Int -> a -> b -> b) -> b -> IntMap a -> b
forall a b. (Int -> a -> b -> b) -> b -> IntMap a -> b
IntMap.foldrWithKey
  ifoldl' :: (Int -> b -> a -> b) -> b -> IntMap a -> b
ifoldl'  = (b -> Int -> a -> b) -> b -> IntMap a -> b
forall a b. (a -> Int -> b -> a) -> a -> IntMap b -> a
IntMap.foldlWithKey' ((b -> Int -> a -> b) -> b -> IntMap a -> b)
-> ((Int -> b -> a -> b) -> b -> Int -> a -> b)
-> (Int -> b -> a -> b)
-> b
-> IntMap a
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> b -> a -> b) -> b -> Int -> a -> b
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 :: (Int -> a -> f b) -> IntMap a -> f (IntMap b)
itraverse = (Int -> a -> f b) -> IntMap a -> f (IntMap b)
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 :: (k -> a -> b) -> Map k a -> Map k b
imap = (k -> a -> b) -> Map k a -> Map k b
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 :: (k -> a -> m) -> Map k a -> m
ifoldMap = (k -> a -> m) -> Map k a -> m
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 :: (k -> a -> b -> b) -> b -> Map k a -> b
ifoldr   = (k -> a -> b -> b) -> b -> Map k a -> b
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey
  ifoldl' :: (k -> b -> a -> b) -> b -> Map k a -> b
ifoldl'  = (b -> k -> a -> b) -> b -> Map k a -> b
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' ((b -> k -> a -> b) -> b -> Map k a -> b)
-> ((k -> b -> a -> b) -> b -> k -> a -> b)
-> (k -> b -> a -> b)
-> b
-> Map k a
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> b -> a -> b) -> b -> k -> a -> b
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 :: (k -> a -> f b) -> Map k a -> f (Map k b)
itraverse = (k -> a -> f b) -> Map k a -> f (Map k b)
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 :: (Void -> a -> b) -> V1 a -> V1 b
imap Void -> a -> b
_ V1 a
v = V1 a
v V1 a -> V1 b -> V1 b
`seq` [Char] -> V1 b
forall a. HasCallStack => [Char] -> a
error [Char]
"imap @V1"
  {-# INLINE imap #-}

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

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

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

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

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

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

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

instance TraversableWithIndex () Par1 where
  itraverse :: (() -> a -> f b) -> Par1 a -> f (Par1 b)
itraverse () -> a -> f b
f (Par1 a
a) = b -> Par1 b
forall p. p -> Par1 p
Par1 (b -> Par1 b) -> f b -> f (Par1 b)
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 :: ((i, j) -> a -> b) -> (:.:) f g a -> (:.:) f g b
imap (i, j) -> a -> b
q (Comp1 f (g a)
fga) = f (g b) -> (:.:) f g b
forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 ((i -> g a -> g b) -> f (g a) -> f (g b)
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (\i
k -> (j -> a -> b) -> g a -> g b
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap ((i, j) -> a -> b
q ((i, j) -> a -> b) -> (j -> (i, j)) -> j -> a -> b
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 :: ((i, j) -> a -> m) -> (:.:) f g a -> m
ifoldMap (i, j) -> a -> m
q (Comp1 f (g a)
fga) = (i -> g a -> m) -> f (g a) -> m
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap (\i
k -> (j -> a -> m) -> g a -> m
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap ((i, j) -> a -> m
q ((i, j) -> a -> m) -> (j -> (i, j)) -> j -> a -> m
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 :: ((i, j) -> a -> f b) -> (:.:) f g a -> f ((:.:) f g b)
itraverse (i, j) -> a -> f b
q (Comp1 f (g a)
fga) = f (g b) -> (:.:) f g b
forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 (f (g b) -> (:.:) f g b) -> f (f (g b)) -> f ((:.:) f g b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (i -> g a -> f (g b)) -> f (g a) -> f (f (g b))
forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse (\i
k -> (j -> a -> f b) -> g a -> f (g b)
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 ((i, j) -> a -> f b) -> (j -> (i, j)) -> j -> a -> f b
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 :: (Either i j -> a -> b) -> (:*:) f g a -> (:*:) f g b
imap Either i j -> a -> b
q (f a
fa :*: g a
ga) = (i -> a -> b) -> f a -> f b
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (Either i j -> a -> b
q (Either i j -> a -> b) -> (i -> Either i j) -> i -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Either i j
forall a b. a -> Either a b
Left) f a
fa f b -> g b -> (:*:) f g b
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: (j -> a -> b) -> g a -> g b
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (Either i j -> a -> b
q (Either i j -> a -> b) -> (j -> Either i j) -> j -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. j -> Either i j
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 :: (Either i j -> a -> m) -> (:*:) f g a -> m
ifoldMap Either i j -> a -> m
q (f a
fa :*: g a
ga) = (i -> a -> m) -> f a -> m
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap (Either i j -> a -> m
q (Either i j -> a -> m) -> (i -> Either i j) -> i -> a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Either i j
forall a b. a -> Either a b
Left) f a
fa m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (j -> a -> m) -> g a -> m
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap (Either i j -> a -> m
q (Either i j -> a -> m) -> (j -> Either i j) -> j -> a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. j -> Either i j
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 :: (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) = (f b -> g b -> (:*:) f g b)
-> f (f b) -> f (g b) -> f ((:*:) f g b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 f b -> g b -> (:*:) f g b
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) ((i -> a -> f b) -> f a -> f (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 (Either i j -> a -> f b) -> (i -> Either i j) -> i -> a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Either i j
forall a b. a -> Either a b
Left) f a
fa) ((j -> a -> f b) -> g a -> f (g 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 (Either i j -> a -> f b) -> (j -> Either i j) -> j -> a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. j -> Either i j
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 :: (Either i j -> a -> b) -> (:+:) f g a -> (:+:) f g b
imap Either i j -> a -> b
q (L1 f a
fa) = f b -> (:+:) f g b
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 ((i -> a -> b) -> f a -> f b
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (Either i j -> a -> b
q (Either i j -> a -> b) -> (i -> Either i j) -> i -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Either i j
forall a b. a -> Either a b
Left) f a
fa)
  imap Either i j -> a -> b
q (R1 g a
ga) = g b -> (:+:) f g b
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 ((j -> a -> b) -> g a -> g b
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (Either i j -> a -> b
q (Either i j -> a -> b) -> (j -> Either i j) -> j -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. j -> Either i j
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 :: (Either i j -> a -> m) -> (:+:) f g a -> m
ifoldMap Either i j -> a -> m
q (L1 f a
fa) = (i -> a -> m) -> f a -> m
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap (Either i j -> a -> m
q (Either i j -> a -> m) -> (i -> Either i j) -> i -> a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Either i j
forall a b. a -> Either a b
Left) f a
fa
  ifoldMap Either i j -> a -> m
q (R1 g a
ga) = (j -> a -> m) -> g a -> m
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap (Either i j -> a -> m
q (Either i j -> a -> m) -> (j -> Either i j) -> j -> a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. j -> Either i j
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 :: (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) = f b -> (:+:) f g b
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (f b -> (:+:) f g b) -> f (f b) -> f ((:+:) f g b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (i -> a -> f b) -> f a -> f (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 (Either i j -> a -> f b) -> (i -> Either i j) -> i -> a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Either i j
forall a b. a -> Either a b
Left) f a
fa
  itraverse Either i j -> a -> f b
q (R1 g a
ga) = g b -> (:+:) f g b
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (g b -> (:+:) f g b) -> f (g b) -> f ((:+:) f g b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (j -> a -> f b) -> g a -> f (g 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 (Either i j -> a -> f b) -> (j -> Either i j) -> j -> a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. j -> Either i j
forall a b. b -> Either a b
Right) g a
ga
  {-# INLINE itraverse #-}

instance FunctorWithIndex i f => FunctorWithIndex i (Rec1 f) where
  imap :: (i -> a -> b) -> Rec1 f a -> Rec1 f b
imap i -> a -> b
q (Rec1 f a
f) = f b -> Rec1 f b
forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Rec1 ((i -> a -> b) -> f a -> f b
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 :: (i -> a -> m) -> Rec1 f a -> m
ifoldMap i -> a -> m
q (Rec1 f a
f) = (i -> a -> m) -> f a -> m
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 :: (i -> a -> f b) -> Rec1 f a -> f (Rec1 f b)
itraverse i -> a -> f b
q (Rec1 f a
f) = f b -> Rec1 f b
forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Rec1 (f b -> Rec1 f b) -> f (f b) -> f (Rec1 f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (i -> a -> f b) -> f a -> f (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 :: (Void -> a -> b) -> K1 i c a -> K1 i c b
imap Void -> a -> b
_ (K1 c
c) = c -> K1 i c b
forall k i c (p :: k). c -> K1 i c p
K1 c
c
  {-# INLINE imap #-}

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

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

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

#if __GLASGOW_HASKELL__ >=708
(#.) :: Coercible b c => (b -> c) -> (a -> b) -> (a -> c)
b -> c
_ #. :: (b -> c) -> (a -> b) -> a -> c
#. a -> b
x = (a -> b) -> a -> c
coerce a -> b
x

(#..) :: Coercible b c => (b -> c) -> (i -> a -> b) -> (i -> a -> c)
b -> c
_ #.. :: (b -> c) -> (i -> a -> b) -> i -> a -> c
#.. i -> a -> b
x = (i -> a -> b) -> i -> a -> c
coerce i -> a -> b
x
#else
(#.) :: (b -> c) -> (a -> b) -> (a -> c)
_ #. x = unsafeCoerce x

(#..) :: (b -> c) -> (i -> a -> b) -> (i -> a -> c)
_ #.. x = unsafeCoerce x
#endif
infixr 9 #., #..
{-# INLINE (#.) #-}
{-# INLINE (#..)#-}

skip :: a -> ()
skip :: 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 { 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 = f a -> Traversed a f
forall k (a :: k) (f :: k -> *). f a -> Traversed a f
Traversed (f a
ma f a -> f a -> f a
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 = f a -> Traversed a f
forall k (a :: k) (f :: k -> *). f a -> Traversed a f
Traversed (a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Traversed: value used"))
  {-# INLINE mempty #-}
  Traversed f a
ma mappend :: Traversed a f -> Traversed a f -> Traversed a f
`mappend` Traversed f a
mb = f a -> Traversed a f
forall k (a :: k) (f :: k -> *). f a -> Traversed a f
Traversed (f a
ma f a -> f a -> f a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f a
mb)
  {-# 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 { 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 = m a -> Sequenced a m
forall k (a :: k) (m :: k -> *). m a -> Sequenced a m
Sequenced (m a
ma m a -> m a -> m a
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 = m a -> Sequenced a m
forall k (a :: k) (m :: k -> *). m a -> Sequenced a m
Sequenced (a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Sequenced: value used"))
  {-# INLINE mempty #-}
  Sequenced m a
ma mappend :: Sequenced a m -> Sequenced a m -> Sequenced a m
`mappend` Sequenced m a
mb = m a -> Sequenced a m
forall k (a :: k) (m :: k -> *). m a -> Sequenced a m
Sequenced (m a
ma m a -> m a -> m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m a
mb)
  {-# 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 { Indexing f a -> Int -> (Int, f a)
runIndexing :: Int -> (Int, f a) }

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

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

uncurry' :: (a -> b -> c) -> (a, b) -> c
uncurry' :: (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' #-}