{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Trustworthy           #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE UndecidableInstances  #-}
module Data.These.Lens (
    -- * Traversals
    here, there,

    -- * Prisms
    _This, _That, _These,
    ) where

import Control.Applicative (pure, (<$>), (<*>))
import Prelude             (Either (..), flip, uncurry, ($), (.))

import Control.Lens (Prism', Traversal, prism)
import Data.These

-- $setup
-- >>> import Data.These
-- >>> import Control.Lens
-- >>> import Prelude (show)

-------------------------------------------------------------------------------
-- Traversals
-------------------------------------------------------------------------------

-- | A 'Control.Lens.Traversal' of the first half of a 'These', suitable for use with "Control.Lens".
--
-- >>> over here show (That 1)
-- That 1
--
-- >>> over here show (These 'a' 2)
-- These "'a'" 2
--
here :: Traversal (These a c) (These b c) a b
here :: forall a c b. Traversal (These a c) (These b c) a b
here a -> f b
f (This a
x) = forall a b. a -> These a b
This forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x
here a -> f b
f (These a
x c
y) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. a -> b -> These a b
These c
y forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x
here a -> f b
_ (That c
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> These a b
That c
x)

-- | A 'Control.Lens.Traversal' of the second half of a 'These', suitable for use with "Control.Lens".
--
-- @
-- 'there' :: 'Control.Lens.Traversal' ('These' t b) ('These' t b) a b
-- @
--
-- >>> over there show (That 1)
-- That "1"
--
-- >>> over there show (These 'a' 2)
-- These 'a' "2"
--
there :: Traversal (These c a) (These c b) a b
there :: forall c a b. Traversal (These c a) (These c b) a b
there a -> f b
_ (This c
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> These a b
This c
x)
there a -> f b
f (These c
x a
y) = forall a b. a -> b -> These a b
These c
x forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
y
there a -> f b
f (That a
x) = forall a b. b -> These a b
That forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x

-------------------------------------------------------------------------------
-- Prisms
-------------------------------------------------------------------------------

-- | A 'Control.Lens.Prism'' selecting the 'This' constructor.
--
-- /Note:/ cannot change type.
_This :: Prism' (These a b) a
_This :: forall a b. Prism' (These a b) a
_This = forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism forall a b. a -> These a b
This (forall a c b.
(a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
these forall a b. b -> Either a b
Right (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> These a b
That) (\a
x b
y -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> These a b
These a
x b
y))

-- | A 'Control.Lens.Prism'' selecting the 'That' constructor.
--
-- /Note:/ cannot change type.
_That :: Prism' (These a b) b
_That :: forall a b. Prism' (These a b) b
_That = forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism forall a b. b -> These a b
That (forall a c b.
(a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
these (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> These a b
This) forall a b. b -> Either a b
Right (\a
x b
y -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> These a b
These a
x b
y))

-- | A 'Control.Lens.Prism'' selecting the 'These' constructor. 'These' names are ridiculous!
--
-- /Note:/ cannot change type.
_These :: Prism' (These a b) (a, b)
_These :: forall a b. Prism' (These a b) (a, b)
_These = forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. a -> b -> These a b
These) (forall a c b.
(a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
these (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> These a b
This) (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> These a b
That) (\a
x b
y -> forall a b. b -> Either a b
Right (a
x, b
y)))