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

-- | Core optic types and subtyping machinery.
--
-- This module contains the core 'Optic' types, and the underlying
-- machinery that we need in order to implement the subtyping between
-- various different flavours of optics.
--
-- The composition operator for optics is also defined here.
--
-- This module is intended for internal use only, and may change without
-- warning in subsequent releases.
--
module Optics.Internal.Optic
  ( Optic(..)
  , Optic'
  , Optic_
  , Optic__
  , getOptic
  , castOptic
  , (%)
  , (%%)
  , (%&)
  -- * Re-exports
  , module Optics.Internal.Optic.Subtyping
  , module Optics.Internal.Optic.Types
  , module Optics.Internal.Optic.TypeLevel
  ) where

import Data.Function ((&))

import Data.Profunctor.Indexed

import Optics.Internal.Optic.Subtyping
import Optics.Internal.Optic.TypeLevel
import Optics.Internal.Optic.Types

-- | Wrapper newtype for the whole family of optics.
--
-- The first parameter @k@ identifies the particular optic kind (e.g. 'A_Lens'
-- or 'A_Traversal').
--
-- The parameter @is@ is a list of types available as indices.  This will
-- typically be 'NoIx' for unindexed optics, or 'WithIx' for optics with a
-- single index. See the "Indexed optics" section of the overview documentation
-- in the @Optics@ module of the main @optics@ package for more details.
--
-- The parameters @s@ and @t@ represent the "big" structure,
-- whereas @a@ and @b@ represent the "small" structure.
--
newtype Optic (k :: OpticKind) (is :: IxList) s t a b
  = Optic (forall p i. Profunctor p => Optic_ k p i (Curry is i) s t a b)

-- | Strip the newtype wrapper off.
getOptic
  :: Profunctor p
  => Optic k is s t a b
  -> Optic_ k p i (Curry is i) s t a b
