{-# LANGUAGE CPP  #-}
{-# LANGUAGE Safe #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

{- |
Copyright:  (c) 2016 Stephen Diehl
            (c) 2016-2018 Serokell
            (c) 2018-2019 Kowainik
SPDX-License-Identifier: MIT
Maintainer: Kowainik <xrom.xkov@gmail.com>

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

module Relude.Monad.Either
       ( fromLeft
       , fromRight
       , maybeToLeft
       , maybeToRight
       , leftToMaybe
       , rightToMaybe
       , whenLeft
       , whenLeft_
       , whenLeftM
       , whenLeftM_
       , whenRight
       , whenRight_
       , whenRightM
       , whenRightM_
       ) where

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

import Relude.Applicative (pure)
import Relude.Function ((.))
import Relude.Monad.Reexport (Either (..), MonadFail (..), either)
import Relude.String.Reexport (IsString (..), String)

#if MIN_VERSION_base(4,10,0)
import Data.Either (fromLeft, fromRight)
#else
-- | 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 _ (Left a)  = a
fromLeft a (Right _) = 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 (Left _)  = b
fromRight _ (Right b) = b
#endif


-- $setup
-- >>> import Relude

instance IsString str => MonadFail (Either str) where
    fail :: String -> Either str a
    fail :: String -> Either str a
fail = str -> Either str a
forall a b. a -> Either a b
Left (str -> Either str a) -> (String -> str) -> String -> Either str a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> str
forall a. IsString a => String -> a
fromString

{- | 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)
{-# INLINE leftToMaybe #-}

{- | 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
{-# INLINE rightToMaybe #-}

{- | 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
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
{-# INLINE maybeToRight #-}

{- | 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
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
{-# INLINE maybeToLeft #-}

{- | Applies given action to 'Either' content if 'Left' is given and returns
the result. In case of 'Right' the default value will be returned.

>>> whenLeft "bar" (Left 42) (\a -> "success!" <$ print a)
42
"success!"

>>> whenLeft "bar" (Right 42) (\a -> "success!" <$ print a)
"bar"
-}
whenLeft :: Applicative f => a -> Either l r -> (l -> f a) -> f a
whenLeft :: a -> Either l r -> (l -> f a) -> f a
whenLeft _ (Left  l :: l
l) f :: l -> f a
f = l -> f a
f l
l
whenLeft a :: a
a (Right _) _ = a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
{-# INLINE whenLeft #-}

{- | Applies given action to 'Either' content if 'Left' is given.

>>> whenLeft_ (Right 42) putTextLn
>>> whenLeft_ (Left "foo") putTextLn
foo
-}
whenLeft_ :: Applicative f => Either l r -> (l -> f ()) -> f ()
whenLeft_ :: Either l r -> (l -> f ()) -> f ()
whenLeft_ = () -> Either l r -> (l -> f ()) -> f ()
forall (f :: * -> *) a l r.
Applicative f =>
a -> Either l r -> (l -> f a) -> f a
whenLeft ()
{-# INLINE whenLeft_ #-}

{- | Monadic version of 'whenLeft'.

>>> whenLeftM "bar" (pure $ Left 42) (\a -> "success!" <$ print a)
42
"success!"

>>> whenLeftM "bar" (pure $ Right 42) (\a -> "success!" <$ print a)
"bar"
-}
whenLeftM :: Monad m => a -> m (Either l r) -> (l -> m a) -> m a
whenLeftM :: a -> m (Either l r) -> (l -> m a) -> m a
whenLeftM a :: a
a me :: m (Either l r)
me f :: l -> m a
f = m (Either l r)
me m (Either l r) -> (Either l r -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \e :: Either l r
e -> a -> Either l r -> (l -> m a) -> m a
forall (f :: * -> *) a l r.
Applicative f =>
a -> Either l r -> (l -> f a) -> f a
whenLeft a
a Either l r
e l -> m a
f
{-# INLINE whenLeftM #-}

{- | Monadic version of 'whenLeft_'.

>>> whenLeftM_ (pure $ Right 42) putTextLn
>>> whenLeftM_ (pure $ Left "foo") putTextLn
foo
-}
whenLeftM_ :: Monad m => m (Either l r) -> (l -> m ()) -> m ()
whenLeftM_ :: m (Either l r) -> (l -> m ()) -> m ()
whenLeftM_ me :: m (Either l r)
me f :: 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
>>= \e :: 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 and returns
the result. In case of 'Left' the default value will be returned.

>>> whenRight "bar" (Left "foo") (\a -> "success!" <$ print a)
"bar"

>>> whenRight "bar" (Right 42) (\a -> "success!" <$ print a)
42
"success!"
-}
whenRight :: Applicative f => a -> Either l r -> (r -> f a) -> f a
whenRight :: a -> Either l r -> (r -> f a) -> f a
whenRight a :: a
a (Left  _) _ = a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
whenRight _ (Right r :: r
r) f :: r -> f a
f = r -> f a
f r
r
{-# INLINE whenRight #-}

{- | Applies given action to 'Either' content if 'Right' is given.

>>> whenRight_ (Left "foo") print
>>> whenRight_ (Right 42) print
42
-}
whenRight_ :: Applicative f => Either l r -> (r -> f ()) -> f ()
whenRight_ :: Either l r -> (r -> f ()) -> f ()
whenRight_ = () -> Either l r -> (r -> f ()) -> f ()
forall (f :: * -> *) a l r.
Applicative f =>
a -> Either l r -> (r -> f a) -> f a
whenRight ()
{-# INLINE whenRight_ #-}

{- | Monadic version of 'whenRight'.

>>> whenRightM "bar" (pure $ Left "foo") (\a -> "success!" <$ print a)
"bar"

>>> whenRightM "bar" (pure $ Right 42) (\a -> "success!" <$ print a)
42
"success!"
-}
whenRightM :: Monad m => a -> m (Either l r) -> (r -> m a) -> m a
whenRightM :: a -> m (Either l r) -> (r -> m a) -> m a
whenRightM a :: a
a me :: m (Either l r)
me f :: r -> m a
f = m (Either l r)
me m (Either l r) -> (Either l r -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \e :: Either l r
e -> a -> Either l r -> (r -> m a) -> m a
forall (f :: * -> *) a l r.
Applicative f =>
a -> Either l r -> (r -> f a) -> f a
whenRight a
a Either l r
e r -> m a
f
{-# INLINE whenRightM #-}

{- | Monadic version of 'whenRight_'.

>>> whenRightM_ (pure $ Left "foo") print
>>> whenRightM_ (pure $ Right 42) print
42
-}
whenRightM_ :: Monad m => m (Either l r) -> (r -> m ()) -> m ()
whenRightM_ :: m (Either l r) -> (r -> m ()) -> m ()
whenRightM_ me :: m (Either l r)
me f :: 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
>>= \e :: 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_ #-}