-- |
-- Module: Optics.AffineTraversal
-- Description: A 'Optics.Traversal.Traversal' that applies to at most one element.
--
-- An 'AffineTraversal' is a 'Optics.Traversal.Traversal' that
-- applies to at most one element.
--
-- These arise most frequently as the composition of a
-- 'Optics.Lens.Lens' with a 'Optics.Prism.Prism'.
--
module Optics.AffineTraversal
  (
  -- * Formation
    AffineTraversal
  , AffineTraversal'

  -- * Introduction
  , atraversal

  -- * Elimination
  -- | An 'AffineTraversal' is in particular an 'Optics.AffineFold.AffineFold'
  -- and a 'Optics.Setter.Setter', therefore you can specialise types to obtain:
  --
  -- @
  -- 'Optics.AffineFold.preview' :: 'AffineTraversal' s t a b -> s -> Maybe a
  -- @
  --
  -- @
  -- 'Optics.Setter.over'    :: 'AffineTraversal' s t a b -> (a -> b) -> s -> t
  -- 'Optics.Setter.set'     :: 'AffineTraversal' s t a b ->       b  -> s -> t
  -- @
  , matching

  -- * Computation
  -- |
  --
  -- @
  -- 'matching' ('atraversal' f g) ≡ f
  -- 'Data.Either.isRight' (f s)  =>  'Optics.Setter.set' ('atraversal' f g) b s ≡ g s b
  -- @

  -- * Additional introduction forms
  -- | See 'Optics.Cons.Core._head', 'Optics.Cons.Core._tail',
  -- 'Optics.Cons.Core._init' and 'Optics.Cons.Core._last' for
  -- 'AffineTraversal's for container types.
  , unsafeFiltered

  -- * Additional elimination forms
  , withAffineTraversal

  -- * Subtyping
  , An_AffineTraversal
  -- | <<diagrams/AffineTraversal.png AffineTraversal in the optics hierarchy>>

  -- * van Laarhoven encoding
  , AffineTraversalVL
  , AffineTraversalVL'
  , atraversalVL
  , atraverseOf
  )
  where

import Data.Profunctor.Indexed

import Optics.Internal.Optic

-- | Type synonym for a type-modifying affine traversal.
type AffineTraversal s t a b = Optic An_AffineTraversal NoIx s t a b

-- | Type synonym for a type-preserving affine traversal.
type AffineTraversal' s a = Optic' An_AffineTraversal NoIx s a

-- | Type synonym for a type-modifying van Laarhoven affine traversal.
--
-- Note: this isn't exactly van Laarhoven representation as there is
-- no @Pointed@ class (which would be a superclass of 'Applicative'
-- that contains 'pure' but not '<*>'). You can interpret the first
-- argument as a dictionary of @Pointed@ that supplies the @point@
-- function (i.e. the implementation of 'pure').
--
-- A 'Optics.Traversal.TraversalVL' has 'Applicative' available and
-- hence can combine the effects arising from multiple elements using
-- '<*>'. In contrast, an 'AffineTraversalVL' has no way to combine
-- effects from multiple elements, so it must act on at most one
-- element.  (It can act on none at all thanks to the availability of
-- @point@.)
--
type AffineTraversalVL s t a b =
  forall f. Functor f => (forall r. r -> f r) -> (a -> f b) -> s -> f t

-- | Type synonym for a type-preserving van Laarhoven affine traversal.
type AffineTraversalVL' s a = AffineTraversalVL s s a a

-- | Build an affine traversal from a matcher and an updater.
--
-- If you want to build an 'AffineTraversal' from the van Laarhoven
-- representation, use 'atraversalVL'.
atraversal :: (s -> Either t a) -> (s -> b -> t) -> AffineTraversal s t a b
atraversal :: forall s t a b.
(s -> Either t a) -> (s -> b -> t) -> AffineTraversal s t a b
atraversal s -> Either t a
match s -> b -> t
update = 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 a b. (a -> b) -> a -> b
$
  -- Do not define atraversal in terms of atraversalVL, mixing profunctor-style
  -- definitions with VL style implementation can lead to subpar generated code.
  forall (p :: * -> * -> * -> *) a b c d i.