-- Note: This is not part of the definition of 'Optic' because it needs to be
-- marked INLINE for GHC to optimize away profunctor classes when profiling.
-- See https://github.com/well-typed/optics/issues/324 for more details.
getOptic :: Optic k is s t a b -> Optic_ k p i (Curry is i) s t a b
getOptic (Optic forall (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_ k p i (Curry is i) s t a b
o) = Optic__ p i (Curry is i) s t a b
forall (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_ k p i (Curry is i) s t a b
o
{-# INLINE getOptic #-}

-- | Common special case of 'Optic' where source and target types are equal.
--
-- Here, we need only one "big" and one "small" type. For lenses, this
-- means that in the restricted form we cannot do type-changing updates.
--
type Optic' k is s a = Optic k is s s a a

-- | Type representing the various kinds of optics.
--
-- The tag parameter @k@ is translated into constraints on @p@
-- via the type family 'Constraints'.
--
type Optic_ k p i j s t a b = Constraints k p => Optic__ p i j s t a b

-- | Optic internally as a profunctor transformation.
type Optic__ p i j s t a b = p i a b -> p j s t

-- | Explicit cast from one optic flavour to another.
--
-- The resulting optic kind is given in the first type argument, so you can use
-- TypeApplications to set it. For example
--
-- @
--  'castOptic' @'A_Lens' o
-- @
--
-- turns @o@ into a 'Optics.Lens.Lens'.
--
-- This is the identity function, modulo some constraint jiggery-pokery.
--
castOptic
  :: forall destKind srcKind is s t a b
  .  Is srcKind destKind
  => Optic srcKind  is s t a b
  -> Optic destKind is s t a b
castOptic :: Optic srcKind is s t a b -> Optic destKind is s t a b
castOptic (Optic forall (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_ srcKind p i (Curry is i) s t a b
o) = (forall (p :: * -> * -> * -> *) i.
 Profunctor p =>
 Optic_ destKind p i (Curry is i) s t a b)
-> Optic destKind 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 (Optic_ srcKind p i (Curry is i) s t a b
-> Optic_ destKind p i (Curry is i) s t a b
forall (p :: * -> * -> * -> *) i.
Optic_ srcKind p i (Curry is i) s t a b
-> Optic_ destKind p i (Curry is i) s t a b
cast Optic_ srcKind p i (Curry is i) s t a b
forall (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_ srcKind p i (Curry is i) s t a b
o)
  where
    cast
      :: forall p i
      .  Optic_ srcKind  p i (Curry is i) s t a b
      -> Optic_ destKind p i (Curry is i) s t a b
    cast :: Optic_ srcKind p i (Curry is i) s t a b
-> Optic_ destKind p i (Curry is i) s t a b
cast Optic_ srcKind p i (Curry is i) s t a b
x = Optic_ srcKind p i (Curry is i) s t a b
-> Optic_ destKind p i (Curry is i) s t a b
forall k l (p :: * -> * -> * -> *) r.
Is k l =>
(Constraints k p => r) -> Constraints l p => r
implies @srcKind @destKind @p Optic_ srcKind p i (Curry is i) s t a b
x

-- | Compose two optics of compatible flavours.
--
-- Returns an optic of the appropriate supertype.  If either or both optics are
-- indexed, the composition preserves all the indices.
--
infixl 9 %
(%) :: forall k l m is js ks s t u v a b. (JoinKinds k l m, AppendIndices is js ks)
    => Optic k is s t u v
    -> Optic l js u v a b
    -> Optic m ks s t a b
Optic forall (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_ k p i (Curry is i) s t u v
k % :: Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic forall (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_ l p i (Curry js i) u v a b
l = (forall (p :: * -> * -> * -> *) i.
 Profunctor p =>
 Optic_ m p i (Curry ks i) s t a b)
-> Optic m ks 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 forall (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_ m p i (Curry ks i) s t a b
m
  where
    km :: forall p i. Profunctor p => Optic_ m p i (Curry is i) s t u v
    km :: Optic__ p i (Curry is i) s t u v
km = ((Constraints k p, Constraints l p) =>
 Optic__ p i (Curry is i) s t u v)
-> Constraints m p => Optic__ p i (Curry is i) s t u v
forall k l m (p :: * -> * -> * -> *) r.
JoinKinds k l m =>
((Constraints k p, Constraints l p) => r) -> Constraints m p => r
joinKinds @k @l @m @p (Constraints k p, Constraints l p) =>
Optic__ p i (Curry is i) s t u v
forall (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_ k p i (Curry is i) s t u v
k

    lm :: forall p i. Profunctor p => Optic_ m p i (Curry js i) u v a b
    lm :: Optic__ p i (Curry js i) u v a b
lm = ((Constraints k p, Constraints l p) =>
 Optic__ p i (Curry js i) u v a b)
-> Constraints m p => Optic__ p i (Curry js i) u v a b
forall k l m (p :: * -> * -> * -> *) r.
JoinKinds k l m =>
((Constraints k p, Constraints l p) => r) -> Constraints m p => r
joinKinds @k @l @m @p (Constraints k p, Constraints l p) =>
Optic__ p i (Curry js i) u v a b
forall (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_ l p i (Curry js i) u v a b
l

    m :: forall p i. (Profunctor p, Constraints m p)
      => Optic__ p i (Curry ks i) s t a b
    m :: Optic__ p i (Curry ks i) s t a b
m | IxEq i (Curry is (Curry js i)) (Curry ks i)
IxEq <- IxEq i (Curry is (Curry js i)) (Curry ks i)
forall (xs :: IxList) (ys :: IxList) (ks :: IxList) i.
AppendIndices xs ys ks =>
IxEq i (Curry xs (Curry ys i)) (Curry ks i)
appendIndices @is @js @ks @i = p (Curry js i) u v -> p (Curry is (Curry js i)) s t
forall (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_ m p i (Curry is i) s t u v
km (p (Curry js i) u v -> p (Curry is (Curry js i)) s t)
-> (p i a b -> p (Curry js i) u v)
-> p i a b
-> p (Curry is (Curry js i)) s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p i a b -> p (Curry js i) u v
forall (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_ m p i (Curry js i) u v a b
lm

-- | Compose two optics of the same flavour.
--
-- Normally you can simply use ('%') instead, but this may be useful to help
-- type inference if the type of one of the optics is otherwise
-- under-constrained.
infixl 9 %%
(%%) :: forall k is js ks s t u v a b. AppendIndices is js ks
     => Optic k is s t u v
     -> Optic k js u v a b
     -> Optic k ks s t a b
Optic forall (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_ k p i (Curry is i) s t u v
o %% :: Optic k is s t u v -> Optic k js u v a b -> Optic k ks s t a b
%% Optic forall (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_ k p i (Curry js i) u v a b
o' = (forall (p :: * -> * -> * -> *) i.
 Profunctor p =>
 Optic_ k p i (Curry ks i) s t a b)
-> Optic k ks 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 forall (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_ k p i (Curry ks i) s t a b
oo
  where
    oo :: forall p i. (Profunctor p, Constraints k p)
       => Optic__ p i (Curry ks i) s t a b
    oo :: Optic__ p i (Curry ks i) s t a b
oo | IxEq i (Curry is (Curry js i)) (Curry ks i)
IxEq <- IxEq i (Curry is (Curry js i)) (Curry ks i)
forall (xs :: IxList) (ys :: IxList) (ks :: IxList) i.
AppendIndices xs ys ks =>
IxEq i (Curry xs (Curry ys i)) (Curry ks i)
appendIndices @is @js @ks @i = p (Curry js i) u v -> p (Curry is (Curry js i)) s t
forall (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_ k p i (Curry is i) s t u v
o (p (Curry js i) u v -> p (Curry is (Curry js i)) s t)
-> (p i a b -> p (Curry js i) u v)
-> p i a b
-> p (Curry is (Curry js i)) s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p i a b -> p (Curry js i) u v
forall (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_ k p i (Curry js i) u v a b
o'

-- | Flipped function application, specialised to optics and binding tightly.
--
-- Useful for post-composing optics transformations:
--
-- >>> toListOf (ifolded %& ifiltered (\i s -> length s <= i)) ["", "a","abc"]
-- ["","a"]
--
infixl 9 %&
(%&) :: Optic k is s t a b
     -> (Optic k is s t a b -> Optic l js s' t' a' b')
     -> Optic l js s' t' a' b'
%& :: Optic k is s t a b
-> (Optic k is s t a b -> Optic l js s' t' a' b')
-> Optic l js s' t' a' b'
(%&) = Optic k is s t a b
-> (Optic k is s t a b -> Optic l js s' t' a' b')
-> Optic l js s' t' a' b'
forall a b. a -> (a -> b) -> b
(&)

-- $setup
-- >>> import Optics.Core