{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Either
-- Copyright   :  (c) The University of Glasgow 2001
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  libraries@haskell.org
-- Stability   :  experimental
-- Portability :  portable
--
-- The Either type, and associated operations.
--
-----------------------------------------------------------------------------

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

import GHC.Base
import GHC.Show
import GHC.Read

-- $setup
-- Allow the use of some Prelude functions in doctests.
-- >>> import Prelude

{-
-- just for testing
import Test.QuickCheck
-}

{-|

The 'Either' type represents values with two possibilities: a value of
type @'Either' a b@ is either @'Left' a@ or @'Right' b@.

The 'Either' type is sometimes used to represent a value which is
either correct or an error; by convention, the 'Left' constructor is
used to hold an error value and the 'Right' constructor is used to
hold a correct value (mnemonic: \"right\" also means \"correct\").

==== __Examples__

The type @'Either' 'String' 'Int'@ is the type of values which can be either
a 'String' or an 'Int'. The 'Left' constructor can be used only on
'String's, and the 'Right' constructor can be used only on 'Int's:

>>> let s = Left "foo" :: Either String Int
>>> s
Left "foo"
>>> let n = Right 3 :: Either String Int
>>> n
Right 3
>>> :type s
s :: Either String Int
>>> :type n
n :: Either String Int

The 'fmap' from our 'Functor' instance will ignore 'Left' values, but
will apply the supplied function to values contained in a 'Right':

>>> let s = Left "foo" :: Either String Int
>>> let n = Right 3 :: Either String Int
>>> fmap (*2) s
Left "foo"
>>> fmap (*2) n
Right 6

The 'Monad' instance for 'Either' allows us to chain together multiple
actions which may fail, and fail overall if any of the individual
steps failed. First we'll write a function that can either parse an
'Int' from a 'Char', or fail.

>>> import Data.Char ( digitToInt, isDigit )
>>> :{
    let parseEither :: Char -> Either String Int
        parseEither c
          | isDigit c = Right (digitToInt c)
          | otherwise = Left "parse error"
>>> :}

The following should work, since both @\'1\'@ and @\'2\'@ can be
parsed as 'Int's.

>>> :{
    let parseMultiple :: Either String Int
        parseMultiple = do
          x <- parseEither '1'
          y <- parseEither '2'
          return (x + y)
>>> :}

>>> parseMultiple
Right 3

But the following should fail overall, since the first operation where
we attempt to parse @\'m\'@ as an 'Int' will fail:

>>> :{
    let parseMultiple :: Either String Int
        parseMultiple = do
          x <- parseEither 'm'
          y <- parseEither '2'
          return (x + y)
>>> :}

>>> parseMultiple
Left "parse error"

-}
data  Either a b  =  Left a | Right b
  deriving ( Either a b -> Either a b -> Bool
(Either a b -> Either a b -> Bool)
-> (Either a b -> Either a b -> Bool) -> Eq (Either a b)
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   -- ^ @since 2.01
           , Eq (Either a b)
Eq (Either a b)
-> (Either a b -> Either a b -> Ordering)
-> (Either a b -> Either a b -> Bool)
-> (Either a b -> Either a b -> Bool)
-> (Either a b -> Either a b -> Bool)
-> (Either a b -> Either a b -> Bool)
-> (Either a b -> Either a b -> Either a b)
-> (Either a b -> Either a b -> Either a b)
-> Ord (Either a b)
Either a b -> Either a b -> Bool
Either a b -> Either a b -> Ordering
Either a b -> Either a b -> Either 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 (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  -- ^ @since 2.01
           , ReadPrec [Either a b]
ReadPrec (Either a b)
Int -> ReadS (Either a b)
ReadS [Either a b]
(Int -> ReadS (Either a b))
-> ReadS [Either a b]
-> ReadPrec (Either a b)
-> ReadPrec [Either a b]
-> Read (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 -- ^ @since 3.0
           , Int -> Either a b -> ShowS
[Either a b] -> ShowS
Either a b -> String
(Int -> Either a b -> ShowS)
-> (Either a b -> String)
-> ([Either a b] -> ShowS)
-> Show (Either a b)
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 -- ^ @since 3.0
           )

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

-- | @since 4.9.0.0
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
#if !defined(__HADDOCK_VERSION__)
    -- workaround https://github.com/haskell/haddock/issues/680
    stimes n x
      | n <= 0 = errorWithoutStackTrace "stimes: positive multiplier expected"
      | otherwise = x
#endif

-- | @since 3.0
instance Applicative (Either e) where
    pure :: forall a. a -> Either e a
pure          = a -> Either e a
forall a b. b -> Either a b
Right
    Left  e
e <*> :: forall a b. Either e (a -> b) -> Either e a -> Either e b
<*> Either e a
_ = e -> Either e b
forall a b. a -> Either a b
Left e
e
    Right a -> b
f <*> Either e a
r = (a -> b) -> Either e a -> Either e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Either e a
r

-- | @since 4.4.0.0
instance Monad (Either e) where
    Left  e
l >>= :: forall a b. Either e a -> (a -> Either e b) -> Either e b
>>= a -> Either e b
_ = e -> Either e b
forall a b. a -> Either a b
Left e
l
    Right a
r >>= a -> Either e b
k = a -> Either e b
k a
r

-- | Case analysis for the 'Either' type.
-- If the value is @'Left' a@, apply the first function to @a@;
-- if it is @'Right' b@, apply the second function to @b@.
--
-- ==== __Examples__
--
-- We create two values of type @'Either' 'String' 'Int'@, one using the
-- 'Left' constructor and another using the 'Right' constructor. Then
-- we apply \"either\" the 'Prelude.length' function (if we have a 'String')
-- or the \"times-two\" function (if we have an 'Int'):
--
-- >>> let s = Left "foo" :: Either String Int
-- >>> let n = Right 3 :: Either String Int
-- >>> either length (*2) s
-- 3
-- >>> either length (*2) n
-- 6
--
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


-- | Extracts from a list of 'Either' all the 'Left' elements.
-- All the 'Left' elements are extracted in order.
--
-- ==== __Examples__
--
-- Basic usage:
--
-- >>> let list = [ Left "foo", Right 3, Left "bar", Right 7, Left "baz" ]
-- >>> lefts list
-- ["foo","bar","baz"]
--
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]
{-# INLINEABLE lefts #-} -- otherwise doesn't get an unfolding, see #13689

-- | Extracts from a list of 'Either' all the 'Right' elements.
-- All the 'Right' elements are extracted in order.
--
-- ==== __Examples__
--
-- Basic usage:
--
-- >>> let list = [ Left "foo", Right 3, Left "bar", Right 7, Left "baz" ]
-- >>> rights list
-- [3,7]
--
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]
{-# INLINEABLE rights #-} -- otherwise doesn't get an unfolding, see #13689

-- | Partitions a list of 'Either' into two lists.
-- All the 'Left' elements are extracted, in order, to the first
-- component of the output.  Similarly the 'Right' elements are extracted
-- to the second component of the output.
--
-- ==== __Examples__
--
-- Basic usage:
--
-- >>> let list = [ Left "foo", Right 3, Left "bar", Right 7, Left "baz" ]
-- >>> partitionEithers list
-- (["foo","bar","baz"],[3,7])
--
-- The pair returned by @'partitionEithers' x@ should be the same
-- pair as @('lefts' x, 'rights' x)@:
--
-- >>> let list = [ Left "foo", Right 3, Left "bar", Right 7, Left "baz" ]
-- >>> partitionEithers list == (lefts list, rights list)
-- True
--
partitionEithers :: [Either a b] -> ([a],[b])
partitionEithers :: forall a b. [Either a b] -> ([a], [b])
partitionEithers = (Either a b -> ([a], [b]) -> ([a], [b]))
-> ([a], [b]) -> [Either a b] -> ([a], [b])
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr ((a -> ([a], [b]) -> ([a], [b]))
-> (b -> ([a], [b]) -> ([a], [b]))
-> Either a b
-> ([a], [b])
-> ([a], [b])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> ([a], [b]) -> ([a], [b])
forall {a} {b}. a -> ([a], b) -> ([a], b)
left b -> ([a], [b]) -> ([a], [b])
forall {a} {a}. a -> (a, [a]) -> (a, [a])
right) ([],[])
 where
  left :: a -> ([a], b) -> ([a], b)
left  a
a ~([a]
l, b
r) = (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
l, b
r)
  right :: a -> (a, [a]) -> (a, [a])
right a
a ~(a
l, [a]
r) = (a
l, a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
r)

-- | Return `True` if the given value is a `Left`-value, `False` otherwise.
--
-- @since 4.7.0.0
--
-- ==== __Examples__
--
-- Basic usage:
--
-- >>> isLeft (Left "foo")
-- True
-- >>> isLeft (Right 3)
-- False
--
-- Assuming a 'Left' value signifies some sort of error, we can use
-- 'isLeft' to write a very simple error-reporting function that does
-- absolutely nothing in the case of success, and outputs \"ERROR\" if
-- any error occurred.
--
-- This example shows how 'isLeft' might be used to avoid pattern
-- matching when one does not care about the value contained in the
-- constructor:
--
-- >>> import Control.Monad ( when )
-- >>> let report e = when (isLeft e) $ putStrLn "ERROR"
-- >>> report (Right 1)
-- >>> report (Left "parse error")
-- ERROR
--
isLeft :: Either a b -> Bool
isLeft :: forall a b. Either a b -> Bool
isLeft (Left  a
_) = Bool
True
isLeft (Right b
_) = Bool
False

-- | Return `True` if the given value is a `Right`-value, `False` otherwise.
--
-- @since 4.7.0.0
--
-- ==== __Examples__
--
-- Basic usage:
--
-- >>> isRight (Left "foo")
-- False
-- >>> isRight (Right 3)
-- True
--
-- Assuming a 'Left' value signifies some sort of error, we can use
-- 'isRight' to write a very simple reporting function that only
-- outputs \"SUCCESS\" when a computation has succeeded.
--
-- This example shows how 'isRight' might be used to avoid pattern
-- matching when one does not care about the value contained in the
-- constructor:
--
-- >>> import Control.Monad ( when )
-- >>> let report e = when (isRight e) $ putStrLn "SUCCESS"
-- >>> report (Left "parse error")
-- >>> report (Right 1)
-- SUCCESS
--
isRight :: Either a b -> Bool
isRight :: forall a b. Either a b -> Bool
isRight (Left  a
_) = Bool
False
isRight (Right b
_) = Bool
True

-- | Return the contents of a 'Left'-value or a default value otherwise.
--
-- @since 4.10.0.0
--
-- ==== __Examples__
--
-- Basic usage:
--
-- >>> fromLeft 1 (Left 3)
-- 3
-- >>> fromLeft 1 (Right "foo")
-- 1
--
fromLeft :: a -> Either a b -> a
fromLeft :: forall a b. a -> Either a b -> a
fromLeft a
_ (Left a
a) = a
a
fromLeft a
a Either a b
_        = a
a

-- | Return the contents of a 'Right'-value or a default value otherwise.
--
-- @since 4.10.0.0
--
-- ==== __Examples__
--
-- Basic usage:
--
-- >>> fromRight 1 (Right 3)
-- 3
-- >>> fromRight 1 (Left "foo")
-- 1
--
fromRight :: b -> Either a b -> b
fromRight :: forall b a. b -> Either a b -> b
fromRight b
_ (Right b
b) = b
b
fromRight b
b Either a b
_         = b
b

{-
{--------------------------------------------------------------------
  Testing
--------------------------------------------------------------------}
prop_partitionEithers :: [Either Int Int] -> Bool
prop_partitionEithers x =
  partitionEithers x == (lefts x, rights x)
-}