{-# LANGUAGE Safe #-}

-- | Utilites to work with @Either@ data type.

module Universum.Monad.Either
       ( fromLeft
       , fromRight
       , maybeToLeft
       , maybeToRight
       , leftToMaybe
       , rightToMaybe
       , whenLeft
       , whenLeftM
       , whenRight
       , whenRightM
       ) where

import Control.Applicative (Applicative)
import Control.Monad (Monad (..))
import Data.Function (const)
import Data.Maybe (Maybe (..), maybe)

import Universum.Applicative (pass)
import Universum.Monad.Reexport (Either (..), either)

-- $setup
-- >>> import Universum.Bool (Bool (..))

-- | Extracts value from 'Left' or return given default value.
--
-- >>> fromLeft 0 (Left 3)
-- 3
-- >>> fromLeft 0 (Right 5)
-- 0
fromLeft :: a -> Either a b -> a
fromLeft :: a -> Either a b -> a
fromLeft a
_ (Left a
a)  = a
a
fromLeft a
a (Right b
_) = a
a

-- | Extracts value from 'Right' or return given default value.
--
-- >>> fromRight 0 (Left 3)
-- 0
-- >>> fromRight 0 (Right 5)
-- 5
fromRight :: b -> Either a b -> b
fromRight :: b -> Either a b -> b
fromRight b
b (Left a
_)  = b
b
fromRight b
_ (Right b
b) = b
b

-- | Maps left part of 'Either' to 'Maybe'.
--
-- >>> leftToMaybe (Left True)
-- Just True
-- >>> leftToMaybe (Right "aba")
-- Nothing
leftToMaybe :: Either l r -> Maybe l
leftToMaybe :: Either l r -> Maybe l
leftToMaybe = (l -> Maybe l) -> (r -> Maybe l) -> Either l r -> Maybe l
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either l -> Maybe l
forall a. a -> Maybe a
Just (Maybe l -> r -> Maybe l
forall a b. a -> b -> a
const Maybe l
forall a. Maybe a
Nothing)

-- | Maps right part of 'Either' to 'Maybe'.
--
-- >>> rightToMaybe (Left True)
-- Nothing
-- >>> rightToMaybe (Right "aba")
-- Just "aba"
rightToMaybe :: Either l r -> Maybe r
rightToMaybe :: Either l r -> Maybe r
rightToMaybe = (l -> Maybe r) -> (r -> Maybe r) -> Either l r -> Maybe r
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe r -> l -> Maybe r
forall a b. a -> b -> a
const Maybe r
forall a. Maybe a
Nothing) r -> Maybe r
forall a. a -> Maybe a
Just

-- | Maps 'Maybe' to 'Either' wrapping default value into 'Left'.
--
-- >>> maybeToRight True (Just "aba")
-- Right "aba"
-- >>> maybeToRight True Nothing
-- Left True
maybeToRight :: l -> Maybe r -> Either l r
maybeToRight :: l -> Maybe r -> Either l r
maybeToRight l
l = Either l r -> (r -> Either l r) -> Maybe r -> Either l r
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (l -> Either l r
forall a b. a -> Either a b
Left l
l) r -> Either l r
forall a b. b -> Either a b
Right

-- | Maps 'Maybe' to 'Either' wrapping default value into 'Right'.
--
-- >>> maybeToLeft True (Just "aba")
-- Left "aba"
-- >>> maybeToLeft True Nothing
-- Right True
maybeToLeft :: r -> Maybe l -> Either l r
maybeToLeft :: r -> Maybe l -> Either l r
maybeToLeft r
r = Either l r -> (l -> Either l r) -> Maybe l -> Either l r
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (r -> Either l r
forall a b. b -> Either a b
Right r
r) l -> Either l r
forall a b. a -> Either a b
Left

-- | Applies given action to 'Either' content if 'Left' is given.
whenLeft :: Applicative f => Either l r -> (l -> f ()) -> f ()
whenLeft :: Either l r -> (l -> f ()) -> f ()
whenLeft (Left  l
l) l -> f ()
f = l -> f ()
f l
l
whenLeft (Right r
_) l -> f ()
_ = f ()
forall (f :: * -> *). Applicative f => f ()
pass
{-# INLINE whenLeft #-}

-- | Monadic version of 'whenLeft'.
whenLeftM :: Monad m => m (Either l r) -> (l -> m ()) -> m ()
whenLeftM :: m (Either l r) -> (l -> m ()) -> m ()
whenLeftM m (Either l r)
me l -> m ()
f = m (Either l r)
me m (Either l r) -> (Either l r -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Either l r
e -> Either l r -> (l -> m ()) -> m ()
forall (f :: * -> *) l r.
Applicative f =>
Either l r -> (l -> f ()) -> f ()
whenLeft Either l r
e l -> m ()
f
{-# INLINE whenLeftM #-}

-- | Applies given action to 'Either' content if 'Right' is given.
whenRight :: Applicative f => Either l r -> (r -> f ()) -> f ()
whenRight :: Either l r -> (r -> f ()) -> f ()
whenRight (Left  l
_) r -> f ()
_ = f ()
forall (f :: * -> *). Applicative f => f ()
pass
whenRight (Right r
r) r -> f ()
f = r -> f ()
f r
r
{-# INLINE whenRight #-}

-- | Monadic version of 'whenRight'.
whenRightM :: Monad m => m (Either l r) -> (r -> m ()) -> m ()
whenRightM :: m (Either l r) -> (r -> m ()) -> m ()
whenRightM m (Either l r)
me r -> m ()
f = m (Either l r)
me m (Either l r) -> (Either l r -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Either l r
e -> Either l r -> (r -> m ()) -> m ()
forall (f :: * -> *) l r.
Applicative f =>
Either l r -> (r -> f ()) -> f ()
whenRight Either l r
e r -> m ()
f
{-# INLINE whenRightM #-}