{-# LANGUAGE CPP, ConstraintKinds #-}
{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}

-- | This module extends "Data.Either" with extra operations, particularly
--   to quickly extract from inside an 'Either'. Some of these operations are
--   partial, and should be used with care in production-quality code.
--
--   If you need more 'Either' functions see the
--   <https://hackage.haskell.org/package/either either>.
module Data.Either.Extra(
    module Data.Either,
    fromLeft, fromRight, fromEither,
    fromLeft', fromRight',
    eitherToMaybe, maybeToEither,
    mapLeft, mapRight,
    ) where

import Data.Either
import Partial


#if __GLASGOW_HASKELL__ < 801

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

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

#endif


-- | The 'fromLeft'' function extracts the element out of a 'Left' and
--   throws an error if its argument is 'Right'.
--   Much like 'fromJust', using this function in polished code is usually a bad idea.
--
-- > \x -> fromLeft' (Left  x) == x
-- > \x -> fromLeft' (Right x) == undefined
fromLeft' :: Partial => Either l r -> l
fromLeft' :: Either l r -> l
fromLeft' (Left l
x) = l
x
fromLeft' Either l r
_ = [Char] -> l
forall a. HasCallStack => [Char] -> a
error [Char]
"fromLeft', given a Right"

-- | The 'fromRight'' function extracts the element out of a 'Right' and
--   throws an error if its argument is 'Left'.
--   Much like 'fromJust', using this function in polished code is usually a bad idea.
--
-- > \x -> fromRight' (Right x) == x
-- > \x -> fromRight' (Left  x) == undefined
fromRight' :: Partial => Either l r -> r
fromRight' :: Either l r -> r
fromRight' (Right r
x) = r
x
fromRight' Either l r
_ = [Char] -> r
forall a. HasCallStack => [Char] -> a
error [Char]
"fromRight', given a Left"


-- | Pull the value out of an 'Either' where both alternatives
--   have the same type.
--
-- > \x -> fromEither (Left x ) == x
-- > \x -> fromEither (Right x) == x
fromEither :: Either a a -> a
fromEither :: Either a a -> a
fromEither = (a -> a) -> (a -> a) -> Either a a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> a
forall a. a -> a
id a -> a
forall a. a -> a
id


-- | Given a 'Maybe', convert it to an 'Either', providing a suitable
--   value for the 'Left' should the value be 'Nothing'.
--
-- > \a b -> maybeToEither a (Just b) == Right b
-- > \a -> maybeToEither a Nothing == Left a
maybeToEither :: a -> Maybe b -> Either a b
maybeToEither :: a -> Maybe b -> Either a b
maybeToEither a
a (Just b
b) = b -> Either a b
forall a b. b -> Either a b
Right b
b
maybeToEither a
a Maybe b
Nothing = a -> Either a b
forall a b. a -> Either a b
Left a
a

-- | Given an 'Either', convert it to a 'Maybe', where 'Left' becomes 'Nothing'.
--
-- > \x -> eitherToMaybe (Left x) == Nothing
-- > \x -> eitherToMaybe (Right x) == Just x
eitherToMaybe :: Either a b -> Maybe b
eitherToMaybe :: Either a b -> Maybe b
eitherToMaybe = (a -> Maybe b) -> (b -> Maybe b) -> Either a b -> Maybe b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe b -> a -> Maybe b
forall a b. a -> b -> a
const Maybe b
forall a. Maybe a
Nothing) b -> Maybe b
forall a. a -> Maybe a
Just


-- | The 'mapLeft' function takes a function and applies it to an Either value
-- iff the value takes the form @'Left' _@.
--
-- > mapLeft show (Left 1) == Left "1"
-- > mapLeft show (Right True) == Right True
mapLeft :: (a -> c) -> Either a b -> Either c b
mapLeft :: (a -> c) -> Either a b -> Either c b
mapLeft a -> c
f = (a -> Either c b) -> (b -> Either c b) -> Either a b -> Either c b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (c -> Either c b
forall a b. a -> Either a b
Left (c -> Either c b) -> (a -> c) -> a -> Either c b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> c
f) b -> Either c b
forall a b. b -> Either a b
Right

-- | The 'mapRight' function takes a function and applies it to an Either value
-- iff the value takes the form @'Right' _@.
--
-- > mapRight show (Left 1) == Left 1
-- > mapRight show (Right True) == Right "True"
mapRight :: (b -> c) -> Either a b -> Either a c
mapRight :: (b -> c) -> Either a b -> Either a c
mapRight = (b -> c) -> Either a b -> Either a c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap