{-# LANGUAGE CPP                #-}
-- | The 'These' type and associated operations. Now enhanced with "Control.Lens" magic!
{-# 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(..)

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

    -- * Partition
    , partitionThese
    , partitionHereThere
    , partitionEithersNE

    -- * Distributivity
    --
    -- | This distributivity combinators aren't isomorphisms!
    , distrThesePair
    , undistrThesePair
    , distrPairThese
    , undistrPairThese
    ) where

import Control.Applicative  (Applicative (..), (<$>))
import Control.DeepSeq      (NFData (..))
import Data.Bifoldable      (Bifoldable (..))
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

-- $setup
-- >>> import Control.Lens

-- --------------------------------------------------------------------------
-- | 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.
--
--   For zipping and unzipping of structures with 'These' values, see
--   "Data.Align".
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
#if __GLASGOW_HASKELL__ >= 706
    , (forall a. These a a -> Rep1 (These a) a)
-> (forall a. Rep1 (These a) a -> These a a) -> Generic1 (These a)
forall a. Rep1 (These a) a -> These a a
forall a. These a a -> Rep1 (These a) a
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
    )

-------------------------------------------------------------------------------
-- Eliminators
-------------------------------------------------------------------------------

-- | 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
x b
y = (a -> (a, b))
-> (b -> (a, b)) -> (a -> b -> (a, b)) -> These a b -> (a, b)
forall a c b.
(a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
these (a -> b -> (a, b)
forall a b. a -> b -> (a, b)
`pair` b
y) (a
x a -> b -> (a, b)
forall a b. a -> b -> (a, b)
`pair`) a -> b -> (a, b)
forall a b. a -> b -> (a, b)
pair where
    pair :: a -> b -> (a, b)
pair = (,)

-- | 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 (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

-------------------------------------------------------------------------------
-- Partitioning
-------------------------------------------------------------------------------

-- | 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 b
t:[These a b]
ts) = case These a b
t of
    This a
x    -> (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs,     [b]
ys,         [(a, b)]
xys)
    That b
y    -> (    [a]
xs, b
y b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b]
ys,         [(a, b)]
xys)
    These a
x b
y -> (    [a]
xs,     [b]
ys, (a
x,b
y) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)]
xys)
  where
    ~([a]
xs,[b]
ys,[(a, b)]
xys) = [These a b] -> ([a], [b], [(a, b)])
forall a b. [These a b] -> ([a], [b], [(a, b)])
partitionThese [These a b]
ts

-- | Select 'here' and 'there' elements and partition them into separate lists.
--
-- @since 0.8
partitionHereThere :: [These a b] -> ([a], [b])
partitionHereThere :: [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 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs,     [b]
ys)
    That b
y     -> (    [a]
xs, b
y b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b]
ys)
    These a
x  b
y -> (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs, b
y b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b]
ys)
  where
    ~([a]
xs,[b]
ys) = [These a b] -> ([a], [b])
forall a b. [These a b] -> ([a], [b])
partitionHereThere [These a b]
ts

-- | Like 'partitionEithers' but for 'NonEmpty' types.
--
-- * either all are 'Left'
-- * either all are 'Right'
-- * or there is both 'Left' and 'Right' stuff
--
-- /Note:/ this is not online algorithm. In the worst case it will traverse
-- the whole list before deciding the result constructor.
--
-- >>> partitionEithersNE $ Left 'x' :| [Right 'y']
-- These ('x' :| "") ('y' :| "")
--
-- >>> partitionEithersNE $ Left 'x' :| map Left "yz"
-- This ('x' :| "yz")
--
-- @since 1.0.1
partitionEithersNE :: NonEmpty (Either a b) -> These (NonEmpty a) (NonEmpty b)
partitionEithersNE :: 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,   [])   -> NonEmpty a -> These (NonEmpty a) (NonEmpty b)
forall a b. a -> These a b
This (a
y a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
ys)
    (Left a
y,  [a]
ys,   b
z:[b]
zs) -> NonEmpty a -> NonEmpty b -> These (NonEmpty a) (NonEmpty b)
forall a b. a -> b -> These a b
These (a
y a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
ys) (b
z b -> [b] -> NonEmpty b
forall a. a -> [a] -> NonEmpty a
:| [b]
zs)
    (Right b
z, [],   [b]
zs)   -> NonEmpty b -> These (NonEmpty a) (NonEmpty b)
forall a b. b -> These a b
That (b
z b -> [b] -> NonEmpty b
forall a. a -> [a] -> NonEmpty a
:| [b]
zs)
    (Right b
z, a
y:[a]
ys, [b]
zs)   -> NonEmpty a -> NonEmpty b -> These (NonEmpty a) (NonEmpty b)
forall a b. a -> b -> These a b
These (a
y a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
ys) (b
z b -> [b] -> NonEmpty b
forall a. a -> [a] -> NonEmpty a
:| [b]
zs)
  where
    ([a]
ls, [b]
rs) = [Either a b] -> ([a], [b])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either a b]
xs


