-- |
-- Module: Optics.IxLens
-- Description: An indexed version of a 'Optics.Lens.Lens'.
--
-- An 'IxLens' is an indexed version of a 'Optics.Lens.Lens'. 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.IxLens
  (
  -- * Formation
    IxLens
  , IxLens'

  -- * Introduction
  , ilens

  -- * Elimination
  -- | An 'IxLens' is in particular an 'Optics.IxGetter.IxGetter' and an
  -- 'Optics.IxSetter.IxSetter', therefore you can specialise types to obtain:
  --
  -- @
  -- 'Optics.IxGetter.iview' :: 'IxLens' i s t a b -> s -> (i, a)
  -- @
  --
  -- @
  -- 'Optics.IxSetter.iover' :: 'IxLens' i s t a b -> (i -> a -> b) -> s -> t
  -- 'Optics.IxSetter.iset'  :: 'IxLens' i s t a b -> (i      -> b) -> s -> t
  -- @

  -- * Additional introduction forms
  , chosen
  , devoid
  , ifst
  , isnd

  -- * Subtyping
  , A_Lens

  -- * van Laarhoven encoding
  , IxLensVL
  , IxLensVL'
  , ilensVL
  , toIxLensVL
  , withIxLensVL
  ) where

import Data.Void

import Data.Profunctor.Indexed

import Optics.Internal.Indexed
import Optics.Internal.Optic
import Optics.Internal.Utils

-- | Type synonym for a type-modifying indexed lens.
type IxLens i s t a b = Optic A_Lens (WithIx i) s t a b

-- | Type synonym for a type-preserving indexed lens.
type IxLens' i s a = Optic' A_Lens (WithIx i) s a

-- | Type synonym for a type-modifying van Laarhoven indexed lens.
type IxLensVL i s t a b =
  forall f. Functor f => (i -> a -> f b) -> s -> f t

-- | Type synonym for a type-preserving van Laarhoven indexed lens.
type IxLensVL' i s a = IxLensVL i s s a a

