-----------------------------------------------------------------------------
-- | Module     :  Data.These
--
-- The 'These' type and associated operations.
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module Data.These (
                    These(..)

                  -- * Functions to get rid of 'These'
                  , these
                  , fromThese
                  , mergeThese
                  , mergeTheseWith

                  -- * Traversals
                  , here, there

                  -- * Case selections
                  , justThis
                  , justThat
                  , justThese

                  , catThis
                  , catThat
                  , catThese

                  , partitionThese

                  -- * Case predicates
                  , isThis
                  , isThat
                  , isThese

                  -- * Map operations
                  , mapThese
                  , mapThis
                  , mapThat

                    -- $align
                  ) where

import Control.Applicative
import Control.Monad
import Data.Bifoldable
import Data.Bifunctor
import Data.Bitraversable
import Data.Foldable
import Data.Maybe (isJust, mapMaybe)
import Data.Semigroup
import Data.Traversable
import Data.Data
import GHC.Generics
import Prelude hiding (foldr)

import Control.DeepSeq (NFData (..))

-- --------------------------------------------------------------------------
-- | The 'These' type represents values with two non-exclusive possibilities.
--
--   This can be useful to represent combinations of two values, where the
--   combination is defined if either input is. Algebraically, the type
--   @These A B@ represents @(A + B + AB)@, which doesn't factor easily into
--   sums and products--a type like @Either A (B, Maybe A)@ is unclear and
--   awkward to use.
--
--   'These' has straightforward instances of 'Functor', 'Monad', &c., and
--   behaves like a hybrid error/writer monad, as would be expected.
data These a b = This a | That b | These a b
    deriving (These a b -> These a b -> Bool
(These a b -> These a b -> Bool)
-> (These a b -> These a b -> Bool) -> Eq (These a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => These a b -> These a b -> Bool
/= :: These a b -> These a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => These a b -> These a b -> Bool
== :: These a b -> These a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => These a b -> These a b -> Bool
Eq, Eq (These a b)
Eq (These a b)
-> (These a b -> These a b -> Ordering)
-> (These a b -> These a b -> Bool)
-> (These a b -> These a b -> Bool)
-> (These a b -> These a b -> Bool)
-> (These a b -> These a b -> Bool)
-> (These a b -> These a b -> These a b)
-> (These a b -> These a b -> These a b)
-> Ord (These a b)
These a b -> These a b -> Bool
These a b -> These a b -> Ordering
These a b -> These a b -> These a b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a b. (Ord a, Ord b) => Eq (These a b)
forall a b. (Ord a, Ord b) => These a b -> These a b -> Bool
forall a b. (Ord a, Ord b) => These a b -> These a b -> Ordering
forall a b. (Ord a, Ord b) => These a b -> These a b -> These a b
min :: These a b -> These a b -> These a b
$cmin :: forall a b. (Ord a, Ord b) => These a b -> These a b -> These a b
max :: These a b -> These a b -> These a b
$cmax :: forall a b. (Ord a, Ord b) => These a b -> These a b -> These a b
>= :: These a b -> These a b -> Bool
$c>= :: forall a b. (Ord a, Ord b) => These a b -> These a b -> Bool
> :: These a b -> These a b -> Bool
$c> :: forall a b. (Ord a, Ord b) => These a b -> These a b -> Bool
<= :: These a b -> These a b -> Bool
$c<= :: forall a b. (Ord a, Ord b) => These a b -> These a b -> Bool
< :: These a b -> These a b -> Bool
$c< :: forall a b. (Ord a, Ord b) => These a b -> These a b -> Bool
compare :: These a b -> These a b -> Ordering
$ccompare :: forall a b. (Ord a, Ord b) => These a b -> These a b -> Ordering
$cp1Ord :: forall a b. (Ord a, Ord b) => Eq (These a b)
Ord, ReadPrec [These a b]
ReadPrec (These a b)
Int -> ReadS (These a b)
ReadS [These a b]
(Int -> ReadS (These a b))
-> ReadS [These a b]
-> ReadPrec (These a b)
-> ReadPrec [These a b]
-> Read (These a b)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall a b. (Read a, Read b) => ReadPrec [These a b]
forall a b. (Read a, Read b) => ReadPrec (These a b)
forall a b. (Read a, Read b) => Int -> ReadS (These a b)
forall a b. (Read a, Read b) => ReadS [These a b]
readListPrec :: ReadPrec [These a b]
$creadListPrec :: forall a b. (Read a, Read b) => ReadPrec [These a b]
readPrec :: ReadPrec (These a b)
$creadPrec :: forall a b. (Read a, Read b) => ReadPrec (These a b)
readList :: ReadS [These a b]
$creadList :: forall a b. (Read a, Read b) => ReadS [These a b]
readsPrec :: Int -> ReadS (These a b)
$creadsPrec :: forall a b. (Read a, Read b) => Int -> ReadS (These a b)
Read, Int -> These a b -> ShowS
[These a b] -> ShowS
These a b -> String
(Int -> These a b -> ShowS)
-> (These a b -> String)
-> ([These a b] -> ShowS)
-> Show (These a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> These a b -> ShowS
forall a b. (Show a, Show b) => [These a b] -> ShowS
forall a b. (Show a, Show b) => These a b -> String
showList :: [These a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [These a b] -> ShowS
show :: These a b -> String
$cshow :: forall a b. (Show a, Show b) => These a b -> String
showsPrec :: Int -> These a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> These a b -> ShowS
Show, Typeable, Typeable (These a b)
DataType
Constr
Typeable (These a b)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> These a b -> c (These a b))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (These a b))
-> (These a b -> Constr)
-> (These a b -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (These a b)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (These a b)))
-> ((forall b. Data b => b -> b) -> These a b -> These a b)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> These a b -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> These a b -> r)
-> (forall u. (forall d. Data d => d -> u) -> These a b -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> These a b -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> These a b -> m (These a b))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> These a b -> m (These a b))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> These a b -> m (These a b))
-> Data (These a b)
These a b -> DataType
These a b -> Constr
(forall b. Data b => b -> b) -> These a b -> These a b
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> These a b -> c (These a b)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (These a b)
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (These a b))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> These a b -> u
forall u. (forall d. Data d => d -> u) -> These a b -> [u]
forall a b. (Data a, Data b) => Typeable (These a b)
forall a b. (Data a, Data b) => These a b -> DataType
forall a b. (Data a, Data b) => These a b -> Constr
forall a b.
(Data a, Data b) =>
(forall b. Data b => b -> b) -> These a b -> These a b
forall a b u.
(Data a, Data b) =>
Int -> (forall d. Data d => d -> u) -> These a b -> u
forall a b u.
(Data a, Data b) =>
(forall d. Data d => d -> u) -> These a b -> [u]
forall a b r r'.
(Data a, Data b) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> These a b -> r
forall a b r r'.
(Data a, Data b) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> These a b -> r
forall a b (m :: * -> *).
(Data a, Data b, Monad m) =>
(forall d. Data d => d -> m d) -> These a b -> m (These a b)
forall a b (m :: * -> *).
(Data a, Data b, MonadPlus m) =>
(forall d. Data d => d -> m d) -> These a b -> m (These a b)
forall a b (c :: * -> *).
(Data a, Data b) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (These a b)
forall a b (c :: * -> *).
(Data a, Data b) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> These a b -> c (These a b)
forall a b (t :: * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (These a b))
forall a b (t :: * -> * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (These a b))
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> These a b -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> These a b -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> These a b -> m (These a b)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> These a b -> m (These a b)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (These a b)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> These a b -> c (These a b)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (These a b))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (These a b))
$cThese :: Constr
$cThat :: Constr
$cThis :: Constr
$tThese :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> These a b -> m (These a b)
$cgmapMo :: forall a b (m :: * -> *).
(Data a, Data b, MonadPlus m) =>
(forall d. Data d => d -> m d) -> These a b -> m (These a b)
gmapMp :: (forall d. Data d => d -> m d) -> These a b -> m (These a b)
$cgmapMp :: forall a b (m :: * -> *).
(Data a, Data b, MonadPlus m) =>
(forall d. Data d => d -> m d) -> These a b -> m (These a b)
gmapM :: (forall d. Data d => d -> m d) -> These a b -> m (These a b)
$cgmapM :: forall a b (m :: * -> *).
(Data a, Data b, Monad m) =>
(forall d. Data d => d -> m d) -> These a b -> m (These a b)
gmapQi :: Int -> (forall d. Data d => d -> u) -> These a b -> u
$cgmapQi :: forall a b u.
(Data a, Data b) =>
Int -> (forall d. Data d => d -> u) -> These a b -> u
gmapQ :: (forall d. Data d => d -> u) -> These a b -> [u]
$cgmapQ :: forall a b u.
(Data a, Data b) =>
(forall d. Data d => d -> u) -> These a b -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> These a b -> r
$cgmapQr :: forall a b r r'.
(Data a, Data b) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> These a b -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> These a b -> r
$cgmapQl :: forall a b r r'.
(Data a, Data b) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> These a b -> r
gmapT :: (forall b. Data b => b -> b) -> These a b -> These a b
$cgmapT :: forall a b.
(Data a, Data b) =>
(forall b. Data b => b -> b) -> These a b -> These a b
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (These a b))
$cdataCast2 :: forall a b (t :: * -> * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (These a b))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (These a b))
$cdataCast1 :: forall a b (t :: * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (These a b))
dataTypeOf :: These a b -> DataType
$cdataTypeOf :: forall a b. (Data a, Data b) => These a b -> DataType
toConstr :: These a b -> Constr
$ctoConstr :: forall a b. (Data a, Data b) => These a b -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (These a b)
$cgunfold :: forall a b (c :: * -> *).
(Data a, Data b) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (These a b)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> These a b -> c (These a b)
$cgfoldl :: forall a b (c :: * -> *).
(Data a, Data b) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> These a b -> c (These a b)
$cp1Data :: forall a b. (Data a, Data b) => Typeable (These a b)
Data, (forall x. These a b -> Rep (These a b) x)
-> (forall x. Rep (These a b) x -> These a b)
-> Generic (These a b)
forall x. Rep (These a b) x -> These a b
forall x. These a b -> Rep (These a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x. Rep (These a b) x -> These a b
forall a b x. These a b -> Rep (These a b) x
$cto :: forall a b x. Rep (These a b) x -> These a b
$cfrom :: forall a b x. These a b -> Rep (These a b) x
Generic)

-- | Case analysis for the 'These' type.
these :: (a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
these :: (a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
these a -> c
l b -> c
_ a -> b -> c
_ (This a
a) = a -> c
l a
a
these a -> c
_ b -> c
r a -> b -> c
_ (That b
x) = b -> c
r b
x
these a -> c
_ b -> c
_ a -> b -> c
lr (These a
a b
x) = a -> b -> c
lr a
a b
x

-- | Takes two default values and produces a tuple.
fromThese :: a -> b -> These a b -> (a, b)
fromThese :: a -> b -> These a b -> (a, b)
fromThese a
_ b
x (This a
a   ) = (a
a, b
x)
fromThese a
a b
_ (That b
x   ) = (a
a, b
x)
fromThese a
_ b
_ (These a
a b
x) = (a
a, b
x)

-- | Coalesce with the provided operation.
mergeThese :: (a -> a -> a) -> These a a -> a
mergeThese :: (a -> a -> a) -> These a a -> a
mergeThese = (a -> a) -> (a -> a) -> (a -> a -> a) -> These a a -> a
forall a c b.
(a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
these a -> a
forall a. a -> a
id a -> a
forall a. a -> a
id

-- | BiMap and coalesce results with the provided operation.
mergeTheseWith :: (a -> c) -> (b -> c) -> (c -> c -> c) -> These a b -> c
mergeTheseWith :: (a -> c) -> (b -> c) -> (c -> c -> c) -> These a b -> c
mergeTheseWith a -> c
f b -> c
g c -> c -> c
op These a b
t = (c -> c -> c) -> These c c -> c
forall a. (a -> a -> a) -> These a a -> a
mergeThese c -> c -> c
op (These c c -> c) -> These c c -> c
forall a b. (a -> b) -> a -> b
$ (a -> c) -> (b -> c) -> These a b -> These c c
forall a c b d. (a -> c) -> (b -> d) -> These a b -> These c d
mapThese a -> c
f b -> c
g These a b
t

-- | A @Traversal@ of the first half of a 'These', suitable for use with @Control.Lens@.
here :: (Applicative f) => (a -> f b) -> These a t -> f (These b t)
here :: (a -> f b) -> These a t -> f (These b t)
here a -> f b
f (This a
x) = b -> These b t
forall a b. a -> These a b
This (b -> These b t) -> f b -> f (These b t)
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 t
y) = (b -> t -> These b t) -> t -> b -> These b t
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> t -> These b t
forall a b. a -> b -> These a b
These t
y (b -> These b t) -> f b -> f (These b t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x
here a -> f b
_ (That t
x) = These b t -> f (These b t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t -> These b t
forall a b. b -> These a b
That t
x)

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

-- | @'justThis' = preview '_This'@
justThis :: These a b -> Maybe a
justThis :: These a b -> Maybe a
justThis (This a
a) = a -> Maybe a
forall a. a -> Maybe a
Just a
a
justThis These a b
_        = Maybe a
forall a. Maybe a
Nothing

-- | @'justThat' = preview '_That'@
justThat :: These a b -> Maybe b
justThat :: These a b -> Maybe b
justThat (That b
x) = b -> Maybe b
forall a. a -> Maybe a
Just b
x
justThat These a b
_        = Maybe b
forall a. Maybe a
Nothing

-- | @'justThese' = preview '_These'@
justThese :: These a b -> Maybe (a, b)
justThese :: These a b -> Maybe (a, b)
justThese (These a
a b
x) = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
a, b
x)
justThese These a b
_           = Maybe (a, b)
forall a. Maybe a
Nothing


isThis, isThat, isThese :: These a b -> Bool
-- | @'isThis' = 'isJust' . 'justThis'@
isThis :: These a b -> Bool
isThis  = Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (Maybe a -> Bool) -> (These a b -> Maybe a) -> These a b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. These a b -> Maybe a
forall a b. These a b -> Maybe a
justThis

-- | @'isThat' = 'isJust' . 'justThat'@
isThat :: These a b -> Bool
isThat  = Maybe b -> Bool
forall a. Maybe a -> Bool
isJust (Maybe b -> Bool) -> (These a b -> Maybe b) -> These a b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. These a b -> Maybe b
forall a b. These a b -> Maybe b
justThat

-- | @'isThese' = 'isJust' . 'justThese'@
isThese :: These a b -> Bool
isThese = Maybe (a, b) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (a, b) -> Bool)
-> (These a b -> Maybe (a, b)) -> These a b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. These a b -> Maybe (a, b)
forall a b. These a b -> Maybe (a, b)
justThese

-- | 'Bifunctor' map.
mapThese :: (a -> c) -> (b -> d) -> These a b -> These c d
mapThese :: (a -> c) -> (b -> d) -> These a b -> These c d
mapThese a -> c
f b -> d
_ (This  a
a  ) = c -> These c d
forall a b. a -> These a b
This (a -> c
f a
a)
mapThese a -> c
_ b -> d
g (That    b
x) = d -> These c d
forall a b. b -> These a b
That (b -> d
g b
x)
mapThese a -> c
f b -> d
g (These a
a b
x) = c -> d -> These c d
forall a b. a -> b -> These a b
These (a -> c
f a
a) (b -> d
g b
x)

-- | @'mapThis' = over 'here'@
mapThis :: (a -> c) -> These a b -> These c b
mapThis :: (a -> c) -> These a b -> These c b
mapThis a -> c
f = (a -> c) -> (b -> b) -> These a b -> These c b
forall a c b d. (a -> c) -> (b -> d) -> These a b -> These c d
mapThese a -> c
f b -> b
forall a. a -> a
id

-- | @'mapThat' = over 'there'@
mapThat :: (b -> d) -> These a b -> These a d
mapThat :: (b -> d) -> These a b -> These a d
mapThat b -> d
f = (a -> a) -> (b -> d) -> These a b -> These a d
forall a c b d. (a -> c) -> (b -> d) -> These a b -> These c d
mapThese a -> a
forall a. a -> a
id b -> d
f

-- | Select all 'This' constructors from a list.
catThis :: [These a b] -> [a]
catThis :: [These a b] -> [a]
catThis = (These a b -> Maybe a) -> [These a b] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe These a b -> Maybe a
forall a b. These a b -> Maybe a
justThis

-- | Select all 'That' constructors from a list.
catThat :: [These a b] -> [b]
catThat :: [These a b] -> [b]
catThat = (These a b -> Maybe b) -> [These a b] -> [b]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe These a b -> Maybe b
forall a b. These a b -> Maybe b
justThat

-- | Select all 'These' constructors from a list.
catThese :: [These a b] -> [(a, b)]
catThese :: [These a b] -> [(a, b)]
catThese = (These a b -> Maybe (a, b)) -> [These a b] -> [(a, b)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe These a b -> Maybe (a, b)
forall a b. These a b -> Maybe (a, b)
justThese

-- | Select each constructor and partition them into separate lists.
partitionThese :: [These a b] -> ( [(a, b)], ([a], [b]) )
partitionThese :: [These a b] -> ([(a, b)], ([a], [b]))
partitionThese []             = ([], ([], []))
partitionThese (These a
x b
y:[These a b]
xs) = ([(a, b)] -> [(a, b)])
-> ([(a, b)], ([a], [b])) -> ([(a, b)], ([a], [b]))
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((a
x, b
y)(a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:)      (([(a, b)], ([a], [b])) -> ([(a, b)], ([a], [b])))
-> ([(a, b)], ([a], [b])) -> ([(a, b)], ([a], [b]))
forall a b. (a -> b) -> a -> b
$ [These a b] -> ([(a, b)], ([a], [b]))
forall a b. [These a b] -> ([(a, b)], ([a], [b]))
partitionThese [These a b]
xs
partitionThese (This  a
x  :[These a b]
xs) = (([a], [b]) -> ([a], [b]))
-> ([(a, b)], ([a], [b])) -> ([(a, b)], ([a], [b]))
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (([a] -> [a]) -> ([a], [b]) -> ([a], [b])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first  (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:)) (([(a, b)], ([a], [b])) -> ([(a, b)], ([a], [b])))
-> ([(a, b)], ([a], [b])) -> ([(a, b)], ([a], [b]))
forall a b. (a -> b) -> a -> b
$ [These a b] -> ([(a, b)], ([a], [b]))
forall a b. [These a b] -> ([(a, b)], ([a], [b]))
partitionThese [These a b]
xs
partitionThese (That    b
y:[These a b]
xs) = (([a], [b]) -> ([a], [b]))
-> ([(a, b)], ([a], [b])) -> ([(a, b)], ([a], [b]))
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (([b] -> [b]) -> ([a], [b]) -> ([a], [b])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (b
yb -> [b] -> [b]
forall a. a -> [a] -> [a]
:)) (([(a, b)], ([a], [b])) -> ([(a, b)], ([a], [b])))
-> ([(a, b)], ([a], [b])) -> ([(a, b)], ([a], [b]))
forall a b. (a -> b) -> a -> b
$ [These a b] -> ([(a, b)], ([a], [b]))
forall a b. [These a b] -> ([(a, b)], ([a], [b]))
partitionThese [These a b]
xs

-- $align
--
-- For zipping and unzipping of structures with 'These' values, see
-- "Data.Align".

instance (Semigroup a, Semigroup b) => Semigroup (These a b) where
    This  a
a   <> :: These a b -> These a b -> These a b
<> This  a
b   = a -> These a b
forall a b. a -> These a b
This  (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b)
    This  a
a   <> That    b
y = a -> b -> These a b
forall a b. a -> b -> These a b
These  a
a             b
y
    This  a
a   <> These a
b b
y = a -> b -> These a b
forall a b. a -> b -> These a b
These (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b)       b
y
    That    b
x <> This  a
b   = a -> b -> These a b
forall a b. a -> b -> These a b
These       a
b   b
x
    That    b
x <> That    b
y = b -> These a b
forall a b. b -> These a b
That           (b
x b -> b -> b
forall a. Semigroup a => a -> a -> a
<> b
y)
    That    b
x <> These a
b b
y = a -> b -> These a b
forall a b. a -> b -> These a b
These       a
b  (b
x b -> b -> b
forall a. Semigroup a => a -> a -> a
<> b
y)
    These a
a b
x <> This  a
b   = a -> b -> These a b
forall a b. a -> b -> These a b
These (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b)  b
x
    These a
a b
x <> That    b
y = a -> b -> These a b
forall a b. a -> b -> These a b
These  a
a       (b
x b -> b -> b
forall a. Semigroup a => a -> a -> a
<> b
y)
    These a
a b
x <> These a
b b
y = a -> b -> These a b
forall a b. a -> b -> These a b
These (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b) (b
x b -> b -> b
forall a. Semigroup a => a -> a -> a
<> b
y)

instance Functor (These a) where
    fmap :: (a -> b) -> These a a -> These a b
fmap a -> b
_ (This a
x) = a -> These a b
forall a b. a -> These a b
This a
x
    fmap a -> b
f (That a
y) = b -> These a b
forall a b. b -> These a b
That (a -> b
f a
y)
    fmap a -> b
f (These a
x a
y) = a -> b -> These a b
forall a b. a -> b -> These a b
These a
x (a -> b
f a
y)

instance Foldable (These a) where
    foldr :: (a -> b -> b) -> b -> These a a -> b
foldr a -> b -> b
_ b
z (This a
_) = b
z
    foldr a -> b -> b
f b
z (That a
x) = a -> b -> b
f a
x b
z
    foldr a -> b -> b
f b
z (These a
_ a
x) = a -> b -> b
f a
x b
z

instance Traversable (These a) where
    traverse :: (a -> f b) -> These a a -> f (These a b)
traverse a -> f b
_ (This a
a) = These a b -> f (These a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (These a b -> f (These a b)) -> These a b -> f (These a b)
forall a b. (a -> b) -> a -> b
$ a -> These a b
forall a b. a -> These a b
This a
a
    traverse a -> f b
f (That a
x) = b -> These a b
forall a b. b -> These a b
That (b -> These a b) -> f b -> f (These a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x
    traverse a -> f b
f (These a
a a
x) = a -> b -> These a b
forall a b. a -> b -> These a b
These a
a (b -> These a b) -> f b -> f (These a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x
    sequenceA :: These a (f a) -> f (These a a)
sequenceA (This a
a) = These a a -> f (These a a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (These a a -> f (These a a)) -> These a a -> f (These a a)
forall a b. (a -> b) -> a -> b
$ a -> These a a
forall a b. a -> These a b
This a
a
    sequenceA (That f a
x) = a -> These a a
forall a b. b -> These a b
That (a -> These a a) -> f a -> f (These a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
x
    sequenceA (These a
a f a
x) = a -> a -> These a a
forall a b. a -> b -> These a b
These a
a (a -> These a a) -> f a -> f (These a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
x

instance Bifunctor These where
    bimap :: (a -> b) -> (c -> d) -> These a c -> These b d
bimap = (a -> b) -> (c -> d) -> These a c -> These b d
forall a c b d. (a -> c) -> (b -> d) -> These a b -> These c d
mapThese
    first :: (a -> b) -> These a c -> These b c
first = (a -> b) -> These a c -> These b c
forall a b c. (a -> b) -> These a c -> These b c
mapThis
    second :: (b -> c) -> These a b -> These a c
second = (b -> c) -> These a b -> These a c
forall b c a. (b -> c) -> These a b -> These a c
mapThat

instance Bifoldable These where
    bifold :: These m m -> m
bifold = (m -> m) -> (m -> m) -> (m -> m -> m) -> These m m -> m
forall a c b.
(a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
these m -> m
forall a. a -> a
id m -> m
forall a. a -> a
id m -> m -> m
forall a. Monoid a => a -> a -> a
mappend
    bifoldr :: (a -> c -> c) -> (b -> c -> c) -> c -> These a b -> c
bifoldr a -> c -> c
f b -> c -> c
g c
z = (a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
forall a c b.
(a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
these (a -> c -> c
`f` c
z) (b -> c -> c
`g` c
z) (\a
x b
y -> a
x a -> c -> c
`f` (b
y b -> c -> c
`g` c
z))
    bifoldl :: (c -> a -> c) -> (c -> b -> c) -> c -> These a b -> c
bifoldl c -> a -> c
f c -> b -> c
g c
z = (a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
forall a c b.
(a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
these (c
z c -> a -> c
`f`) (c
z c -> b -> c
`g`) (\a
x b
y -> (c
z c -> a -> c
`f` a
x) c -> b -> c
`g` b
y)

instance Bitraversable These where
    bitraverse :: (a -> f c) -> (b -> f d) -> These a b -> f (These c d)
bitraverse a -> f c
f b -> f d
_ (This a
x) = c -> These c d
forall a b. a -> These a b
This (c -> These c d) -> f c -> f (These c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
x
    bitraverse a -> f c
_ b -> f d
g (That b
x) = d -> These c d
forall a b. b -> These a b
That (d -> These c d) -> f d -> f (These c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
g b
x
    bitraverse a -> f c
f b -> f d
g (These a
x b
y) = c -> d -> These c d
forall a b. a -> b -> These a b
These (c -> d -> These c d) -> f c -> f (d -> These c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
x f (d -> These c d) -> f d -> f (These c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> f d
g b
y

instance (Semigroup a) => Applicative (These a) where
    pure :: a -> These a a
pure = a -> These a a
forall a b. b -> These a b
That
    This  a
a   <*> :: These a (a -> b) -> These a a -> These a b
<*> These a a
_         = a -> These a b
forall a b. a -> These a b
This a
a
    That    a -> b
_ <*> This  a
b   = a -> These a b
forall a b. a -> These a b
This a
b
    That    a -> b
f <*> That    a
x = b -> These a b
forall a b. b -> These a b
That (a -> b
f a
x)
    That    a -> b
f <*> These a
b a
x = a -> b -> These a b
forall a b. a -> b -> These a b
These a
b (a -> b
f a
x)
    These a
a a -> b
_ <*> This  a
b   = a -> These a b
forall a b. a -> These a b
This (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b)
    These a
a a -> b
f <*> That    a
x = a -> b -> These a b
forall a b. a -> b -> These a b
These a
a (a -> b
f a
x)
    These a
a a -> b
f <*> These a
b a
x = a -> b -> These a b
forall a b. a -> b -> These a b
These (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b) (a -> b
f a
x)

instance (Semigroup a) => Monad (These a) where
    return :: a -> These a a
return = a -> These a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    This  a
a   >>= :: These a a -> (a -> These a b) -> These a b
>>= a -> These a b
_ = a -> These a b
forall a b. a -> These a b
This a
a
    That    a
x >>= a -> These a b
k = a -> These a b
k a
x
    These a
a a
x >>= a -> These a b
k = case a -> These a b
k a
x of
                          This  a
b   -> a -> These a b
forall a b. a -> These a b
This  (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b)
                          That    b
y -> a -> b -> These a b
forall a b. a -> b -> These a b
These a
a b
y
                          These a
b b
y -> a -> b -> These a b
forall a b. a -> b -> These a b
These (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b) b
y

instance (NFData a, NFData b) => NFData (These a b) where
    rnf :: These a b -> ()
rnf (This a
a)    = a -> ()
forall a. NFData a => a -> ()
rnf a
a
    rnf (That b
b)    = b -> ()
forall a. NFData a => a -> ()
rnf b
b
    rnf (These a
a b
b) = a -> ()
forall a. NFData a => a -> ()
rnf a
a () -> () -> ()
`seq` b -> ()
forall a. NFData a => a -> ()
rnf b
b