{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
#if MIN_VERSION_base(4,9,0)
#define LIFTED_FUNCTOR_CLASSES 1
#else
#if MIN_VERSION_transformers(0,5,0)
#define LIFTED_FUNCTOR_CLASSES 1
#else
#if MIN_VERSION_transformers_compat(0,5,0) && !MIN_VERSION_transformers(0,4,0)
#define LIFTED_FUNCTOR_CLASSES 1
#endif
#endif
#endif
module Data.These (
These(..)
, these
, fromThese
, mergeThese
, mergeTheseWith
, partitionThese
, partitionHereThere
, partitionEithersNE
, distrThesePair
, undistrThesePair
, distrPairThese
, undistrPairThese
) where
import Control.Applicative (Applicative (..), (<$>))
import Control.DeepSeq (NFData (..))
import Data.Bifoldable (Bifoldable (..))
import Data.Bifoldable1 (Bifoldable1 (..))
import Data.Bifunctor (Bifunctor (..))
import Data.Binary (Binary (..))
import Data.Bitraversable (Bitraversable (..))
import Data.Data (Data, Typeable)
import Data.Either (partitionEithers)
import Data.Foldable (Foldable (..))
import Data.Hashable (Hashable (..))
import Data.Hashable.Lifted (Hashable1 (..), Hashable2 (..))
import Data.List.NonEmpty (NonEmpty (..))
import Data.Monoid (Monoid (..))
import Data.Semigroup (Semigroup (..))
import Data.Traversable (Traversable (..))
import GHC.Generics (Generic)
import Prelude
(Bool (..), Either (..), Eq (..), Functor (..), Int, Monad (..),
Ord (..), Ordering (..), Read (..), Show (..), fail, id, lex, readParen,
seq, showParen, showString, ($), (&&), (.))
#if MIN_VERSION_deepseq(1,4,3)
import Control.DeepSeq (NFData1 (..), NFData2 (..))
#endif
#if __GLASGOW_HASKELL__ >= 706
import GHC.Generics (Generic1)
#endif
#ifdef MIN_VERSION_assoc
import Data.Bifunctor.Assoc (Assoc (..))
import Data.Bifunctor.Swap (Swap (..))
#endif
#ifdef LIFTED_FUNCTOR_CLASSES
import Data.Functor.Classes
(Eq1 (..), Eq2 (..), Ord1 (..), Ord2 (..), Read1 (..), Read2 (..),
Show1 (..), Show2 (..))
#else
import Data.Functor.Classes (Eq1 (..), Ord1 (..), Read1 (..), Show1 (..))
#endif
data These a b = This a | That b | These a b
deriving (These a b -> These a b -> Bool
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, These a b -> These a b -> Bool
These a b -> These a b -> Ordering
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
Ord, ReadPrec [These a b]
ReadPrec (These a b)
ReadS [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
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, These a b -> DataType
These a b -> Constr
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 {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 (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 e. (Data d, Data e) => c (t d e))
-> Maybe (c (These a b))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. 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 u. (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 :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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)
Data, 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
#if __GLASGOW_HASKELL__ >= 706
, forall a a. Rep1 (These a) a -> These a a
forall a a. These a a -> Rep1 (These a) a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a a. Rep1 (These a) a -> These a a
$cfrom1 :: forall a a. These a a -> Rep1 (These a) a
Generic1
#endif
)
these :: (a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
these :: forall a c b.
(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
fromThese :: a -> b -> These a b -> (a, b)
fromThese :: forall a b. a -> b -> These a b -> (a, b)
fromThese a
x b
y = forall a c b.
(a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
these (forall {a} {b}. a -> b -> (a, b)
`pair` b
y) (a
x forall {a} {b}. a -> b -> (a, b)
`pair`) forall {a} {b}. a -> b -> (a, b)
pair where
pair :: a -> b -> (a, b)
pair = (,)
mergeThese :: (a -> a -> a) -> These a a -> a
mergeThese :: forall a. (a -> a -> a) -> These a a -> a
mergeThese = forall a c b.
(a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
these forall a. a -> a
id forall a. a -> a
id
mergeTheseWith :: (a -> c) -> (b -> c) -> (c -> c -> c) -> These a b -> c
mergeTheseWith :: forall a c b.
(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 = forall a. (a -> a -> a) -> These a a -> a
mergeThese c -> c -> c
op forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> c
f b -> c
g These a b
t
partitionThese :: [These a b] -> ([a], [b], [(a, b)])
partitionThese :: forall a b. [These a b] -> ([a], [b], [(a, b)])
partitionThese [] = ([], [], [])
partitionThese (These a b
t:[These a b]
ts) = case These a b
t of
This a
x -> (a
x forall a. a -> [a] -> [a]
: [a]
xs, [b]
ys, [(a, b)]
xys)
That b
y -> ( [a]
xs, b
y forall a. a -> [a] -> [a]
: [b]
ys, [(a, b)]
xys)
These a
x b
y -> ( [a]
xs, [b]
ys, (a
x,b
y) forall a. a -> [a] -> [a]
: [(a, b)]
xys)
where
~([a]
xs,[b]
ys,[(a, b)]
xys) = forall a b. [These a b] -> ([a], [b], [(a, b)])
partitionThese [These a b]
ts
partitionHereThere :: [These a b] -> ([a], [b])
partitionHereThere :: forall a b. [These a b] -> ([a], [b])
partitionHereThere [] = ([], [])
partitionHereThere (These a b
t:[These a b]
ts) = case These a b
t of
This a
x -> (a
x forall a. a -> [a] -> [a]
: [a]
xs, [b]
ys)
That b
y -> ( [a]
xs, b
y forall a. a -> [a] -> [a]
: [b]
ys)
These a
x b
y -> (a
x forall a. a -> [a] -> [a]
: [a]
xs, b
y forall a. a -> [a] -> [a]
: [b]
ys)
where
~([a]
xs,[b]
ys) = forall a b. [These a b] -> ([a], [b])
partitionHereThere [These a b]
ts
partitionEithersNE :: NonEmpty (Either a b) -> These (NonEmpty a) (NonEmpty b)
partitionEithersNE :: forall a b.
NonEmpty (Either a b) -> These (NonEmpty a) (NonEmpty b)
partitionEithersNE (Either a b
x :| [Either a b]
xs) = case (Either a b
x, [a]
ls, [b]
rs) of
(Left a
y, [a]
ys, []) -> forall a b. a -> These a b
This (a
y forall a. a -> [a] -> NonEmpty a
:| [a]
ys)
(Left a
y, [a]
ys, b
z:[b]
zs) -> forall a b. a -> b -> These a b
These (a
y forall a. a -> [a] -> NonEmpty a
:| [a]
ys) (b
z forall a. a -> [a] -> NonEmpty a
:| [b]
zs)
(Right b
z, [], [b]
zs) -> forall a b. b -> These a b
That (b
z forall a. a -> [a] -> NonEmpty a
:| [b]
zs)
(Right b
z, a
y:[a]
ys, [b]
zs) -> forall a b. a -> b -> These a b
These (a
y forall a. a -> [a] -> NonEmpty a
:| [a]
ys) (b
z forall a. a -> [a] -> NonEmpty a
:| [b]
zs)
where
([a]
ls, [b]
rs) = forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either a b]
xs
distrThesePair :: These (a, b) c -> (These a c, These b c)
distrThesePair :: forall a b c. These (a, b) c -> (These a c, These b c)
distrThesePair (This (a
a, b
b)) = (forall a b. a -> These a b
This a
a, forall a b. a -> These a b
This b
b)
distrThesePair (That c
c) = (forall a b. b -> These a b
That c
c, forall a b. b -> These a b
That c
c)
distrThesePair (These (a
a, b
b) c
c) = (forall a b. a -> b -> These a b
These a
a c
c, forall a b. a -> b -> These a b
These b
b c
c)
undistrThesePair :: (These a c, These b c) -> These (a, b) c
undistrThesePair :: forall a c b. (These a c, These b c) -> These (a, b) c
undistrThesePair (This a
a, This b
b) = forall a b. a -> These a b
This (a
a, b
b)
undistrThesePair (That c
c, That c
_) = forall a b. b -> These a b
That c
c
undistrThesePair (These a
a c
c, These b
b c
_) = forall a b. a -> b -> These a b
These (a
a, b
b) c
c
undistrThesePair (This a
_, That c
c) = forall a b. b -> These a b
That c
c
undistrThesePair (This a
a, These b
b c
c) = forall a b. a -> b -> These a b
These (a
a, b
b) c
c
undistrThesePair (That c
c, This b
_) = forall a b. b -> These a b
That c
c
undistrThesePair (That c
c, These b
_ c
_) = forall a b. b -> These a b
That c
c
undistrThesePair (These a
a c
c, This b
b) = forall a b. a -> b -> These a b
These (a
a, b
b) c
c
undistrThesePair (These a
_ c
c, That c
_) = forall a b. b -> These a b
That c
c
distrPairThese :: (These a b, c) -> These (a, c) (b, c)
distrPairThese :: forall a b c. (These a b, c) -> These (a, c) (b, c)
distrPairThese (This a
a, c
c) = forall a b. a -> These a b
This (a
a, c
c)
distrPairThese (That b
b, c
c) = forall a b. b -> These a b
That (b
b, c
c)
distrPairThese (These a
a b
b, c
c) = forall a b. a -> b -> These a b
These (a
a, c
c) (b
b, c
c)
undistrPairThese :: These (a, c) (b, c) -> (These a b, c)
undistrPairThese :: forall a c b. These (a, c) (b, c) -> (These a b, c)
undistrPairThese (This (a
a, c
c)) = (forall a b. a -> These a b
This a
a, c
c)
undistrPairThese (That (b
b, c
c)) = (forall a b. b -> These a b
That b
b, c
c)
undistrPairThese (These (a
a, c
c) (b
b, c
_)) = (forall a b. a -> b -> These a b
These a
a b
b, c
c)
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 = forall a b. a -> These a b
This (a
a forall a. Semigroup a => a -> a -> a
<> a
b)
This a
a <> That b
y = forall a b. a -> b -> These a b
These a
a b
y
This a
a <> These a
b b
y = forall a b. a -> b -> These a b
These (a
a forall a. Semigroup a => a -> a -> a
<> a
b) b
y
That b
x <> This a
b = forall a b. a -> b -> These a b
These a
b b
x
That b
x <> That b
y = forall a b. b -> These a b
That (b
x forall a. Semigroup a => a -> a -> a
<> b
y)
That b
x <> These a
b b
y = forall a b. a -> b -> These a b
These a
b (b
x forall a. Semigroup a => a -> a -> a
<> b
y)
These a
a b
x <> This a
b = forall a b. a -> b -> These a b
These (a
a forall a. Semigroup a => a -> a -> a
<> a
b) b
x
These a
a b
x <> That b
y = forall a b. a -> b -> These a b
These a
a (b
x forall a. Semigroup a => a -> a -> a
<> b
y)
These a
a b
x <> These a
b b
y = forall a b. a -> b -> These a b
These (a
a forall a. Semigroup a => a -> a -> a
<> a
b) (b
x forall a. Semigroup a => a -> a -> a
<> b
y)
instance Functor (These a) where
fmap :: forall a b. (a -> b) -> These a a -> These a b
fmap a -> b
_ (This a
x) = forall a b. a -> These a b
This a
x
fmap a -> b
f (That a
y) = forall a b. b -> These a b
That (a -> b
f a
y)
fmap a -> b
f (These a
x a
y) = forall a b. a -> b -> These a b
These a
x (a -> b
f a
y)
instance Foldable (These a) where
foldr :: forall a b. (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 :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> These a a -> f (These a b)
traverse a -> f b
_ (This a
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> These a b
This a
a
traverse 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
traverse a -> f b
f (These a
a a
x) = forall a b. a -> b -> These a b
These a
a forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
These a (f a) -> f (These a a)
sequenceA (This a
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> These a b
This a
a
sequenceA (That f a
x) = forall a b. b -> These a b
That forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
x
sequenceA (These a
a f a
x) = forall a b. a -> b -> These a b
These a
a forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
x
instance Bifunctor These where
bimap :: forall a b c d. (a -> b) -> (c -> d) -> These a c -> These b d
bimap a -> b
f c -> d
_ (This a
a ) = forall a b. a -> These a b
This (a -> b
f a
a)
bimap a -> b
_ c -> d
g (That c
x) = forall a b. b -> These a b
That (c -> d
g c
x)
bimap a -> b
f c -> d
g (These a
a c
x) = forall a b. a -> b -> These a b
These (a -> b
f a
a) (c -> d
g c
x)
instance Bifoldable These where
bifold :: forall m. Monoid m => These m m -> m
bifold = forall a c b.
(a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
these forall a. a -> a
id forall a. a -> a
id forall a. Monoid a => a -> a -> a
mappend
bifoldMap :: forall m a b. Monoid m => (a -> m) -> (b -> m) -> These a b -> m
bifoldMap a -> m
f b -> m
g = forall a c b.
(a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
these a -> m
f b -> m
g (\a
x b
y -> forall a. Monoid a => a -> a -> a
mappend (a -> m
f a
x) (b -> m
g b
y))
bifoldr :: forall a c b. (a -> c -> c) -> (b -> c -> c) -> c -> These a b -> c
bifoldr a -> c -> c
f b -> c -> c
g c
z = 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 :: forall c a b. (c -> a -> c) -> (c -> b -> c) -> c -> These a b -> c
bifoldl c -> a -> c
f c -> b -> c
g c
z = 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 Bifoldable1 These where
bifold1 :: forall m. Semigroup m => These m m -> m
bifold1 = forall a c b.
(a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
these forall a. a -> a
id forall a. a -> a
id forall a. Semigroup a => a -> a -> a
(<>)
bifoldMap1 :: forall m a b. Semigroup m => (a -> m) -> (b -> m) -> These a b -> m
bifoldMap1 a -> m
f b -> m
g = forall a c b.
(a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
these a -> m
f b -> m
g (\a
x b
y -> a -> m
f a
x forall a. Semigroup a => a -> a -> a
<> b -> m
g b
y)
instance Bitraversable These where
bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> These a b -> f (These c d)
bitraverse a -> f c
f b -> f d
_ (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 c
f a
x
bitraverse a -> f c
_ b -> f d
g (That b
x) = forall a b. b -> These a b
That 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) = forall a b. a -> b -> These a b
These forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
x 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 :: forall a. a -> These a a
pure = forall a b. b -> These a b
That
This a
a <*> :: forall a b. These a (a -> b) -> These a a -> These a b
<*> These a a
_ = forall a b. a -> These a b
This a
a
That a -> b
_ <*> This a
b = forall a b. a -> These a b
This a
b
That a -> b
f <*> That a
x = forall a b. b -> These a b
That (a -> b
f a
x)
That a -> b
f <*> These a
b a
x = forall a b. a -> b -> These a b
These a
b (a -> b
f a
x)
These a
a a -> b
_ <*> This a
b = forall a b. a -> These a b
This (a
a forall a. Semigroup a => a -> a -> a
<> a
b)
These a
a a -> b
f <*> That a
x = 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 = forall a b. a -> b -> These a b
These (a
a forall a. Semigroup a => a -> a -> a
<> a
b) (a -> b
f a
x)
instance (Semigroup a) => Monad (These a) where
return :: forall a. a -> These a a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
This a
a >>= :: forall a b. These a a -> (a -> These a b) -> 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 -> forall a b. a -> These a b
This (a
a forall a. Semigroup a => a -> a -> a
<> a
b)
That b
y -> forall a b. a -> b -> These a b
These a
a b
y
These a
b b
y -> forall a b. a -> b -> These a b
These (a
a forall a. Semigroup a => a -> a -> a
<> a
b) b
y
#ifdef LIFTED_FUNCTOR_CLASSES
instance Eq2 These where
liftEq2 :: forall a b c d.
(a -> b -> Bool)
-> (c -> d -> Bool) -> These a c -> These b d -> Bool
liftEq2 a -> b -> Bool
f c -> d -> Bool
_ (This a
a) (This b
a') = a -> b -> Bool
f a
a b
a'
liftEq2 a -> b -> Bool
_ c -> d -> Bool
g (That c
b) (That d
b') = c -> d -> Bool
g c
b d
b'
liftEq2 a -> b -> Bool
f c -> d -> Bool
g (These a
a c
b) (These b
a' d
b') = a -> b -> Bool
f a
a b
a' Bool -> Bool -> Bool
&& c -> d -> Bool
g c
b d
b'
liftEq2 a -> b -> Bool
_ c -> d -> Bool
_ These a c
_ These b d
_ = Bool
False
instance Eq a => Eq1 (These a) where
liftEq :: forall a b. (a -> b -> Bool) -> These a a -> These a b -> Bool
liftEq = forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 forall a. Eq a => a -> a -> Bool
(==)
instance Ord2 These where
liftCompare2 :: forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> These a c -> These b d -> Ordering
liftCompare2 a -> b -> Ordering
f c -> d -> Ordering
_ (This a
a) (This b
a') = a -> b -> Ordering
f a
a b
a'
liftCompare2 a -> b -> Ordering
_ c -> d -> Ordering
_ (This a
_) These b d
_ = Ordering
LT
liftCompare2 a -> b -> Ordering
_ c -> d -> Ordering
_ These a c
_ (This b
_) = Ordering
GT
liftCompare2 a -> b -> Ordering
_ c -> d -> Ordering
g (That c
b) (That d
b') = c -> d -> Ordering
g c
b d
b'
liftCompare2 a -> b -> Ordering
_ c -> d -> Ordering
_ (That c
_) These b d
_ = Ordering
LT
liftCompare2 a -> b -> Ordering
_ c -> d -> Ordering
_ These a c
_ (That d
_) = Ordering
GT
liftCompare2 a -> b -> Ordering
f c -> d -> Ordering
g (These a
a c
b) (These b
a' d
b') = a -> b -> Ordering
f a
a b
a' forall a. Monoid a => a -> a -> a
`mappend` c -> d -> Ordering
g c
b d
b'
instance Ord a => Ord1 (These a) where
liftCompare :: forall a b.
(a -> b -> Ordering) -> These a a -> These a b -> Ordering
liftCompare = forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 forall a. Ord a => a -> a -> Ordering
compare
instance Show a => Show1 (These a) where
liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> These a a -> ShowS
liftShowsPrec = forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 forall a. Show a => Int -> a -> ShowS
showsPrec forall a. Show a => [a] -> ShowS
showList
instance Show2 These where
liftShowsPrec2 :: forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> These a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
sa [a] -> ShowS
_ Int -> b -> ShowS
_sb [b] -> ShowS
_ Int
d (This a
a) = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10)
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"This "
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
sa Int
11 a
a
liftShowsPrec2 Int -> a -> ShowS
_sa [a] -> ShowS
_ Int -> b -> ShowS
sb [b] -> ShowS
_ Int
d (That b
b) = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10)
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"That "
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> b -> ShowS
sb Int
11 b
b
liftShowsPrec2 Int -> a -> ShowS
sa [a] -> ShowS
_ Int -> b -> ShowS
sb [b] -> ShowS
_ Int
d (These a
a b
b) = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10)
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"These "
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
sa Int
11 a
a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> b -> ShowS
sb Int
11 b
b
instance Read2 These where
liftReadsPrec2 :: forall a b.
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (These a b)
liftReadsPrec2 Int -> ReadS a
ra ReadS [a]
_ Int -> ReadS b
rb ReadS [b]
_ Int
d = forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ \String
s -> ReadS (These a b)
cons String
s
where
cons :: ReadS (These a b)
cons String
s0 = do
(String
ident, String
s1) <- ReadS String
lex String
s0
case String
ident of
String
"This" -> do
(a
a, String
s2) <- Int -> ReadS a
ra Int
11 String
s1
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> These a b
This a
a, String
s2)
String
"That" -> do
(b
b, String
s2) <- Int -> ReadS b
rb Int
11 String
s1
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> These a b
That b
b, String
s2)
String
"These" -> do
(a
a, String
s2) <- Int -> ReadS a
ra Int
11 String
s1
(b
b, String
s3) <- Int -> ReadS b
rb Int
11 String
s2
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> b -> These a b
These a
a b
b, String
s3)
String
_ -> []
instance Read a => Read1 (These a) where
liftReadsPrec :: forall a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (These a a)
liftReadsPrec = forall (f :: * -> * -> *) a b.
Read2 f =>
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (f a b)
liftReadsPrec2 forall a. Read a => Int -> ReadS a
readsPrec forall a. Read a => ReadS [a]
readList
#else
instance Eq a => Eq1 (These a) where eq1 = (==)
instance Ord a => Ord1 (These a) where compare1 = compare
instance Show a => Show1 (These a) where showsPrec1 = showsPrec
instance Read a => Read1 (These a) where readsPrec1 = readsPrec
#endif
instance Swap These where
swap :: forall a b. These a b -> These b a
swap (This a
a) = forall a b. b -> These a b
That a
a
swap (That b
b) = forall a b. a -> These a b
This b
b
swap (These a
a b
b) = forall a b. a -> b -> These a b
These b
b a
a
instance Assoc These where
assoc :: forall a b c. These (These a b) c -> These a (These b c)
assoc (This (This a
a)) = forall a b. a -> These a b
This a
a
assoc (This (That b
b)) = forall a b. b -> These a b
That (forall a b. a -> These a b
This b
b)
assoc (That c
c) = forall a b. b -> These a b
That (forall a b. b -> These a b
That c
c)
assoc (These (That b
b) c
c) = forall a b. b -> These a b
That (forall a b. a -> b -> These a b
These b
b c
c)
assoc (This (These a
a b
b)) = forall a b. a -> b -> These a b
These a
a (forall a b. a -> These a b
This b
b)
assoc (These (This a
a) c
c) = forall a b. a -> b -> These a b
These a
a (forall a b. b -> These a b
That c
c)
assoc (These (These a
a b
b) c
c) = forall a b. a -> b -> These a b
These a
a (forall a b. a -> b -> These a b
These b
b c
c)
unassoc :: forall a b c. These a (These b c) -> These (These a b) c
unassoc (This a
a) = forall a b. a -> These a b
This (forall a b. a -> These a b
This a
a)
unassoc (That (This b
b)) = forall a b. a -> These a b
This (forall a b. b -> These a b
That b
b)
unassoc (That (That c
c)) = forall a b. b -> These a b
That c
c
unassoc (That (These b
b c
c)) = forall a b. a -> b -> These a b
These (forall a b. b -> These a b
That b
b) c
c
unassoc (These a
a (This b
b)) = forall a b. a -> These a b
This (forall a b. a -> b -> These a b
These a
a b
b)
unassoc (These a
a (That c
c)) = forall a b. a -> b -> These a b
These (forall a b. a -> These a b
This a
a) c
c
unassoc (These a
a (These b
b c
c)) = forall a b. a -> b -> These a b
These (forall a b. a -> b -> These a b
These a
a b
b) c
c
instance (NFData a, NFData b) => NFData (These a b) where
rnf :: These a b -> ()
rnf (This a
a) = forall a. NFData a => a -> ()
rnf a
a
rnf (That b
b) = forall a. NFData a => a -> ()
rnf b
b
rnf (These a
a b
b) = forall a. NFData a => a -> ()
rnf a
a seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf b
b
#if MIN_VERSION_deepseq(1,4,3)
instance NFData a => NFData1 (These a) where
liftRnf :: forall a. (a -> ()) -> These a a -> ()
liftRnf a -> ()
_rnfB (This a
a) = forall a. NFData a => a -> ()
rnf a
a
liftRnf a -> ()
rnfB (That a
b) = a -> ()
rnfB a
b
liftRnf a -> ()
rnfB (These a
a a
b) = forall a. NFData a => a -> ()
rnf a
a seq :: forall a b. a -> b -> b
`seq` a -> ()
rnfB a
b
instance NFData2 These where
liftRnf2 :: forall a b. (a -> ()) -> (b -> ()) -> These a b -> ()
liftRnf2 a -> ()
rnfA b -> ()
_rnfB (This a
a) = a -> ()
rnfA a
a
liftRnf2 a -> ()
_rnfA b -> ()
rnfB (That b
b) = b -> ()
rnfB b
b
liftRnf2 a -> ()
rnfA b -> ()
rnfB (These a
a b
b) = a -> ()
rnfA a
a seq :: forall a b. a -> b -> b
`seq` b -> ()
rnfB b
b
#endif
instance (Binary a, Binary b) => Binary (These a b) where
put :: These a b -> Put
put (This a
a) = forall t. Binary t => t -> Put
put (Int
0 :: Int) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put a
a
put (That b
b) = forall t. Binary t => t -> Put
put (Int
1 :: Int) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put b
b
put (These a
a b
b) = forall t. Binary t => t -> Put
put (Int
2 :: Int) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put a
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put b
b
get :: Get (These a b)
get = do
Int
i <- forall t. Binary t => Get t
get
case (Int
i :: Int) of
Int
0 -> forall a b. a -> These a b
This forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
Int
1 -> forall a b. b -> These a b
That forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
Int
2 -> forall a b. a -> b -> These a b
These forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get
Int
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid These index"
instance (Hashable a, Hashable b) => Hashable (These a b) where
hashWithSalt :: Int -> These a b -> Int
hashWithSalt Int
salt (This a
a) =
Int
salt forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
0 :: Int) forall a. Hashable a => Int -> a -> Int
`hashWithSalt` a
a
hashWithSalt Int
salt (That b
b) =
Int
salt forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
1 :: Int) forall a. Hashable a => Int -> a -> Int
`hashWithSalt` b
b
hashWithSalt Int
salt (These a
a b
b) =
Int
salt forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
2 :: Int) forall a. Hashable a => Int -> a -> Int
`hashWithSalt` a
a forall a. Hashable a => Int -> a -> Int
`hashWithSalt` b
b
instance Hashable a => Hashable1 (These a) where
liftHashWithSalt :: forall a. (Int -> a -> Int) -> Int -> These a a -> Int
liftHashWithSalt Int -> a -> Int
_hashB Int
salt (This a
a) =
Int
salt forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
0 :: Int) forall a. Hashable a => Int -> a -> Int
`hashWithSalt` a
a
liftHashWithSalt Int -> a -> Int
hashB Int
salt (That a
b) =
(Int
salt forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
1 :: Int)) Int -> a -> Int
`hashB` a
b
liftHashWithSalt Int -> a -> Int
hashB Int
salt (These a
a a
b) =
(Int
salt forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
2 :: Int) forall a. Hashable a => Int -> a -> Int
`hashWithSalt` a
a) Int -> a -> Int
`hashB` a
b
instance Hashable2 These where
liftHashWithSalt2 :: forall a b.
(Int -> a -> Int) -> (Int -> b -> Int) -> Int -> These a b -> Int
liftHashWithSalt2 Int -> a -> Int
hashA Int -> b -> Int
_hashB Int
salt (This a
a) =
(Int
salt forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
0 :: Int)) Int -> a -> Int
`hashA` a
a
liftHashWithSalt2 Int -> a -> Int
_hashA Int -> b -> Int
hashB Int
salt (That b
b) =
(Int
salt forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
1 :: Int)) Int -> b -> Int
`hashB` b
b
liftHashWithSalt2 Int -> a -> Int
hashA Int -> b -> Int
hashB Int
salt (These a
a b
b) =
(Int
salt forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
2 :: Int)) Int -> a -> Int
`hashA` a
a Int -> b -> Int
`hashB` b
b