{-# LANGUAGE DataKinds #-}
-- |
-- Module: Optics.Indexed.Core
-- Description: Core definitions for indexed optics.
--
-- This module defines basic functionality for indexed optics.  See the "Indexed
-- optics" section of the overview documentation in the @Optics@ module of the
-- main @optics@ package for more details.
--
module Optics.Indexed.Core
  (
  -- * Class for optic kinds that can be indexed
    IxOptic(..)

  , conjoined

  -- * Composition of indexed optics
  , (%)
  , (<%>)
  , (%>)
  , (<%)
  , reindexed
  , icompose
  , icompose3
  , icompose4
  , icompose5
  , icomposeN

    -- * Indexed optic flavours
  , module Optics.IxAffineFold
  , module Optics.IxAffineTraversal
  , module Optics.IxFold
  , module Optics.IxGetter
  , module Optics.IxLens
  , module Optics.IxSetter
  , module Optics.IxTraversal

  -- * Functors with index
  , FunctorWithIndex (..)
  -- ** Foldable with index
  , FoldableWithIndex (..)
  , itraverse_
  , ifor_
  , itoList
  -- ** Traversable with index
  , TraversableWithIndex (..)
  , ifor
  ) where

import Data.Profunctor.Indexed

import Optics.Internal.Indexed
import Optics.Internal.Indexed.Classes
import Optics.Internal.Optic

import Optics.AffineFold
import Optics.AffineTraversal
import Optics.Fold
import Optics.Getter
import Optics.IxAffineFold
import Optics.IxAffineTraversal
import Optics.IxFold
import Optics.IxGetter
import Optics.IxLens
import Optics.IxSetter
import Optics.IxTraversal
import Optics.Lens
import Optics.Setter
import Optics.Traversal

-- | Compose two indexed optics. Their indices are composed as a pair.
--
-- >>> itoListOf (ifolded <%> ifolded) ["foo", "bar"]
-- [((0,0),'f'),((0,1),'o'),((0,2),'o'),((1,0),'b'),((1,1),'a'),((1,2),'r')]
--
infixl 9 <%>
(<%>)
  :: (JoinKinds k l m, IxOptic m s t a b, is `HasSingleIndex` i, js `HasSingleIndex` j)
  => Optic k is              s t u v
  -> Optic l js              u v a b
  -> Optic m (WithIx (i, j)) s t a b
Optic k is s t u v
o <%> :: forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (s :: OpticKind) (t :: OpticKind) (a :: OpticKind) (b :: OpticKind)
       (is :: IxList) (i :: OpticKind) (js :: IxList) (j :: OpticKind)
       (u :: OpticKind) (v :: OpticKind).
(JoinKinds k l m, IxOptic m s t a b, HasSingleIndex is i,
 HasSingleIndex js j) =>
Optic k is s t u v
-> Optic l js u v a b -> Optic m (WithIx (i, j)) s t a b
<%> Optic l js u v a b
o' = forall (i :: OpticKind) (j :: OpticKind) (ix :: OpticKind)
       (k :: OpticKind) (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(i -> j -> ix)
-> Optic k '[i, j] s t a b -> Optic k (WithIx ix) s t a b
icompose (,) (Optic k is s t u v
o forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(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 l js u v a b
o')
{-# INLINE (<%>) #-}

-- | Compose two indexed optics and drop indices of the left one. (If you want
-- to compose a non-indexed and an indexed optic, you can just use ('%').)
--
-- >>> itoListOf (ifolded %> ifolded) ["foo", "bar"]
-- [(0,'f'),(1,'o'),(2,'o'),(0,'b'),(1,'a'),(2,'r')]
--
infixl 9 %>
(%>)
  :: (JoinKinds k l m, IxOptic k s t u v, NonEmptyIndices is)
  => Optic k is s t u v
  -> Optic l js u v a b
  -> Optic m js s t a b
Optic k is s t u v
o %> :: forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (s :: OpticKind) (t :: OpticKind) (u :: OpticKind) (v :: OpticKind)
       (is :: IxList) (js :: IxList) (a :: OpticKind) (b :: OpticKind).
(JoinKinds k l m, IxOptic k s t u v, NonEmptyIndices is) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m js s t a b
%> Optic l js u v a b
o' = forall (k :: OpticKind) (s :: OpticKind) (t :: OpticKind)
       (a :: OpticKind) (b :: OpticKind) (is :: IxList).
(IxOptic k s t a b, NonEmptyIndices is) =>
Optic k is s t a b -> Optic k '[] s t a b
noIx Optic k is s t u v
o forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(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 l js u v a b
o'
{-# INLINE (%>) #-}

-- | Compose two indexed optics and drop indices of the right one. (If you want
-- to compose an indexed and a non-indexed optic, you can just use ('%').)
--
-- >>> itoListOf (ifolded <% ifolded) ["foo", "bar"]
-- [(0,'f'),(0,'o'),(0,'o'),(1,'b'),(1,'a'),(1,'r')]
--
infixl 9 <%
(<%)
  :: (JoinKinds k l m, IxOptic l u v a b, NonEmptyIndices js)
  => Optic k is s t u v
  -> Optic l js u v a b
  -> Optic m is s t a b
Optic k is s t u v
o <% :: forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (u :: OpticKind) (v :: OpticKind) (a :: OpticKind) (b :: OpticKind)
       (js :: IxList) (is :: IxList) (s :: OpticKind) (t :: OpticKind).
(JoinKinds k l m, IxOptic l u v a b, NonEmptyIndices js) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m is s t a b
<% Optic l js u v a b
o' = Optic k is s t u v
o forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(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
% forall (k :: OpticKind) (s :: OpticKind) (t :: OpticKind)
       (a :: OpticKind) (b :: OpticKind) (is :: IxList).
(IxOptic k s t a b, NonEmptyIndices is) =>
Optic k is s t a b -> Optic k '[] s t a b
noIx Optic l js u v a b
o'
{-# INLINE (<%) #-}

-- | Remap the index.
--
-- >>> itoListOf (reindexed succ ifolded) "foo"
-- [(1,'f'),(2,'o'),(3,'o')]
--
-- >>> itoListOf (ifolded %& reindexed succ) "foo"
-- [(1,'f'),(2,'o'),(3,'o')]
--
reindexed
  :: is `HasSingleIndex` i
  => (i -> j)
  -> Optic k is         s t a b
  -> Optic k (WithIx j) s t a b
reindexed :: forall (is :: IxList) (i :: OpticKind) (j :: OpticKind)
       (k :: OpticKind) (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
HasSingleIndex is i =>
(i -> j) -> Optic k is s t a b -> Optic k (WithIx j) s t a b
reindexed = forall (k :: OpticKind) (i :: OpticKind) (is :: IxList)
       (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(CurryCompose is, NonEmptyIndices is) =>
Curry is i -> Optic k is s t a b -> Optic k (WithIx i) s t a b
icomposeN
{-# INLINE reindexed #-}

-- | Flatten indices obtained from two indexed optics.
--
-- >>> itoListOf (ifolded % ifolded %& icompose (,)) ["foo","bar"]
-- [((0,0),'f'),((0,1),'o'),((0,2),'o'),((1,0),'b'),((1,1),'a'),((1,2),'r')]
--
icompose
  :: (i -> j -> ix)
  -> Optic k '[i, j]     s t a b
  -> Optic k (WithIx ix) s t a b
icompose :: forall (i :: OpticKind) (j :: OpticKind) (ix :: OpticKind)
       (k :: OpticKind) (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(i -> j -> ix)
-> Optic k '[i, j] s t a b -> Optic k (WithIx ix) s t a b
icompose = forall (k :: OpticKind) (i :: OpticKind) (is :: IxList)
       (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(CurryCompose is, NonEmptyIndices is) =>
Curry is i -> Optic k is s t a b -> Optic k (WithIx i) s t a b
icomposeN
{-# INLINE icompose #-}

-- | Flatten indices obtained from three indexed optics.
--
-- >>> itoListOf (ifolded % ifolded % ifolded %& icompose3 (,,)) [["foo","bar"],["xyz"]]
-- [((0,0,0),'f'),((0,0,1),'o'),((0,0,2),'o'),((0,1,0),'b'),((0,1,1),'a'),((0,1,2),'r'),((1,0,0),'x'),((1,0,1),'y'),((1,0,2),'z')]
--
icompose3
  :: (i1 -> i2 -> i3 -> ix)
  -> Optic k '[i1, i2, i3] s t a b
  -> Optic k (WithIx ix)   s t a b
icompose3 :: forall (i1 :: OpticKind) (i2 :: OpticKind) (i3 :: OpticKind)
       (ix :: OpticKind) (k :: OpticKind) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
(i1 -> i2 -> i3 -> ix)
-> Optic k '[i1, i2, i3] s t a b -> Optic k (WithIx ix) s t a b
icompose3 = forall (k :: OpticKind) (i :: OpticKind) (is :: IxList)
       (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(CurryCompose is, NonEmptyIndices is) =>
Curry is i -> Optic k is s t a b -> Optic k (WithIx i) s t a b
icomposeN
{-# INLINE icompose3 #-}

-- | Flatten indices obtained from four indexed optics.
icompose4
  :: (i1 -> i2 -> i3 -> i4 -> ix)
  -> Optic k '[i1, i2, i3, i4] s t a b
  -> Optic k (WithIx ix)       s t a b
icompose4 :: forall (i1 :: OpticKind) (i2 :: OpticKind) (i3 :: OpticKind)
       (i4 :: OpticKind) (ix :: OpticKind) (k :: OpticKind)
       (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(i1 -> i2 -> i3 -> i4 -> ix)
-> Optic k '[i1, i2, i3, i4] s t a b -> Optic k (WithIx ix) s t a b
icompose4 = forall (k :: OpticKind) (i :: OpticKind) (is :: IxList)
       (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(CurryCompose is, NonEmptyIndices is) =>
Curry is i -> Optic k is s t a b -> Optic k (WithIx i) s t a b
icomposeN
{-# INLINE icompose4 #-}

-- | Flatten indices obtained from five indexed optics.
icompose5
  :: (i1 -> i2 -> i3 -> i4 -> i5 -> ix)
  -> Optic k '[i1, i2, i3, i4, i5] s t a b
  -> Optic k (WithIx ix)           s t a b
icompose5 :: forall (i1 :: OpticKind) (i2 :: OpticKind) (i3 :: OpticKind)
       (i4 :: OpticKind) (i5 :: OpticKind) (ix :: OpticKind)
       (k :: OpticKind) (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(i1 -> i2 -> i3 -> i4 -> i5 -> ix)
-> Optic k '[i1, i2, i3, i4, i5] s t a b
-> Optic k (WithIx ix) s t a b
icompose5 = forall (k :: OpticKind) (i :: OpticKind) (is :: IxList)
       (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(CurryCompose is, NonEmptyIndices is) =>
Curry is i -> Optic k is s t a b -> Optic k (WithIx i) s t a b
icomposeN
{-# INLINE icompose5 #-}

-- | Flatten indices obtained from arbitrary number of indexed optics.
icomposeN
  :: forall k i is s t a b
  . (CurryCompose is, NonEmptyIndices is)
  => Curry is i
  -> Optic k is         s t a b
  -> Optic k (WithIx i) s t a b
icomposeN :: forall (k :: OpticKind) (i :: OpticKind) (is :: IxList)
       (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(CurryCompose is, NonEmptyIndices is) =>
Curry is i -> Optic k is s t a b -> Optic k (WithIx i) s t a b
icomposeN Curry is i
f (Optic forall (p :: OpticKind -> OpticKind -> OpticKind -> OpticKind)
       (i :: OpticKind).
Profunctor p =>
Optic_ k p i (Curry is i) s t a b
o) = forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
(forall (p :: OpticKind -> OpticKind -> OpticKind -> OpticKind)
        (i :: OpticKind).
 Profunctor p =>
 Optic_ k p i (Curry is i) s t a b)
-> Optic k is s t a b
Optic (forall (p :: OpticKind -> OpticKind -> OpticKind -> OpticKind)
       (j :: OpticKind) (i :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Profunctor p =>
(j -> i) -> p i a b -> p j a b
ixcontramap (\i -> i
ij -> forall (xs :: IxList) (i :: OpticKind) (j :: OpticKind).
CurryCompose xs =>
(i -> j) -> Curry xs i -> Curry xs j
composeN @is i -> i
ij Curry is i
f) forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (p :: OpticKind -> OpticKind -> OpticKind -> OpticKind)
       (i :: OpticKind).
Profunctor p =>
Optic_ k p i (Curry is i) s t a b
o)
{-# INLINE icomposeN #-}

----------------------------------------
-- IxOptic

-- | Class for optic kinds that can have indices.
class IxOptic k s t a b where
  -- | Convert an indexed optic to its unindexed equivalent.
  noIx
    :: NonEmptyIndices is
    => Optic k is   s t a b
    -> Optic k NoIx s t a b

instance (s ~ t, a ~ b) => IxOptic A_Getter s t a b where
  noIx :: forall (is :: IxList).
NonEmptyIndices is =>
Optic A_Getter is s t a b -> Optic A_Getter '[] s t a b
noIx Optic A_Getter is s t a b
o = forall (s :: OpticKind) (a :: OpticKind). (s -> a) -> Getter s a
to (forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (a :: OpticKind).
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic A_Getter is s t a b
o)
  {-# INLINE noIx #-}

instance IxOptic A_Lens s t a b where
  noIx :: forall (is :: IxList).
NonEmptyIndices is =>
Optic A_Lens is s t a b -> Optic A_Lens '[] s t a b
noIx Optic A_Lens is s t a b
o = forall (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
LensVL s t a b -> Lens s t a b
lensVL (forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Lens =>
Optic k is s t a b -> LensVL s t a b
toLensVL Optic A_Lens is s t a b
o)
  {-# INLINE noIx #-}

instance IxOptic An_AffineTraversal s t a b where
  noIx :: forall (is :: IxList).
NonEmptyIndices is =>
Optic An_AffineTraversal is s t a b
-> Optic An_AffineTraversal '[] s t a b
noIx Optic An_AffineTraversal is s t a b
o = forall (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
AffineTraversalVL s t a b -> AffineTraversal s t a b
atraversalVL (forall (k :: OpticKind) (f :: OpticKind -> OpticKind)
       (is :: IxList) (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(Is k An_AffineTraversal, Functor f) =>
Optic k is s t a b
-> (forall (r :: OpticKind). r -> f r) -> (a -> f b) -> s -> f t
atraverseOf Optic An_AffineTraversal is s t a b
o)
  {-# INLINE noIx #-}

instance (s ~ t, a ~ b) => IxOptic An_AffineFold s t a b where
  noIx :: forall (is :: IxList).
NonEmptyIndices is =>
Optic An_AffineFold is s t a b -> Optic An_AffineFold '[] s t a b
noIx Optic An_AffineFold is s t a b
o = forall (s :: OpticKind) (a :: OpticKind).
(s -> Maybe a) -> AffineFold s a
afolding (forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (a :: OpticKind).
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview Optic An_AffineFold is s t a b
o)
  {-# INLINE noIx #-}

instance IxOptic A_Traversal s t a b where
  noIx :: forall (is :: IxList).
NonEmptyIndices is =>
Optic A_Traversal is s t a b -> Optic A_Traversal '[] s t a b
noIx Optic A_Traversal is s t a b
o = forall (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
TraversalVL s t a b -> Traversal s t a b
traversalVL (forall (k :: OpticKind) (f :: OpticKind -> OpticKind)
       (is :: IxList) (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(Is k A_Traversal, Applicative f) =>
Optic k is s t a b -> (a -> f b) -> s -> f t
traverseOf Optic A_Traversal is s t a b
o)
  {-# INLINE noIx #-}

instance (s ~ t, a ~ b) => IxOptic A_Fold s t a b where
  noIx :: forall (is :: IxList).
NonEmptyIndices is =>
Optic A_Fold is s t a b -> Optic A_Fold '[] s t a b
noIx Optic A_Fold is s t a b
o = forall (a :: OpticKind) (u :: OpticKind) (s :: OpticKind)
       (v :: OpticKind).
(forall (f :: OpticKind -> OpticKind).
 Applicative f =>
 (a -> f u) -> s -> f v)
-> Fold s a
foldVL (forall (k :: OpticKind) (f :: OpticKind -> OpticKind)
       (is :: IxList) (s :: OpticKind) (a :: OpticKind) (r :: OpticKind).
(Is k A_Fold, Applicative f) =>
Optic' k is s a -> (a -> f r) -> s -> f ()
traverseOf_ Optic A_Fold is s t a b
o)
  {-# INLINE noIx #-}

instance IxOptic A_Setter s t a b where
  noIx :: forall (is :: IxList).
NonEmptyIndices is =>
Optic A_Setter is s t a b -> Optic A_Setter '[] s t a b
noIx Optic A_Setter is s t a b
o = forall (a :: OpticKind) (b :: OpticKind) (s :: OpticKind)
       (t :: OpticKind).
((a -> b) -> s -> t) -> Setter s t a b
sets (forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Setter is s t a b
o)
  {-# INLINE noIx #-}

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