{-# 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 :: (in2 -> in1) -> (out1 -> out2) -> (in1 -> out1) -> in2 -> out2
dimap in2 -> in1
in21 out1 -> out2
out12 in1 -> out1
f = out1 -> out2
out12 (out1 -> out2) -> (in2 -> out1) -> in2 -> out2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. in1 -> out1
f (in1 -> out1) -> (in2 -> in1) -> in2 -> out1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. in2 -> in1
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
    { Fun m a b -> a -> m b
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 :: (a -> b) -> Fun m x a -> Fun m x b
fmap a -> b
f (Fun x -> m a
xma) = (x -> m b) -> Fun m x b
forall (m :: * -> *) a b. (a -> m b) -> Fun m a b
Fun ((a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (m a -> m b) -> (x -> m a) -> x -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> m a
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 :: (in2 -> in1) -> (out1 -> out2) -> Fun m in1 out1 -> Fun m in2 out2
dimap in2 -> in1
in21 out1 -> out2
out12 (Fun in1 -> m out1
f) = (in2 -> m out2) -> Fun m in2 out2
forall (m :: * -> *) a b. (a -> m b) -> Fun m a b
Fun ((out1 -> out2) -> m out1 -> m out2
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap out1 -> out2
out12 (m out1 -> m out2) -> (in2 -> m out1) -> in2 -> m out2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. in1 -> m out1
f (in1 -> m out1) -> (in2 -> in1) -> in2 -> m out1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. in2 -> in1
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 :: (a -> b) -> (a, c) -> (b, c)
first a -> b
ab (a
a, c
c) = (a -> b
ab a
a, c
c)
    {-# INLINE first #-}

    second :: (a -> b) -> (c, a) -> (c, b)
    second :: (a -> b) -> (c, a) -> (c, b)
second a -> b
ab (c
c, a
a) = (c
c, a -> b
ab a
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 m a b -> Fun m (a, c) (b, c)
first (Fun a -> m b
amb) = ((a, c) -> m (b, c)) -> Fun m (a, c) (b, c)
forall (m :: * -> *) a b. (a -> m b) -> Fun m a b
Fun (\(a
a, c
c) -> (b -> (b, c)) -> m b -> m (b, c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, c
c) (a -> m b
amb a
a))
    {-# INLINE first #-}

    second :: Fun m a b -> Fun m (c, a) (c, b)
    second :: Fun m a b -> Fun m (c, a) (c, b)
second (Fun a -> m b
amb) = ((c, a) -> m (c, b)) -> Fun m (c, a) (c, b)
forall (m :: * -> *) a b. (a -> m b) -> Fun m a b
Fun (\(c
c, a
a) -> (b -> (c, b)) -> m b -> m (c, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (c
c,) (a -> m b
amb a
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 :: (a -> b) -> Either a c -> Either b c
left a -> b
ab = \case
        Left a
a  -> b -> Either b c
forall a b. a -> Either a b
Left (b -> Either b c) -> b -> Either b c
forall a b. (a -> b) -> a -> b
$ a -> b
ab a
a
        Right c
c -> c -> Either b c
forall a b. b -> Either a b
Right c
c
    {-# INLINE left #-}

    right :: (a -> b) -> Either c a -> Either c b
    right :: (a -> b) -> Either c a -> Either c b
right a -> b
ab = \case
        Right a
a -> b -> Either c b
forall a b. b -> Either a b
Right (b -> Either c b) -> b -> Either c b
forall a b. (a -> b) -> a -> b
$ a -> b
ab a
a
        Left c
c  -> c -> Either c b
forall a b. a -> Either a b
Left c
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 m a b -> Fun m (Either a c) (Either b c)
left (Fun a -> m b
amb)= (Either a c -> m (Either b c)) -> Fun m (Either a c) (Either b c)
forall (m :: * -> *) a b. (a -> m b) -> Fun m a b
Fun ((Either a c -> m (Either b c)) -> Fun m (Either a c) (Either b c))
-> (Either a c -> m (Either b c))
-> Fun m (Either a c) (Either b c)
forall a b. (a -> b) -> a -> b
$ \Either a c
eitherAc -> case Either a c
eitherAc of
        Left a
a  -> b -> Either b c
forall a b. a -> Either a b
Left (b -> Either b c) -> m b -> m (Either b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m b
amb a
a
        Right c
c -> Either b c -> m (Either b c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either b c -> m (Either b c)) -> Either b c -> m (Either b c)
forall a b. (a -> b) -> a -> b
$ c -> Either b c
forall a b. b -> Either a b
Right c
c
    {-# INLINE left #-}

    right :: Fun m a b -> Fun m (Either c a) (Either c b)
    right :: Fun m a b -> Fun m (Either c a) (Either c b)
right (Fun a -> m b
amb)= (Either c a -> m (Either c b)) -> Fun m (Either c a) (Either c b)
forall (m :: * -> *) a b. (a -> m b) -> Fun m a b
Fun ((Either c a -> m (Either c b)) -> Fun m (Either c a) (Either c b))
-> (Either c a -> m (Either c b))
-> Fun m (Either c a) (Either c b)
forall a b. (a -> b) -> a -> b
$ \Either c a
eitherCa -> case Either c a
eitherCa of
        Right a
a -> b -> Either c b
forall a b. b -> Either a b
Right (b -> Either c b) -> m b -> m (Either c b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m b
amb a
a
        Left c
c  -> Either c b -> m (Either c b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either c b -> m (Either c b)) -> Either c b -> m (Either c b)
forall a b. (a -> b) -> a -> b
$ c -> Either c b
forall a b. a -> Either a b
Left c
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 :: (a -> b) -> (c -> d) -> (a, c) -> (b, d)
pappend a -> b
ab c -> d
cd (a
a, c
c) = (a -> b
ab a
a, c -> d
cd c
c)
    {-# INLINE pappend #-}

    pempty :: a -> a
    pempty :: a -> a
pempty = a -> a
forall a. a -> a
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 m a b -> Fun m c d -> Fun m (a, c) (b, d)
pappend (Fun a -> m b
amb) (Fun c -> m d
cmd) = ((a, c) -> m (b, d)) -> Fun m (a, c) (b, d)
forall (m :: * -> *) a b. (a -> m b) -> Fun m a b
Fun (\(a
a, c
c) -> (b -> d -> (b, d)) -> m b -> m d -> m (b, d)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (a -> m b
amb a
a) (c -> m d
cmd c
c))
    {-# INLINE pappend #-}

    pempty :: Fun m a a
    pempty :: Fun m a a
pempty = (a -> m a) -> Fun m a a
forall (m :: * -> *) a b. (a -> m b) -> Fun m a b
Fun (a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a) -> (a -> a) -> a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. a -> a
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 :: Optic p source target a b -> b -> source -> target
set Optic p source target a b
abst = Optic p source target a b
abst Optic p source target a b -> (b -> p a b) -> b -> p source target
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> p a b
forall a b. a -> b -> a
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 :: Optic p source target a b -> (a -> b) -> source -> target
over = Optic p source target a b -> (a -> b) -> source -> target
forall a. a -> a
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 :: Optic p source target a b -> source -> a
view Optic p source target a b
opt = p source target -> source -> a
coerce (Optic p source target a b
opt ((a -> Const a b) -> Fun (Const a) a b
forall (m :: * -> *) a b. (a -> m b) -> Fun m a b
Fun a -> Const a b
forall k a (b :: k). a -> Const a b
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 :: (source -> a) -> (source -> b -> target) -> Lens source target a b
lens source -> a
getter source -> b -> target
setter = (source -> (source, a))
-> ((source, b) -> target)
-> p (source, a) (source, b)
-> p source target
forall (p :: * -> * -> *) in2 in1 out1 out2.
Profunctor p =>
(in2 -> in1) -> (out1 -> out2) -> p in1 out1 -> p in2 out2
dimap (\source
s -> (source
s, source -> a
getter source
s)) ((source -> b -> target) -> (source, b) -> target
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry source -> b -> target
setter) (p (source, a) (source, b) -> p source target)
-> (p a b -> p (source, a) (source, b)) -> p a b -> p source target
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a b -> p (source, a) (source, b)
forall (p :: * -> * -> *) a b c.
Strong p =>
p a b -> p (c, a) (c, b)
second
{-# INLINE lens #-}

{- | The operator form of 'view' with the arguments flipped.

@since 0.0.0.0
-}
infixl 8 ^.
(^.) :: source -> Lens' source a -> a
source
s ^. :: source -> Lens' source a -> a
^. Lens' source a
l = Optic (Fun (Const a)) source source a a -> source -> a
forall (p :: * -> * -> *) a source target b.
(p ~ Fun (Const a)) =>
Optic p source target a b -> source -> a
view Optic (Fun (Const a)) source source a a
Lens' source a
l source
s
{-# INLINE (^.) #-}

{- | The operator form of 'set'.

@since 0.0.0.0
-}
infixr 4 .~
(.~) :: Lens' source a -> a -> source -> source
.~ :: Lens' source a -> a -> source -> source
(.~) Lens' source a
l = Optic (->) source source a a -> a -> source -> source
forall (p :: * -> * -> *) source target a b.
(p ~ (->)) =>
Optic p source target a b -> b -> source -> target
set Optic (->) source source a a
Lens' source a
l
{-# INLINE (.~) #-}

{- | The operator form of 'over'.

@since 0.0.0.0
-}
infixr 4 %~
(%~) :: Lens' source a -> (a -> a) -> source -> source
%~ :: Lens' source a -> (a -> a) -> source -> source
(%~) Lens' source a
l = ((a -> a) -> source -> source) -> (a -> a) -> source -> source
forall (p :: * -> * -> *) source target a b.
(p ~ (->)) =>
Optic p source target a b -> (a -> b) -> source -> target
over (a -> a) -> source -> source
Lens' source a
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 :: Optic p (a, c) (b, c) a b
fstL = ((a, c) -> a) -> ((a, c) -> b -> (b, c)) -> Lens (a, c) (b, c) a b
forall source a b target.
(source -> a) -> (source -> b -> target) -> Lens source target a b
lens (a, c) -> a
forall a b. (a, b) -> a
fst (((a, c) -> b -> (b, c)) -> Lens (a, c) (b, c) a b)
-> ((a, c) -> b -> (b, c)) -> Lens (a, c) (b, c) a b
forall a b. (a -> b) -> a -> b
$ \(a
_, c
b) b
new -> (b
new, c
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 :: Optic p (x, a) (x, b) a b
sndL = ((x, a) -> a) -> ((x, a) -> b -> (x, b)) -> Lens (x, a) (x, b) a b
forall source a b target.
(source -> a) -> (source -> b -> target) -> Lens source target a b
lens (x, a) -> a
forall a b. (a, b) -> b
snd (((x, a) -> b -> (x, b)) -> Lens (x, a) (x, b) a b)
-> ((x, a) -> b -> (x, b)) -> Lens (x, a) (x, b) a b
forall a b. (a -> b) -> a -> b
$ \(x
a, a
_) b
new -> (x
a, b
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
    { Forget r a b -> a -> Maybe r
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 :: (a -> b) -> Forget r x a -> Forget r x b
fmap a -> b
_ = Forget r x a -> Forget r x b
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 :: (a -> b) -> (c -> d) -> Forget r b c -> Forget r a d
dimap a -> b
ab c -> d
_cd (Forget b -> Maybe r
br) = (a -> Maybe r) -> Forget r a d
forall r a b. (a -> Maybe r) -> Forget r a b
Forget (b -> Maybe r
br (b -> Maybe r) -> (a -> b) -> a -> Maybe r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
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 r a b -> Forget r (a, c) (b, c)
first (Forget a -> Maybe r
ar) = ((a, c) -> Maybe r) -> Forget r (a, c) (b, c)
forall r a b. (a -> Maybe r) -> Forget r a b
Forget (a -> Maybe r
ar (a -> Maybe r) -> ((a, c) -> a) -> (a, c) -> Maybe r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, c) -> a
forall a b. (a, b) -> a
fst)
    {-# INLINE first #-}

    second :: Forget r a b -> Forget r (c, a) (c, b)
    second :: Forget r a b -> Forget r (c, a) (c, b)
second (Forget a -> Maybe r
ar) = ((c, a) -> Maybe r) -> Forget r (c, a) (c, b)
forall r a b. (a -> Maybe r) -> Forget r a b
Forget (a -> Maybe r
ar (a -> Maybe r) -> ((c, a) -> a) -> (c, a) -> Maybe r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c, a) -> a
forall a b. (a, b) -> b
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 r a b -> Forget r (Either a c) (Either b c)
left (Forget a -> Maybe r
ar) = (Either a c -> Maybe r) -> Forget r (Either a c) (Either b c)
forall r a b. (a -> Maybe r) -> Forget r a b
Forget ((a -> Maybe r) -> (c -> Maybe r) -> Either a c -> Maybe r
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Maybe r
ar (Maybe r -> c -> Maybe r
forall a b. a -> b -> a
const Maybe r
forall a. Maybe a
Nothing))
    {-# INLINE left #-}

    right :: Forget r a b -> Forget r (Either c a) (Either c b)
    right :: Forget r a b -> Forget r (Either c a) (Either c b)
right (Forget a -> Maybe r
ar) = (Either c a -> Maybe r) -> Forget r (Either c a) (Either c b)
forall r a b. (a -> Maybe r) -> Forget r a b
Forget ((c -> Maybe r) -> (a -> Maybe r) -> Either c a -> Maybe r
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe r -> c -> Maybe r
forall a b. a -> b -> a
const Maybe r
forall a. Maybe a
Nothing) a -> Maybe r
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 r a b -> Forget r c d -> Forget r (a, c) (b, d)
pappend (Forget a -> Maybe r
ar) (Forget c -> Maybe r
cr) = ((a, c) -> Maybe r) -> Forget r (a, c) (b, d)
forall r a b. (a -> Maybe r) -> Forget r a b
Forget
        (\(a
a, c
c) -> First r -> Maybe r
forall a. First a -> Maybe a
getFirst (First r -> Maybe r) -> First r -> Maybe r
forall a b. (a -> b) -> a -> b
$  Maybe r -> First r
forall a. Maybe a -> First a
First (a -> Maybe r
ar a
a) First r -> First r -> First r
forall a. Semigroup a => a -> a -> a
<> Maybe r -> First r
forall a. Maybe a -> First a
First (c -> Maybe r
cr c
c))
    {-# INLINE pappend #-}

    pempty :: Forget r a a
    pempty :: Forget r a a
pempty = (a -> Maybe r) -> Forget r a a
forall r a b. (a -> Maybe r) -> Forget r a b
Forget (Maybe r -> a -> Maybe r
forall a b. a -> b -> a
const Maybe r
forall a. Maybe a
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 :: Optic p source source a a -> source -> Maybe a
preview Optic p source source a a
paapss = p source source -> source -> Maybe a
coerce (Optic p source source a a
paapss p a a
Forget a a a
wrap)
  where
    wrap :: Forget a a a
    wrap :: Forget a a a
wrap = (a -> Maybe a) -> Forget a a a
coerce @(a -> Maybe a) @(Forget a a a) a -> Maybe a
forall a. a -> Maybe 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 :: (b -> target)
-> (source -> Either target a) -> Prism source target a b
prism b -> target
ctor source -> Either target a
match = (source -> Either target a)
-> (Either target b -> target)
-> p (Either target a) (Either target b)
-> p source target
forall (p :: * -> * -> *) in2 in1 out1 out2.
Profunctor p =>
(in2 -> in1) -> (out1 -> out2) -> p in1 out1 -> p in2 out2
dimap source -> Either target a
match ((target -> target) -> (b -> target) -> Either target b -> target
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either target -> target
forall a. a -> a
id b -> target
ctor) (p (Either target a) (Either target b) -> p source target)
-> (p a b -> p (Either target a) (Either target b))
-> p a b
-> p source target
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a b -> p (Either target a) (Either target b)
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
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' :: (a -> source) -> (source -> Maybe a) -> Prism' source a
prism' a -> source
ctor source -> Maybe a
match = (a -> source) -> (source -> Either source a) -> Prism' source a
forall b target source a.
(b -> target)
-> (source -> Either target a) -> Prism source target a b
prism a -> source
ctor (\source
s -> Either source a
-> (a -> Either source a) -> Maybe a -> Either source a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (source -> Either source a
forall a b. a -> Either a b
Left source
s) a -> Either source a
forall a b. b -> Either a b
Right (Maybe a -> Either source a) -> Maybe a -> Either source a
forall a b. (a -> b) -> a -> b
$ source -> Maybe a
match source
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 :: Optic p (Maybe a) (Maybe b) a b
_Just = (b -> Maybe b)
-> (Maybe a -> Either (Maybe b) a) -> Prism (Maybe a) (Maybe b) a b
forall b target source a.
(b -> target)
-> (source -> Either target a) -> Prism source target 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
$ \case
    Just a
a  -> a -> Either (Maybe b) a
forall a b. b -> Either a b
Right a
a
    Maybe a
Nothing -> Maybe b -> Either (Maybe b) a
forall a b. a -> Either a b
Left Maybe b
forall a. Maybe a
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 :: Optic p (Either a x) (Either b x) a b
_Left = (b -> Either b x)
-> (Either a x -> Either (Either b x) a)
-> Prism (Either a x) (Either b x) a b
forall b target source a.
(b -> target)
-> (source -> Either target a) -> Prism source target a b
prism b -> Either b x
forall a b. a -> Either a b
Left ((Either a x -> Either (Either b x) a)
 -> Prism (Either a x) (Either b x) a b)
-> (Either a x -> Either (Either b x) a)
-> Prism (Either a x) (Either b x) a b
forall a b. (a -> b) -> a -> b
$ \case
    Left a
l  -> a -> Either (Either b x) a
forall a b. b -> Either a b
Right a
l
    Right x
r -> Either b x -> Either (Either b x) a
forall a b. a -> Either a b
Left (Either b x -> Either (Either b x) a)
-> Either b x -> Either (Either b x) a
forall a b. (a -> b) -> a -> b
$ x -> Either b x
forall a b. b -> Either a b
Right x
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 :: Optic p (Either x a) (Either x b) a b
_Right = (b -> Either x b)
-> (Either x a -> Either (Either x b) a)
-> Prism (Either x a) (Either x b) a b
forall b target source a.
(b -> target)
-> (source -> Either target a) -> Prism source target a b
prism b -> Either x b
forall a b. b -> Either a b
Right ((Either x a -> Either (Either x b) a)
 -> Prism (Either x a) (Either x b) a b)
-> (Either x a -> Either (Either x b) a)
-> Prism (Either x a) (Either x b) a b
forall a b. (a -> b) -> a -> b
$ \case
    Right a
a -> a -> Either (Either x b) a
forall a b. b -> Either a b
Right a
a
    Left x
x  -> Either x b -> Either (Either x b) a
forall a b. a -> Either a b
Left (Either x b -> Either (Either x b) a)
-> Either x b -> Either (Either x b) a
forall a b. (a -> b) -> a -> b
$ x -> Either x b
forall a b. a -> Either a b
Left x
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 :: Optic p source target a b -> (a -> f b) -> source -> f target
traverseOf Optic p source target a b
pabPst a -> f b
aFb = Fun f source target -> source -> f target
forall (m :: * -> *) a b. Fun m a b -> a -> m b
unFun (Optic p source target a b
pabPst ((a -> f b) -> Fun f a b
forall (m :: * -> *) a b. (a -> m b) -> Fun m a b
Fun a -> f b
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 :: Optic p (a, a) (b, b) a b
eachPair p a b
pab = p a b -> Optic p (a, a) (b, b) a b
forall (p :: * -> * -> *) a b c d.
Monoidal p =>
p a b -> p c d -> p (a, c) (b, d)
pappend p a b
pab p a b
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 :: Optic p (Maybe a) (Maybe b) a b
eachMaybe p a b
pab = (Maybe a -> Either a ())
-> (Either b () -> Maybe b)
-> p (Either a ()) (Either b ())
-> p (Maybe a) (Maybe b)
forall (p :: * -> * -> *) in2 in1 out1 out2.
Profunctor p =>
(in2 -> in1) -> (out1 -> out2) -> p in1 out1 -> p in2 out2
dimap Maybe a -> Either a ()
forall a. Maybe a -> Either a ()
maybeToEither Either b () -> Maybe b
forall a. Either a () -> Maybe a
eitherToMaybe (p a b -> p (Either a ()) (Either b ())
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either a c) (Either b c)
left p a b
pab)
  where
    maybeToEither :: Maybe a -> Either a ()
    maybeToEither :: Maybe a -> Either a ()
maybeToEither = \case
        Just a
a  -> a -> Either a ()
forall a b. a -> Either a b
Left a
a
        Maybe a
Nothing -> () -> Either a ()
forall a b. b -> Either a b
Right ()

    eitherToMaybe :: Either a () -> Maybe a
    eitherToMaybe :: Either a () -> Maybe a
eitherToMaybe = \case
        Left a
a   -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
        Right () -> Maybe a
forall a. Maybe a
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 :: Optic p [a] [b] a b
eachList p a b
pab = ([a] -> Either (a, [a]) ())
-> (Either (b, [b]) () -> [b])
-> p (Either (a, [a]) ()) (Either (b, [b]) ())
-> p [a] [b]
forall (p :: * -> * -> *) in2 in1 out1 out2.
Profunctor p =>
(in2 -> in1) -> (out1 -> out2) -> p in1 out1 -> p in2 out2
dimap [a] -> Either (a, [a]) ()
forall a. [a] -> Either (a, [a]) ()
listToEither Either (b, [b]) () -> [b]
forall a. Either (a, [a]) () -> [a]
eitherToList (p (Either (a, [a]) ()) (Either (b, [b]) ()) -> p [a] [b])
-> p (Either (a, [a]) ()) (Either (b, [b]) ()) -> p [a] [b]
forall a b. (a -> b) -> a -> b
$ p (a, [a]) (b, [b]) -> p (Either (a, [a]) ()) (Either (b, [b]) ())
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either a c) (Either b c)
left (p (a, [a]) (b, [b])
 -> p (Either (a, [a]) ()) (Either (b, [b]) ()))
-> p (a, [a]) (b, [b])
-> p (Either (a, [a]) ()) (Either (b, [b]) ())
forall a b. (a -> b) -> a -> b
$ p a b -> p [a] [b] -> p (a, [a]) (b, [b])
forall (p :: * -> * -> *) a b c d.
Monoidal p =>
p a b -> p c d -> p (a, c) (b, d)
pappend p a b
pab (Optic p [a] [b] a b
forall a b. Traversal [a] [b] a b
eachList p a b
pab)
  where
    listToEither :: [a] -> Either (a, [a]) ()
    listToEither :: [a] -> Either (a, [a]) ()
listToEither = \case
        []   -> () -> Either (a, [a]) ()
forall a b. b -> Either a b
Right ()
        a
x:[a]
xs -> (a, [a]) -> Either (a, [a]) ()
forall a b. a -> Either a b
Left (a
x, [a]
xs)

    eitherToList :: Either (a, [a]) () -> [a]
    eitherToList :: Either (a, [a]) () -> [a]
eitherToList = \case
        Right ()     -> []
        Left (a
x, [a]
xs) -> a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs