{-# language CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Either.Combinators
-- Copyright   :  (c) 2010-2014 Gregory Crosswhite, Chris Done, Edward Kmett
-- License     :  BSD-style
--
-- Maintainer  :  ekmett@gmail.com
-- Stability   :  provisional
-- Portability :  portable
--
-- Functions for probing and unwrapping values inside of 'Either'.
--
-- Most of these combinators are provided for pedagogical purposes and exist
-- in more general forms in other libraries. To that end alternative definitions
-- are supplied below.
--
-----------------------------------------------------------------------------

module Data.Either.Combinators
  ( isLeft
  , isRight
  , fromLeft
  , fromRight
  , fromLeft'
  , fromRight'
  , mapBoth
  , mapLeft
  , mapRight
  , whenLeft
  , whenRight
  , unlessLeft
  , unlessRight
  , leftToMaybe
  , rightToMaybe
  , maybeToLeft
  , maybeToRight
  , eitherToError
  , swapEither
  ) where

#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif
import Control.Monad.Error.Class ( MonadError(throwError) )

-- ---------------------------------------------------------------------------
-- Functions over Either

-- |The 'isLeft' function returns 'True' iff its argument is of the form @'Left' _@.
--
-- Using @Control.Lens@:
--
-- @
-- 'isLeft' ≡ has _Left
-- @
--
-- >>> isLeft (Left 12)
-- True
--
-- >>> isLeft (Right 12)
-- False
isLeft :: Either a b -> Bool
isLeft :: forall a b. Either a b -> Bool
isLeft (Left a
_) = Bool
True
isLeft Either a b
_        = Bool
False

-- |The 'isRight' function returns 'True' iff its argument is of the form @'Right' _@.
--
-- Using @Control.Lens@:
--
-- @
-- 'isRight' ≡ has _Right
-- @
--
-- >>> isRight (Left 12)
-- False
--
-- >>> isRight (Right 12)
-- True
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 its argument take the form  @'Right' _@.
--
-- Using @Control.Lens@:
--
-- @
-- 'fromLeft'' x ≡ x^?!_Left
-- @
--
-- >>> fromLeft' (Left 12)
-- 12
fromLeft' :: Either a b -> a
fromLeft' :: forall a b. Either a b -> a
fromLeft' (Right b
_) = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Data.Either.Combinators.fromLeft' encountered a value of form 'Right _', consider using Data.Either.Combinators.fromLeft with a default value." -- yuck
fromLeft' (Left a
x)  = a
x

-- | Extracts the element out of a 'Right' and
-- throws an error if its argument take the form @'Left' _@.
--
-- Using @Control.Lens@:
--
-- @
-- 'fromRight'' x ≡ x^?!_Right
-- @
--
-- >>> fromRight' (Right 12)
-- 12
fromRight' :: Either a b -> b
fromRight' :: forall a b. Either a b -> b
fromRight' (Left a
_)  = [Char] -> b
forall a. HasCallStack => [Char] -> a
error [Char]
"Data.Either.Combinators.fromRight' encountered a value of form 'Left _', consider using Data.Either.Combinators.fromRight with a default value." -- yuck
fromRight' (Right b
x) = b
x

-- | The 'mapBoth' function takes two functions and applies the first if iff the value
-- takes the form @'Left' _@ and the second if the value takes the form @'Right' _@.
--
-- Using @Data.Bifunctor@:
--
-- @
-- 'mapBoth' = bimap
-- @
--
-- Using @Control.Arrow@:
--
-- @
-- 'mapBoth' = ('Control.Arrow.+++')
-- @
--
-- >>> mapBoth (*2) (*3) (Left 4)
-- Left 8
--
-- >>> mapBoth (*2) (*3) (Right 4)
-- Right 12
mapBoth :: (a -> c) -> (b -> d) -> Either a b -> Either c d
mapBoth :: forall a c b d. (a -> c) -> (b -> d) -> Either a b -> Either c d
mapBoth a -> c
f b -> d
_ (Left a
x)  = c -> Either c d
forall a b. a -> Either a b
Left (a -> c
f a
x)
mapBoth a -> c
_ b -> d
f (Right b
x) = d -> Either c d
forall a b. b -> Either a b
Right (b -> d
f b
x)