-- | Build an indexed lens from a getter and a setter.
--
-- If you want to build an 'IxLens' from the van Laarhoven representation, use
-- 'ilensVL'.
ilens :: (s -> (i, a)) -> (s -> b -> t) -> IxLens i s t a b
ilens :: (s -> (i, a)) -> (s -> b -> t) -> IxLens i s t a b
ilens s -> (i, a)
get s -> b -> t
set = IxLensVL i s t a b -> IxLens i s t a b
forall i s t a b. IxLensVL i s t a b -> IxLens i s t a b
ilensVL (IxLensVL i s t a b -> IxLens i s t a b)
-> IxLensVL i s t a b -> IxLens i s t a b
forall a b. (a -> b) -> a -> b
$ \i -> a -> f b
f s
s -> s -> b -> t
set s
s (b -> t) -> f b -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (i -> a -> f b) -> (i, a) -> f b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry' i -> a -> f b
f (s -> (i, a)
get s
s)
{-# INLINE ilens #-}

-- | Build an indexed lens from the van Laarhoven representation.
ilensVL :: IxLensVL i s t a b -> IxLens i s t a b
ilensVL :: IxLensVL i s t a b -> IxLens i s t a b
ilensVL IxLensVL i s t a b
f = (forall (p :: * -> * -> * -> *) i.
 Profunctor p =>
 Optic_ A_Lens p i (Curry (WithIx i) i) s t a b)
-> IxLens 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 (IxLensVL i s t a b -> p i a b -> p (i -> i) s t
forall (p :: * -> * -> * -> *) i a b s t j.
Strong p =>
(forall (f :: * -> *). Functor f => (i -> a -> f b) -> s -> f t)
-> p j a b -> p (i -> j) s t
ilinear IxLensVL i s t a b
f)
{-# INLINE ilensVL #-}

-- | Convert an indexed lens to its van Laarhoven representation.
toIxLensVL
  :: (Is k A_Lens, is `HasSingleIndex` i)
  => Optic k is s t a b
  -> IxLensVL i s t a b
toIxLensVL :: Optic k is s t a b -> IxLensVL i s t a b
toIxLensVL Optic k is s t a b
o = \i -> a -> f b
f ->
  IxStar f (i -> i) s t -> (i -> i) -> s -> f t
forall (f :: * -> *) i a b. IxStar f i a b -> i -> a -> f b
runIxStar (Optic A_Lens is s t a b
-> Optic__ (IxStar f) 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_Lens 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_Lens Optic k is s t a b
o) ((i -> a -> f b) -> IxStar f i a b
forall (f :: * -> *) i a b. (i -> a -> f b) -> IxStar f i a b
IxStar i -> a -> f b
f)) i -> i
forall a. a -> a
id
{-# INLINE toIxLensVL #-}

-- | Work with an indexed lens in the van Laarhoven representation.
withIxLensVL
  :: (Is k A_Lens, is `HasSingleIndex` i)
  => Optic k is s t a b
  -> (IxLensVL i s t a b -> r)
  -> r
withIxLensVL :: Optic k is s t a b -> (IxLensVL i s t a b -> r) -> r
withIxLensVL Optic k is s t a b
o IxLensVL i s t a b -> r
k = IxLensVL i s t a b -> r
k (Optic k is s t a b -> IxLensVL i s t a b
forall k (is :: IxList) i s t a b.
(Is k A_Lens, HasSingleIndex is i) =>
Optic k is s t a b -> IxLensVL i s t a b
toIxLensVL Optic k is s t a b
o)
{-# INLINE withIxLensVL #-}

----------------------------------------
-- Lenses

-- | Focus on both sides of an 'Either'.
chosen :: IxLens (Either () ()) (Either a a) (Either b b) a b
chosen :: IxLens (Either () ()) (Either a a) (Either b b) a b
chosen = IxLensVL (Either () ()) (Either a a) (Either b b) a b
-> IxLens (Either () ()) (Either a a) (Either b b) a b
forall i s t a b. IxLensVL i s t a b -> IxLens i s t a b
ilensVL (IxLensVL (Either () ()) (Either a a) (Either b b) a b
 -> IxLens (Either () ()) (Either a a) (Either b b) a b)
-> IxLensVL (Either () ()) (Either a a) (Either b b) a b
-> IxLens (Either () ()) (Either a a) (Either b b) a b
forall a b. (a -> b) -> a -> b
$ \Either () () -> a -> f b
f -> \case
  Left  a -> b -> Either b b
forall a b. a -> Either a b
Left  (b -> Either b b) -> f b -> f (Either b b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either () () -> a -> f b
f (() -> Either () ()
forall a b. a -> Either a b
Left ())  a
a
  Right a -> b -> Either b b
forall a b. b -> Either a b
Right (b -> Either b b) -> f b -> f (Either b b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either () () -> a -> f b
f (() -> Either () ()
forall a b. b -> Either a b
Right ()) a
a
{-# INLINE chosen #-}

-- | There is an indexed field for every type in the 'Void'.
--
-- >>> set (mapped % devoid) 1 []
-- []
--
-- >>> over (_Just % devoid) abs Nothing
-- Nothing
--
devoid :: IxLens' i Void a
devoid :: IxLens' i Void a
devoid = (Void -> (i, a)) -> (Void -> a -> Void) -> IxLens' i Void a
forall s i a b t.
(s -> (i, a)) -> (s -> b -> t) -> IxLens i s t a b
ilens Void -> (i, a)
forall a. Void -> a
absurd Void -> a -> Void
forall a b. a -> b -> a
const
{-# INLINE devoid #-}

-- | Indexed '_1' with other half of a pair as an index.
--
-- See 'isnd' for examples.
--
-- @since 0.4
--
ifst :: IxLens i (a, i) (b, i) a b
ifst :: IxLens i (a, i) (b, i) a b
ifst = ((a, i) -> (i, a))
-> ((a, i) -> b -> (b, i)) -> IxLens i (a, i) (b, i) a b
forall s i a b t.
(s -> (i, a)) -> (s -> b -> t) -> IxLens i s t a b
ilens (\(a
a, i
i) -> (i
i, a
a)) (\(a
_,i
i) b
b -> (b
b, i
i))

-- | Indexed '_2' with other half of a pair as an index.
-- Specialized version of 'itraversed' to pairs, which can be 'IxLens'.
--
-- >>> iview isnd ('a', True)
-- ('a',True)
--
-- That is not possible with 'itraversed', because it is an 'IxTraversal'.
--
-- >>> :t itraversed :: IxTraversal i (i, a) (i, b) a b
-- itraversed :: IxTraversal i (i, a) (i, b) a b
--   :: IxTraversal i (i, a) (i, b) a b
--
-- @since 0.4
--
isnd :: IxLens i (i, a) (i, b) a b
isnd :: IxLens i (i, a) (i, b) a b
isnd = ((i, a) -> (i, a))
-> ((i, a) -> b -> (i, b)) -> IxLens i (i, a) (i, b) a b
forall s i a b t.
(s -> (i, a)) -> (s -> b -> t) -> IxLens i s t a b
ilens (i, a) -> (i, a)
forall a. a -> a
id (\(i
i,a
_) b
b -> (i
i, b
b))

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