-- |
-- Module: Optics.AffineFold
-- Description: A 'Optics.Fold.Fold' that contains at most one element.
--
-- An 'AffineFold' is a 'Optics.Fold.Fold' that contains at most one
-- element, or a 'Optics.Getter.Getter' where the function may be
-- partial.
--
module Optics.AffineFold
  (
  -- * Formation
    AffineFold

  -- * Introduction
  , afolding

  -- * Elimination
  , preview
  , previews

  -- * Computation
  -- |
  --
  -- @
  -- 'preview' ('afolding' f) ≡ f
  -- @

  -- * Additional introduction forms
  , afoldVL
  , filtered

  -- * Additional elimination forms
  , atraverseOf_
  , isn't

  -- * Monoid structure
  -- | 'AffineFold' admits a monoid structure where 'afailing' combines folds
  -- (returning a result from the second fold only if the first returns none)
  -- and the identity element is 'Optics.IxAffineTraversal.ignored' (which
  -- returns no results).
  --
  -- /Note:/ There is no 'Optics.Fold.summing' equivalent that returns an
  -- 'AffineFold', because it would not need to return more than one result.
  --
  -- There is no 'Semigroup' or 'Monoid' instance for 'AffineFold', because
  -- there is not a unique choice of monoid to use that works for all optics,
  -- and the ('<>') operator could not be used to combine optics of different
  -- kinds.
  , afailing

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

import Data.Maybe

import Data.Profunctor.Indexed

import Optics.Internal.Bi
import Optics.Internal.Optic

-- | Type synonym for an affine fold.
type AffineFold s a = Optic' An_AffineFold NoIx s a

-- | Obtain an 'AffineFold' by lifting 'traverse_' like function.
--
-- @
-- 'afoldVL' '.' 'atraverseOf_' ≡ 'id'
-- 'atraverseOf_' '.' 'afoldVL' ≡ 'id'
-- @
--
-- @since 0.3
afoldVL
  :: (forall f. Functor f => (forall r. r -> f r) -> (a -> f u) -> s -> f v)
  -> AffineFold s a
afoldVL :: (forall (f :: * -> *).
 Functor f =>
 (forall r. r -> f r) -> (a -> f u) -> s -> f v)
-> AffineFold s a
afoldVL forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (a -> f u) -> s -> f v
f = (forall (p :: * -> * -> * -> *) i.
 Profunctor p =>
 Optic_ An_AffineFold p i (Curry NoIx i) s s a a)
-> AffineFold s a
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 (p i s v -> p i s s
forall (p :: * -> * -> * -> *) i c a b.
(Profunctor p, Bicontravariant p) =>
p i c a -> p i c b
rphantom (p i s v -> p i s s) -> (p i a a -> p i s v) -> p i a a -> p i s s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (f :: * -> *).
 Functor f =>
 (forall r. r -> f r) -> (a -> f u) -> s -> f v)
-> p i a u -> p i s v
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 forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (a -> f u) -> s -> f v
f (p i a u -> p i s v) -> (p i a a -> p i a u) -> p i a a -> p i s v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p i a a -> p i a u
forall (p :: * -> * -> * -> *) i c a b.
(Profunctor p, Bicontravariant p) =>
p i c a -> p i c b
rphantom)
{-# INLINE afoldVL #-}

-- | Retrieve the value targeted by an 'AffineFold'.
--
-- >>> let _Right = prism Right $ either (Left . Left) Right
--
-- >>> preview _Right (Right 'x')
-- Just 'x'
--
-- >>> preview _Right (Left 'y')
-- Nothing
--
preview :: Is k An_AffineFold => Optic' k is s a -> s -> Maybe a
preview :: Optic' k is s a -> s -> Maybe a
preview Optic' k is s a
o = Optic' k is s a -> (a -> a) -> s -> Maybe a
forall k (is :: IxList) s a r.
Is k An_AffineFold =>
Optic' k is s a -> (a -> r) -> s -> Maybe r
previews Optic' k is s a
o a -> a
forall a. a -> a
id
{-# INLINE preview #-}

-- | Retrieve a function of the value targeted by an 'AffineFold'.
previews :: Is k An_AffineFold => Optic' k is s a -> (a -> r) -> s -> Maybe r
previews :: Optic' k is s a -> (a -> r) -> s -> Maybe r
previews Optic' k is s a
o = \a -> r
f -> ForgetM r (Curry is Any) s s -> s -> Maybe r
forall r i a b. ForgetM r i a b -> a -> Maybe r
runForgetM (ForgetM r (Curry is Any) s s -> s -> Maybe r)
-> ForgetM r (Curry is Any) s s -> s -> Maybe r
forall a b. (a -> b) -> a -> b
$
  Optic An_AffineFold is s s a a
-> Optic_ An_AffineFold (ForgetM r) Any (Curry is Any) s s a a
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 a -> Optic An_AffineFold is s s a a
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_AffineFold Optic' k is s a
o) Optic__ (ForgetM r) Any (Curry is Any) s s a a
-> Optic__ (ForgetM r) Any (Curry is Any) s s a a
forall a b. (a -> b) -> a -> b
$ (a -> Maybe r) -> ForgetM r Any a a
forall r i a b. (a -> Maybe r) -> ForgetM r i a b
ForgetM (r -> Maybe r
forall a. a -> Maybe a
Just (r -> Maybe r) -> (a -> r) -> a -> Maybe r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> r
f)
{-# INLINE previews #-}

-- | Traverse over the target of an 'AffineFold', computing a 'Functor'-based
-- answer, but unlike 'Optics.AffineTraversal.atraverseOf' do not construct a
-- new structure.
--
-- @since 0.3
atraverseOf_
  :: (Is k An_AffineFold, Functor f)
  => Optic' k is s a
  -> (forall r. r -> f r) -> (a -> f u) -> s -> f ()
atraverseOf_ :: Optic' k is s a -> (forall r. r -> f r) -> (a -> f u) -> s -> f ()
atraverseOf_ Optic' k is s a
o forall r. r -> f r
point a -> f u
f s
s = case Optic' k is s a -> s -> Maybe a
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview Optic' k is s a
o s
s of
  Just a
a  -> () () -> f u -> f ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ a -> f u
f a
a
  Maybe a
Nothing -> () -> f ()
forall r. r -> f r
point ()
{-# INLINE atraverseOf_ #-}

-- | Create an 'AffineFold' from a partial function.
--
-- >>> preview (afolding listToMaybe) "foo"
-- Just 'f'
--
afolding :: (s -> Maybe a) -> AffineFold s a
afolding :: (s -> Maybe a) -> AffineFold s a
afolding s -> Maybe a
f = (forall (p :: * -> * -> * -> *) i.
 Profunctor p =>
 Optic_ An_AffineFold p i (Curry NoIx i) s s a a)
-> AffineFold s a
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 ((s -> Either s a)
-> (s -> Either s a) -> p i (Either s a) (Either s a) -> p i s s
forall (p :: * -> * -> * -> *) b a d c i.
Bicontravariant p =>
(b -> a) -> (d -> c) -> p i a c -> p i b d
contrabimap (\s
s -> Either s a -> (a -> Either s a) -> Maybe a -> Either s a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (s -> Either s a
forall a b. a -> Either a b
Left s
s) a -> Either s a
forall a b. b -> Either a b
Right (s -> Maybe a
f s
s)) s -> Either s a
forall a b. a -> Either a b
Left (p i (Either s a) (Either s a) -> p i s s)
-> (p i a a -> p i (Either s a) (Either s a)) -> p i a a -> p i s s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p i a a -> p i (Either s a) (Either s a)
forall (p :: * -> * -> * -> *) i a b c.
Choice p =>
p i a b -> p i (Either c a) (Either c b)
right')
{-# INLINE afolding #-}

-- | Filter result(s) of a fold that don't satisfy a predicate.
filtered :: (a -> Bool) -> AffineFold a a
filtered :: (a -> Bool) -> AffineFold a a
filtered a -> Bool
p = (forall (f :: * -> *).
 Functor f =>
 (forall r. r -> f r) -> (a -> f a) -> a -> f a)
-> AffineFold a a
forall a u s v.
(forall (f :: * -> *).
 Functor f =>
 (forall r. r -> f r) -> (a -> f u) -> s -> f v)
-> AffineFold s a
afoldVL (\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 a -> f a
forall r. r -> f r
point a
a)
{-# INLINE filtered #-}

-- | Try the first 'AffineFold'. If it returns no entry, try the second one.
--
-- >>> preview (ix 1 % re _Left `afailing` ix 2 % re _Right) [0,1,2,3]
-- Just (Left 1)
--
-- >>> preview (ix 42 % re _Left `afailing` ix 2 % re _Right) [0,1,2,3]
-- Just (Right 2)
--
afailing
  :: (Is k An_AffineFold, Is l An_AffineFold)
  => Optic' k is s a
  -> Optic' l js s a
  -> AffineFold s a
afailing :: Optic' k is s a -> Optic' l js s a -> AffineFold s a
afailing Optic' k is s a
a Optic' l js s a
b = (s -> Maybe a) -> AffineFold s a
forall s a. (s -> Maybe a) -> AffineFold s a
afolding ((s -> Maybe a) -> AffineFold s a)
-> (s -> Maybe a) -> AffineFold s a
forall a b. (a -> b) -> a -> b
$ \s
s -> Maybe a -> (a -> Maybe a) -> Maybe a -> Maybe a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Optic' l js s a -> s -> Maybe a
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview Optic' l js s a
b s
s) a -> Maybe a
forall a. a -> Maybe a
Just (Optic' k is s a -> s -> Maybe a
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview Optic' k is s a
a s
s)
infixl 3 `afailing` -- Same as (<|>)
{-# INLINE afailing #-}

-- | Check to see if this 'AffineFold' doesn't match.
--
-- >>> isn't _Just Nothing
-- True
--
isn't :: Is k An_AffineFold => Optic' k is s a -> s -> Bool
isn't :: Optic' k is s a -> s -> Bool
isn't Optic' k is s a
k s
s = Bool -> Bool
not (Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (Optic' k is s a -> s -> Maybe a
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview Optic' k is s a
k s
s))
{-# INLINE isn't #-}

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