{-# LANGUAGE DataKinds #-}
-- |
-- Module: Optics.IxSetter
-- Description: An indexed version of a 'Optics.Setter.Setter'.
--
-- An 'IxSetter' is an indexed version of a 'Optics.Setter.Setter'. See the
-- "Indexed optics" section of the overview documentation in the @Optics@ module
-- of the main @optics@ package for more details on indexed optics.
--
module Optics.IxSetter
  (
  -- * Formation
    IxSetter
  , IxSetter'

  -- * Introduction
  , isets

  -- * Elimination
  , iover

  -- * Computation
  -- |
  --
  -- @
  -- 'iover' ('isets' f) ≡ f
  -- @

  -- * Well-formedness
  -- |
  --
  -- * __PutPut__: Setting twice is the same as setting once:
  --
  --     @
  --     'Optics.Setter.iset' l v' ('Optics.Setter.iset' l v s) ≡ 'Optics.Setter.iset' l v' s
  --     @
  --
  -- * __Functoriality__: 'IxSetter's must preserve identities and composition:
  --
  --     @
  --     'iover' s ('const' 'id') ≡ 'id'
  --     'iover' s f '.' 'iover' s g ≡ 'iover' s (\i -> f i '.' g i)
  --     @

  -- * Additional introduction forms
  , imapped

  -- * Additional elimination forms
  , iset
  , iset'
  , iover'

  -- * Subtyping
  , A_Setter

  -- * Re-exports
  , FunctorWithIndex(..)
  ) where

import Data.Profunctor.Indexed

import Optics.Internal.Indexed
import Optics.Internal.Indexed.Classes
import Optics.Internal.IxSetter
import Optics.Internal.Optic
import Optics.Internal.Utils

-- | Type synonym for a type-modifying indexed setter.
type IxSetter i s t a b = Optic A_Setter (WithIx i) s t a b

-- | Type synonym for a type-preserving indexed setter.
type IxSetter' i s a = Optic' A_Setter (WithIx i) s a

-- | Apply an indexed setter as a modifier.
iover
  :: (Is k A_Setter, is `HasSingleIndex` i)
  => Optic k is s t a b
  -> (i -> a -> b) -> s -> t
iover :: forall (k :: OpticKind) (is :: IxList) (i :: OpticKind)
       (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(Is k A_Setter, HasSingleIndex is i) =>
Optic k is s t a b -> (i -> a -> b) -> s -> t
iover Optic k is s t a b
o = \i -> a -> b
f -> IxFunArrow (i -> i) s t -> (i -> i) -> s -> t
forall (i :: OpticKind) (a :: OpticKind) (b :: OpticKind).
IxFunArrow i a b -> i -> a -> b
runIxFunArrow (Optic A_Setter is s t a b
-> Optic_ A_Setter IxFunArrow i (Curry is i) s t a b
forall (p :: OpticKind -> OpticKind -> OpticKind -> OpticKind)
       (k :: OpticKind) (is :: IxList) (s :: OpticKind) (t :: OpticKind)
       (a :: OpticKind) (b :: OpticKind) (i :: OpticKind).
Profunctor p =>
Optic k is s t a b -> Optic_ k p i (Curry is i) s t a b
getOptic (forall (destKind :: OpticKind) (srcKind :: OpticKind)
       (is :: IxList) (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Is srcKind destKind =>
Optic srcKind is s t a b -> Optic destKind is s t a b
castOptic @A_Setter Optic k is s t a b
o) ((i -> a -> b) -> IxFunArrow i a b
forall (i :: OpticKind) (a :: OpticKind) (b :: OpticKind).
(i -> a -> b) -> IxFunArrow i a b
IxFunArrow i -> a -> b
f)) i -> i
forall (a :: OpticKind). a -> a
id
{-# INLINE iover #-}

-- | Apply an indexed setter as a modifier, strictly.
iover'
  :: (Is k A_Setter, is `HasSingleIndex` i)
  => Optic k is s t a b
  -> (i -> a -> b) -> s -> t
iover' :: forall (k :: OpticKind) (is :: IxList) (i :: OpticKind)
       (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(Is k A_Setter, HasSingleIndex is i) =>
Optic k is s t a b -> (i -> a -> b) -> s -> t
iover' Optic k is s t a b
o = \i -> a -> b
f ->
  let star :: IxStar Identity' (Curry is i) s t
star = Optic A_Setter is s t a b
-> Optic_ A_Setter (IxStar Identity') i (Curry is i) s t a b
forall (p :: OpticKind -> OpticKind -> OpticKind -> OpticKind)
       (k :: OpticKind) (is :: IxList) (s :: OpticKind) (t :: OpticKind)
       (a :: OpticKind) (b :: OpticKind) (i :: OpticKind).
Profunctor p =>
Optic k is s t a b -> Optic_ k p i (Curry is i) s t a b
getOptic (forall (destKind :: OpticKind) (srcKind :: OpticKind)
       (is :: IxList) (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Is srcKind destKind =>
Optic srcKind is s t a b -> Optic destKind is s t a b
castOptic @A_Setter Optic k is s t a b
o) Optic__ (IxStar Identity') i (Curry is i) s t a b
-> Optic__ (IxStar Identity') i (Curry is i) s t a b
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (i -> a -> Identity' b) -> IxStar Identity' i a b
forall (f :: OpticKind -> OpticKind) (i :: OpticKind)
       (a :: OpticKind) (b :: OpticKind).
(i -> a -> f b) -> IxStar f i a b
IxStar (\i
i -> b -> Identity' b
forall (a :: OpticKind). a -> Identity' a
wrapIdentity' (b -> Identity' b) -> (a -> b) -> a -> Identity' b
forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. i -> a -> b
f i
i)
  in Identity' t -> t
forall (a :: OpticKind). Identity' a -> a
unwrapIdentity' (Identity' t -> t) -> (s -> Identity' t) -> s -> t
forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. IxStar Identity' (i -> i) s t -> (i -> i) -> s -> Identity' t
forall (f :: OpticKind -> OpticKind) (i :: OpticKind)
       (a :: OpticKind) (b :: OpticKind).
IxStar f i a b -> i -> a -> f b
runIxStar IxStar Identity' (Curry is i) s t
IxStar Identity' (i -> i) s t
star i -> i
forall (a :: OpticKind). a -> a
id

{-# INLINE iover' #-}

-- | Apply an indexed setter.
--
-- @
-- 'iset' o f ≡ 'iover' o (\i _ -> f i)
-- @
--
iset
  :: (Is k A_Setter, is `HasSingleIndex` i)
  => Optic k is s t a b
  -> (i -> b) -> s -> t
iset :: forall (k :: OpticKind) (is :: IxList) (i :: OpticKind)
       (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(Is k A_Setter, HasSingleIndex is i) =>
Optic k is s t a b -> (i -> b) -> s -> t
iset Optic k is s t a b
o = \i -> b
f -> Optic k is s t a b -> (i -> a -> b) -> s -> t
forall (k :: OpticKind) (is :: IxList) (i :: OpticKind)
       (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(Is k A_Setter, HasSingleIndex is i) =>
Optic k is s t a b -> (i -> a -> b) -> s -> t
iover Optic k is s t a b
o (\i
i a
_ -> i -> b
f i
i)
{-# INLINE iset #-}

-- | Apply an indexed setter, strictly.
iset'
  :: (Is k A_Setter, is `HasSingleIndex` i)
  => Optic k is s t a b
  -> (i -> b) -> s -> t
iset' :: forall (k :: OpticKind) (is :: IxList) (i :: OpticKind)
       (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(Is k A_Setter, HasSingleIndex is i) =>
Optic k is s t a b -> (i -> b) -> s -> t
iset' Optic k is s t a b
o = \i -> b
f -> Optic k is s t a b -> (i -> a -> b) -> s -> t
forall (k :: OpticKind) (is :: IxList) (i :: OpticKind)
       (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(Is k A_Setter, HasSingleIndex is i) =>
Optic k is s t a b -> (i -> a -> b) -> s -> t
iover' Optic k is s t a b
o (\i
i a
_ -> i -> b
f i
i)
{-# INLINE iset' #-}

-- | Build an indexed setter from a function to modify the element(s).
isets
  :: ((i -> a -> b) -> s -> t)
  -> IxSetter i s t a b
isets :: forall (i :: OpticKind) (a :: OpticKind) (b :: OpticKind)
       (s :: OpticKind) (t :: OpticKind).
((i -> a -> b) -> s -> t) -> IxSetter i s t a b
isets (i -> a -> b) -> s -> t
f = (forall (p :: OpticKind -> OpticKind -> OpticKind -> OpticKind)
        (i :: OpticKind).
 Profunctor p =>
 Optic_ A_Setter p i (Curry (WithIx i) i) s t a b)
-> Optic A_Setter (WithIx i) s t a b
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 (((i -> a -> b) -> s -> t) -> p i a b -> p (i -> i) s t
forall (i :: OpticKind) (a :: OpticKind) (b :: OpticKind)
       (s :: OpticKind) (t :: OpticKind) (j :: OpticKind).
((i -> a -> b) -> s -> t) -> p j a b -> p (i -> j) s t
forall (p :: OpticKind -> OpticKind -> OpticKind -> OpticKind)
       (i :: OpticKind) (a :: OpticKind) (b :: OpticKind) (s :: OpticKind)
       (t :: OpticKind) (j :: OpticKind).
Mapping p =>
((i -> a -> b) -> s -> t) -> p j a b -> p (i -> j) s t
iroam (i -> a -> b) -> s -> t
f)
{-# INLINE isets #-}

-- | Indexed setter via the 'FunctorWithIndex' class.
--
-- @
-- 'iover' 'imapped' ≡ 'imap'
-- @
imapped :: FunctorWithIndex i f => IxSetter i (f a) (f b) a b
imapped :: forall (i :: OpticKind) (f :: OpticKind -> OpticKind)
       (a :: OpticKind) (b :: OpticKind).
FunctorWithIndex i f =>
IxSetter i (f a) (f b) a b
imapped = (forall (p :: OpticKind -> OpticKind -> OpticKind -> OpticKind)
        (i :: OpticKind).
 Profunctor p =>
 Optic_ A_Setter p i (Curry (WithIx i) i) (f a) (f b) a b)
-> Optic A_Setter (WithIx i) (f a) (f b) a b
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 p i a b -> p (Curry (WithIx i) i) (f a) (f b)
Optic__ p i (i -> i) (f a) (f b) a b
forall (p :: OpticKind -> OpticKind -> OpticKind -> OpticKind)
       (i :: OpticKind).
Profunctor p =>
Optic_ A_Setter p i (Curry (WithIx i) i) (f a) (f b) a b
forall (p :: OpticKind -> OpticKind -> OpticKind -> OpticKind)
       (i :: OpticKind) (f :: OpticKind -> OpticKind) (j :: OpticKind)
       (a :: OpticKind) (b :: OpticKind).
(Mapping p, FunctorWithIndex i f) =>
Optic__ p j (i -> j) (f a) (f b) a b
imapped__
{-# INLINE imapped #-}