{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE DeriveGeneric      #-}

#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

-----------------------------------------------------------------------------
-- |
--
-- The strict variant of the standard Haskell 'L.Either' type and the
-- corresponding variants of the functions from "Data.Either".
--
-- Note that the strict 'Either' type is not an applicative functor, and
-- therefore also no monad. The reasons are the same as the ones for the
-- strict @Maybe@ type, which are explained in "Data.Maybe.Strict".
--
-----------------------------------------------------------------------------

module Data.Strict.Either (
    Either(..)
  , either
  , isLeft, isRight
  , fromLeft, fromRight
  , lefts, rights
  , partitionEithers
) where

-- import parts explicitly, helps with compatibility
import           Prelude ( Functor (..), Eq (..), Ord (..), Show (..), Read (..), Bool (..), (.), ($)
                         , error, Ordering (..), showParen, showString, lex, return, readParen)
import           Control.Applicative (pure, (<$>))
import           Data.Semigroup (Semigroup (..))
import           Data.Foldable (Foldable (..))
import           Data.Traversable (Traversable (..))

-- Lazy variants
import qualified Prelude             as L

import           Control.DeepSeq     (NFData (..))
import           Data.Bifoldable     (Bifoldable (..))
import           Data.Bifunctor      (Bifunctor (..))
import           Data.Binary         (Binary (..))
import           Data.Bitraversable  (Bitraversable (..))
import           Data.Hashable       (Hashable(..))
import           Data.Hashable.Lifted (Hashable1 (..), Hashable2 (..))
import           GHC.Generics        (Generic)
import           Data.Data           (Data (..), Typeable)

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

#if MIN_VERSION_deepseq(1,4,3)
import Control.DeepSeq (NFData1 (..), NFData2 (..))
#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

-- | The strict choice type.
data Either a b = Left !a | Right !b
  deriving (Either a b -> Either a b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => Either a b -> Either a b -> Bool
/= :: Either a b -> Either a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => Either a b -> Either a b -> Bool
== :: Either a b -> Either a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => Either a b -> Either a b -> Bool
Eq, Either a b -> Either a b -> Bool
Either a b -> Either a b -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a} {b}. (Ord a, Ord b) => Eq (Either a b)
forall a b. (Ord a, Ord b) => Either a b -> Either a b -> Bool
forall a b. (Ord a, Ord b) => Either a b -> Either a b -> Ordering
forall a b.
(Ord a, Ord b) =>
Either a b -> Either a b -> Either a b
min :: Either a b -> Either a b -> Either a b
$cmin :: forall a b.
(Ord a, Ord b) =>
Either a b -> Either a b -> Either a b
max :: Either a b -> Either a b -> Either a b
$cmax :: forall a b.
(Ord a, Ord b) =>
Either a b -> Either a b -> Either a b
>= :: Either a b -> Either a b -> Bool
$c>= :: forall a b. (Ord a, Ord b) => Either a b -> Either a b -> Bool
> :: Either a b -> Either a b -> Bool
$c> :: forall a b. (Ord a, Ord b) => Either a b -> Either a b -> Bool
<= :: Either a b -> Either a b -> Bool
$c<= :: forall a b. (Ord a, Ord b) => Either a b -> Either a b -> Bool
< :: Either a b -> Either a b -> Bool
$c< :: forall a b. (Ord a, Ord b) => Either a b -> Either a b -> Bool
compare :: Either a b -> Either a b -> Ordering
$ccompare :: forall a b. (Ord a, Ord b) => Either a b -> Either a b -> Ordering
Ord, ReadPrec [Either a b]
ReadPrec (Either a b)
ReadS [Either a b]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall a b. (Read a, Read b) => ReadPrec [Either a b]
forall a b. (Read a, Read b) => ReadPrec (Either a b)
forall a b. (Read a, Read b) => Int -> ReadS (Either a b)
forall a b. (Read a, Read b) => ReadS [Either a b]
readListPrec :: ReadPrec [Either a b]
$creadListPrec :: forall a b. (Read a, Read b) => ReadPrec [Either a b]
readPrec :: ReadPrec (Either a b)
$creadPrec :: forall a b. (Read a, Read b) => ReadPrec (Either a b)
readList :: ReadS [Either a b]
$creadList :: forall a b. (Read a, Read b) => ReadS [Either a b]
readsPrec :: Int -> ReadS (Either a b)
$creadsPrec :: forall a b. (Read a, Read b) => Int -> ReadS (Either a b)
Read, Int -> Either a b -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> Either a b -> ShowS
forall a b. (Show a, Show b) => [Either a b] -> ShowS
forall a b. (Show a, Show b) => Either a b -> String
showList :: [Either a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [Either a b] -> ShowS
show :: Either a b -> String
$cshow :: forall a b. (Show a, Show b) => Either a b -> String
showsPrec :: Int -> Either a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> Either a b -> ShowS
Show, Typeable, Either a b -> DataType
Either a b -> Constr
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall {a} {b}. (Data a, Data b) => Typeable (Either a b)
forall a b. (Data a, Data b) => Either a b -> DataType
forall a b. (Data a, Data b) => Either a b -> Constr
forall a b.
(Data a, Data b) =>
(forall b. Data b => b -> b) -> Either a b -> Either a b
forall a b u.
(Data a, Data b) =>
Int -> (forall d. Data d => d -> u) -> Either a b -> u
forall a b u.
(Data a, Data b) =>
(forall d. Data d => d -> u) -> Either a b -> [u]
forall a b r r'.
(Data a, Data b) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Either a b -> r
forall a b r r'.
(Data a, Data b) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Either a b -> r
forall a b (m :: * -> *).
(Data a, Data b, Monad m) =>
(forall d. Data d => d -> m d) -> Either a b -> m (Either a b)
forall a b (m :: * -> *).
(Data a, Data b, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Either a b -> m (Either 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 (Either 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) -> Either a b -> c (Either a b)
forall a b (t :: * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Either 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 (Either a b))
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Either a b)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Either a b -> c (Either a b)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Either a b))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Either a b -> m (Either a b)
$cgmapMo :: forall a b (m :: * -> *).
(Data a, Data b, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Either a b -> m (Either a b)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Either a b -> m (Either a b)
$cgmapMp :: forall a b (m :: * -> *).
(Data a, Data b, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Either a b -> m (Either a b)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Either a b -> m (Either a b)
$cgmapM :: forall a b (m :: * -> *).
(Data a, Data b, Monad m) =>
(forall d. Data d => d -> m d) -> Either a b -> m (Either a b)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Either a b -> u
$cgmapQi :: forall a b u.
(Data a, Data b) =>
Int -> (forall d. Data d => d -> u) -> Either a b -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Either a b -> [u]
$cgmapQ :: forall a b u.
(Data a, Data b) =>
(forall d. Data d => d -> u) -> Either a b -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Either a b -> r
$cgmapQr :: forall a b r r'.
(Data a, Data b) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Either a b -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Either a b -> r
$cgmapQl :: forall a b r r'.
(Data a, Data b) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Either a b -> r
gmapT :: (forall b. Data b => b -> b) -> Either a b -> Either a b
$cgmapT :: forall a b.
(Data a, Data b) =>
(forall b. Data b => b -> b) -> Either a b -> Either a b
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Either 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 (Either a b))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Either a b))
$cdataCast1 :: forall a b (t :: * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Either a b))
dataTypeOf :: Either a b -> DataType
$cdataTypeOf :: forall a b. (Data a, Data b) => Either a b -> DataType
toConstr :: Either a b -> Constr
$ctoConstr :: forall a b. (Data a, Data b) => Either a b -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Either 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 (Either a b)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Either a b -> c (Either 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) -> Either a b -> c (Either a b)
Data, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x. Rep (Either a b) x -> Either a b
forall a b x. Either a b -> Rep (Either a b) x
$cto :: forall a b x. Rep (Either a b) x -> Either a b
$cfrom :: forall a b x. Either a b -> Rep (Either a b) x
Generic
#if __GLASGOW_HASKELL__ >= 706
    , forall a a. Rep1 (Either a) a -> Either a a
