{-# 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.Strict.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 (..), id, lex, readParen,
       seq, showParen, showString, ($), (&&), (.))

import qualified Data.These as L

#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 Prelude (map)

-- | The strict these type.
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
    )

toStrict :: L.These a b -> These a b
toStrict :: These a b -> These a b
toStrict (L.This a
x)    = a -> These a b
forall a b. a -> These a b
This a
x
toStrict (L.That b
y)    = b -> These a b
forall a b. b -> These a b
That b
y
toStrict (L.These a
x b
y) = a -> b -> These a b
forall a b. a -> b -> These a b
These a
x b
y

toLazy :: These a b -> L.These a b
toLazy :: These a b -> These a b
toLazy (This a
x)    = a -> These a b
forall a b. a -> These a b
L.This a
x
toLazy (That b
y)    = b -> These a b
forall a b. b -> These a b
L.That b
y
toLazy (These a
x b
y) = a -> b -> These a b
forall a b. a -> b -> These a b
L.These a
x b
y

-------------------------------------------------------------------------------
-- 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.
--
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")
--
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
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

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

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'

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

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

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

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
_ -> []

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

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

#ifdef MIN_VERSION_assoc
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

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

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

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

instance (Binary a, Binary b) => Binary (These a b) where
    put :: These a b -> Put
put = These a b -> Put
forall t. Binary t => t -> Put
put (These a b -> Put) -> (These a b -> These a b) -> These a b -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. These a b -> These a b
forall a b. These a b -> These a b
toLazy
    get :: Get (These a b)
get = These a b -> These a b
forall a b. These a b -> These a b
toStrict (These a b -> These a b) -> Get (These a b) -> Get (These a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (These a b)
forall t. Binary t => Get t
get

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

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

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