{-# 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 :: 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 a b. IxFunArrow i a b -> i -> a -> b
runIxFunArrow (Optic A_Setter is s t a b
-> Optic__ IxFunArrow i (Curry is i) s t a b
forall (p :: * -> * -> * -> *) k (is :: IxList) s t a b i.
Profunctor p =>
Optic k is s t a b -> Optic_ k p i (Curry is i) s t a b
getOptic (Optic k is s t a b -> Optic A_Setter is s t a b
forall destKind srcKind (is :: IxList) s t a b.
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 a b. (i -> a -> b) -> IxFunArrow i a b
IxFunArrow i -> a -> b
f)) i -> i
forall a. 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' :: 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 :: * -> * -> * -> *) k (is :: IxList) s t a b i.
Profunctor p =>
Optic k is s t a b -> Optic_ k p i (Curry is i) s t a b
getOptic (Optic k is s t a b -> Optic A_Setter is s t a b
forall destKind srcKind (is :: IxList) s t a b.
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 b. (a -> b) -> a -> b
$ (i -> a -> Identity' b) -> IxStar Identity' i a b
forall (f :: * -> *) i a b. (i -> a -> f b) -> IxStar f i a b
IxStar (\i
i -> b -> Identity' b
forall a. a -> Identity' a
wrapIdentity' (b -> Identity' b) -> (a -> b) -> a -> Identity' b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> a -> b
f i
i)
  in Identity' t -> t
forall a. Identity' a -> a
unwrapIdentity' (Identity' t -> t) -> (s -> Identity' t) -> s -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IxStar Identity' (i -> i) s t -> (i -> i) -> s -> Identity' t
forall (f :: * -> *) i a b. 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. 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 :: 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 (is :: IxList) i s t a b.
(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' :: 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 (is :: IxList) i s t a b.
(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 :: ((i -> a -> b) -> s -> t) -> IxSetter i s t a b
isets (i -> a -> b) -> s -> t
f = (forall (p :: * -> * -> * -> *) i.
 Profunctor p =>
 Optic_ A_Setter p i (Curry (WithIx i) i) s t a b)
-> IxSetter i 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 (((i -> a -> b) -> s -> t) -> p i a b -> p (i -> i) s t
forall (p :: * -> * -> * -> *) i a b s t j.
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 :: IxSetter i (f a) (f b) a b
imapped = (forall (p :: * -> * -> * -> *) i.
 Profunctor p =>
 Optic_ A_Setter p i (Curry (WithIx i) i) (f a) (f b) a b)
-> IxSetter i (f a) (f b) 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_ A_Setter p i (Curry (WithIx i) i) (f a) (f b) a b
forall (p :: * -> * -> * -> *) i (f :: * -> *) j a b.
(Mapping p, FunctorWithIndex i f) =>
Optic__ p j (i -> j) (f a) (f b) a b
imapped__
{-# INLINE imapped #-}