forall a a. Either a a -> Rep1 (Either 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 (Either a) a -> Either a a
$cfrom1 :: forall a a. Either a a -> Rep1 (Either a) a
Generic1
#endif
    )

toStrict :: L.Either a b -> Either a b
toStrict :: forall a b. Either a b -> Either a b
toStrict (L.Left a
x)  = forall a b. a -> Either a b
Left a
x
toStrict (L.Right b
y) = forall a b. b -> Either a b
Right b
y

toLazy :: Either a b -> L.Either a b
toLazy :: forall a b. Either a b -> Either a b
toLazy (Left a
x)  = forall a b. a -> Either a b
L.Left a
x
toLazy (Right b
y) = forall a b. b -> Either a b
L.Right b
y

-- | Case analysis: if the value is @'Left' a@, apply the first function to @a@;
-- if it is @'Right' b@, apply the second function to @b@.
either :: (a -> c) -> (b -> c) -> Either a b -> c
either :: forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> c
f b -> c
_ (Left  a
x) = a -> c
f a
x
either a -> c
_ b -> c
g (Right b
y) = b -> c
g b
y

-- | Yields 'True' iff the argument is of the form @Left _@.
--
isLeft :: Either a b -> Bool
isLeft :: forall a b. Either a b -> Bool
isLeft (Left a
_) = Bool
True
isLeft Either a b
_        = Bool
False

