    {-# LANGUAGE DataKinds #-}
    {-# LANGUAGE TypeInType #-}
    {-# LANGUAGE UndecidableInstances #-}
    {-# OPTIONS_HADDOCK not-home #-}

    -- | Internal implementation details of indexed optics.
    --
    -- This module is intended for internal use only, and may change without warning
    -- in subsequent releases.
    module Optics.Internal.Indexed where

    import Data.Kind (Type)
    import GHC.TypeLits

    import Data.Profunctor.Indexed
    import Optics.Internal.Optic

    -- | Show useful error message when a function expects optics without indices.
    class is ~ NoIx => AcceptsEmptyIndices (f :: Symbol) (is :: IxList)

    instance
      ( TypeError
        ('Text "‘" ':<>: 'Text f ':<>: 'Text "’ accepts only optics with no indices")
      , (x ': xs) ~ NoIx
      ) => AcceptsEmptyIndices f (x ': xs)

    instance AcceptsEmptyIndices f '[]

    -- | Check whether a list of indices is not empty and generate sensible error
    -- message if it's not.
    class NonEmptyIndices (is :: IxList)

    instance
      ( TypeError
        ('Text "Indexed optic is expected")
      ) => NonEmptyIndices '[]

    instance NonEmptyIndices (x ': xs)

    -- | Generate sensible error messages in case a user tries to pass either an
    -- unindexed optic or indexed optic with unflattened indices where indexed optic
    -- with a single index is expected.
    class is ~ '[i] => HasSingleIndex (is :: IxList) (i :: Type)

    instance HasSingleIndex '[i] i

    instance
      ( TypeError
        ('Text "Indexed optic is expected")
      , '[] ~ '[i]
      ) => HasSingleIndex '[] i

    instance
      ( TypeError
        ('Text "Use (<%>) or icompose to combine indices of type "
         ':<>: ShowTypes is)
      , is ~ '[i1, i2]
      , is ~ '[i]
      ) => HasSingleIndex '[i1, i2] i

    instance
      ( TypeError
        ('Text "Use icompose3 to combine indices of type "
         ':<>: ShowTypes is)
      , is ~ '[i1, i2, i3]
      , is ~ '[i]
      ) => HasSingleIndex [i1, i2, i3] i

    instance
      ( TypeError
        ('Text "Use icompose4 to combine indices of type "
         ':<>: ShowTypes is)
      , is ~ '[i1, i2, i3, i4]
      , is ~ '[i]
      ) => HasSingleIndex '[i1, i2, i3, i4] i

    instance
      ( TypeError
        ('Text "Use icompose5 to flatten indices of type "
         ':<>: ShowTypes is)
      , is ~ '[i1, i2, i3, i4, i5]
      , is ~ '[i]
      ) => HasSingleIndex '[i1, i2, i3, i4, i5] i

    instance
      ( TypeError
        ('Text "Use icomposeN to flatten indices of type "
         ':<>: ShowTypes is)
      , is ~ (i1 ': i2 ': i3 ': i4 ': i5 ': i6 : is')
      , is ~ '[i]
      ) => HasSingleIndex (i1 ': i2 ': i3 ': i4 ': i5 ': i6 ': is') i

    ----------------------------------------
    -- Helpers for HasSingleIndex

    type family ShowTypes (types :: [Type]) :: ErrorMessage where
      ShowTypes '[i]      = QuoteType i
      ShowTypes '[i, j]   = QuoteType i ':<>: 'Text " and " ':<>: QuoteType j
      ShowTypes (i ': is) = QuoteType i ':<>: 'Text ", " ':<>: ShowTypes is

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

    data IntT f a = IntT {-# UNPACK #-} !Int (f a)

    unIntT :: IntT f a -> f a
    unIntT :: forall {k} (f :: k -> *) (a :: k). IntT f a -> f a
    unIntT (IntT Int
    _ f a
    fa) = f a
    fa

    newtype Indexing f a = Indexing { forall {k} (f :: k -> *) (a :: k). Indexing f a -> Int -> IntT f a
    runIndexing :: Int -> IntT 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 -> IntT f a
    m) = (Int -> IntT f b) -> Indexing f b
    forall {k} (f :: k -> *) (a :: k).
    (Int -> IntT f a) -> Indexing f a
    Indexing ((Int -> IntT f b) -> Indexing f b)
    -> (Int -> IntT f b) -> Indexing f b
    forall a b. (a -> b) -> a -> b
    $ \Int
    i -> case Int -> IntT f a
    m Int
    i of
        IntT Int
    j f a
    x -> Int -> f b -> IntT f b
    forall {k} (f :: k -> *) (a :: k). Int -> f a -> IntT f a
    IntT Int
    j ((a -> b) -> f a -> f b
    forall a b. (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)

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

    -- | Index a traversal by position of visited elements.
    indexing
      :: ((a -> Indexing f b) -> s -> Indexing f t)
      -> ((Int -> a -> f b) -> s -> f t)
    indexing :: forall {k} a (f :: k -> *) (b :: k) s (t :: k).
    ((a -> Indexing f b) -> s -> Indexing f t)
    -> (Int -> a -> f b) -> s -> f t
    indexing (a -> Indexing f b) -> s -> Indexing f t
    l Int -> a -> f b
    iafb s
    s =
      IntT f t -> f t
    forall {k} (f :: k -> *) (a :: k). IntT f a -> f a
    unIntT (IntT f t -> f t) -> IntT f t -> f t
    forall a b. (a -> b) -> a -> b
    $ Indexing f t -> Int -> IntT f t
    forall {k} (f :: k -> *) (a :: k). Indexing f a -> Int -> IntT f a
    runIndexing ((a -> Indexing f b) -> s -> Indexing f t
    l (\a
    a -> (Int -> IntT f b) -> Indexing f b
    forall {k} (f :: k -> *) (a :: k).
    (Int -> IntT f a) -> Indexing f a
    Indexing (\Int
    i -> Int -> f b -> IntT f b
    forall {k} (f :: k -> *) (a :: k). Int -> f a -> IntT f a
    IntT (Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) (Int -> a -> f b
    iafb Int
    i a
    a))) s
    s) Int
    0

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

    -- | Construct a conjoined indexed optic that provides a separate code path when
    -- used without indices. Useful for defining indexed optics that are as
    -- efficient as their unindexed equivalents when used without indices.
    --
    -- /Note:/ @'conjoined' f g@ is well-defined if and only if @f ≡
    -- 'Optics.Indexed.Core.noIx' g@.
    conjoined
      :: is `HasSingleIndex` i
      => Optic k NoIx s t a b
      -> Optic k is   s t a b
      -> Optic k is   s t a b
    conjoined :: forall (is :: IxList) i k s t a b.
    HasSingleIndex is i =>
    Optic k NoIx s t a b -> Optic k is s t a b -> Optic k is s t a b
    conjoined (Optic forall (p :: * -> * -> * -> *) i.
    Profunctor p =>
    Optic_ k p i (Curry NoIx i) s t a b
    f) (Optic forall (p :: * -> * -> * -> *) i.
    Profunctor p =>
    Optic_ k p i (Curry is i) s t a b
    g) = (forall (p :: * -> * -> * -> *) i.
     Profunctor p =>
     Optic_ k p i (Curry is i) s t a b)
    -> Optic k is s t a b
    forall k (is :: IxList) s t a b.
    (forall (p :: * -> * -> * -> *) i.
     Profunctor p =>
     Optic_ k p i (Curry is i) s t a b)
    -> Optic k is s t a b
    Optic ((p i a b -> p i s t)
    -> (p i a b -> p (i -> i) s t) -> p i a b -> p (i -> i) s t
    forall i a b s t j.
    (p i a b -> p i s t) -> (p i a b -> p j s t) -> p i a b -> p j s t
    forall (p :: * -> * -> * -> *) i a b s t j.
    Profunctor p =>
    (p i a b -> p i s t) -> (p i a b -> p j s t) -> p i a b -> p j s t
    conjoined__ p i a b -> p i s t
    Optic__ p i (Curry NoIx i) s t a b
    forall (p :: * -> * -> * -> *) i.
    Profunctor p =>
    Optic_ k p i (Curry NoIx i) s t a b
    f p i a b -> p (Curry is i) s t
    p i a b -> p (i -> i) s t
    forall (p :: * -> * -> * -> *) i.
    Profunctor p =>
    Optic_ k p i (Curry is i) s t a b
    g)