content: -- |
  -- Module: Optics.Prism
  -- Description: A generalised or first-class constructor.
  --
  -- A 'Prism' generalises the notion of a constructor (just as a
  -- 'Optics.Lens.Lens' generalises the notion of a field).
  --
  module Optics.Prism
    (
    -- * Formation
      Prism
    , Prism'
  
    -- * Introduction
    , prism
  
    -- * Elimination
    -- | A 'Prism' is in particular an 'Optics.AffineFold.AffineFold',
    -- an 'Optics.AffineTraversal.AffineTraversal', a
    -- 'Optics.Review.Review' and a 'Optics.Setter.Setter', therefore you can
    -- specialise types to obtain:
    --
    -- @
    -- 'Optics.AffineFold.preview'  :: 'Prism'' s a -> s -> Maybe a
    -- 'Optics.Review.review'   :: 'Prism'' s a -> a -> s
    -- @
    --
    -- @
    -- 'Optics.Setter.over'     :: 'Prism' s t a b -> (a -> b) -> s -> t
    -- 'Optics.Setter.set'      :: 'Prism' s t a b ->       b  -> s -> t
    -- 'Optics.AffineTraversal.matching' :: 'Prism' s t a b             -> s -> Either t a
    -- @
    --
    -- If you want to 'Optics.AffineFold.preview' a type-modifying 'Prism' that is
    -- insufficiently polymorphic to be used as a type-preserving 'Prism'', use
    -- 'Optics.ReadOnly.getting':
    --
    -- @
    -- 'Optics.AffineFold.preview' . 'Optics.ReadOnly.getting' :: 'Prism' s t a b -> s -> 'Maybe' a
    -- @
  
    -- * Computation
    -- |
    --
    -- @
    -- 'Optics.Review.review'   ('prism' f g) ≡ f
    -- 'Optics.AffineTraversal.matching' ('prism' f g) ≡ g
    -- @
  
    -- * Well-formedness
    -- |
    --
    -- @
    -- 'Optics.AffineTraversal.matching' o ('Optics.Review.review' o b) ≡ 'Right' b
    -- 'Optics.AffineTraversal.matching' o s ≡ 'Right' a  =>  'Optics.Review.review' o a ≡ s
    -- @
  
    -- * Additional introduction forms
    -- | See "Data.Maybe.Optics" and "Data.Either.Optics" for 'Prism's for the
    -- corresponding types, and 'Optics.Cons.Core._Cons', 'Optics.Cons.Core._Snoc'
    -- and 'Optics.Empty.Core._Empty' for 'Prism's for container types.
    , prism'
    , only
    , nearly
  
    -- * Additional elimination forms
    , withPrism
  
    -- * Combinators
    , aside
    , without
    , below
  
    -- * Subtyping
    , A_Prism
    -- | <<diagrams/Prism.png Prism in the optics hierarchy>>
    )
    where
  
  import Control.Monad
  import Data.Bifunctor
  
  import Data.Profunctor.Indexed
  
  import Optics.Internal.Optic
  
  -- | Type synonym for a type-modifying prism.
  type Prism s t a b = Optic A_Prism NoIx s t a b
  
  -- | Type synonym for a type-preserving prism.
  type Prism' s a = Optic' A_Prism NoIx s a
  
  -- | Build a prism from a constructor and a matcher, which must respect the
  -- well-formedness laws.
  --
  -- If you want to build a 'Prism' from the van Laarhoven representation, use
  -- @prismVL@ from the @optics-vl@ package.
  prism :: (b -> t) -> (s -> Either t a) -> Prism s t a b
  prism construct match = Optic $ dimap match (either id construct) . 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' bs sma = prism bs (\s -> maybe (Left s) Right (sma s))
  {-# INLINE prism' #-}
  
  -- | Work with a 'Prism' as a constructor and a matcher.
  withPrism
    :: Is k A_Prism
    => Optic k is s t a b
    -> ((b -> t) -> (s -> Either t a) -> r)
    -> r
  withPrism o k = case getOptic (castOptic @A_Prism o) (Market id Right) of
    Market construct match -> k construct match
  {-# INLINE withPrism #-}
  
  ----------------------------------------
  
  -- | Use a 'Prism' to work over part of a structure.
  aside :: Is k A_Prism => Optic k is s t a b -> Prism (e, s) (e, t) (e, a) (e, b)
  aside k =
    withPrism k     $ \bt seta ->
    prism (fmap bt) $ \(e,s) ->
    case seta s of
      Left t  -> Left  (e,t)
      Right a -> Right (e,a)
  {-# INLINE aside #-}
  
  -- | Given a pair of prisms, project sums.
  --
  -- Viewing a 'Prism' as a co-'Optics.Lens.Lens', this combinator can be seen to
  -- be dual to 'Optics.Lens.alongside'.
  without
    :: (Is k A_Prism, Is l A_Prism)
    => Optic k is s t a b
    -> Optic l is u v c d
    -> Prism (Either s u) (Either t v) (Either a c) (Either b d)
  without k =
    withPrism k         $ \bt seta k' ->
    withPrism k'        $ \dv uevc    ->
    prism (bimap bt dv) $ \su ->
    case su of
      Left s  -> bimap Left Left (seta s)
      Right u -> bimap Right Right (uevc u)
  {-# INLINE without #-}
  
  -- | Lift a 'Prism' through a 'Traversable' functor, giving a 'Prism' that
  -- matches only if all the elements of the container match the 'Prism'.
  below
    :: (Is k A_Prism, Traversable f)
    => Optic' k is s a
    -> Prism' (f s) (f a)
  below k =
    withPrism k     $ \bt seta ->
    prism (fmap bt) $ \s ->
    case traverse seta s of
      Left _  -> Left s
      Right t -> Right t
  {-# INLINE below #-}
  
  -- | 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) $ guard . (a ==)
  {-# 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 'Optics.Empty._Empty' with the
  -- 'Optics.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 p = prism' (\() -> a) $ guard . p
  {-# INLINE nearly #-}
  
  -- $setup
  -- >>> import Optics.Core
  