-- | Yields 'True' iff the argument is of the form @Right _@.
--
isRight :: Either a b -> Bool
isRight :: forall a b. Either a b -> Bool
isRight (Right b
_) = Bool
True
isRight Either a b
_         = Bool
False

-- | Extracts the element out of a 'Left' and throws an error if the argument
-- is a 'Right'.
fromLeft :: Either a b -> a
fromLeft :: forall a b. Either a b -> a
fromLeft (Left a
x) = a
x
fromLeft Either a b
_        = forall a. HasCallStack => String -> a
error String
"Data.Strict.Either.fromLeft: Right"

-- | Extracts the element out of a 'Right' and throws an error if the argument
-- is a 'Left'.
fromRight :: Either a b -> b
fromRight :: forall a b. Either a b -> b
fromRight (Right b
x) = b
x
fromRight Either a b
_         = forall a. HasCallStack => String -> a
error String
"Data.Strict.Either.fromRight: Left"

-- | Analogous to 'L.lefts' in "Data.Either".
lefts   :: [Either a b] -> [a]
lefts :: forall a b. [Either a b] -> [a]
lefts [Either a b]
x = [a
a | Left a
a <- [Either a b]
x]

-- | Analogous to 'L.rights' in "Data.Either".
rights   :: [Either a b] -> [b]
rights :: forall a b. [Either a b] -> [b]
rights [Either a b]
x = [b
a | Right b
a <- [Either a b]
x]

-- | Analogous to 'L.partitionEithers' in "Data.Either".
partitionEithers :: [Either a b] -> ([a],[b])
partitionEithers :: forall a b. [Either a b] -> ([a], [b])
partitionEithers =
    forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
L.foldr (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {a} {b}. a -> ([a], b) -> ([a], b)
left forall {a} {a}. a -> (a, [a]) -> (a, [a])
right) ([],[])
  where
    left :: a -> ([a], b) -> ([a], b)
left  a
a ~([a]
l, b
r) = (a
aforall a. a -> [a] -> [a]
:[a]
l, b
r)
    right :: a -> (a, [a]) -> (a, [a])
right a
a ~(a
l, [a]
r) = (a
l, a
aforall a. a -> [a] -> [a]
:[a]
r)

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

instance Functor (Either a) where
  fmap :: forall a b. (a -> b) -> Either a a -> Either a b
fmap a -> b
_ (Left  a
x) = forall a b. a -> Either a b
Left a
x
  fmap a -> b
f (Right a
y) = forall a b. b -> Either a b
Right (a -> b
f a
y)

instance Foldable (Either e) where
  foldr :: forall a b. (a -> b -> b) -> b -> Either e a -> b
foldr a -> b -> b
_ b
y (Left e
_)  = b
y
  foldr a -> b -> b
f b
y (Right a
x) = a -> b -> b
f a
x b
y

  foldl :: forall b a. (b -> a -> b) -> b -> Either e a -> b
foldl b -> a -> b
_ b
y (Left e
_)  = b
y
  foldl b -> a -> b
f b
y (Right a
x) = b -> a -> b
f b
y a
x

instance Traversable (Either e) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Either e a -> f (Either e b)
traverse a -> f b
_ (Left e
x)  = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left e
x)
  traverse a -> f b
f (Right a
x) = forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x

instance Semigroup (Either a b) where
  Left a
_ <> :: Either a b -> Either a b -> Either a b
<> Either a b
b = Either a b
b
  Either a b
a      <> Either a b
_ = Either a b
a

-- deepseq
instance (NFData a, NFData b) => NFData (Either a b) where
  rnf :: Either a b -> ()
rnf = forall a. NFData a => a -> ()
rnf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Either a b -> Either a b
toLazy

