{-# 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 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 , 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 -- ^ @since 2.01 , 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 -- ^ @since 3.0 , 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 -- ^ @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) = 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) -- | @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 = 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 _ = forall a b. a -> Either a b Left e e Right a -> b f <*> Either e a r = 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 _ = 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 = forall a b. (a -> b -> b) -> b -> [a] -> b 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) -- | 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) -}