-- |
-- 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
  , filtered

  -- * Additional elimination forms
  , isn't

    -- * Semigroup structure
  , 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

-- | 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 o :: Optic' k is s a
o = Optic' k is s a -> (a -> a) -> s -> Maybe a
forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (a :: OpticKind) (r :: OpticKind).
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 :: OpticKind). 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 o :: Optic' k is s a
o = \f :: a -> r
f -> ForgetM r (Curry is Any) s s -> s -> Maybe r
forall (r :: OpticKind) (i :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
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 :: OpticKind) b. (a -> b) -> a -> b
$
  Optic An_AffineFold is s s a a
-> forall (p :: OpticKind -> OpticKind -> OpticKind -> OpticKind)
          (i :: OpticKind).
   (Profunctor p, Constraints An_AffineFold p) =>
   Optic__ p i (Curry is i) s s a a
forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Optic k is s t a b
-> forall (p :: OpticKind -> OpticKind -> OpticKind -> OpticKind)
          (i :: OpticKind).
   (Profunctor p, Constraints k p) =>
   Optic__ 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 :: 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 @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 :: OpticKind) b. (a -> b) -> a -> b
$ (a -> Maybe r) -> ForgetM r Any a a
forall (r :: OpticKind) (i :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(a -> Maybe r) -> ForgetM r i a b
ForgetM (r -> Maybe r
forall (a :: OpticKind). a -> Maybe a
Just (r -> Maybe r) -> (a -> r) -> a -> Maybe r
forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. a -> r
f)
{-# INLINE previews #-}

-- | 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 f :: s -> Maybe a
f = (forall (p :: OpticKind -> OpticKind -> OpticKind -> OpticKind)
        (i :: OpticKind).
 Profunctor p =>
 Optic_ An_AffineFold p i (Curry NoIx i) s s a a)
-> AffineFold s a
forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
(forall (p :: OpticKind -> OpticKind -> OpticKind -> OpticKind)
        (i :: OpticKind).
 (Profunctor p, Constraints k p) =>
 Optic__ 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 :: OpticKind -> OpticKind -> OpticKind -> OpticKind)
       (b :: OpticKind) (a :: OpticKind) (d :: OpticKind) (c :: OpticKind)
       (i :: OpticKind).
Bicontravariant p =>
(b -> a) -> (d -> c) -> p i a c -> p i b d
contrabimap (\s :: s
s -> Either s a -> (a -> Either s a) -> Maybe a -> Either s a
forall (b :: OpticKind) (a :: OpticKind).
b -> (a -> b) -> Maybe a -> b
maybe (s -> Either s a
forall (a :: OpticKind) (b :: OpticKind). a -> Either a b
Left s
s) a -> Either s a
forall (a :: OpticKind) (b :: OpticKind). b -> Either a b
Right (s -> Maybe a
f s
s)) s -> Either s a
forall (a :: OpticKind) (b :: OpticKind). 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 :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. p i a a -> p i (Either s a) (Either s a)
forall (p :: OpticKind -> OpticKind -> OpticKind -> OpticKind)
       (i :: OpticKind) (a :: OpticKind) (b :: OpticKind)
       (c :: OpticKind).
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 p :: a -> Bool
p = (forall (p :: OpticKind -> OpticKind -> OpticKind -> OpticKind)
        (i :: OpticKind).
 Profunctor p =>
 Optic_ An_AffineFold p i (Curry NoIx i) a a a a)
-> AffineFold a a
forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
(forall (p :: OpticKind -> OpticKind -> OpticKind -> OpticKind)
        (i :: OpticKind).
 (Profunctor p, Constraints k p) =>
 Optic__ p i (Curry is i) s t a b)
-> Optic k is s t a b
Optic ((forall (f :: OpticKind -> OpticKind).
 Functor f =>
 (forall (r :: OpticKind). r -> f r) -> (a -> f a) -> a -> f a)
-> p i a a -> p i a a
forall (p :: OpticKind -> OpticKind -> OpticKind -> OpticKind)
       (i :: OpticKind) (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Visiting p =>
(forall (f :: OpticKind -> OpticKind).
 Functor f =>
 (forall (r :: OpticKind). r -> f r) -> (a -> f b) -> s -> f t)
-> p i a b -> p i s t
visit (\point :: forall (r :: OpticKind). r -> f r
point f :: a -> f a
f a :: a
a -> if a -> Bool
p a
a then a -> f a
f a
a else a -> f a
forall (r :: OpticKind). 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)
--
-- /Note:/ There is no 'Optics.Fold.summing' equivalent, because @asumming = afailing@.
--
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 a :: Optic' k is s a
a b :: Optic' l js s a
b = (s -> Maybe a) -> AffineFold s a
forall (s :: OpticKind) (a :: OpticKind).
(s -> Maybe a) -> AffineFold s a
afolding ((s -> Maybe a) -> AffineFold s a)
-> (s -> Maybe a) -> AffineFold s a
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \s :: s
s -> Maybe a -> (a -> Maybe a) -> Maybe a -> Maybe a
forall (b :: OpticKind) (a :: OpticKind).
b -> (a -> b) -> Maybe a -> b
maybe (Optic' l js s a -> s -> Maybe a
forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (a :: OpticKind).
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 :: OpticKind). a -> Maybe a
Just (Optic' k is s a -> s -> Maybe a
forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (a :: OpticKind).
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 k :: Optic' k is s a
k s :: s
s = Bool -> Bool
not (Maybe a -> Bool
forall (a :: OpticKind). Maybe a -> Bool
isJust (Optic' k is s a -> s -> Maybe a
forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (a :: OpticKind).
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