{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}

#ifdef TRUSTWORTHY
{-# LANGUAGE Trustworthy #-}
#endif

#include "lens-common.h"

-------------------------------------------------------------------------------
-- |
-- Module      :  Control.Lens.Prism
-- Copyright   :  (C) 2012-16 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  non-portable
--
-------------------------------------------------------------------------------
module Control.Lens.Prism
  (
  -- * Prisms
    Prism, Prism'
  , APrism, APrism'
  -- * Constructing Prisms
  , prism
  , prism'
  -- * Consuming Prisms
  , withPrism
  , clonePrism
  , outside
  , aside
  , without
  , below
  , isn't
  , matching
  -- * Common Prisms
  , _Left
  , _Right
  , _Just
  , _Nothing
  , _Void
  , _Show
  , only
  , nearly
  -- * Prismatic profunctors
  , Choice(..)
  ) where

import Control.Applicative
import Control.Lens.Internal.Prism
import Control.Lens.Lens
import Control.Lens.Review
import Control.Lens.Type
import Control.Monad
import Data.Functor.Identity
import Data.Profunctor
import Data.Profunctor.Rep
import Data.Profunctor.Sieve
import Data.Traversable
import Data.Void
import Data.Coerce
import Prelude

-- $setup
-- >>> :set -XNoOverloadedStrings
-- >>> import Control.Lens
-- >>> import Numeric.Natural
-- >>> import Debug.SimpleReflect.Expr
-- >>> import Debug.SimpleReflect.Vars as Vars hiding (f,g)
-- >>> let isLeft  (Left  _) = True; isLeft  _ = False
-- >>> let isRight (Right _) = True; isRight _ = False
-- >>> let f :: Expr -> Expr; f = Debug.SimpleReflect.Vars.f
-- >>> let g :: Expr -> Expr; g = Debug.SimpleReflect.Vars.g

------------------------------------------------------------------------------
-- Prism Internals
------------------------------------------------------------------------------

-- | If you see this in a signature for a function, the function is expecting a 'Prism'.
type APrism s t a b = Market a b a (Identity b) -> Market a b s (Identity t)

-- | @
-- type APrism' = 'Simple' 'APrism'
-- @
type APrism' s a = APrism s s a a

-- | Convert 'APrism' to the pair of functions that characterize it.
withPrism :: APrism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism :: APrism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism APrism s t a b
k (b -> t) -> (s -> Either t a) -> r
f = case Market a b s (Identity t) -> Market a b s t
coerce (APrism s t a b
k ((b -> Identity b)
-> (a -> Either (Identity b) a) -> Market a b a (Identity b)
forall a b s t. (b -> t) -> (s -> Either t a) -> Market a b s t
Market b -> Identity b
forall a. a -> Identity a
Identity a -> Either (Identity b) a
forall a b. b -> Either a b
Right)) of
  Market b -> t
bt s -> Either t a
seta -> (b -> t) -> (s -> Either t a) -> r
f b -> t
bt s -> Either t a
seta
{-# INLINE withPrism #-}

-- | Clone a 'Prism' so that you can reuse the same monomorphically typed 'Prism' for different purposes.
--
-- See 'Control.Lens.Lens.cloneLens' and 'Control.Lens.Traversal.cloneTraversal' for examples of why you might want to do this.
clonePrism :: APrism s t a b -> Prism s t a b
clonePrism :: APrism s t a b -> Prism s t a b
clonePrism APrism s t a b
k = APrism s t a b
-> ((b -> t) -> (s -> Either t a) -> p a (f b) -> p s (f t))
-> p a (f b)
-> p s (f t)
forall s t a b r.
APrism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism APrism s t a b
k (((b -> t) -> (s -> Either t a) -> p a (f b) -> p s (f t))
 -> p a (f b) -> p s (f t))
-> ((b -> t) -> (s -> Either t a) -> p a (f b) -> p s (f t))
-> p a (f b)
-> p s (f t)
forall a b. (a -> b) -> a -> b
$ \b -> t
bt s -> Either t a
sta -> (b -> t) -> (s -> Either t a) -> Prism s t a b
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism b -> t
bt s -> Either t a
sta
{-# INLINE clonePrism #-}

------------------------------------------------------------------------------
-- Prism Combinators
------------------------------------------------------------------------------

-- | Build a 'Control.Lens.Prism.Prism'.
--
-- @'Either' t a@ is used instead of @'Maybe' a@ to permit the types of @s@ and @t@ to differ.
--
prism :: (b -> t) -> (s -> Either t a) -> Prism s t a b
prism :: (b -> t) -> (s -> Either t a) -> Prism s t a b
prism b -> t
bt s -> Either t a
seta = (s -> Either t a)
-> (Either t (f b) -> f t)
-> p (Either t a) (Either t (f b))
-> p s (f t)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap s -> Either t a
seta ((t -> f t) -> (f b -> f t) -> Either t (f b) -> f t
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either t -> f t
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((b -> t) -> f b -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> t
bt)) (p (Either t a) (Either t (f b)) -> p s (f t))
-> (p a (f b) -> p (Either t a) (Either t (f b)))
-> p a (f b)
-> p s (f t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a (f b) -> p (Either t a) (Either t (f b))
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right'
{-# INLINE prism #-}

-- | This is usually used to build a 'Prism'', when you have to use an operation like
-- 'Data.Typeable.cast' which already returns a 'Maybe'.
prism' :: (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' :: (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' b -> s
bs s -> Maybe a
sma = (b -> s) -> (s -> Either s a) -> Prism s s a b
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism b -> s
bs (\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
sma s
s))
{-# INLINE prism' #-}

-- | Use a 'Prism' as a kind of first-class pattern.
--
-- @'outside' :: 'Prism' s t a b -> 'Lens' (t -> r) (s -> r) (b -> r) (a -> r)@

-- TODO: can we make this work with merely Strong?
outside :: Representable p => APrism s t a b -> Lens (p t r) (p s r) (p b r) (p a r)
outside :: APrism s t a b -> Lens (p t r) (p s r) (p b r) (p a r)
outside APrism s t a b
k = APrism s t a b
-> ((b -> t)
    -> (s -> Either t a) -> (p b r -> f (p a r)) -> p t r -> f (p s r))
-> (p b r -> f (p a r))
-> p t r
-> f (p s r)
forall s t a b r.
APrism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism APrism s t a b
k (((b -> t)
  -> (s -> Either t a) -> (p b r -> f (p a r)) -> p t r -> f (p s r))
 -> (p b r -> f (p a r)) -> p t r -> f (p s r))
-> ((b -> t)
    -> (s -> Either t a) -> (p b r -> f (p a r)) -> p t r -> f (p s r))
-> (p b r -> f (p a r))
-> p t r
-> f (p s r)
forall a b. (a -> b) -> a -> b
$ \b -> t
bt s -> Either t a
seta p b r -> f (p a r)
f p t r
ft ->
  p b r -> f (p a r)
f ((b -> t) -> p t r -> p b r
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap b -> t
bt p t r
ft) f (p a r) -> (p a r -> p s r) -> f (p s r)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \p a r
fa -> (s -> Rep p r) -> p s r
forall (p :: * -> * -> *) d c.
Representable p =>
(d -> Rep p c) -> p d c
tabulate ((s -> Rep p r) -> p s r) -> (s -> Rep p r) -> p s r
forall a b. (a -> b) -> a -> b
$ (t -> Rep p r) -> (a -> Rep p r) -> Either t a -> Rep p r
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (p t r -> t -> Rep p r
forall (p :: * -> * -> *) (f :: * -> *) a b.
Sieve p f =>
p a b -> a -> f b
sieve p t r
ft) (p a r -> a -> Rep p r
forall (p :: * -> * -> *) (f :: * -> *) a b.
Sieve p f =>
p a b -> a -> f b
sieve p a r
fa) (Either t a -> Rep p r) -> (s -> Either t a) -> s -> Rep p r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Either t a
seta
{-# INLINE outside #-}

-- | Given a pair of prisms, project sums.
--
-- Viewing a 'Prism' as a co-'Lens', this combinator can be seen to be dual to 'Control.Lens.Lens.alongside'.
without :: APrism s t a b
        -> APrism u v c d
        -> Prism (Either s u) (Either t v) (Either a c) (Either b d)
without :: APrism s t a b
-> APrism u v c d
-> Prism (Either s u) (Either t v) (Either a c) (Either b d)
without APrism s t a b
k APrism u v c d
k' =
  APrism s t a b
-> ((b -> t)
    -> (s -> Either t a)
    -> p (Either a c) (f (Either b d))
    -> p (Either s u) (f (Either t v)))
-> p (Either a c) (f (Either b d))
-> p (Either s u) (f (Either t v))
forall s t a b r.
APrism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism APrism s t a b
k         (((b -> t)
  -> (s -> Either t a)
  -> p (Either a c) (f (Either b d))
  -> p (Either s u) (f (Either t v)))
 -> p (Either a c) (f (Either b d))
 -> p (Either s u) (f (Either t v)))
-> ((b -> t)
    -> (s -> Either t a)
    -> p (Either a c) (f (Either b d))
    -> p (Either s u) (f (Either t v)))
-> p (Either a c) (f (Either b d))
-> p (Either s u) (f (Either t v))
forall a b. (a -> b) -> a -> b
$ \b -> t
bt s -> Either t a
seta ->
  APrism u v c d
-> ((d -> v)
    -> (u -> Either v c)
    -> p (Either a c) (f (Either b d))
    -> p (Either s u) (f (Either t v)))
-> p (Either a c) (f (Either b d))
-> p (Either s u) (f (Either t v))
forall s t a b r.
APrism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism APrism u v c d
k'        (((d -> v)
  -> (u -> Either v c)
  -> p (Either a c) (f (Either b d))
  -> p (Either s u) (f (Either t v)))
 -> p (Either a c) (f (Either b d))
 -> p (Either s u) (f (Either t v)))
-> ((d -> v)
    -> (u -> Either v c)
    -> p (Either a c) (f (Either b d))
    -> p (Either s u) (f (Either t v)))
-> p (Either a c) (f (Either b d))
-> p (Either s u) (f (Either t v))
forall a b. (a -> b) -> a -> b
$ \d -> v
dv u -> Either v c
uevc ->
  (Either b d -> Either t v)
-> (Either s u -> Either (Either t v) (Either a c))
-> Prism (Either s u) (Either t v) (Either a c) (Either b d)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((b -> t) -> (d -> v) -> Either b d -> Either t v
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap b -> t
bt d -> v
dv) ((Either s u -> Either (Either t v) (Either a c))
 -> Prism (Either s u) (Either t v) (Either a c) (Either b d))
-> (Either s u -> Either (Either t v) (Either a c))
-> Prism (Either s u) (Either t v) (Either a c) (Either b d)
forall a b. (a -> b) -> a -> b
$ \Either s u
su ->
  case Either s u
su of
    Left s
s  -> (t -> Either t v)
-> (a -> Either a c)
-> Either t a
-> Either (Either t v) (Either a c)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap t -> Either t v
forall a b. a -> Either a b
Left a -> Either a c
forall a b. a -> Either a b
Left (s -> Either t a
seta s
s)
    Right u
u -> (v -> Either t v)
-> (c -> Either a c)
-> Either v c
-> Either (Either t v) (Either a c)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap v -> Either t v
forall a b. b -> Either a b
Right c -> Either a c
forall a b. b -> Either a b
Right (u -> Either v c
uevc u
u)
{-# INLINE without #-}

-- | Use a 'Prism' to work over part of a structure.
--
aside :: APrism s t a b -> Prism (e, s) (e, t) (e, a) (e, b)
aside :: APrism s t a b -> Prism (e, s) (e, t) (e, a) (e, b)
aside APrism s t a b
k =
  APrism s t a b
-> ((b -> t)
    -> (s -> Either t a) -> p (e, a) (f (e, b)) -> p (e, s) (f (e, t)))
-> p (e, a) (f (e, b))
-> p (e, s) (f (e, t))
forall s t a b r.
APrism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism APrism s t a b
k     (((b -> t)
  -> (s -> Either t a) -> p (e, a) (f (e, b)) -> p (e, s) (f (e, t)))
 -> p (e, a) (f (e, b)) -> p (e, s) (f (e, t)))
-> ((b -> t)
    -> (s -> Either t a) -> p (e, a) (f (e, b)) -> p (e, s) (f (e, t)))
-> p (e, a) (f (e, b))
-> p (e, s) (f (e, t))
forall a b. (a -> b) -> a -> b
$ \b -> t
bt s -> Either t a
seta ->
  ((e, b) -> (e, t))
-> ((e, s) -> Either (e, t) (e, a))
-> Prism (e, s) (e, t) (e, a) (e, b)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((b -> t) -> (e, b) -> (e, t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> t
bt) (((e, s) -> Either (e, t) (e, a))
 -> Prism (e, s) (e, t) (e, a) (e, b))
-> ((e, s) -> Either (e, t) (e, a))
-> Prism (e, s) (e, t) (e, a) (e, b)
forall a b. (a -> b) -> a -> b
$ \(e
e,s
s) ->
  case s -> Either t a
seta s
s of
    Left t
t  -> (e, t) -> Either (e, t) (e, a)
forall a b. a -> Either a b
Left  (e
e,t
t)
    Right a
a -> (e, a) -> Either (e, t) (e, a)
forall a b. b -> Either a b
Right (e
e,a
a)
{-# INLINE aside #-}

-- | 'lift' a 'Prism' through a 'Traversable' functor, giving a Prism that matches only if all the elements of the container match the 'Prism'.
--
-- >>> [Left 1, Right "foo", Left 4, Right "woot"]^..below _Right
-- []
--
-- >>> [Right "hail hydra!", Right "foo", Right "blah", Right "woot"]^..below _Right
-- [["hail hydra!","foo","blah","woot"]]
below :: Traversable f => APrism' s a -> Prism' (f s) (f a)
below :: APrism' s a -> Prism' (f s) (f a)
below APrism' s a
k =
  APrism' s a
-> ((a -> s)
    -> (s -> Either s a) -> p (f a) (f (f a)) -> p (f s) (f (f s)))
-> p (f a) (f (f a))
-> p (f s) (f (f s))
forall s t a b r.
APrism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism APrism' s a
k     (((a -> s)
  -> (s -> Either s a) -> p (f a) (f (f a)) -> p (f s) (f (f s)))
 -> p (f a) (f (f a)) -> p (f s) (f (f s)))
-> ((a -> s)
    -> (s -> Either s a) -> p (f a) (f (f a)) -> p (f s) (f (f s)))
-> p (f a) (f (f a))
-> p (f s) (f (f s))
forall a b. (a -> b) -> a -> b
$ \a -> s
bt s -> Either s a
seta ->
  (f a -> f s) -> (f s -> Either (f s) (f a)) -> Prism' (f s) (f a)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((a -> s) -> f a -> f s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> s
bt) ((f s -> Either (f s) (f a)) -> Prism' (f s) (f a))
-> (f s -> Either (f s) (f a)) -> Prism' (f s) (f a)
forall a b. (a -> b) -> a -> b
$ \f s
s ->
  case (s -> Either s a) -> f s -> Either s (f a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse s -> Either s a
seta f s
s of
    Left s
_  -> f s -> Either (f s) (f a)
forall a b. a -> Either a b
Left f s
s
    Right f a
t -> f a -> Either (f s) (f a)
forall a b. b -> Either a b
Right f a
t
{-# INLINE below #-}

-- | Check to see if this 'Prism' doesn't match.
--
-- >>> isn't _Left (Right 12)
-- True
--
-- >>> isn't _Left (Left 12)
-- False
--
-- >>> isn't _Empty []
-- False
--
-- @
-- 'isn't' = 'not' . 'Control.Lens.Extra.is'
-- 'isn't' = 'hasn't'
-- @
isn't :: APrism s t a b -> s -> Bool
isn't :: APrism s t a b -> s -> Bool
isn't APrism s t a b
k s
s =
  case APrism s t a b -> s -> Either t a
forall s t a b. APrism s t a b -> s -> Either t a
matching APrism s t a b
k s
s of
    Left  t
_ -> Bool
True
    Right a
_ -> Bool
False
{-# INLINE isn't #-}

-- | Retrieve the value targeted by a 'Prism' or return the
-- original value while allowing the type to change if it does
-- not match.
--
-- >>> matching _Just (Just 12)
-- Right 12
--
-- >>> matching _Just (Nothing :: Maybe Int) :: Either (Maybe Bool) Int
-- Left Nothing
matching :: APrism s t a b -> s -> Either t a
matching :: APrism s t a b -> s -> Either t a
matching APrism s t a b
k = APrism s t a b
-> ((b -> t) -> (s -> Either t a) -> s -> Either t a)
-> s
-> Either t a
forall s t a b r.
APrism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism APrism s t a b
k (((b -> t) -> (s -> Either t a) -> s -> Either t a)
 -> s -> Either t a)
-> ((b -> t) -> (s -> Either t a) -> s -> Either t a)
-> s
-> Either t a
forall a b. (a -> b) -> a -> b
$ \b -> t
_ s -> Either t a
seta -> s -> Either t a
seta
{-# INLINE matching #-}

------------------------------------------------------------------------------
-- Common Prisms
------------------------------------------------------------------------------

-- | This 'Prism' provides a 'Traversal' for tweaking the 'Left' half of an 'Either':
--
-- >>> over _Left (+1) (Left 2)
-- Left 3
--
-- >>> over _Left (+1) (Right 2)
-- Right 2
--
-- >>> Right 42 ^._Left :: String
-- ""
--
-- >>> Left "hello" ^._Left
-- "hello"
--
-- It also can be turned around to obtain the embedding into the 'Left' half of an 'Either':
--
-- >>> _Left # 5
-- Left 5
--
-- >>> 5^.re _Left
-- Left 5
_Left :: Prism (Either a c) (Either b c) a b
_Left :: p a (f b) -> p (Either a c) (f (Either b c))
_Left = (b -> Either b c)
-> (Either a c -> Either (Either b c) a)
-> Prism (Either a c) (Either b c) a b
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism b -> Either b c
forall a b. a -> Either a b
Left ((Either a c -> Either (Either b c) a)
 -> Prism (Either a c) (Either b c) a b)
-> (Either a c -> Either (Either b c) a)
-> Prism (Either a c) (Either b c) a b
forall a b. (a -> b) -> a -> b
$ (a -> Either (Either b c) a)
-> (c -> Either (Either b c) a)
-> Either a c
-> Either (Either b c) a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Either (Either b c) a
forall a b. b -> Either a b
Right (Either b c -> Either (Either b c) a
forall a b. a -> Either a b
Left (Either b c -> Either (Either b c) a)
-> (c -> Either b c) -> c -> Either (Either b c) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Either b c
forall a b. b -> Either a b
Right)
{-# INLINE _Left #-}

-- | This 'Prism' provides a 'Traversal' for tweaking the 'Right' half of an 'Either':
--
-- >>> over _Right (+1) (Left 2)
-- Left 2
--
-- >>> over _Right (+1) (Right 2)
-- Right 3
--
-- >>> Right "hello" ^._Right
-- "hello"
--
-- >>> Left "hello" ^._Right :: [Double]
-- []
--
-- It also can be turned around to obtain the embedding into the 'Right' half of an 'Either':
--
-- >>> _Right # 5
-- Right 5
--
-- >>> 5^.re _Right
-- Right 5
_Right :: Prism (Either c a) (Either c b) a b
_Right :: p a (f b) -> p (Either c a) (f (Either c b))
_Right = (b -> Either c b)
-> (Either c a -> Either (Either c b) a)
-> Prism (Either c a) (Either c b) a b
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism b -> Either c b
forall a b. b -> Either a b
Right ((Either c a -> Either (Either c b) a)
 -> Prism (Either c a) (Either c b) a b)
-> (Either c a -> Either (Either c b) a)
-> Prism (Either c a) (Either c b) a b
forall a b. (a -> b) -> a -> b
$ (c -> Either (Either c b) a)
-> (a -> Either (Either c b) a)
-> Either c a
-> Either (Either c b) a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either c b -> Either (Either c b) a
forall a b. a -> Either a b
Left (Either c b -> Either (Either c b) a)
-> (c -> Either c b) -> c -> Either (Either c b) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Either c b
forall a b. a -> Either a b
Left) a -> Either (Either c b) a
forall a b. b -> Either a b
Right
{-# INLINE _Right #-}

-- | This 'Prism' provides a 'Traversal' for tweaking the target of the value of 'Just' in a 'Maybe'.
--
-- >>> over _Just (+1) (Just 2)
-- Just 3
--
-- Unlike 'Data.Traversable.traverse' this is a 'Prism', and so you can use it to inject as well:
--
-- >>> _Just # 5
-- Just 5
--
-- >>> 5^.re _Just
-- Just 5
--
-- Interestingly,
--
-- @
-- m '^?' '_Just' ≡ m
-- @
--
-- >>> Just x ^? _Just
-- Just x
--
-- >>> Nothing ^? _Just
-- Nothing
_Just :: Prism (Maybe a) (Maybe b) a b
_Just :: p a (f b) -> p (Maybe a) (f (Maybe b))
_Just = (b -> Maybe b)
-> (Maybe a -> Either (Maybe b) a) -> Prism (Maybe a) (Maybe b) a b
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism b -> Maybe b
forall a. a -> Maybe a
Just ((Maybe a -> Either (Maybe b) a) -> Prism (Maybe a) (Maybe b) a b)
-> (Maybe a -> Either (Maybe b) a) -> Prism (Maybe a) (Maybe b) a b
forall a b. (a -> b) -> a -> b
$ Either (Maybe b) a
-> (a -> Either (Maybe b) a) -> Maybe a -> Either (Maybe b) a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe b -> Either (Maybe b) a
forall a b. a -> Either a b
Left Maybe b
forall a. Maybe a
Nothing) a -> Either (Maybe b) a
forall a b. b -> Either a b
Right
{-# INLINE _Just #-}

-- | This 'Prism' provides the 'Traversal' of a 'Nothing' in a 'Maybe'.
--
-- >>> Nothing ^? _Nothing
-- Just ()
--
-- >>> Just () ^? _Nothing
-- Nothing
--
-- But you can turn it around and use it to construct 'Nothing' as well:
--
-- >>> _Nothing # ()
-- Nothing
_Nothing :: Prism' (Maybe a) ()
_Nothing :: p () (f ()) -> p (Maybe a) (f (Maybe a))
_Nothing = (() -> Maybe a)
-> (Maybe a -> Maybe ()) -> Prism (Maybe a) (Maybe a) () ()
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (Maybe a -> () -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) ((Maybe a -> Maybe ()) -> Prism (Maybe a) (Maybe a) () ())
-> (Maybe a -> Maybe ()) -> Prism (Maybe a) (Maybe a) () ()
forall a b. (a -> b) -> a -> b
$ Maybe () -> (a -> Maybe ()) -> Maybe a -> Maybe ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Maybe ()
forall a. a -> Maybe a
Just ()) (Maybe () -> a -> Maybe ()
forall a b. a -> b -> a
const Maybe ()
forall a. Maybe a
Nothing)
{-# INLINE _Nothing #-}

-- | 'Void' is a logically uninhabited data type.
--
-- This is a 'Prism' that will always fail to match.
_Void :: Prism s s a Void
_Void :: p a (f Void) -> p s (f s)
_Void = (Void -> s) -> (s -> Either s a) -> Prism s s a Void
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism Void -> s
forall a. Void -> a
absurd s -> Either s a
forall a b. a -> Either a b
Left
{-# INLINE _Void #-}

-- | This 'Prism' compares for exact equality with a given value.
--
-- >>> only 4 # ()
-- 4
--
-- >>> 5 ^? only 4
-- Nothing
only :: Eq a => a -> Prism' a ()
only :: a -> Prism' a ()
only a
a = (() -> a) -> (a -> Maybe ()) -> Prism' a ()
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (\() -> a
a) ((a -> Maybe ()) -> Prism' a ()) -> (a -> Maybe ()) -> Prism' a ()
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> (a -> Bool) -> a -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==)
{-# INLINE only #-}


-- | This 'Prism' compares for approximate equality with a given value and a predicate for testing,
-- an example where the value is the empty list and the predicate checks that a list is empty (same
-- as 'Control.Lens.Empty._Empty' with the 'Control.Lens.Empty.AsEmpty' list instance):
--
-- >>> nearly [] null # ()
-- []
-- >>> [1,2,3,4] ^? nearly [] null
-- Nothing
--
-- @'nearly' [] 'Prelude.null' :: 'Prism'' [a] ()@
--
-- To comply with the 'Prism' laws the arguments you supply to @nearly a p@ are somewhat constrained.
--
-- We assume @p x@ holds iff @x ≡ a@. Under that assumption then this is a valid 'Prism'.
--
-- This is useful when working with a type where you can test equality for only a subset of its
-- values, and the prism selects such a value.

nearly :: a -> (a -> Bool) -> Prism' a ()
nearly :: a -> (a -> Bool) -> Prism' a ()
nearly a
a a -> Bool
p = (() -> a) -> (a -> Maybe ()) -> Prism' a ()
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (\() -> a
a) ((a -> Maybe ()) -> Prism' a ()) -> (a -> Maybe ()) -> Prism' a ()
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> (a -> Bool) -> a -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p
{-# INLINE nearly #-}

-- | This is an improper prism for text formatting based on 'Read' and 'Show'.
--
-- This 'Prism' is \"improper\" in the sense that it normalizes the text formatting, but round tripping
-- is idempotent given sane 'Read'/'Show' instances.
--
-- >>> _Show # 2
-- "2"
--
-- >>> "EQ" ^? _Show :: Maybe Ordering
-- Just EQ
--
-- @
-- '_Show' ≡ 'prism'' 'show' 'readMaybe'
-- @
_Show :: (Read a, Show a) => Prism' String a
_Show :: Prism' String a
_Show = (a -> String) -> (String -> Either String a) -> Prism' String a
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism a -> String
forall a. Show a => a -> String
show ((String -> Either String a) -> Prism' String a)
-> (String -> Either String a) -> Prism' String a
forall a b. (a -> b) -> a -> b
$ \String
s -> case ReadS a
forall a. Read a => ReadS a
reads String
s of
  [(a
a,String
"")] -> a -> Either String a
forall a b. b -> Either a b
Right a
a
  [(a, String)]
_ -> String -> Either String a
forall a b. a -> Either a b
Left String
s
{-# INLINE _Show #-}