content: {-# 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 (IntT _ fa) = fa
  
  newtype Indexing f a = Indexing { runIndexing :: Int -> IntT f a }
  
  instance Functor f => Functor (Indexing f) where
    fmap f (Indexing m) = Indexing $ \i -> case m i of
      IntT j x -> IntT j (fmap f x)
  
  instance Applicative f => Applicative (Indexing f) where
    pure x = Indexing $ \i -> IntT i (pure x)
    Indexing mf <*> Indexing ma = Indexing $ \i -> case mf i of
      IntT j ff -> case ma j of
         IntT k fa -> IntT k (ff <*> 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 l iafb s =
    unIntT $ runIndexing (l (\a -> Indexing (\i -> IntT (i + 1) (iafb i a))) s) 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 (Optic f) (Optic g) = Optic (conjoined__ f g)
  