-- | The 'mapLeft' function takes a function and applies it to an Either value
-- iff the value takes the form @'Left' _@.
--
-- Using @Data.Bifunctor@:
--
-- @
-- 'mapLeft' = first
-- @
--
-- Using @Control.Arrow@:
--
-- @
-- 'mapLeft' = ('Control.Arrow.left')
-- @
--
-- Using @Control.Lens@:
--
-- @
-- 'mapLeft' = over _Left
-- @
--
-- >>> mapLeft (*2) (Left 4)
-- Left 8
--
-- >>> mapLeft (*2) (Right "hello")
-- Right "hello"
mapLeft :: (a -> c) -> Either a b -> Either c b
mapLeft :: forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft a -> c
f = (a -> c) -> (b -> b) -> Either a b -> Either c b
forall a c b d. (a -> c) -> (b -> d) -> Either a b -> Either c d
mapBoth a -> c
f b -> b
forall a. a -> a
id

-- | The 'mapRight' function takes a function and applies it to an Either value
-- iff the value takes the form @'Right' _@.
--
-- Using @Data.Bifunctor@:
--
-- @
-- 'mapRight' = second
-- @
--
-- Using @Control.Arrow@:
--
-- @
-- 'mapRight' = ('Control.Arrow.right')
-- @
--
-- Using @Control.Lens@:
--
-- @
-- 'mapRight' = over _Right
-- @
--
-- >>> mapRight (*2) (Left "hello")
-- Left "hello"
--
-- >>> mapRight (*2) (Right 4)
-- Right 8
mapRight :: (b -> c) -> Either a b -> Either a c
mapRight :: forall b c a. (b -> c) -> Either a b -> Either a c
mapRight = (a -> a) -> (b -> c) -> Either a b -> Either a c
forall a c b d. (a -> c) -> (b -> d) -> Either a b -> Either c d
mapBoth a -> a
forall a. a -> a
id

-- | The 'whenLeft' function takes an 'Either' value and a function which returns a monad.
-- The monad is only executed when the given argument takes the form @'Left' _@, otherwise
-- it does nothing.
--
-- Using @Control.Lens@:
--
-- @
-- 'whenLeft' ≡ forOf_ _Left
-- @
--
-- >>> whenLeft (Left 12) print
-- 12
whenLeft :: Applicative m => Either a b -> (a -> m ()) -> m ()
whenLeft :: forall (m :: * -> *) a b.
Applicative m =>
Either a b -> (a -> m ()) -> m ()
whenLeft (Left a
x) a -> m ()
f = a -> m ()
f a
x
whenLeft Either a b
_        a -> m ()
_ = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | The 'whenRight' function takes an 'Either' value and a function which returns a monad.
-- The monad is only executed when the given argument takes the form @'Right' _@, otherwise
-- it does nothing.
--
-- Using @Data.Foldable@:
--
-- @
-- 'whenRight' ≡ 'forM_'
-- @
--
-- Using @Control.Lens@:
--
-- @
-- 'whenRight' ≡ forOf_ _Right
-- @
--
-- >>> whenRight (Right 12) print
-- 12
whenRight :: Applicative m => Either a b -> (b -> m ()) -> m ()
whenRight :: forall (m :: * -> *) a b.
Applicative m =>
Either a b -> (b -> m ()) -> m ()
whenRight (Right b
x) b -> m ()
f = b -> m ()
f b
x
whenRight Either a b
_         b -> m ()
_ = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | A synonym of 'whenRight'.
unlessLeft :: Applicative m => Either a b -> (b -> m ()) -> m ()
unlessLeft :: forall (m :: * -> *) a b.
Applicative m =>
Either a b -> (b -> m ()) -> m ()
unlessLeft = Either a b -> (b -> m ()) -> m ()
forall (m :: * -> *) a b.
Applicative m =>
Either a b -> (b -> m ()) -> m ()
whenRight

-- | A synonym of 'whenLeft'.
unlessRight :: Applicative m => Either a b -> (a -> m ()) -> m ()
unlessRight :: forall (m :: * -> *) a b.
Applicative m =>
Either a b -> (a -> m ()) -> m ()
unlessRight = Either a b -> (a -> m ()) -> m ()
forall (m :: * -> *) a b.
Applicative m =>
Either a b -> (a -> m ()) -> m ()
whenLeft

