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

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.Hashable      (Hashable (..))
import Data.List.NonEmpty (NonEmpty (..))
import Data.Semigroup     (Semigroup (..))
import GHC.Generics       (Generic)

#if __GLASGOW_HASKELL__ >= 706
import GHC.Generics (Generic1)
#endif

#ifdef MIN_VERSION_aeson
import Data.Aeson (FromJSON (..), ToJSON (..), (.=))

import qualified Data.Aeson          as Aeson
import qualified Data.Aeson.Encoding as Aeson (pair)
import qualified Data.HashMap.Strict as HM
#endif

#ifdef MIN_VERSION_assoc
import Data.Bifunctor.Assoc (Assoc (..))
import Data.Bifunctor.Swap  (Swap (..))
#endif

#ifdef MIN_VERSION_semigroupoids
import Data.Functor.Bind            (Apply (..), Bind (..))
import Data.Semigroup.Bifoldable    (Bifoldable1 (..))
import Data.Semigroup.Bitraversable (Bitraversable1 (..))
#endif

#ifdef MIN_VERSION_QuickCheck
import Test.QuickCheck
       (Arbitrary (..), Arbitrary1 (..), Arbitrary2 (..), CoArbitrary (..),
       arbitrary1, oneof, shrink1)
import Test.QuickCheck.Function (Function (..), functionMap)
#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)
Constr
DataType
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 -> Constr
These a b -> DataType
(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 -> Constr
forall a b. (Data a, Data b) => These a b -> DataType
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 l :: a -> c
l _ _ (This a :: a
a) = a -> c
l a
a
these _ r :: b -> c
r _ (That x :: b
x) = b -> c
r b
x
these _ _ lr :: a -> b -> c
lr (These a :: a
a x :: 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 x :: a
x y :: 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 f :: a -> c
f g :: b -> c
g op :: c -> c -> c
op t :: 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 (t :: These a b
t:ts :: [These a b]
ts) = case These a b
t of
    This x :: a
x    -> (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs,     [b]
ys,         [(a, b)]
xys)
    That y :: b
y    -> (    [a]
xs, b
y b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b]
ys,         [(a, b)]
xys)
    These x :: a
x y :: 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
    ~(xs :: [a]
xs,ys :: [b]
ys,xys :: [(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 (t :: These a b
t:ts :: [These a b]
ts) = case These a b
t of
    This x :: a
x     -> (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs,     [b]
ys)
    That y :: b
y     -> (    [a]
xs, b
y b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b]
ys)
    These x :: a
x  y :: 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
    ~(xs :: [a]
xs,ys :: [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 (x :: Either a b
x :| xs :: [Either a b]
xs) = case (Either a b
x, [a]
ls, [b]
rs) of
    (Left y :: a
y,  ys :: [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 y :: a
y,  ys :: [a]
ys,     (z :: b
z:zs :: [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 z :: b
z, [],     zs :: [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 z :: b
z, (y :: a
y:ys :: [a]
ys), zs :: [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
    (ls :: [a]
ls, rs :: [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
a, b :: 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)         = (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
a, b :: b
b) c :: 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
a,    This b :: b
b)    = (a, b) -> These (a, b) c
forall a b. a -> These a b
This (a
a, b
b)
undistrThesePair (That c :: c
c,    That _)    = c -> These (a, b) c
forall a b. b -> These a b
That c
c
undistrThesePair (These a :: a
a c :: c
c, These b :: 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 (This _,    That c :: c
c)    = c -> These (a, b) c
forall a b. b -> These a b
That c
c
undistrThesePair (This a :: a
a,    These b :: b
b c :: 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
c,    This _)    = c -> These (a, b) c
forall a b. b -> These a b
That c
c
undistrThesePair (That c :: c
c,    These _ _) = c -> These (a, b) c
forall a b. b -> These a b
That c
c
undistrThesePair (These a :: a
a c :: c
c, This b :: 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 _ c :: c
c, That _)    = 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
a,    c :: 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
b,    c :: 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
a b :: b
b, c :: 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
a, c :: c
c))         = (a -> These a b
forall a b. a -> These a b
This a
a, c
c)
undistrPairThese (That (b :: b
b, c :: c
c))         = (b -> These a b
forall a b. b -> These a b
That b
b, c
c)
undistrPairThese (These (a :: a
a, c :: c
c) (b :: b
b, _)) = (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
a   <> :: These a b -> These a b -> These a b
<> This  b :: 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
a   <> That    y :: b
y = a -> b -> These a b
forall a b. a -> b -> These a b
These  a
a             b
y
    This  a :: a
a   <> These b :: a
b y :: 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    x :: b
x <> This  b :: a
b   = a -> b -> These a b
forall a b. a -> b -> These a b
These       a
b   b
x
    That    x :: b
x <> That    y :: 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    x :: b
x <> These b :: a
b y :: 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
a x :: b
x <> This  b :: 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
a x :: b
x <> That    y :: 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
a x :: b
x <> These b :: a
b y :: 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 _ (This x :: a
x) = a -> These a b
forall a b. a -> These a b
This a
x
    fmap f :: a -> b
f (That y :: a
y) = b -> These a b
forall a b. b -> These a b
That (a -> b
f a
y)
    fmap f :: a -> b
f (These x :: a
x y :: 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 _ z :: b
z (This _) = b
z
    foldr f :: a -> b -> b
f z :: b
z (That x :: a
x) = a -> b -> b
f a
x b
z
    foldr f :: a -> b -> b
f z :: b
z (These _ x :: 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 _ (This a :: 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 f :: a -> f b
f (That x :: 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 f :: a -> f b
f (These a :: a
a x :: 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
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 x :: 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
a x :: 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 f :: a -> b
f _ (This  a :: a
a  ) = b -> These b d
forall a b. a -> These a b
This (a -> b
f a
a)
    bimap _ g :: c -> d
g (That    x :: c
x) = d -> These b d
forall a b. b -> These a b
That (c -> d
g c
x)
    bimap f :: a -> b
f g :: c -> d
g (These a :: a
a x :: 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 f :: a -> c -> c
f g :: b -> c -> c
g z :: 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) (\x :: a
x y :: 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 f :: c -> a -> c
f g :: c -> b -> c
g z :: 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`) (\x :: a
x y :: 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 f :: a -> f c
f _ (This x :: 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 _ g :: b -> f d
g (That x :: 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 f :: a -> f c
f g :: b -> f d
g (These x :: a
x y :: 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
a   <*> :: These a (a -> b) -> These a a -> These a b
<*> _         = a -> These a b
forall a b. a -> These a b
This a
a
    That    _ <*> This  b :: a
b   = a -> These a b
forall a b. a -> These a b
This a
b
    That    f :: a -> b
f <*> That    x :: a
x = b -> These a b
forall a b. b -> These a b
That (a -> b
f a
x)
    That    f :: a -> b
f <*> These b :: a
b x :: 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 _ <*> This  b :: 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 f :: a -> b
f <*> That    x :: 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 f :: a -> b
f <*> These b :: a
b x :: 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
a   >>= :: These a a -> (a -> These a b) -> These a b
>>= _ = a -> These a b
forall a b. a -> These a b
This a
a
    That    x :: a
x >>= k :: a -> These a b
k = a -> These a b
k a
x
    These a :: a
a x :: a
x >>= k :: a -> These a b
k = case a -> These a b
k a
x of
                          This  b :: 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    y :: b
y -> a -> b -> These a b
forall a b. a -> b -> These a b
These a
a b
y
                          These b :: a
b y :: b
y -> a -> b -> These a b
forall a b. a -> b -> These a b
These (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b) b
y
instance (Hashable a, Hashable b) => Hashable (These a b)

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

#ifdef MIN_VERSION_assoc
-- | @since 0.8
instance Swap These where
    swap :: These a b -> These b a
swap (This a :: a
a)    = a -> These b a
forall a b. b -> These a b
That a
a
    swap (That b :: b
b)    = b -> These b a
forall a b. a -> These a b
This b
b
    swap (These a :: a
a b :: 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))       = a -> These a (These b c)
forall a b. a -> These a b
This a
a
    assoc (This (That b :: 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
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
b) c :: 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
a b :: 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
a) c :: 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
a b :: b
b) c :: 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
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
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))       = c -> These (These a b) c
forall a b. b -> These a b
That c
c
    unassoc (That (These b :: b
b c :: 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
a (This b :: 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
a (That c :: 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
a (These b :: b
b c :: 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)    = a -> ()
forall a. NFData a => a -> ()
rnf a
a
    rnf (That b :: b
b)    = b -> ()
forall a. NFData a => a -> ()
rnf b
b
    rnf (These a :: a
a b :: b
b) = a -> ()
forall a. NFData a => a -> ()
rnf a
a () -> () -> ()
forall a b. a -> b -> b
`seq` b -> ()
forall a. NFData a => a -> ()
rnf b
b

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

-- | @since 0.7.1
instance (Binary a, Binary b) => Binary (These a b) where
    put :: These a b -> Put
put (This a :: a
a)    = Int -> Put
forall t. Binary t => t -> Put
put (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
b)    = Int -> Put
forall t. Binary t => t -> Put
put (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
a b :: b
b) = Int -> Put
forall t. Binary t => t -> Put
put (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
            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
            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
            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
            _ -> String -> Get (These a b)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Invalid These index"

-------------------------------------------------------------------------------
-- semigroupoids
-------------------------------------------------------------------------------

#ifdef MIN_VERSION_semigroupoids
instance Bifoldable1 These where
    bifold1 :: These m m -> m
bifold1 = (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. Semigroup a => a -> a -> a
(<>)

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

instance (Semigroup a) => Bind (These a) where
    This  a :: a
a   >>- :: These a a -> (a -> These a b) -> These a b
>>- _ = a -> These a b
forall a b. a -> These a b
This a
a
    That    x :: a
x >>- k :: a -> These a b
k = a -> These a b
k a
x
    These a :: a
a x :: a
x >>- k :: a -> These a b
k = case a -> These a b
k a
x of
                          This  b :: 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    y :: b
y -> a -> b -> These a b
forall a b. a -> b -> These a b
These a
a b
y
                          These b :: a
b y :: b
y -> a -> b -> These a b
forall a b. a -> b -> These a b
These (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b) b
y

instance (Semigroup a) => Apply (These a) where
    This  a :: a
a   <.> :: These a (a -> b) -> These a a -> These a b
<.> _         = a -> These a b
forall a b. a -> These a b
This a
a
    That    _ <.> This  b :: a
b   = a -> These a b
forall a b. a -> These a b
This a
b
    That    f :: a -> b
f <.> That    x :: a
x = b -> These a b
forall a b. b -> These a b
That (a -> b
f a
x)
    That    f :: a -> b
f <.> These b :: a
b x :: 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 _ <.> This  b :: 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 f :: a -> b
f <.> That    x :: 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 f :: a -> b
f <.> These b :: a
b x :: 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)
#endif

-------------------------------------------------------------------------------
-- aeson
-------------------------------------------------------------------------------

#ifdef MIN_VERSION_aeson

-- | @since 0.7.1
instance (ToJSON a, ToJSON b) => ToJSON (These a b) where
    toJSON :: These a b -> Value
toJSON (This a :: a
a)    = [Pair] -> Value
Aeson.object [ "This" Text -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= a
a ]
    toJSON (That b :: b
b)    = [Pair] -> Value
Aeson.object [ "That" Text -> b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= b
b ]
    toJSON (These a :: a
a b :: b
b) = [Pair] -> Value
Aeson.object [ "This" Text -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= a
a, "That" Text -> b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= b
b ]

    toEncoding :: These a b -> Encoding
toEncoding (This a :: a
a)    = Series -> Encoding
Aeson.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ "This" Text -> a -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= a
a
    toEncoding (That b :: b
b)    = Series -> Encoding
Aeson.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ "That" Text -> b -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= b
b
    toEncoding (These a :: a
a b :: b
b) = Series -> Encoding
Aeson.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ "This" Text -> a -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= a
a Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "That" Text -> b -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= b
b

-- | @since 0.7.1
instance (FromJSON a, FromJSON b) => FromJSON (These a b) where
    parseJSON :: Value -> Parser (These a b)
parseJSON = String
-> (Object -> Parser (These a b)) -> Value -> Parser (These a b)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject "These a b" ([Pair] -> Parser (These a b)
forall a a a.
(Eq a, IsString a, FromJSON a, FromJSON a) =>
[(a, Value)] -> Parser (These a a)
p ([Pair] -> Parser (These a b))
-> (Object -> [Pair]) -> Object -> Parser (These a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> [Pair]
forall k v. HashMap k v -> [(k, v)]
HM.toList)
      where
        p :: [(a, Value)] -> Parser (These a a)
p [("This", a :: Value
a), ("That", b :: Value
b)] = a -> a -> These a a
forall a b. a -> b -> These a b
These (a -> a -> These a a) -> Parser a -> Parser (a -> These a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
a Parser (a -> These a a) -> Parser a -> Parser (These a a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
b
        p [("That", b :: Value
b), ("This", a :: Value
a)] = a -> a -> These a a
forall a b. a -> b -> These a b
These (a -> a -> These a a) -> Parser a -> Parser (a -> These a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
a Parser (a -> These a a) -> Parser a -> Parser (These a a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
b
        p [("This", a :: Value
a)] = a -> These a a
forall a b. a -> These a b
This (a -> These a a) -> Parser a -> Parser (These a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
a
        p [("That", b :: Value
b)] = a -> These a a
forall a b. b -> These a b
That (a -> These a a) -> Parser a -> Parser (These a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
b
        p _  = String -> Parser (These a a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Expected object with 'This' and 'That' keys only"

-- | @since 0.7.2
instance Aeson.ToJSON2 These where
    liftToJSON2 :: (a -> Value)
-> ([a] -> Value)
-> (b -> Value)
-> ([b] -> Value)
-> These a b
-> Value
liftToJSON2  toa :: a -> Value
toa _ _tob :: b -> Value
_tob _ (This a :: a
a)    = [Pair] -> Value
Aeson.object [ "This" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= a -> Value
toa a
a ]
    liftToJSON2 _toa :: a -> Value
_toa _  tob :: b -> Value
tob _ (That b :: b
b)    = [Pair] -> Value
Aeson.object [ "That" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= b -> Value
tob b
b ]
    liftToJSON2  toa :: a -> Value
toa _  tob :: b -> Value
tob _ (These a :: a
a b :: b
b) = [Pair] -> Value
Aeson.object [ "This" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= a -> Value
toa a
a, "That" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= b -> Value
tob b
b ]

    liftToEncoding2 :: (a -> Encoding)
-> ([a] -> Encoding)
-> (b -> Encoding)
-> ([b] -> Encoding)
-> These a b
-> Encoding
liftToEncoding2  toa :: a -> Encoding
toa _ _tob :: b -> Encoding
_tob _ (This a :: a
a)    = Series -> Encoding
Aeson.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ Text -> Encoding -> Series
Aeson.pair "This" (a -> Encoding
toa a
a)
    liftToEncoding2 _toa :: a -> Encoding
_toa _  tob :: b -> Encoding
tob _ (That b :: b
b)    = Series -> Encoding
Aeson.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ Text -> Encoding -> Series
Aeson.pair "That" (b -> Encoding
tob b
b)
    liftToEncoding2  toa :: a -> Encoding
toa _  tob :: b -> Encoding
tob _ (These a :: a
a b :: b
b) = Series -> Encoding
Aeson.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ Text -> Encoding -> Series
Aeson.pair "This" (a -> Encoding
toa a
a) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text -> Encoding -> Series
Aeson.pair "That" (b -> Encoding
tob b
b)

-- | @since 0.7.2
instance ToJSON a => Aeson.ToJSON1 (These a) where
    liftToJSON :: (a -> Value) -> ([a] -> Value) -> These a a -> Value
liftToJSON _tob :: a -> Value
_tob _ (This a :: a
a)    = [Pair] -> Value
Aeson.object [ "This" Text -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= a
a ]
    liftToJSON  tob :: a -> Value
tob _ (That b :: a
b)    = [Pair] -> Value
Aeson.object [ "That" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= a -> Value
tob a
b ]
    liftToJSON  tob :: a -> Value
tob _ (These a :: a
a b :: a
b) = [Pair] -> Value
Aeson.object [ "This" Text -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= a
a, "That" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= a -> Value
tob a
b ]

    liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> These a a -> Encoding
liftToEncoding _tob :: a -> Encoding
_tob _ (This a :: a
a)    = Series -> Encoding
Aeson.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ "This" Text -> a -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= a
a
    liftToEncoding  tob :: a -> Encoding
tob _ (That b :: a
b)    = Series -> Encoding
Aeson.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ Text -> Encoding -> Series
Aeson.pair "That" (a -> Encoding
tob a
b)
    liftToEncoding  tob :: a -> Encoding
tob _ (These a :: a
a b :: a
b) = Series -> Encoding
Aeson.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ "This" Text -> a -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= a
a Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text -> Encoding -> Series
Aeson.pair "That" (a -> Encoding
tob a
b)

-- | @since 0.7.2
instance Aeson.FromJSON2 These where
    liftParseJSON2 :: (Value -> Parser a)
-> (Value -> Parser [a])
-> (Value -> Parser b)
-> (Value -> Parser [b])
-> Value
-> Parser (These a b)
liftParseJSON2 pa :: Value -> Parser a
pa _ pb :: Value -> Parser b
pb _ = String
-> (Object -> Parser (These a b)) -> Value -> Parser (These a b)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject "These a b" ([Pair] -> Parser (These a b)
forall a. (Eq a, IsString a) => [(a, Value)] -> Parser (These a b)
p ([Pair] -> Parser (These a b))
-> (Object -> [Pair]) -> Object -> Parser (These a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> [Pair]
forall k v. HashMap k v -> [(k, v)]
HM.toList)
      where
        p :: [(a, Value)] -> Parser (These a b)
p [("This", a :: Value
a), ("That", b :: Value
b)] = a -> b -> These a b
forall a b. a -> b -> These a b
These (a -> b -> These a b) -> Parser a -> Parser (b -> These a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
pa Value
a Parser (b -> These a b) -> Parser b -> Parser (These a b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser b
pb Value
b
        p [("That", b :: Value
b), ("This", a :: Value
a)] = a -> b -> These a b
forall a b. a -> b -> These a b
These (a -> b -> These a b) -> Parser a -> Parser (b -> These a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
pa Value
a Parser (b -> These a b) -> Parser b -> Parser (These a b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser b
pb Value
b
        p [("This", a :: Value
a)] = a -> These a b
forall a b. a -> These a b
This (a -> These a b) -> Parser a -> Parser (These a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
pa Value
a
        p [("That", b :: Value
b)] = b -> These a b
forall a b. b -> These a b
That (b -> These a b) -> Parser b -> Parser (These a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser b
pb Value
b
        p _  = String -> Parser (These a b)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Expected object with 'This' and 'That' keys only"

-- | @since 0.7.2
instance FromJSON a => Aeson.FromJSON1 (These a) where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (These a a)
liftParseJSON pb :: Value -> Parser a
pb _ = String
-> (Object -> Parser (These a a)) -> Value -> Parser (These a a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject "These a b" ([Pair] -> Parser (These a a)
forall a a.
(Eq a, IsString a, FromJSON a) =>
[(a, Value)] -> Parser (These a a)
p ([Pair] -> Parser (These a a))
-> (Object -> [Pair]) -> Object -> Parser (These a a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> [Pair]
forall k v. HashMap k v -> [(k, v)]
HM.toList)
      where
        p :: [(a, Value)] -> Parser (These a a)
p [("This", a :: Value
a), ("That", b :: Value
b)] = a -> a -> These a a
forall a b. a -> b -> These a b
These (a -> a -> These a a) -> Parser a -> Parser (a -> These a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
a Parser (a -> These a a) -> Parser a -> Parser (These a a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser a
pb Value
b
        p [("That", b :: Value
b), ("This", a :: Value
a)] = a -> a -> These a a
forall a b. a -> b -> These a b
These (a -> a -> These a a) -> Parser a -> Parser (a -> These a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
a Parser (a -> These a a) -> Parser a -> Parser (These a a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser a
pb Value
b
        p [("This", a :: Value
a)] = a -> These a a
forall a b. a -> These a b
This (a -> These a a) -> Parser a -> Parser (These a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
a
        p [("That", b :: Value
b)] = a -> These a a
forall a b. b -> These a b
That (a -> These a a) -> Parser a -> Parser (These a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
pb Value
b
        p _  = String -> Parser (These a a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Expected object with 'This' and 'That' keys only"
#endif

-------------------------------------------------------------------------------
-- QuickCheck
-------------------------------------------------------------------------------

#ifdef MIN_VERSION_QuickCheck
-- | @since 0.7.4
instance Arbitrary2 These where
    liftArbitrary2 :: Gen a -> Gen b -> Gen (These a b)
liftArbitrary2 arbA :: Gen a
arbA arbB :: Gen b
arbB = [Gen (These a b)] -> Gen (These a b)
forall a. [Gen a] -> Gen a
oneof
        [ a -> These a b
forall a b. a -> These a b
This (a -> These a b) -> Gen a -> Gen (These a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
arbA
        , b -> These a b
forall a b. b -> These a b
That (b -> These a b) -> Gen b -> Gen (These a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen b
arbB
        , a -> b -> These a b
forall a b. a -> b -> These a b
These (a -> b -> These a b) -> Gen a -> Gen (b -> These a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
arbA Gen (b -> These a b) -> Gen b -> Gen (These a b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen b
arbB
        ]

    liftShrink2 :: (a -> [a]) -> (b -> [b]) -> These a b -> [These a b]
liftShrink2  shrA :: a -> [a]
shrA _shrB :: b -> [b]
_shrB (This x :: a
x) = a -> These a b
forall a b. a -> These a b
This (a -> These a b) -> [a] -> [These a b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> [a]
shrA a
x
    liftShrink2 _shrA :: a -> [a]
_shrA  shrB :: b -> [b]
shrB (That y :: b
y) = b -> These a b
forall a b. b -> These a b
That (b -> These a b) -> [b] -> [These a b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> [b]
shrB b
y
    liftShrink2  shrA :: a -> [a]
shrA  shrB :: b -> [b]
shrB (These x :: a
x y :: b
y) =
        [a -> These a b
forall a b. a -> These a b
This a
x, b -> These a b
forall a b. b -> These a b
That b
y] [These a b] -> [These a b] -> [These a b]
forall a. [a] -> [a] -> [a]
++ [a -> b -> These a b
forall a b. a -> b -> These a b
These a
x' b
y' | (x' :: a
x', y' :: b
y') <- (a -> [a]) -> (b -> [b]) -> (a, b) -> [(a, b)]
forall (f :: * -> * -> *) a b.
Arbitrary2 f =>
(a -> [a]) -> (b -> [b]) -> f a b -> [f a b]
liftShrink2 a -> [a]
shrA b -> [b]
shrB (a
x, b
y)]

-- | @since 0.7.4
instance (Arbitrary a) => Arbitrary1 (These a) where
    liftArbitrary :: Gen a -> Gen (These a a)
liftArbitrary = Gen a -> Gen a -> Gen (These a a)
forall (f :: * -> * -> *) a b.
Arbitrary2 f =>
Gen a -> Gen b -> Gen (f a b)
liftArbitrary2 Gen a
forall a. Arbitrary a => Gen a
arbitrary
    liftShrink :: (a -> [a]) -> These a a -> [These a a]
liftShrink = (a -> [a]) -> (a -> [a]) -> These a a -> [These a a]
forall (f :: * -> * -> *) a b.
Arbitrary2 f =>
(a -> [a]) -> (b -> [b]) -> f a b -> [f a b]
liftShrink2 a -> [a]
forall a. Arbitrary a => a -> [a]
shrink

-- | @since 0.7.1
instance (Arbitrary a, Arbitrary b) => Arbitrary (These a b) where
    arbitrary :: Gen (These a b)
arbitrary = Gen (These a b)
forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => Gen (f a)
arbitrary1
    shrink :: These a b -> [These a b]
shrink = These a b -> [These a b]
forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => f a -> [f a]
shrink1

-- | @since 0.7.1
instance (Function a, Function b) => Function (These a b) where
  function :: (These a b -> b) -> These a b :-> b
function = (These a b -> Either a (Either b (a, b)))
-> (Either a (Either b (a, b)) -> These a b)
-> (These a b -> b)
-> These a b :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap These a b -> Either a (Either b (a, b))
forall a b. These a b -> Either a (Either b (a, b))
g Either a (Either b (a, b)) -> These a b
forall a b. Either a (Either b (a, b)) -> These a b
f
    where
      g :: These a b -> Either a (Either b (a, b))
g (This a :: a
a)    = a -> Either a (Either b (a, b))
forall a b. a -> Either a b
Left a
a
      g (That b :: b
b)    = Either b (a, b) -> Either a (Either b (a, b))
forall a b. b -> Either a b
Right (b -> Either b (a, b)
forall a b. a -> Either a b
Left b
b)
      g (These a :: a
a b :: b
b) = Either b (a, b) -> Either a (Either b (a, b))
forall a b. b -> Either a b
Right ((a, b) -> Either b (a, b)
forall a b. b -> Either a b
Right (a
a, b
b))

      f :: Either a (Either b (a, b)) -> These a b
f (Left a :: a
a)               = a -> These a b
forall a b. a -> These a b
This a
a
      f (Right (Left b :: b
b))       = b -> These a b
forall a b. b -> These a b
That b
b
      f (Right (Right (a :: a
a, b :: b
b))) = a -> b -> These a b
forall a b. a -> b -> These a b
These a
a b
b

-- | @since 0.7.1
instance (CoArbitrary a, CoArbitrary b) => CoArbitrary (These a b)
#endif