-- |
-- Module: Optics.Setter
-- Description: Applies an update to all contained values.
--
-- A @'Setter' S T A B@ has the ability to lift a function of type
-- @A -> B@ 'over' a function of type @S -> T@, applying the function
-- to update all the @A@s contained in @S@.  This can be used to 'set'
-- all the @A@s to a single value (by lifting a constant function).
--
-- This can be seen as a generalisation of 'fmap', where the type @S@
-- does not need to be a type constructor with @A@ as its last
-- parameter.
--
module Optics.Setter
  (
  -- * Formation
    Setter
  , Setter'

  -- * Introduction
  , sets

  -- * Elimination
  , over

  -- * Computation
  -- |
  --
  -- @
  -- 'over' ('sets' f) ≡ f
  -- @

  -- * Well-formedness
  -- |
  --
  -- * __PutPut__: Setting twice is the same as setting once:
  --
  --     @
  --     'Optics.Setter.set' l v' ('Optics.Setter.set' l v s) ≡ 'Optics.Setter.set' l v' s
  --     @
  --
  -- * __Functoriality__: 'Setter's must preserve identities and composition:
  --
  --     @
  --     'over' s 'id' ≡ 'id'
  --     'over' s f '.' 'over' s g ≡ 'over' s (f '.' g)
  --     @

  -- * Additional introduction forms
  -- | See also 'Data.Set.Optics.setmapped', which changes the elements of a 'Data.Set.Set'.
  , mapped

  -- * Additional elimination forms
  , set
  , set'
  , over'
  , rewriteOf
  , transformOf

  -- * Subtyping
  , A_Setter
  -- | <<diagrams/Setter.png Setter in the optics hierarchy>>
  ) where

import Data.Profunctor.Indexed

import Optics.Internal.Optic
import Optics.Internal.Setter
import Optics.Internal.Utils

-- | Type synonym for a type-modifying setter.
type Setter s t a b = Optic A_Setter NoIx s t a b

-- | Type synonym for a type-preserving setter.
type Setter' s a = Optic' A_Setter NoIx s a

-- | Apply a setter as a modifier.
over
  :: Is k A_Setter
  => Optic k is s t a b
  -> (a -> b) -> s -> t