-- | Extract the left value or a default.
--
-- @
-- 'fromLeft' b ≡ 'either' 'id' ('const' b)
-- @
--
-- >>> fromLeft "hello" (Right 42)
-- "hello"
--
-- >>> fromLeft "hello" (Left "world")
-- "world"
fromLeft :: a -> Either a b -> a
fromLeft :: forall a b. a -> Either a b -> a
fromLeft a
_ (Left a
x) = a
x
fromLeft a
x Either a b
_ = a
x

-- | Extract the right value or a default.
--
-- @
-- 'fromRight' b ≡ 'either' ('const' b) 'id'
-- @
--
-- >>> fromRight "hello" (Right "world")
-- "world"
--
-- >>> fromRight "hello" (Left 42)
-- "hello"
fromRight :: b -> Either a b -> b
fromRight :: forall b a. b -> Either a b -> b
fromRight b
_ (Right b
x) = b
x
fromRight b
x Either a b
_ = b
x

-- | Maybe get the 'Left' side of an 'Either'.
--
-- @
-- 'leftToMaybe' ≡ 'either' 'Just' ('const' 'Nothing')
-- @
--
-- Using @Control.Lens@:
--
-- @
-- 'leftToMaybe' ≡ preview _Left
-- 'leftToMaybe' x ≡ x^?_Left
-- @
--
-- >>> leftToMaybe (Left 12)
-- Just 12
--
-- >>> leftToMaybe (Right 12)
-- Nothing
leftToMaybe :: Either a b -> Maybe a
leftToMaybe :: forall a b. Either a b -> Maybe a
leftToMaybe = (a -> Maybe a) -> (b -> Maybe a) -> Either a b -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Maybe a
forall a. a -> Maybe a
Just (Maybe a -> b -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing)

-- | Maybe get the 'Right' side of an 'Either'.
--
-- @
-- 'rightToMaybe' ≡ 'either' ('const' 'Nothing') 'Just'
-- @
--
-- Using @Control.Lens@:
--
-- @
-- 'rightToMaybe' ≡ preview _Right
-- 'rightToMaybe' x ≡ x^?_Right
-- @
--
-- >>> rightToMaybe (Left 12)
-- Nothing
--
-- >>> rightToMaybe (Right 12)
-- Just 12
rightToMaybe :: Either a b -> Maybe b
rightToMaybe :: forall a b. Either a b -> Maybe b
rightToMaybe = (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

-- | Maybe produce a 'Left', otherwise produce a 'Right'.
--
-- >>> maybeToLeft "default" (Just 12)
-- Left 12
--
-- >>> maybeToLeft "default" Nothing
-- Right "default"
maybeToLeft :: b -> Maybe a -> Either a b
maybeToLeft :: forall b a. b -> Maybe a -> Either a b
maybeToLeft b
_ (Just a
x) = a -> Either a b
forall a b. a -> Either a b
Left a
x
maybeToLeft b
y Maybe a
Nothing  = b -> Either a b
forall a b. b -> Either a b
Right b
y

-- | Maybe produce a 'Right', otherwise produce a 'Left'.
--
-- >>> maybeToRight "default" (Just 12)
-- Right 12
--
-- >>> maybeToRight "default" Nothing
-- Left "default"
maybeToRight :: b -> Maybe a -> Either b a
maybeToRight :: forall b a. b -> Maybe a -> Either b a
maybeToRight b
_ (Just a
x) = a -> Either b a
forall a b. b -> Either a b
Right a
x
maybeToRight b
y Maybe a
Nothing  = b -> Either b a
forall a b. a -> Either a b
Left b
y

-- | Generalize @Either e@ as @MonadError e m@.
--
-- If the argument has form @Left e@, an error is produced in the monad via
-- 'throwError'. Otherwise, the @Right a@ part is forwarded.
eitherToError :: (MonadError e m) => Either e a -> m a
eitherToError :: forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
eitherToError = (e -> m a) -> (a -> m a) -> Either e a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> m a
forall a. e -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Swap the 'Left' and 'Right' sides of an 'Either'.
--
-- >>> swapEither (Right 3)
-- Left 3
--
-- >>> swapEither (Left "error")
-- Right "error"
swapEither :: Either e a -> Either a e
swapEither :: forall e a. Either e a -> Either a e
swapEither = (e -> Either a e) -> (a -> Either a e) -> Either e a -> Either a e
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> Either a e
forall a b. b -> Either a b
Right a -> Either a e
forall a b. a -> Either a b
Left
{-# INLINE swapEither #-}