#if MIN_VERSION_deepseq(1,4,3)
instance (NFData a) => NFData1 (Either a) where
  liftRnf :: forall a. (a -> ()) -> Either a a -> ()
liftRnf a -> ()
rnfA = forall (f :: * -> *) a. NFData1 f => (a -> ()) -> f a -> ()
liftRnf a -> ()
rnfA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Either a b -> Either a b
toLazy

instance NFData2 Either where
  liftRnf2 :: forall a b. (a -> ()) -> (b -> ()) -> Either a b -> ()
liftRnf2 a -> ()
rnfA b -> ()
rnfB = forall (p :: * -> * -> *) a b.
NFData2 p =>
(a -> ()) -> (b -> ()) -> p a b -> ()
liftRnf2 a -> ()
rnfA b -> ()
rnfB forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Either a b -> Either a b
toLazy
#endif

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

-- bifunctors
instance Bifunctor Either where
  bimap :: forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
bimap a -> b
f c -> d
_ (Left a
a) = forall a b. a -> Either a b
Left (a -> b
f a
a)
  bimap a -> b
_ c -> d
g (Right c
a) = forall a b. b -> Either a b
Right (c -> d
g c
a)
  first :: forall a b c. (a -> b) -> Either a c -> Either b c
first a -> b
f = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) forall a b. b -> Either a b
Right
  second :: forall b c a. (b -> c) -> Either a b -> Either a c
second b -> c
g = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c
g)

instance Bifoldable Either where
  bifold :: forall m. Monoid m => Either m m -> m
bifold (Left m
a) = m
a
  bifold (Right m
b) = m
b
  bifoldMap :: forall m a b. Monoid m => (a -> m) -> (b -> m) -> Either a b -> m
bifoldMap = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
  bifoldr :: forall a c b.
(a -> c -> c) -> (b -> c -> c) -> c -> Either a b -> c
bifoldr a -> c -> c
f b -> c -> c
_ c
c (Left a
a) = a -> c -> c
f a
a c
c
  bifoldr a -> c -> c
_ b -> c -> c
g c
c (Right b
b) = b -> c -> c
g b
b c
c
  bifoldl :: forall c a b.
(c -> a -> c) -> (c -> b -> c) -> c -> Either a b -> c
bifoldl c -> a -> c
f c -> b -> c
_ c
c (Left a
a) = c -> a -> c
f c
c a
a
  bifoldl c -> a -> c
_ c -> b -> c
g c
c (Right b
b) = c -> b -> c
g c
c b
b

instance Bitraversable Either where
  bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Either a b -> f (Either c d)
bitraverse a -> f c
f b -> f d
_ (Left a
a) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left (a -> f c
f a
a)
  bitraverse a -> f c
_ b -> f d
g (Right b
b) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right (b -> f d
g b
b)

-- hashable
instance (Hashable a, Hashable b) => Hashable (Either a b) where
  hashWithSalt :: Int -> Either a b -> Int
hashWithSalt Int
salt = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Either a b -> Either a b
toLazy

instance (Hashable a) => Hashable1 (Either a) where
  liftHashWithSalt :: forall a. (Int -> a -> Int) -> Int -> Either a a -> Int
liftHashWithSalt Int -> a -> Int
hashA Int
salt = forall (t :: * -> *) a.
Hashable1 t =>
(Int -> a -> Int) -> Int -> t a -> Int
liftHashWithSalt Int -> a -> Int
hashA Int
salt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Either a b -> Either a b
toLazy

instance Hashable2 Either where
  liftHashWithSalt2 :: forall a b.
(Int -> a -> Int) -> (Int -> b -> Int) -> Int -> Either a b -> Int
liftHashWithSalt2 Int -> a -> Int
hashA Int -> b -> Int
hashB Int
salt = forall (t :: * -> * -> *) a b.
Hashable2 t =>
(Int -> a -> Int) -> (Int -> b -> Int) -> Int -> t a b -> Int
liftHashWithSalt2 Int -> a -> Int
hashA Int -> b -> Int
hashB Int
salt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Either a b -> Either a b
toLazy

-- assoc
#ifdef MIN_VERSION_assoc
instance Assoc Either where
    assoc :: forall a b c. Either (Either a b) c -> Either a (Either b c)
assoc (Left (Left a
a))  = forall a b. a -> Either a b
Left a
a
    assoc (Left (Right b
b)) = forall a b. b -> Either a b
Right (forall a b. a -> Either a b
Left b
b)
    assoc (Right c
c)        = forall a b. b -> Either a b
Right (forall a b. b -> Either a b
Right c
c)

    unassoc :: forall a b c. Either a (Either b c) -> Either (Either a b) c
