content: {-# OPTIONS_GHC -Wno-redundant-constraints #-}
  
  {-# LANGUAGE QuantifiedConstraints #-}
  {-# LANGUAGE RankNTypes            #-}
  {-# LANGUAGE TypeFamilies          #-}
  
  {- |
  Module                  : Prolens
  Copyright               : (c) 2020-2021 Kowainik
  SPDX-License-Identifier : MPL-2.0
  Maintainer              : Kowainik <xrom.xkov@gmail.com>
  Stability               : Stable
  Portability             : Portable
  
  The @prolens@ package is a Haskell library with a minimal and lightweight
  implementation of optics based on 'Profunctor's. __'Optic'__ is a high-level
  concept for values that provide composable access to different parts of structures.
  
  "Prolens" implements the following optics:
  
   * 'Lens' — composable getters and setters
   * 'Prism' — composable constructors and deconstructors
   * 'Traversal' — composable data structures visitors
  
  == Usage
  
  To use lenses or prisms in your project, you need to add @prolens@ package as
  the dependency in the @build-depends@ field of your @.cabal@ file. E.g.:
  
  @
  build-depends: prolens ^>= 0.0.0.0
  @
  
  You should add the import of this module in the place of lenses usage:
  
  @
  __import__ "Prolens"
  @
  
  == Creating your own optics
  
  We show in each section of this module how to create values of each
  kind of optics.
  
  ⚠️ __The general crucial rule__ for achieving maximum performance:
  always add @\{\-\# INLINE ... \#\-\}@ pragmas to your optics.
  
  == Typeclasses table
  
  The below table shows required constraints for each 'Optic':
  
  +-------------+------------------------------+
  | Optic       | Constraints                  |
  +=============+==============================+
  | 'Lens'      | @'Strong' p@                 |
  +-------------+------------------------------+
  | 'Prism'     | @'Choice' p@                 |
  +-------------+------------------------------+
  | 'Traversal' | @('Choice' p, 'Monoidal' p)@ |
  +-------------+------------------------------+
  
  == Usage table: get, set, modify
  
  Here is a go-to table on how to use getter, setters and modifiers with different
  'Optic's.
  
  +-------------+------------------+--------------+------------------+------------------+-----------------+-----------------+
  |             | get              | get operator | set              | set operator     | modify          | modify operator |
  +=============+==================+==============+==================+==================+=================+=================+
  | 'Lens'      | @'view' l x@     | @x '^.' l@   | @'set' l new x@  | @x & l '.~' new@ | @'over' l f x@  | @x & l '%~' f@  |
  +-------------+------------------+--------------+------------------+------------------+-----------------+-----------------+
  | 'Prism'     | @'preview' _L x@ | -            | @'set' _L new x@ | -                | @'over' _L f x@ | -               |
  +-------------+------------------+--------------+------------------+------------------+-----------------+-----------------+
  | 'Traversal' | @'view' l x@     | -            | @'set' l new x@  | -                | @'over' l f x@  | -               |
  +-------------+------------------+--------------+------------------+------------------+-----------------+-----------------+
  
  @since 0.0.0.0
  -}
  
  module Prolens
      ( -- * Profunctor typeclass
        Profunctor (..)
  
        -- * Optics
      , Optic
  
        -- * Lenses
        -- $lenses
  
        -- ** Lenses types
      , Lens
      , Lens'
        -- ** Strong typeclass
      , Strong (..)
  
        -- ** Lenses functions
      , set
      , over
      , view
      , lens
  
        -- ** Lenses operators
      , (^.)
      , (.~)
      , (%~)
  
        -- ** Standard lenses
      , fstL
      , sndL
  
        -- * Prisms
        -- $prisms
  
        -- ** Prism types
      , Prism
      , Prism'
        -- ** Choice typeclass
      , Choice (..)
  
        -- ** Prism functions
      , prism
      , prism'
      , preview
  
        -- ** Standard Prisms
      , _Just
      , _Left
      , _Right
  
        -- * Traversals
  
        -- ** Traversal types
      , Traversal
        -- ** Monoidal typeclass
      , Monoidal (..)
  
        -- ** Traversal functions
      , traverseOf
  
        -- ** Standard traversals
      , eachPair
      , eachMaybe
      , eachList
  
        -- * Internal data types
      , Forget (..)
      , Fun (..)
      ) where
  
  import Control.Applicative (Const (..), liftA2)
  import Data.Coerce (coerce)
  import Data.Monoid (First (..))
  
  
  -- $setup
  -- >>> import Data.Function ((&))
  
  
  {- | The type @p@ is called 'Profunctor' and it means, that a value of
  type @p in out@ takes a value of type @in@ as an argument (input) and
  outputs a value of type @out@. 'Profunctor' allows mapping of inputs
  and outputs.
  
  @
            +----> Result input
            |
            |                                +--> Original profunctor
            |      +-> Original input        |
            +      +                         +
  dimap :: (in2 -> in1) -> (out1 -> out2) -> p in1 out1 -> p in2 out2
                            +       +
                            |       +-> Result output
                            |
                            +-> Original output
  @
  
  Speaking in terms of other abstractions, 'Profunctor' is
  'Data.Functor.Contravariant.Contravariant' in the first type argument
  (type variable @in@) and 'Functor' in the second type argument (type
  variable @out@).
  
  Moreover, @p in@ must have 'Functor' instance first to implement the
  'Profunctor' instance. This required using @QuantifiedConstraints@.
  
  @
                           Contravariant <---+
                                             |
                                           +-+-+
                                           +   +
  (forall a . Functor (p a)) => Profunctor p a b
            +                              + +
            |                              | |
            +--> Quantified constraint     +++
                                            |
                                Functor  <--+
  @
  
  Instances of 'Profunctor' should satisfy the following laws:
  
  * __Identity:__ @'dimap' 'id' 'id' ≡ 'id'@
  * __Composition:__ @'dimap' (inAB . inBC) (outYZ . outXY) ≡ 'dimap' inBC outYZ . 'dimap' inAB outXY@
  
  @since 0.0.0.0
  -}
  -- type Profunctor :: (Type -> Type -> Type) -> Constraint
  class (forall a . Functor (p a)) => Profunctor p where
      dimap
          :: (in2 -> in1)  -- ^ Map input
          -> (out1 -> out2)  -- ^ Map output
          -> p in1 out1  -- ^ Take @in1@ as input and return @out1@
          -> p in2 out2  -- ^ Take @in2@ as input and return @out2@
  
  -- | @since 0.0.0.0
  instance Profunctor (->) where
      dimap :: (in2 -> in1) -> (out1 -> out2) -> (in1 -> out1) -> (in2 -> out2)
      dimap in21 out12 f = out12 . f . in21
      {-# INLINE dimap #-}
  
  {- | @'Fun' m a b@ is a wrapper for function @a -> m b@.
  
  @since 0.0.0.0
  -}
  newtype Fun m a b = Fun
      { unFun :: a -> m b
      }
  
  -- | @since 0.0.0.0
  instance Functor m => Functor (Fun m x) where
      fmap :: (a -> b) -> Fun m x a -> Fun m x b
      fmap f (Fun xma) = Fun (fmap f . xma)
      {-# INLINE fmap #-}
  
  -- | @since 0.0.0.0
  instance Functor m => Profunctor (Fun m) where
      dimap :: (in2 -> in1) -> (out1 -> out2) -> Fun m in1 out1 -> Fun m in2 out2
      dimap in21 out12 (Fun f) = Fun (fmap out12 . f . in21)
      {-# INLINE dimap #-}
  
  {- | 'Strong' is a 'Profunctor' that can be lifted to take a pair as
  an input and return a pair.
  
  The second element of a pair (variable of type @c@) can be of any
  type, and you can decide what type it should be. This is convenient
  for implementing various functions. E.g. 'lens' uses this fact.
  
  Instances of 'Strong' should satisfy the following laws:
  
  * __'first' via 'second' swap:__ @'first' ≡ 'dimap' 'Data.Tuple.swap' 'Data.Tuple.swap' . 'second'@
  * __'second' via 'first' swap:__ @'second' ≡ 'dimap' 'Data.Tuple.swap' 'Data.Tuple.swap' . 'first'@
  
  * __Fst functor:__ @'dimap' 'fst' 'id' ≡ 'fmap' 'fst' . 'first'@
  * __Snd functor:__ @'dimap' 'snd' 'id' ≡ 'fmap' 'snd' . 'second'@
  
  * __Distribution over 'first':__ @'dimap' ('second' f) 'id' . 'first' ≡ 'fmap' ('second' f) . 'first'@
  * __Distribution over 'second':__ @'dimap' ('first' f) 'id' . 'second' ≡ 'fmap' ('first' f) . 'second'@
  
  * __Associativity of 'first':__ @'first' . 'first' ≡ 'dimap' (\\((a, b), c) -> (a, (b, c))) (\\(a, (b, c)) -> ((a, b), c)) . 'first'@
  * __Associativity of 'second':__ @'second' . 'second' ≡ 'dimap' (\\(a, (b, c)) -> ((a, b), c)) (\\((a, b), c) -> (a, (b, c))) . 'second'@
  
  @since 0.0.0.0
  -}
  class Profunctor p => Strong p where
      first  :: p a b -> p (a, c) (b, c)
      second :: p a b -> p (c, a) (c, b)
  
  -- | @since 0.0.0.0
  instance Strong (->) where
      first :: (a -> b) -> (a, c) -> (b, c)
      first ab (a, c) = (ab a, c)
      {-# INLINE first #-}
  
      second :: (a -> b) -> (c, a) -> (c, b)
      second ab (c, a) = (c, ab a)
      {-# INLINE second #-}
  
  -- | @since 0.0.0.0
  instance (Functor m) => Strong (Fun m) where
      first :: Fun m a b -> Fun m (a, c) (b, c)
      first (Fun amb) = Fun (\(a, c) -> fmap (, c) (amb a))
      {-# INLINE first #-}
  
      second :: Fun m a b -> Fun m (c, a) (c, b)
      second (Fun amb) = Fun (\(c, a) -> fmap (c,) (amb a))
      {-# INLINE second #-}
  
  {- | 'Choice' is a 'Profunctor' that can be lifted to work with
  'Either' given input or some other value.
  
  The other element of 'Either' (variable of type @c@) can be of any
  type, and you can decide what type it should be. This is convenient
  for implementing various functions. E.g. 'prism' uses this fact.
  
  
  Assuming, we have the following functions in scope:
  
  @
  swapEither  :: Either a b -> Either b a
  unnestLeft  :: Either (Either a b) c -> Either a (Either b c)
  unnestRight :: Either a (Either b c) -> Either (Either a b) c
  @
  
  Instances of 'Choice' should satisfy the following laws:
  
  * __'left' via 'right' swap:__ @'left' ≡ 'dimap' swapEither swapEither . 'right'@
  * __'right' via 'left' swap:__ @'right' ≡ 'dimap' swapEither swapEither . 'left'@
  
  * __'Left' functor:__ @'fmap' 'Left' ≡ 'dimap' 'Left' 'id' . 'left'@
  * __'Right' functor:__ @'fmap' 'Right' ≡ 'dimap' 'Right' 'id' . 'right'@
  
  * __Distribution over 'left':__ @'dimap' ('right' f) 'id' . 'left' ≡ 'fmap' ('right' f) . 'left'@
  * __Distribution over 'right':__ @'dimap' ('left' f) 'id' . 'right' ≡ 'fmap' ('left' f) . 'right'@
  
  * __Associativity of 'left':__ @'left' . 'left' ≡ 'dimap' unnestLeft unnestRight . 'left'@
  * __Associativity of 'right':__ @'right' . 'right' ≡ 'dimap' unnestRight unnestLeft . 'right'@
  
  @since 0.0.0.0
  -}
  class Profunctor p => Choice p where
      left  :: p a b -> p (Either a c) (Either b c)
      right :: p a b -> p (Either c a) (Either c b)
  
  -- | @since 0.0.0.0
  instance Choice (->) where
      left  :: (a -> b) -> Either a c -> Either b c
      left ab = \case
          Left a  -> Left $ ab a
          Right c -> Right c
      {-# INLINE left #-}
  
      right :: (a -> b) -> Either c a -> Either c b
      right ab = \case
          Right a -> Right $ ab a
          Left c  -> Left c
      {-# INLINE right #-}
  
  -- | @since 0.0.0.0
  instance (Applicative m) => Choice (Fun m) where
      left :: Fun m a b -> Fun m (Either a c) (Either b c)
      left (Fun amb)= Fun $ \eitherAc -> case eitherAc of
          Left a  -> Left <$> amb a
          Right c -> pure $ Right c
      {-# INLINE left #-}
  
      right :: Fun m a b -> Fun m (Either c a) (Either c b)
      right (Fun amb)= Fun $ \eitherCa -> case eitherCa of
          Right a -> Right <$> amb a
          Left c  -> pure $ Left c
      {-# INLINE right #-}
  
  {- | 'Monoidal' is 'Strong' 'Profunctor' that can be appended. It is
  similar to 'Monoid's but for higher-kinded types.
  
  Instances of 'Monoidal' should satisfy the following laws:
  
  * __Right identity:__ @'pappend' f 'pempty' ≡ 'first' f@
  * __Left identity:__ @'pappend' 'pempty' f ≡ 'second' f@
  * __Associativity:__ @'pappend' f ('pappend' g h) ⋍ 'pappend' ('pappend' f g) h@
  
  ⚠️ __Note:__ The @⋍@ operator in the __associativity__ law is equality
  ignoring the structure. The law is written in that way because
  'pappend' returns a tuple and the order of nested tuples depends on
  the order of 'pappend' applications. In practice, this means, that if
  you want to check the law, you reorder tuples in the following way:
  
  @
  'pappend' f ('pappend' g h) ≡ 'dimap' (\\(a, (b, c)) -> ((a, b), c)) (\\((a, b), c) -> (a, (b, c))) ('pappend' ('pappend' f g) h)
  @
  
  @since 0.0.0.0
  -}
  class Strong p => Monoidal p where
      pappend :: p a b -> p c d -> p (a, c) (b, d)
      pempty  :: p a a
  
  -- | @since 0.0.0.0
  instance Monoidal (->) where
      pappend :: (a -> b) -> (c -> d) -> (a, c) -> (b, d)
      pappend ab cd (a, c) = (ab a, cd c)
      {-# INLINE pappend #-}
  
      pempty :: a -> a
      pempty = id
      {-# INLINE pempty #-}
  
  -- | @since 0.0.0.0
  instance (Applicative m) => Monoidal (Fun m) where
      pappend :: Fun m a b -> Fun m c d -> Fun m (a, c) (b, d)
      pappend (Fun amb) (Fun cmd) = Fun (\(a, c) -> liftA2 (,) (amb a) (cmd c))
      {-# INLINE pappend #-}
  
      pempty :: Fun m a a
      pempty = Fun (pure . id)
      {-# INLINE pempty #-}
  
  {- | 'Optic' takes a connection from @a@ to @b@ (represented as a
  value of type @p a b@) and returns a connection from @source@ to
  @target@ (represented as a value of type @p source target@).
  
  @
             +---> Profunctor
             |
             | +----> Final input
             | |
             | |      +-> Final output
             | |      |
             + +      +
  type Optic p source target a b
                             + +
                             | |
              Given input <--+ |
                               |
          Given output <-------+
  @
  
  @since 0.0.0.0
  -}
  type Optic p source target a b = p a b -> p source target
  
  
  {- $lenses
  
  == Example
  
  To understand better how to use this library lets look at some simple example.
  Let's say we have the user and address data types in our system:
  
  >>> :{
  data Address = Address
      { addressCountry :: String
      , addressCity    :: String
      , addressIndex   :: String
      } deriving (Show)
  :}
  
  >>> :{
  data User = User
      { userName    :: String
      , userAge     :: Int
      , userAddress :: Address
      } deriving (Show)
  :}
  
  We can easily get fields of the @User@ and @Address@ types, but
  setting values is inconvenient (especially for nested records). To
  solve this problem, we can use lenses — composable getters and
  setters. 'Lens' is a value, so we need to define lenses for fields of
  our data types first.
  
  To create the lens for the @userName@ field we can use 'lens' function and
  manually writing getter and setter function:
  
  >>> :{
  nameL :: Lens' User String
  nameL = lens getter setter
    where
      getter :: User -> String
      getter = userName
      setter :: User -> String -> User
      setter user newName = user {userName = newName}
  :}
  
  In this manner, we can create other lenses for our @User@ data type.
  Usually, lenses are one-liners, and we can define them easily using lambda-functions.
  
  >>> :{
  ageL :: Lens' User Int
  ageL = lens userAge (\u new -> u {userAge = new})
  :}
  
  >>> :{
  addressL :: Lens' User Address
  addressL = lens userAddress (\u new -> u {userAddress = new})
  :}
  
  We want to have lenses for accessing @Adress@ fields inside @User@, so we want to have the following values:
  
  @
  countryL :: 'Lens'' User 'String'
  cityL    :: 'Lens'' User 'String'
  indexL   :: 'Lens'' User 'String'
  @
  
  /Note:/ for lenses as @countryL@, @cityL@ etc., we are using composition of the
  lenses for the @userAddress@ field. If we have
  
  >>> :{
  addressCityL :: Lens' Address String
  addressCityL = lens addressCity (\a new -> a {addressCity = new})
  :}
  
  then
  
  >>> cityL = addressL . addressCityL
  
  Let's say we have some sample user
  
  >>> :{
  address = Address
      { addressCountry = "UK"
      , addressCity    = "London"
      , addressIndex   = "XXX"
      }
  user :: User
  user = User
      { userName = "John"
      , userAge  = 42
      , userAddress = address
      }
  :}
  
  To view the fields of the User data type we can use 'view' or '^.'
  
  >>> view ageL user
  42
  >>> user ^. cityL
  "London"
  
  If we want to change any of the user's data, we should use 'set' or '.~'
  
  >>> set nameL "Johnny" user
  User {userName = "Johnny", userAge = 42, userAddress = Address {addressCountry = "UK", addressCity = "London", addressIndex = "XXX"}}
  >>> user & cityL .~ "Bristol"
  User {userName = "John", userAge = 42, userAddress = Address {addressCountry = "UK", addressCity = "Bristol", addressIndex = "XXX"}}
  
  'over' or '%~' operator could be useful when, for example, you want to increase the age by one on the user's birthday:
  
  >>> over ageL succ user
  User {userName = "John", userAge = 43, userAddress = Address {addressCountry = "UK", addressCity = "London", addressIndex = "XXX"}}
  >>> user & ageL %~ succ
  User {userName = "John", userAge = 43, userAddress = Address {addressCountry = "UK", addressCity = "London", addressIndex = "XXX"}}
  -}
  
  {- | 'Lens' represents composable getters and setters.
  
  'Lens' is an @'Optic' p@ with the 'Strong' constraint on the @p@ type variable.
  
  @
            +---> Current object
            |
            |      +-> Final object
            |      |
            +      +
  type Lens source target a b
                          + +
                          | |
         Current field <--+ |
                            |
        Final field <-------+
  @
  
  @since 0.0.0.0
  -}
  type Lens source target a b = forall p . Strong p => Optic p source target a b
  
  {- | The monomorphic lenses which don't change the type of the container (or of
  the value inside). It has a 'Strong' constraint, and it can be used whenever a
  getter or a setter is needed.
  
    * @a@ is the type of the value inside of structure
    * @source@ is the type of the whole structure
  
  For most use-cases it's enought to use this 'Lens'' instead of more general 'Lens'.
  
  @since 0.0.0.0
  -}
  type Lens' source a = Lens source source a a
  
  {- | Sets the given value to the structure using a setter.
  
  @since 0.0.0.0
  -}
  set :: (p ~ (->))
      => Optic p source target a b  -- ^ 'Optic' that can be lens
      -> b  -- ^ Value to set
      -> source  -- ^ Object where we want to set value
      -> target  -- ^ Resulting object with @b@ set
  set abst = abst . const
  {-# INLINE set #-}
  
  {- | Applies the given function to the target.
  
  @since 0.0.0.0
  -}
  over
      :: (p ~ (->))
      => Optic p source target a b  -- ^ 'Optic' that can be lens
      -> (a -> b)  -- ^ Field modification function
      -> source  -- ^ Object where we want to set value
      -> target  -- ^ Resulting object with the modified field
  over = id
  {-# INLINE over #-}
  
  {- | Gets a value out of a structure using a getter.
  
  @since 0.0.0.0
  -}
  view
      :: (p ~ Fun (Const a))
      => Optic p source target a b  -- ^ 'Optic' that can be lens
      -> source  -- ^ Object from which we want to get value
      -> a  -- ^ Field of @source@
  view opt = coerce (opt (Fun Const))
  {-# INLINE view #-}
  -- view opt = getConst . unFun (opt (Fun Const))
  -- opt :: Fun (Const a) a b -> Fun (Const a) s t
  -- opt :: (a -> Const a b) -> ( s -> Const a t)
  
  {- | Creates 'Lens' from the getter and setter.
  
  @since 0.0.0.0
  -}
  lens
      :: (source -> a)  -- ^ Getter
      -> (source -> b -> target)  -- ^ Setter
      -> Lens source target a b
  lens getter setter = dimap (\s -> (s, getter s)) (uncurry setter) . second
  {-# INLINE lens #-}
  
  {- | The operator form of 'view' with the arguments flipped.
  
  @since 0.0.0.0
  -}
  infixl 8 ^.
  (^.) :: source -> Lens' source a -> a
  s ^. l = view l s
  {-# INLINE (^.) #-}
  
  {- | The operator form of 'set'.
  
  @since 0.0.0.0
  -}
  infixr 4 .~
  (.~) :: Lens' source a -> a -> source -> source
  (.~) l = set l
  {-# INLINE (.~) #-}
  
  {- | The operator form of 'over'.
  
  @since 0.0.0.0
  -}
  infixr 4 %~
  (%~) :: Lens' source a -> (a -> a) -> source -> source
  (%~) l = over l
  {-# INLINE (%~) #-}
  
  {- | 'Lens'' for a tuple on the first argument.
  
  >>> view fstL (42, "str")
  42
  
  @since 0.0.0.0
  -}
  fstL :: Lens (a, c) (b, c) a b
  fstL = lens fst $ \(_, b) new -> (new, b)
  {-# INLINE fstL #-}
  
  {- | 'Lens'' for a tuple on the second argument.
  
  >>> view sndL (42, "Hello")
  "Hello"
  
  @since 0.0.0.0
  -}
  sndL :: Lens (x, a) (x, b) a b
  sndL = lens snd $ \(a, _) new -> (a, new)
  {-# INLINE sndL #-}
  
  {- $prisms
  Prisms work with sum types.
  
  == Example
  
  Let's say we have the user data type in our system:
  
  >>> :{
  data Address = Address
      { addressCountry :: String
      , addressCity    :: String
      } deriving (Show)
  :}
  
  >>> :{
  data Payload
      = NamePayload String
      | IdPayload Int
      | AddressPayload Address
      deriving (Show)
  :}
  
  To create the prism for each constructor we can use 'prism'' function and
  manually writing getter and setter function:
  
  /NOTE:/ The naming convention for prisms is the following:
  
  @
  _ConstructorName
  @
  
  >>> :{
  _NamePayload :: Prism' Payload String
  _NamePayload = prism' construct match
    where
      match :: Payload -> Maybe String
      match p = case p of
          NamePayload name -> Just name
          _otherPayload -> Nothing
      construct :: String -> Payload
      construct = NamePayload
  :}
  
  In this manner, we can create other prisms for our @Payload@ data type.
  
  >>> :{
  _IdPayload :: Prism' Payload Int
  _IdPayload = prism' IdPayload $ \p -> case p of
      IdPayload i -> Just i
      _otherPayload -> Nothing
  :}
  
  >>> :{
  _AddressPayload :: Prism' Payload Address
  _AddressPayload = prism' AddressPayload $ \p -> case p of
      AddressPayload a -> Just a
      _otherPayload -> Nothing
  :}
  
  Let's say we have some sample payload
  
  >>> :{
  payloadName :: Payload
  payloadName = NamePayload "Some name"
  :}
  
  To view the fields of the @Payload@ data type we can use 'preview'
  
  >>> preview _NamePayload payloadName
  Just "Some name"
  >>> preview _IdPayload payloadName
  Nothing
  
  If we want to change any of the data, we should use 'set' or '.~' (just like in lenses)
  
  >>> set _NamePayload "Johnny" payloadName
  NamePayload "Johnny"
  >>> set _IdPayload 3 payloadName
  NamePayload "Some name"
  
  Note, that you can easily compose lenses and prisms together:
  
  >>> :{
  address = Address
      { addressCountry = "UK"
      , addressCity    = "London"
      }
  :}
  
  >>> :{
  addressCityL :: Lens' Address String
  addressCityL = lens addressCity (\a new -> a {addressCity = new})
  :}
  
  >>> :{
  payloadAddress :: Payload
  payloadAddress = AddressPayload address
  :}
  
  >>> set _AddressPayload (address & addressCityL .~ "Bristol") payloadAddress
  AddressPayload (Address {addressCountry = "UK", addressCity = "Bristol"})
  -}
  
  {- | 'Prism' represents composable constructors and deconstructors.
  
  'Prism' is an @'Optic' p@ with 'Choice' constraint on the @p@ type
  variable.
  
  @
                     +---> Current object
                     |
                     |      +-> Final object
                     |      |
                     +      +
          type Prism source target a b
                                   + +
                                   | |
   Field in current constructor <--+ |
                                     |
  Field in final constructor <-------+
  @
  
  @since 0.0.0.0
  -}
  type Prism source target a b = forall p . Choice p => Optic p source target a b
  
  {- | The monomorphic prisms which don't change the type of the container (or of
  the value inside).
  
    * @a@ is the value inside the particular constructor
    * @source@ is some sum type
  
  @since 0.0.0.0
  -}
  type Prism' source a = Prism source source a a
  
  {- | Newtype around function @a -> r@. It's called /forget/ because it
  forgets about its last type variable.
  
  @since 0.0.0.0
  -}
  newtype Forget r a b = Forget
      { unForget :: a -> Maybe r
      }
  
  -- | @since 0.0.0.0
  instance Functor (Forget r x) where
      fmap :: (a -> b) -> Forget r x a -> Forget r x b
      fmap _ = coerce
      {-# INLINE fmap #-}
  
  -- | @since 0.0.0.0
  instance Profunctor (Forget r) where
      dimap :: (a -> b) -> (c -> d) -> Forget r b c -> Forget r a d
      dimap ab _cd (Forget br) = Forget (br . ab)
      {-# INLINE dimap #-}
  
  -- | @since 0.0.0.0
  instance Strong (Forget r) where
      first :: Forget r a b -> Forget r (a, c) (b, c)
      first (Forget ar) = Forget (ar . fst)
      {-# INLINE first #-}
  
      second :: Forget r a b -> Forget r (c, a) (c, b)
      second (Forget ar) = Forget (ar . snd)
      {-# INLINE second #-}
  
  -- | @since 0.0.0.0
  instance Choice (Forget r) where
      left :: Forget r a b -> Forget r (Either a c) (Either b c)
      left (Forget ar) = Forget (either ar (const Nothing))
      {-# INLINE left #-}
  
      right :: Forget r a b -> Forget r (Either c a) (Either c b)
      right (Forget ar) = Forget (either (const Nothing) ar)
      {-# INLINE right #-}
  
  -- | @since 0.0.0.0
  instance Monoidal (Forget r) where
      pappend :: Forget r a b -> Forget r c d -> Forget r (a, c) (b, d)
      pappend (Forget ar) (Forget cr) = Forget
          (\(a, c) -> getFirst $  First (ar a) <> First (cr c))
      {-# INLINE pappend #-}
  
      pempty :: Forget r a a
      pempty = Forget (const Nothing)
      {-# INLINE pempty #-}
  
  {- | Match a value from @source@ type.
  
  @since 0.0.0.0
  -}
  preview
      :: forall a source p
      .  (p ~ Forget a)
      => Optic p source source a a  -- ^ 'Optic' that can be prism
      -> source  -- ^ Object (possible sum type)
      -> Maybe a  -- ^ Value of type @a@ from a specific constructor
  preview paapss = coerce (paapss wrap)
    where
      wrap :: Forget a a a
      wrap = coerce @(a -> Maybe a) @(Forget a a a) Just
      {-# INLINE wrap #-}
  {-# INLINE preview #-}
  -- preview paapss = getFirst . unForget (paapss (Forget (First . Just)))
  -- paapss :: Forget (First a) a a -> Forget (First a) source source
  -- paapss :: (a -> First a) -> source -> First a
  -- paapss :: (a -> Maybe a) -> source -> Maybe a
  
  {- | Create 'Prism' from constructor and matching function.
  
  @since 0.0.0.0
  -}
  prism
      :: (b -> target)  -- ^ Constructor
      -> (source -> Either target a)  -- ^ Matching function
      -> Prism source target a b
  -- prism :: (b -> target) -> (source -> Either target a) -> p a b -> p source target
  prism ctor match = dimap match (either id ctor) . right
  {-# INLINE prism #-}
  
  {- | Create monomorphic 'Prism'' from constructor and matching function.
  
  @since 0.0.0.0
  -}
  prism'
      :: (a -> source)  -- ^ Constructor
      -> (source -> Maybe a)  -- ^ Matching function
      -> Prism' source a
  prism' ctor match = prism ctor (\s -> maybe (Left s) Right $ match s)
  {-# INLINE prism' #-}
  
  {- | 'Prism' for a 'Just' of 'Maybe'.
  
  >>> preview _Just (Just 42)
  Just 42
  
  >>> preview _Just Nothing
  Nothing
  
  @since 0.0.0.0
  -}
  _Just :: Prism (Maybe a) (Maybe b) a b
  _Just = prism Just $ \case
      Just a  -> Right a
      Nothing -> Left Nothing
  {-# INLINE _Just #-}
  
  
  {- | 'Prism' for a 'Left' of 'Either'.
  
  >>> preview _Left (Left 42)
  Just 42
  
  >>> preview _Left (Right "Hello")
  Nothing
  
  @since 0.0.0.0
  -}
  _Left :: Prism (Either a x) (Either b x) a b
  _Left = prism Left $ \case
      Left l  -> Right l
      Right r -> Left $ Right r
  {-# INLINE _Left #-}
  
  {- | 'Prism' for a 'Left' of 'Either'.
  
  >>> preview _Right (Left 42)
  Nothing
  
  >>> preview _Right (Right "Hello")
  Just "Hello"
  
  @since 0.0.0.0
  -}
  _Right :: Prism (Either x a) (Either x b) a b
  _Right = prism Right $ \case
      Right a -> Right a
      Left x  -> Left $ Left x
  {-# INLINE _Right #-}
  
  
  {- | 'Traversal' provides composable ways to visit different parts of
  a data structure.
  
  'Traversal' is an @'Optic' p@ with the 'Choice' and 'Monoidal'
  constraints on the @p@ type variable.
  
  @
                 +---> Current collection
                 |
                 |      +-> Final collection
                 |      |
                 +      +
  type Traversal source target a b
                               + +
                               | |
            Current element <--+ |
                                 |
           Final element <-------+
  @
  
  @since 0.0.0.0
  -}
  type Traversal source target a b
      = forall p
      . (Choice p, Monoidal p)
      => Optic p source target a b
  
  {- | Traverse a data structure using given 'Traversal'.
  
  >>> traverseOf eachPair putStrLn ("Hello", "World!")
  Hello
  World!
  ((),())
  
  @since 0.0.0.0
  -}
  traverseOf
      :: (Applicative f, p ~ Fun f)
      => Optic p source target a b  -- ^ 'Optic' that can be a traversal
      -> (a -> f b)  -- ^ Traversing function
      -> source  -- ^ Data structure to traverse
      -> f target  -- ^ Traversing result
  traverseOf pabPst aFb = unFun (pabPst (Fun aFb))
  -- pabPst :: Fun f a b -> Fun f source target
  -- pabPst :: (a -> f b) -> Fun f source target
  
  {- | 'Traversal' for a pair of same type elements.
  
  >>> over eachPair (+ 1) (3, 7)
  (4,8)
  
  @since 0.0.0.0
  -}
  eachPair :: Traversal (a, a) (b, b) a b
  eachPair pab = pappend pab pab
  
  {- | 'Traversal' for a 'Maybe'.
  
  >>> over eachMaybe (+ 1) (Just 3)
  Just 4
  >>> over eachMaybe (+ 1) Nothing
  Nothing
  
  @since 0.0.0.0
  -}
  eachMaybe :: Traversal (Maybe a) (Maybe b) a b
  eachMaybe pab = dimap maybeToEither eitherToMaybe (left pab)
    where
      maybeToEither :: Maybe a -> Either a ()
      maybeToEither = \case
          Just a  -> Left a
          Nothing -> Right ()
  
      eitherToMaybe :: Either a () -> Maybe a
      eitherToMaybe = \case
          Left a   -> Just a
          Right () -> Nothing
  
  {- | 'Traversal' for lists.
  
  >>> over eachList (+ 1) [1..5]
  [2,3,4,5,6]
  >>> over eachList (+ 1) []
  []
  
  @since 0.0.0.0
  -}
  eachList :: Traversal [a] [b] a b
  eachList pab = dimap listToEither eitherToList $ left $ pappend pab (eachList pab)
    where
      listToEither :: [a] -> Either (a, [a]) ()
      listToEither = \case
          []   -> Right ()
          x:xs -> Left (x, xs)
  
      eitherToList :: Either (a, [a]) () -> [a]
      eitherToList = \case
          Right ()     -> []
          Left (x, xs) -> x:xs
  