-------------------------------------------------------------------------------
-- Distributivity
-------------------------------------------------------------------------------

distrThesePair :: These (a, b) c -> (These a c, These b c)
distrThesePair :: These (a, b) c -> (These a c, These b c)
distrThesePair (This (a
a, b
b))    = (a -> These a c
forall a b. a -> These a b
This a
a, b -> These b c
forall a b. a -> These a b
This b
b)
distrThesePair (That c
c)         = (c -> These a c
forall a b. b -> These a b
That c
c, c -> These b c
forall a b. b -> These a b
That c
c)
distrThesePair (These (a
a, b
b) c
c) = (a -> c -> These a c
forall a b. a -> b -> These a b
These a
a c
c, b -> c -> These b 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 :: (These a c, These b c) -> These (a, b) c
undistrThesePair (This a
a,    This b
b)    = (a, b) -> These (a, b) c
forall a b. a -> These a b
This (a
a, b
b)
undistrThesePair (That c
c,    That c
_)    = c -> These (a, b) c
forall a b. b -> These a b
That c
c
undistrThesePair (These a
a c
c, These b
b c
_) = (a, b) -> c -> These (a, b) c
forall a b. a -> b -> These a b
These (a
a, b
b) c
c
undistrThesePair (This a
_,    That c
c)    = c -> These (a, b) c
forall a b. b -> These a b
That c
c
undistrThesePair (This a
a,    These b
b c
c) = (a, b) -> c -> These (a, b) c
forall a b. a -> b -> These a b
These (a
a, b
b) c
c
undistrThesePair (That c
c,    This b
_)    = c -> These (a, b) c
forall a b. b -> These a b
That c
c
undistrThesePair (That c
c,    These b
_ c
_) = c -> These (a, b) c
forall a b. b -> These a b
That c
c
undistrThesePair (These a
a c
c, This b
b)    = (a, b) -> c -> These (a, b) c
forall a b. a -> b -> These a b
These (a
a, b
b) c
c
undistrThesePair (These a
_ c
c, That c
_)    = c -> These (a, b) c
forall a b. b -> These a b
That c
c


distrPairThese :: (These a b, c) -> These (a, c) (b, c)
distrPairThese :: (These a b, c) -> These (a, c) (b, c)
distrPairThese (This a
a,    c
c) = (a, c) -> These (a, c) (b, c)
forall a b. a -> These a b
This (a
a, c
c)
distrPairThese (That b
b,    c
c) = (b, c) -> These (a, c) (b, c)
forall a b. b -> These a b
That (b
b, c
c)
distrPairThese (These a
a b
b, c
c) = (a, c) -> (b, c) -> These (a, c) (b, 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 :: These (a, c) (b, c) -> (These a b, c)
undistrPairThese (This (a
a, c
c))         = (a -> These a b
forall a b. a -> These a b
This a
a, c
c)
undistrPairThese (That (b
b, c
c))         = (b -> These a b
forall a b. b -> These a b
That b
b, c
c)
undistrPairThese (These (a
a, c
c) (b
b, c
_)) = (a -> b -> These a b
forall a b. a -> b -> These a b
These a
a b
b, c
c)

-------------------------------------------------------------------------------
-- Instances
-------------------------------------------------------------------------------



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
f c -> d
_ (This  a
a  ) = b -> These b d
forall a b. a -> These a b
This (a -> b
f a
a)
    bimap a -> b
_ c -> d
g (That    c
x) = d -> These b d
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) = b -> d -> These b d
forall a b. a -> b -> These a b
These (a -> b
f a
a) (c -> d
g c
x)

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

-------------------------------------------------------------------------------
-- Data.Functor.Classes
-------------------------------------------------------------------------------

#ifdef LIFTED_FUNCTOR_CLASSES
-- | @since 1.1.1
instance Eq2 These where
  liftEq2 :: (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

-- | @since 1.1.1
instance Eq a => Eq1 (These a) where
  liftEq :: (a -> b -> Bool) -> These a a -> These a b -> Bool
liftEq = (a -> a -> Bool)
-> (a -> b -> Bool) -> These a a -> These a b -> Bool
forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- | @since 1.1.1
instance Ord2 These where
  liftCompare2 :: (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' Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` c -> d -> Ordering
g c
b d
b'

-- | @since 1.1.1
instance Ord a => Ord1 (These a) where
  liftCompare :: (a -> b -> Ordering) -> These a a -> These a b -> Ordering
liftCompare = (a -> a -> Ordering)
-> (a -> b -> Ordering) -> These a a -> These a b -> Ordering
forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

-- | @since 1.1.1
instance Show a => Show1 (These a) where
  liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> These a a -> ShowS
liftShowsPrec = (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> These a a
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec [a] -> ShowS
forall a. Show a => [a] -> ShowS
showList

-- | @since 1.1.1
instance Show2 These where
  liftShowsPrec2 :: (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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10)
    (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"This "
    ShowS -> ShowS -> ShowS
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10)
    (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"That "
    ShowS -> ShowS -> ShowS
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10)
    (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"These "
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
sa Int
11 a
a
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> b -> ShowS
sb Int
11 b
b

-- | @since 1.1.1
instance Read2 These where
  liftReadsPrec2 :: (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 = Bool -> ReadS (These a b) -> ReadS (These a b)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ReadS (These a b) -> ReadS (These a b))
-> ReadS (These a b) -> ReadS (These a b)
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
                (These a b, String) -> [(These a b, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> These a b
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
                (These a b, String) -> [(These a b, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> These a b
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
                (These a b, String) -> [(These a b, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b -> These a b
forall a b. a -> b -> These a b
These a
a b
b, String
s3)
            String
_ -> []

-- | @since 1.1.1
instance Read a => Read1 (These a) where
  liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (These a a)
liftReadsPrec = (Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS a)
-> ReadS [a]
-> Int
-> ReadS (These a a)
forall (f :: * -> * -> *) a b.
Read2 f =>
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (f a b)
liftReadsPrec2 Int -> ReadS a
forall a. Read a => Int -> ReadS a
readsPrec ReadS [a]
forall a. Read a => ReadS [a]
readList

#else
-- | @since 1.1.1
instance Eq a   => Eq1   (These a) where eq1        = (==)
-- | @since 1.1.1
instance Ord a  => Ord1  (These a) where compare1   = compare
-- | @since 1.1.1
instance Show a => Show1 (These a) where showsPrec1 = showsPrec
-- | @since 1.1.1
instance Read a => Read1 (These a) where readsPrec1 = readsPrec
#endif

-------------------------------------------------------------------------------
-- assoc
-------------------------------------------------------------------------------

#ifdef MIN_VERSION_assoc
-- | @since 0.8
instance Swap These where
    swap :: These a b -> These b a
swap (This a
a)    = a -> These b a
forall a b. b -> These a b
That a
a
    swap (That b
b)    = b -> These b a
forall a b. a -> These a b
This b
b
    swap (These a
a b
b) = b -> a -> These b a
forall a b. a -> b -> These a b
These b
b a
a

-- | @since 0.8
instance Assoc These where
    assoc :: These (These a b) c -> These a (These b c)
assoc (This (This a
a))       = a -> These a (These b c)
forall a b. a -> These a b
This a
a
    assoc (This (That b
b))       = These b c -> These a (These b c)
forall a b. b -> These a b
That (b -> These b c
forall a b. a -> These a b
This b
b)
    assoc (That c
c)              = These b c -> These a (These b c)
forall a b. b -> These a b
That (c -> These b c
forall a b. b -> These a b
That c
c)
    assoc (These (That b
b) c
c)    = These b c -> These a (These b c)
forall a b. b -> These a b
That (b -> c -> These b c
forall a b. a -> b -> These a b
These b
b c
c)
    assoc (This (These a
a b
b))    = a -> These b c -> These a (These b c)
forall a b. a -> b -> These a b
These a
a (b -> These b c
forall a b. a -> These a b
This b
b)
    assoc (These (This a
a) c
c)    = a -> These b c -> These a (These b c)
forall a b. a -> b -> These a b
These a
a (c -> These b c
forall a b. b -> These a b
That c
c)
    assoc (These (These a
a b
b) c
c) = a -> These b c -> These a (These b c)
forall a b. a -> b -> These a b
These a
a (b -> c -> These b c
forall a b. a -> b -> These a b
These b
b c
c)

    unassoc :: These a (These b c) -> These (These a b) c
unassoc (This a
a)              = These a b -> These (These a b) c
forall a b. a -> These a b
This (a -> These a b
forall a b. a -> These a b
This a
a)
    unassoc (That (This b
b))       = These a b -> These (These a b) c
forall a b. a -> These a b
This (b -> These a b
forall a b. b -> These a b
That b
b)
    unassoc (That (That c
c))       = c -> These (These a b) c
forall a b. b -> These a b
That c
c
    unassoc (That (These b
b c
c))    = These a b -> c -> These (These a b) c
forall a b. a -> b -> These a b
These (b -> These a b
forall a b. b -> These a b
That b
b) c
c
    unassoc (These a
a (This b
b))    = These a b -> These (These a b) c
forall a b. a -> These a b
This (a -> b -> These a b
forall a b. a -> b -> These a b
These a
a b
b)
    unassoc (These a
a (That c
c))    = These a b -> c -> These (These a b) c
forall a b. a -> b -> These a b
These (a -> These a b
forall a b. a -> These a b
This a
a) c
c
    unassoc (These a
a (These b
b c
c)) = These a b -> c -> These (These a b) c
forall a b. a -> b -> These a b
These (a -> b -> These a b
forall a b. a -> b -> These a b
These a
a b
b) c
c
#endif

-------------------------------------------------------------------------------
-- deepseq
-------------------------------------------------------------------------------

-- | @since 0.7.1
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

#if MIN_VERSION_deepseq(1,4,3)
-- | @since 1.1.1
instance NFData a => NFData1 (These a) where
    liftRnf :: (a -> ()) -> These a a -> ()
liftRnf a -> ()
_rnfB (This a
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) = a -> ()
forall a. NFData a => a -> ()
rnf a
a () -> () -> ()
`seq` a -> ()
rnfB a
b

-- | @since 1.1.1
instance NFData2 These where
    liftRnf2 :: (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` b -> ()
rnfB b
b
#endif

-------------------------------------------------------------------------------
-- binary
-------------------------------------------------------------------------------

-- | @since 0.7.1
instance (Binary a, Binary b) => Binary (These a b) where
    put :: These a b -> Put
put (This a
a)    = Int -> Put
forall t. Binary t => t -> Put
put (Int
0 :: Int) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Put
forall t. Binary t => t -> Put
put a
a
    put (That b
b)    = Int -> Put
forall t. Binary t => t -> Put
put (Int
1 :: Int) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> Put
forall t. Binary t => t -> Put
put b
b
    put (These a
a b
b) = Int -> Put
forall t. Binary t => t -> Put
put (Int
2 :: Int) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Put
forall t. Binary t => t -> Put
put a
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> Put
forall t. Binary t => t -> Put
put b
b

    get :: Get (These a b)
get = do
        Int
i <- Get Int
forall t. Binary t => Get t
get
        case (Int
i :: Int) of
            Int
0 -> a -> These a b
forall a b. a -> These a b
This (a -> These a b) -> Get a -> Get (These a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
forall t. Binary t => Get t
get
            Int
1 -> b -> These a b
forall a b. b -> These a b
That (b -> These a b) -> Get b -> Get (These a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get b
forall t. Binary t => Get t
get
            Int
2 -> a -> b -> These a b
forall a b. a -> b -> These a b
These (a -> b -> These a b) -> Get a -> Get (b -> These a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
forall t. Binary t => Get t
get Get (b -> These a b) -> Get b -> Get (These a b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get b
forall t. Binary t => Get t
get
            Int
_ -> String -> Get (These a b)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid These index"

-------------------------------------------------------------------------------
-- hashable
-------------------------------------------------------------------------------

instance (Hashable a, Hashable b) => Hashable (These a b) where
    hashWithSalt :: Int -> These a b -> Int
hashWithSalt Int
salt (This a
a) =
        Int
salt Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
0 :: Int) Int -> a -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` a
a
    hashWithSalt Int
salt (That b
b) =
        Int
salt Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
1 :: Int) Int -> b -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` b
b
    hashWithSalt Int
salt (These a
a b
b) =
        Int
salt Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
2 :: Int) Int -> a -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` a
a Int -> b -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` b
b

-- | @since 1.1.1
instance Hashable a => Hashable1 (These a) where
    liftHashWithSalt :: (Int -> a -> Int) -> Int -> These a a -> Int
liftHashWithSalt Int -> a -> Int
_hashB Int
salt (This a
a) =
        Int
salt Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
0 :: Int) Int -> a -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` a
a
    liftHashWithSalt  Int -> a -> Int
hashB Int
salt (That a
b) =
        (Int
salt Int -> Int -> Int
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 Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
2 :: Int) Int -> a -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` a
a) Int -> a -> Int
`hashB` a
b

-- | @since 1.1.1
instance Hashable2 These where
    liftHashWithSalt2 :: (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 Int -> Int -> Int
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 Int -> Int -> Int
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 Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
2 :: Int)) Int -> a -> Int
`hashA` a
a Int -> b -> Int
`hashB` b
b