unassoc (Left a
a)          = forall a b. a -> Either a b
Left (forall a b. a -> Either a b
Left a
a)
    unassoc (Right (Left b
b))  = forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right b
b)
    unassoc (Right (Right c
c)) = forall a b. b -> Either a b
Right c
c

instance Swap Either where
    swap :: forall a b. Either a b -> Either b a
swap (Left a
x) = forall a b. b -> Either a b
Right a
x
    swap (Right b
x) = forall a b. a -> Either a b
Left b
x
#endif

-- Data.Functor.Classes
#ifdef LIFTED_FUNCTOR_CLASSES
instance Eq2 Either where
  liftEq2 :: forall a b c d.
(a -> b -> Bool)
-> (c -> d -> Bool) -> Either a c -> Either b d -> Bool
liftEq2 a -> b -> Bool
f c -> d -> Bool
_ (Left a
a)  (Left b
a')  = a -> b -> Bool
f a
a b
a'
  liftEq2 a -> b -> Bool
_ c -> d -> Bool
g (Right c
b) (Right d
b') = c -> d -> Bool
g c
b d
b'
  liftEq2 a -> b -> Bool
_ c -> d -> Bool
_ Either a c
_         Either b d
_          = Bool
False

instance Eq a => Eq1 (Either a) where
  liftEq :: forall a b. (a -> b -> Bool) -> Either a a -> Either a b -> Bool
liftEq = forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 forall a. Eq a => a -> a -> Bool
(==)

instance Ord2 Either where
  liftCompare2 :: forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> Either a c -> Either b d -> Ordering
liftCompare2 a -> b -> Ordering
f c -> d -> Ordering
_ (Left a
a)    (Left b
a')     = a -> b -> Ordering
f a
a b
a'
  liftCompare2 a -> b -> Ordering
_ c -> d -> Ordering
_ (Left a
_)    Either b d
_             = Ordering
LT
  liftCompare2 a -> b -> Ordering
_ c -> d -> Ordering
_ Either a c
_           (Left b
_)      = Ordering
GT
  liftCompare2 a -> b -> Ordering
_ c -> d -> Ordering
g (Right c
b)    (Right d
b')     = c -> d -> Ordering
g c
b d
b'

instance Ord a => Ord1 (Either a) where
  liftCompare :: forall a b.
(a -> b -> Ordering) -> Either a a -> Either a b -> Ordering
liftCompare = forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 forall a. Ord a => a -> a -> Ordering
compare

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

instance Show2 Either where
  liftShowsPrec2 :: forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> Either a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
sa [a] -> ShowS
_ Int -> b -> ShowS
_sb [b] -> ShowS
_ Int
d (Left a
a) = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10)
    forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Left "
    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 (Right b
b) = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10)
    forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Right "
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> b -> ShowS
sb Int
11 b
b

instance Read2 Either where
  liftReadsPrec2 :: forall a b.
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (Either a b)
liftReadsPrec2 Int -> ReadS a
ra ReadS [a]
_ Int -> ReadS b
rb ReadS [b]
_ Int
d = forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ \String
s -> ReadS (Either a b)
cons String
s
    where
      cons :: ReadS (Either a b)
cons String
s0 = do
        (String
ident, String
s1) <- ReadS String
lex String
s0
        case String
ident of
            String
"Left" ->  do
                (a
a, String
s2) <- Int -> ReadS a
ra Int
11 String
s1
                forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left a
a, String
s2)
            String
"Right" ->  do
                (b
b, String
s2) <- Int -> ReadS b
rb Int
11 String
s1
                forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right b
b, String
s2)
            String
_ -> []

instance Read a => Read1 (Either a) where
  liftReadsPrec :: forall a.
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Either a a)
liftReadsPrec = forall (f :: * -> * -> *) a b.
Read2 f =>
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (f a b)
liftReadsPrec2 forall a. Read a => Int -> ReadS a
readsPrec forall a. Read a => ReadS [a]
readList
#else
instance Eq a   => Eq1   (Either a) where eq1        = (==)
instance Ord a  => Ord1  (Either a) where compare1   = compare
instance Show a => Show1 (Either a) where showsPrec1 = showsPrec
instance Read a => Read1 (Either a) where readsPrec1 = readsPrec
#endif