over :: 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 k is s t a b
o = \a -> b
f -> FunArrow (Curry is Any) s t -> s -> t
forall (i :: OpticKind) (a :: OpticKind) (b :: OpticKind).
FunArrow i a b -> a -> b
runFunArrow (FunArrow (Curry is Any) s t -> s -> t)
-> FunArrow (Curry is Any) s t -> s -> t
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Optic A_Setter is s t a b
-> Optic_ A_Setter FunArrow Any (Curry is Any) 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) ((a -> b) -> FunArrow Any a b
forall (i :: OpticKind) (a :: OpticKind) (b :: OpticKind).
(a -> b) -> FunArrow i a b
FunArrow a -> b
f)
{-# INLINE over #-}

-- | Apply a setter as a modifier, strictly.
--
-- TODO DOC: what exactly is the strictness property?
--
-- Example:
--
-- @
--  f :: Int -> (Int, a) -> (Int, a)
--  f k acc
--    | k > 0     = f (k - 1) $ 'over'' 'Data.Tuple.Optics._1' (+1) acc
--    | otherwise = acc
-- @
--
-- runs in constant space, but would result in a space leak if used with 'over'.
--
-- Note that replacing '$' with '$!' or 'Data.Tuple.Optics._1' with
-- 'Data.Tuple.Optics._1'' (which amount to the same thing) doesn't help when
-- 'over' is used, because the first coordinate of a pair is never forced.
--
over'
  :: Is k A_Setter
  => Optic k is s t a b
  -> (a -> b) -> s -> t
over' :: 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 k is s t a b
o = \a -> b
f ->
  let star :: Star Identity' (Curry is Any) s t
star = Optic A_Setter is s t a b
-> Optic_ A_Setter (Star Identity') Any (Curry is Any) 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__ (Star Identity') Any (Curry is Any) s t a b
-> Optic__ (Star Identity') Any (Curry is Any) s t a b
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (a -> Identity' b) -> Star Identity' Any a b
forall (f :: OpticKind -> OpticKind) (i :: OpticKind)
       (a :: OpticKind) (b :: OpticKind).
(a -> f b) -> Star f i a b
Star (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
. a -> b
f)
  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
. Star Identity' (Curry is Any) s t -> s -> Identity' t
forall (f :: OpticKind -> OpticKind) (i :: OpticKind)
       (a :: OpticKind) (b :: OpticKind).
Star f i a b -> a -> f b
runStar Star Identity' (Curry is Any) s t
star
{-# INLINE over' #-}

-- | Apply a setter.
--
-- @
-- 'set' o v ≡ 'over' o ('const' v)
-- @
--
-- >>> set _1 'x' ('y', 'z')
-- ('x','z')
--
set
  :: Is k A_Setter
  => Optic k is s t a b
  -> b -> s -> t
set :: forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic k is s t a b
o = Optic k is s t a b -> (a -> b) -> s -> t
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 k is s t a b
o ((a -> b) -> s -> t) -> (b -> a -> b) -> b -> s -> t
forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. b -> a -> b
forall (a :: OpticKind) (b :: OpticKind). a -> b -> a
const
{-# INLINE set #-}

-- | Apply a setter, strictly.
--
-- TODO DOC: what exactly is the strictness property?
--
set'
  :: Is k A_Setter
  => Optic k is s t a b
  -> b -> s -> t
set' :: forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set' Optic k is s t a b
o = Optic k is s t a b -> (a -> b) -> s -> t
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 k is s t a b
o ((a -> b) -> s -> t) -> (b -> a -> b) -> b -> s -> t
forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. b -> a -> b
forall (a :: OpticKind) (b :: OpticKind). a -> b -> a
const
{-# INLINE set' #-}

-- | Build a setter from a function to modify the element(s), which must respect
-- the well-formedness laws.
sets
  :: ((a -> b) -> s -> t)
  -> Setter s t a b
sets :: forall (a :: OpticKind) (b :: OpticKind) (s :: OpticKind)
       (t :: OpticKind).
((a -> b) -> s -> t) -> Setter s t a b
sets (a -> b) -> s -> t
f = (forall (p :: OpticKind -> OpticKind -> OpticKind -> OpticKind)
        (i :: OpticKind).
 Profunctor p =>
 Optic_ A_Setter p i (Curry NoIx i) s t a b)
-> Optic A_Setter NoIx 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 (((a -> b) -> s -> t) -> p i a b -> p i s t
forall (a :: OpticKind) (b :: OpticKind) (s :: OpticKind)
       (t :: OpticKind) (i :: OpticKind).
((a -> b) -> s -> t) -> p i a b -> p i s t
forall (p :: OpticKind -> OpticKind -> OpticKind -> OpticKind)
       (a :: OpticKind) (b :: OpticKind) (s :: OpticKind) (t :: OpticKind)
       (i :: OpticKind).
Mapping p =>
((a -> b) -> s -> t) -> p i a b -> p i s t
roam (a -> b) -> s -> t
f)
{-# INLINE sets #-}

-- | Create a 'Setter' for a 'Functor'.
--
-- @
-- 'over' 'mapped' ≡ 'fmap'
-- @
--
mapped :: Functor f => Setter (f a) (f b) a b
mapped :: forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
Setter (f a) (f b) a b
mapped = (forall (p :: OpticKind -> OpticKind -> OpticKind -> OpticKind)
        (i :: OpticKind).
 Profunctor p =>
 Optic_ A_Setter p i (Curry NoIx i) (f a) (f b) a b)
-> Optic A_Setter NoIx (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 Optic__ p i i (f a) (f b) a b
p i a b -> p (Curry NoIx i) (f a) (f b)
forall (p :: OpticKind -> OpticKind -> OpticKind -> OpticKind)
       (i :: OpticKind).
Profunctor p =>
Optic_ A_Setter p i (Curry NoIx i) (f a) (f b) a b
forall (p :: OpticKind -> OpticKind -> OpticKind -> OpticKind)
       (f :: OpticKind -> OpticKind) (i :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(Mapping p, Functor f) =>
Optic__ p i i (f a) (f b) a b
mapped__
{-# INLINE mapped #-}

-- | Rewrite by applying a rule everywhere you can. Ensures that the rule cannot
-- be applied anywhere in the result:
--
-- @
-- propRewriteOf l r x = 'all' ('Data.Just.isNothing' '.' r) ('universeOf' l ('rewriteOf' l r x))
-- @
--
-- Usually 'transformOf' is more appropriate, but 'rewriteOf' can give better
-- compositionality. Given two single transformations @f@ and @g@, you can
-- construct @\\a -> f a '<|>' g a@ which performs both rewrites until a fixed
-- point.
--
-- @since 0.4.1
rewriteOf :: Is k A_Setter => Optic k is a b a b -> (b -> Maybe a) -> a -> b
rewriteOf :: forall (k :: OpticKind) (is :: IxList) (a :: OpticKind)
       (b :: OpticKind).
Is k A_Setter =>
Optic k is a b a b -> (b -> Maybe a) -> a -> b
rewriteOf Optic k is a b a b
o b -> Maybe a
f = a -> b
go
  where
    go :: a -> b
go = Optic k is a b a b -> (b -> b) -> a -> b
forall (k :: OpticKind) (is :: IxList) (a :: OpticKind)
       (b :: OpticKind).
Is k A_Setter =>
Optic k is a b a b -> (b -> b) -> a -> b
transformOf Optic k is a b a b
o ((b -> b) -> a -> b) -> (b -> b) -> a -> b
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \b
x -> b -> (a -> b) -> Maybe a -> b
forall (b :: OpticKind) (a :: OpticKind).
b -> (a -> b) -> Maybe a -> b
maybe b
x a -> b
go (b -> Maybe a
f b
x)
{-# INLINE rewriteOf #-}

-- | Transform every element by recursively applying a given 'Setter' in a
-- bottom-up manner.
--
-- @since 0.4.1
transformOf :: Is k A_Setter => Optic k is a b a b -> (b -> b) -> a -> b
transformOf :: forall (k :: OpticKind) (is :: IxList) (a :: OpticKind)
       (b :: OpticKind).
Is k A_Setter =>
Optic k is a b a b -> (b -> b) -> a -> b
transformOf Optic k is a b a b
o b -> b
f = a -> b
go
  where
    go :: a -> b
go = b -> b
f (b -> b) -> (a -> b) -> a -> b
forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Optic k is a b a b -> (a -> b) -> a -> b
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 k is a b a b
o a -> b
go
{-# INLINE transformOf #-}

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