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

module Protolude.Either (
  maybeToLeft
, maybeToRight
, leftToMaybe
, rightToMaybe
, maybeEmpty
, maybeToEither
, fromLeft
, fromRight
) where

import Data.Function (const)
import Data.Monoid (Monoid, mempty)
import Data.Maybe (Maybe(Nothing, Just), maybe)
import Data.Either (Either(Left, Right), either)
#if MIN_VERSION_base(4,10,0)
import Data.Either (fromLeft, fromRight)
#else
-- | Return the contents of a 'Right'-value or a default value otherwise.
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 :: b -> Either a b -> b
fromRight _ (Right b) = b
fromRight b _         = b
#endif

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)

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

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

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

maybeEmpty :: Monoid b => (a -> b) -> Maybe a -> b
maybeEmpty :: (a -> b) -> Maybe a -> b
maybeEmpty = b -> (a -> b) -> Maybe a -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
forall a. Monoid a => a
mempty

maybeToEither :: e -> Maybe a -> Either e a
maybeToEither :: e -> Maybe a -> Either e a
maybeToEither e
e Maybe a
Nothing = e -> Either e a
forall a b. a -> Either a b
Left e
e
maybeToEither e
_ (Just a
a) = a -> Either e a
forall a b. b -> Either a b
Right a
a