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

    #ifndef MIN_VERSION_profunctors
    #define MIN_VERSION_profunctors(x,y,z) 1
    #endif

    #if __GLASGOW_HASKELL__ < 708 || !(MIN_VERSION_profunctors(4,4,0))
    {-# LANGUAGE Trustworthy #-}
    #endif

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Control.Lens.Internal.Indexed
    -- Copyright   :  (C) 2012-2015 Edward Kmett
    -- License     :  BSD-style (see the file LICENSE)
    -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
    -- Stability   :  experimental
    -- Portability :  non-portable
    --
    -- Internal implementation details for 'Indexed' lens-likes
    ----------------------------------------------------------------------------
    module Control.Lens.Internal.Indexed
      (
      -- * An Indexed Profunctor
        Indexed(..)
      -- * Classes
      , Conjoined(..)
      , Indexable(..)
      -- * Indexing
      , Indexing(..)
      , indexing
      -- * 64-bit Indexing
      , Indexing64(..)
      , indexing64
      -- * Converting to Folds
      , withIndex
      , asIndex
      ) where

    import Control.Applicative
    import Control.Arrow as Arrow
    import Control.Category
    import Control.Comonad
    import Control.Lens.Internal.Instances ()
    import Control.Monad
    import Control.Monad.Fix
    import Data.Distributive
    import Data.Functor.Bind
    import Data.Functor.Contravariant
    import Data.Int
    import Data.Profunctor
    import Data.Profunctor.Rep
    import Data.Profunctor.Sieve
    import Data.Traversable
    import Prelude hiding ((.),id)
    #ifndef SAFE
    import Data.Profunctor.Unsafe
    import Control.Lens.Internal.Coerce
    #endif

    ------------------------------------------------------------------------------
    -- Conjoined
    ------------------------------------------------------------------------------

    -- | This is a 'Profunctor' that is both 'Corepresentable' by @f@ and 'Representable' by @g@ such
    -- that @f@ is left adjoint to @g@. From this you can derive a lot of structure due
    -- to the preservation of limits and colimits.
    class
      ( Choice p, Corepresentable p, Comonad (Corep p), Traversable (Corep p)
      , Strong p, Representable p, Monad (Rep p), MonadFix (Rep p), Distributive (Rep p)
      , Costrong p, ArrowLoop p, ArrowApply p, ArrowChoice p
      ) => Conjoined p where

      -- | 'Conjoined' is strong enough to let us distribute every 'Conjoined'
      -- 'Profunctor' over every Haskell 'Functor'. This is effectively a
      -- generalization of 'fmap'.
      distrib :: Functor f => p a b -> p (f a) (f b)
      distrib = tabulate . collect . sieve
      {-# INLINE distrib #-}

      -- | This permits us to make a decision at an outermost point about whether or not we use an index.
      --
      -- Ideally any use of this function should be done in such a way so that you compute the same answer,
      -- but this cannot be enforced at the type level.
      conjoined :: ((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r
      conjoined _ r = r
      {-# INLINE conjoined #-}

    instance Conjoined (->) where
      distrib = fmap
      {-# INLINE distrib #-}
      conjoined l _ = l
      {-# INLINE conjoined #-}

    ----------------------------------------------------------------------------
    -- Indexable
    ----------------------------------------------------------------------------

    -- | This class permits overloading of function application for things that
    -- also admit a notion of a key or index.
    class Conjoined p => Indexable i p where
      -- | Build a function from an 'indexed' function.
      indexed :: p a b -> i -> a -> b

    instance Indexable i (->) where
      indexed = const
      {-# INLINE indexed #-}

    -----------------------------------------------------------------------------
    -- Indexed Internals
    -----------------------------------------------------------------------------

    -- | A function with access to a index. This constructor may be useful when you need to store
    -- an 'Indexable' in a container to avoid @ImpredicativeTypes@.
    --
    -- @index :: Indexed i a b -> i -> a -> b@
    newtype Indexed i a b = Indexed { runIndexed :: i -> a -> b }

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

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

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

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

    instance Monad (Indexed i a) where
      return b = Indexed $ \_ _ -> b
      {-# INLINE return #-}
      Indexed f >>= k = Indexed $ \i a -> runIndexed (k (f i a)) i a
      {-# INLINE (>>=) #-}

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

    instance Profunctor (Indexed i) where
      dimap ab cd ibc = Indexed $ \i -> cd . runIndexed ibc i . ab
      {-# INLINE dimap #-}
      lmap ab ibc = Indexed $ \i -> runIndexed ibc i . ab
      {-# INLINE lmap #-}
      rmap bc iab = Indexed $ \i -> bc . runIndexed iab i
      {-# INLINE rmap #-}
    #ifndef SAFE
      ( .# ) ibc _ = coerce ibc
      {-# INLINE ( .# ) #-}
      ( #. ) _ = coerce'
      {-# INLINE ( #. ) #-}
    #endif

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

    instance Sieve (Indexed i) ((->) i) where
      sieve = flip . runIndexed
      {-# INLINE sieve #-}

    instance Representable (Indexed i) where
      type Rep (Indexed i) = (->) i
      tabulate = Indexed . flip
      {-# INLINE tabulate #-}

    instance Cosieve (Indexed i) ((,) i) where
      cosieve = uncurry . runIndexed
      {-# INLINE cosieve #-}

    instance Corepresentable (Indexed i) where
      type Corep (Indexed i) = (,) i
      cotabulate = Indexed . curry
      {-# INLINE cotabulate #-}

    instance Choice (Indexed i) where
      right' = right
      {-# INLINE right' #-}

    instance Strong (Indexed i) where
      second' = second
      {-# INLINE second' #-}

    instance Category (Indexed i) where
      id = Indexed (const id)
      {-# INLINE id #-}
      Indexed f . Indexed g = Indexed $ \i -> f i . g i
      {-# INLINE (.) #-}

    instance Arrow (Indexed i) where
      arr f = Indexed (\_ -> f)
      {-# INLINE arr #-}
      first f = Indexed (Arrow.first . runIndexed f)
      {-# INLINE first #-}
      second f = Indexed (Arrow.second . runIndexed f)
      {-# INLINE second #-}
      Indexed f *** Indexed g = Indexed $ \i -> f i *** g i
      {-# INLINE (***) #-}
      Indexed f &&& Indexed g = Indexed $ \i -> f i &&& g i
      {-# INLINE (&&&) #-}

    instance ArrowChoice (Indexed i) where
      left f = Indexed (left . runIndexed f)
      {-# INLINE left #-}
      right f = Indexed (right . runIndexed f)
      {-# INLINE right #-}
      Indexed f +++ Indexed g = Indexed $ \i -> f i +++ g i
      {-# INLINE (+++)  #-}
      Indexed f ||| Indexed g = Indexed $ \i -> f i ||| g i
      {-# INLINE (|||) #-}

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

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

    instance Conjoined (Indexed i) where
      distrib (Indexed iab) = Indexed $ \i fa -> iab i <$> fa
      {-# INLINE distrib #-}

    instance i ~ j => Indexable i (Indexed j) where
      indexed = runIndexed
      {-# INLINE indexed #-}

    ------------------------------------------------------------------------------
    -- Indexing
    ------------------------------------------------------------------------------

    -- | 'Applicative' composition of @'Control.Monad.Trans.State.Lazy.State' 'Int'@ with a 'Functor', used
    -- by 'Control.Lens.Indexed.indexed'.
    newtype Indexing f a = Indexing { runIndexing :: Int -> (Int, f a) }

    instance Functor f => Functor (Indexing f) where
      fmap f (Indexing m) = Indexing $ \i -> case m i of
        (j, x) -> (j, fmap f x)
      {-# INLINE fmap #-}

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

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

    instance Contravariant f => Contravariant (Indexing f) where
      contramap f (Indexing m) = Indexing $ \i -> case m i of
        (j, ff) -> (j, contramap f ff)
      {-# INLINE contramap #-}

    -- | Transform a 'Control.Lens.Traversal.Traversal' into an 'Control.Lens.Traversal.IndexedTraversal' or
    -- a 'Control.Lens.Fold.Fold' into an 'Control.Lens.Fold.IndexedFold', etc.
    --
    -- @
    -- 'indexing' :: 'Control.Lens.Type.Traversal' s t a b -> 'Control.Lens.Type.IndexedTraversal' 'Int' s t a b
    -- 'indexing' :: 'Control.Lens.Type.Prism' s t a b     -> 'Control.Lens.Type.IndexedTraversal' 'Int' s t a b
    -- 'indexing' :: 'Control.Lens.Type.Lens' s t a b      -> 'Control.Lens.Type.IndexedLens' 'Int'  s t a b
    -- 'indexing' :: 'Control.Lens.Type.Iso' s t a b       -> 'Control.Lens.Type.IndexedLens' 'Int' s t a b
    -- 'indexing' :: 'Control.Lens.Type.Fold' s a          -> 'Control.Lens.Type.IndexedFold' 'Int' s a
    -- 'indexing' :: 'Control.Lens.Type.Getter' s a        -> 'Control.Lens.Type.IndexedGetter' 'Int' s a
    -- @
    --
    -- @'indexing' :: 'Indexable' 'Int' p => 'Control.Lens.Type.LensLike' ('Indexing' f) s t a b -> 'Control.Lens.Type.Over' p f s t a b@
    indexing :: Indexable Int p => ((a -> Indexing f b) -> s -> Indexing f t) -> p a (f b) -> s -> f t
    indexing l iafb s = snd $ runIndexing (l (\a -> Indexing (\i -> i `seq` (i + 1, indexed iafb i a))) s) 0
    {-# INLINE indexing #-}

    ------------------------------------------------------------------------------
    -- Indexing64
    ------------------------------------------------------------------------------

    -- | 'Applicative' composition of @'Control.Monad.Trans.State.Lazy.State' 'Int64'@ with a 'Functor', used
    -- by 'Control.Lens.Indexed.indexed64'.
    newtype Indexing64 f a = Indexing64 { runIndexing64 :: Int64 -> (Int64, f a) }

    instance Functor f => Functor (Indexing64 f) where
      fmap f (Indexing64 m) = Indexing64 $ \i -> case m i of
        (j, x) -> (j, fmap f x)
      {-# INLINE fmap #-}

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

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

    instance Contravariant f => Contravariant (Indexing64 f) where
      contramap f (Indexing64 m) = Indexing64 $ \i -> case m i of
        (j, ff) -> (j, contramap f ff)
      {-# INLINE contramap #-}

    -- | Transform a 'Control.Lens.Traversal.Traversal' into an 'Control.Lens.Traversal.IndexedTraversal' or
    -- a 'Control.Lens.Fold.Fold' into an 'Control.Lens.Fold.IndexedFold', etc.
    --
    -- This combinator is like 'indexing' except that it handles large traversals and folds gracefully.
    --
    -- @
    -- 'indexing64' :: 'Control.Lens.Type.Traversal' s t a b -> 'Control.Lens.Type.IndexedTraversal' 'Int64' s t a b
    -- 'indexing64' :: 'Control.Lens.Type.Prism' s t a b     -> 'Control.Lens.Type.IndexedTraversal' 'Int64' s t a b
    -- 'indexing64' :: 'Control.Lens.Type.Lens' s t a b      -> 'Control.Lens.Type.IndexedLens' 'Int64' s t a b
    -- 'indexing64' :: 'Control.Lens.Type.Iso' s t a b       -> 'Control.Lens.Type.IndexedLens' 'Int64' s t a b
    -- 'indexing64' :: 'Control.Lens.Type.Fold' s a          -> 'Control.Lens.Type.IndexedFold' 'Int64' s a
    -- 'indexing64' :: 'Control.Lens.Type.Getter' s a        -> 'Control.Lens.Type.IndexedGetter' 'Int64' s a
    -- @
    --
    -- @'indexing64' :: 'Indexable' 'Int64' p => 'Control.Lens.Type.LensLike' ('Indexing64' f) s t a b -> 'Control.Lens.Type.Over' p f s t a b@
    indexing64 :: Indexable Int64 p => ((a -> Indexing64 f b) -> s -> Indexing64 f t) -> p a (f b) -> s -> f t
    indexing64 l iafb s = snd $ runIndexing64 (l (\a -> Indexing64 (\i -> i `seq` (i + 1, indexed iafb i a))) s) 0
    {-# INLINE indexing64 #-}

    -------------------------------------------------------------------------------
    -- Converting to Folds
    -------------------------------------------------------------------------------

    -- | Fold a container with indices returning both the indices and the values.
    --
    -- The result is only valid to compose in a 'Traversal', if you don't edit the
    -- index as edits to the index have no effect.
    withIndex :: (Indexable i p, Functor f) => p (i, s) (f (j, t)) -> Indexed i s (f t)
    withIndex f = Indexed $ \i a -> snd <$> indexed f i (i, a)
    {-# INLINE withIndex #-}

    -- | When composed with an 'IndexedFold' or 'IndexedTraversal' this yields an
    -- ('Indexed') 'Fold' of the indices.
    asIndex :: (Indexable i p, Contravariant f, Functor f) => p i (f i) -> Indexed i s (f s)
    asIndex f = Indexed $ \i _ -> phantom (indexed f i i)
    {-# INLINE asIndex #-}