Profunctor p =>
(a -> b) -> (c -> d) -> p i b c -> p i a d
dimap (\s
s -> (s -> Either t a
match s
s, s -> b -> t
update s
s))
        (\(Either t b
etb, b -> t
f) -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id b -> t
f Either t b
etb)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> * -> *) i a b c.
Strong p =>
p i a b -> p i (a, c) (b, c)
first'
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> * -> *) i a b c.
Choice p =>
p i a b -> p i (Either c a) (Either c b)
right'
{-# INLINE atraversal #-}

-- | Work with an affine traversal as a matcher and an updater.
withAffineTraversal
  :: Is k An_AffineTraversal
  => Optic k is s t a b
  -> ((s -> Either t a) -> (s -> b -> t) -> r)
  -> r
withAffineTraversal :: forall k (is :: IxList) s t a b r.
Is k An_AffineTraversal =>
Optic k is s t a b
-> ((s -> Either t a) -> (s -> b -> t) -> r) -> r
withAffineTraversal Optic k is s t a b
o = \(s -> Either t a) -> (s -> b -> t) -> r
k ->
  case 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 (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 @An_AffineTraversal Optic k is s t a b
o) (forall a b i s t.
(s -> b -> t) -> (s -> Either t a) -> AffineMarket a b i s t
AffineMarket (\a
_ b
b -> b
b) forall a b. b -> Either a b
Right) of
    AffineMarket s -> b -> t
update s -> Either t a
match -> (s -> Either t a) -> (s -> b -> t) -> r
k s -> Either t a
match s -> b -> t
update
{-# INLINE withAffineTraversal #-}

-- | Build an affine traversal from the van Laarhoven representation.
--
-- Example:
--
-- >>> :{
-- azSnd = atraversalVL $ \point f ab@(a, b) ->
--   if a >= 'a' && a <= 'z'
--   then (a, ) <$> f b
--   else point ab
-- :}
--
-- >>> preview azSnd ('a', "Hi")
-- Just "Hi"
--
-- >>> preview azSnd ('@', "Hi")
-- Nothing
--
-- >>> over azSnd (++ "!!!") ('f', "Hi")
-- ('f',"Hi!!!")
--
-- >>> set azSnd "Bye" ('Y', "Hi")
-- ('Y',"Hi")
--
atraversalVL :: AffineTraversalVL s t a b -> AffineTraversal s t a b
atraversalVL :: forall s t a b.
AffineTraversalVL s t a b -> AffineTraversal s t a b
atraversalVL AffineTraversalVL s t a b
f = 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 s t a b.
Visiting p =>
(forall (f :: * -> *).
 Functor f =>
 (forall r. r -> f r) -> (a -> f b) -> s -> f t)
-> p i a b -> p i s t
visit AffineTraversalVL s t a b
f)
{-# INLINE atraversalVL #-}

-- | Traverse over the target of an 'AffineTraversal' and compute a
-- 'Functor'-based answer.
--
-- @since 0.3
atraverseOf
  :: (Is k An_AffineTraversal, Functor f)
  => Optic k is s t a b
  -> (forall r. r -> f r) -> (a -> f b) -> s -> f t
atraverseOf :: forall k (f :: * -> *) (is :: IxList) s t a b.
(Is k An_AffineTraversal, Functor f) =>
Optic k is s t a b
-> (forall r. r -> f r) -> (a -> f b) -> s -> f t
atraverseOf Optic k is s t a b
o forall r. r -> f r
point =
  forall (f :: * -> *) i a b. StarA f i a b -> a -> f b
runStarA forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (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 @An_AffineTraversal Optic k is s t a b
o) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) i a b.
(forall r. r -> f r) -> (a -> f b) -> StarA f i a b
StarA forall r. r -> f r
point
{-# INLINE atraverseOf #-}

-- | Retrieve the value targeted by an 'AffineTraversal' or return the original
-- value while allowing the type to change if it does not match.
--
-- @
-- 'Optics.AffineFold.preview' o ≡ 'either' ('const' 'Nothing') 'id' . 'matching' o
-- @
matching :: Is k An_AffineTraversal => Optic k is s t a b -> s -> Either t a
matching :: forall k (is :: IxList) s t a b.
Is k An_AffineTraversal =>
Optic k is s t a b -> s -> Either t a
matching Optic k is s t a b
o = forall k (is :: IxList) s t a b r.
Is k An_AffineTraversal =>
Optic k is s t a b
-> ((s -> Either t a) -> (s -> b -> t) -> r) -> r
withAffineTraversal Optic k is s t a b
o forall a b. (a -> b) -> a -> b
$ \s -> Either t a
match s -> b -> t
_ -> s -> Either t a
match
{-# INLINE matching #-}

-- | Filter result(s) of a traversal that don't satisfy a predicate.
--
-- /Note:/ This is /not/ a legal 'Optics.Traversal.Traversal', unless you are
-- very careful not to invalidate the predicate on the target.
--
-- As a counter example, consider that given @evens = 'unsafeFiltered' 'even'@
-- the second 'Optics.Traversal.Traversal' law is violated:
--
-- @
-- 'Optics.Setter.over' evens 'succ' '.' 'Optics.over' evens 'succ' '/=' 'Optics.Setter.over' evens ('succ' '.' 'succ')
-- @
--
-- So, in order for this to qualify as a legal 'Optics.Traversal.Traversal' you
-- can only use it for actions that preserve the result of the predicate!
--
-- For a safe variant see 'Optics.IxTraversal.indices' (or
-- 'Optics.AffineFold.filtered' for read-only optics).
--
unsafeFiltered :: (a -> Bool) -> AffineTraversal' a a
unsafeFiltered :: forall a. (a -> Bool) -> AffineTraversal' a a
unsafeFiltered a -> Bool
p = forall s t a b.
AffineTraversalVL s t a b -> AffineTraversal s t a b
atraversalVL (\forall r. r -> f r
point a -> f a
f a
a -> if a -> Bool
p a
a then a -> f a
f a
a else forall r. r -> f r
point a
a)
{-# INLINE unsafeFiltered #-}

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