{- |
Module      : Antelude.Either
Description : Contains some functions for Eithers.
Maintainer  : dneavesdev@pm.me
-}
module Antelude.Either
    ( Either (..)
      -- * Rexports
    , Either.either
    , Either.isLeft
    , Either.isRight
      -- * New and Reconstructed for safety
    , filterLefts
    , filterRights
    , fromMaybe
    , fromResult
    , leftWithDefault
    , mapLeft
    , mapRight
    , partition
    , rightWithDefault
    , swap
    ) where

import safe           Antelude.Internal.TypesClasses
    ( Either (..)
    , List
    , Maybe (..)
    , Result (..)
    )

import safe qualified Data.Either                    as Either


-- | Convert a 'Result a b' to an 'Either a b'.
fromResult :: Result err ok -> Either err ok
fromResult :: forall err ok. Result err ok -> Either err ok
fromResult = \case
  Err err
err -> err -> Either err ok
forall a b. a -> Either a b
Left err
err
  Ok ok
ok -> ok -> Either err ok
forall a b. b -> Either a b
Right ok
ok


-- | Convert a 'Maybe a' to an 'Either () a'.
fromMaybe :: Maybe a -> Either () a
fromMaybe :: forall a. Maybe a -> Either () a
fromMaybe = \case
  Just a
a -> a -> Either () a
forall a b. b -> Either a b
Right a
a
  Maybe a
Nothing -> () -> Either () a
forall a b. a -> Either a b
Left ()


-- | Apply a function to the 'Left' case of an 'Either'.
mapLeft :: (left -> newLeft) -> Either left right -> Either newLeft right
mapLeft :: forall left newLeft right.
(left -> newLeft) -> Either left right -> Either newLeft right
mapLeft left -> newLeft
leftFn (Left left
left) = newLeft -> Either newLeft right
forall a b. a -> Either a b
Left (left -> newLeft
leftFn left
left)
mapLeft left -> newLeft
_ (Right right
right)    = right -> Either newLeft right
forall a b. b -> Either a b
Right right
right


-- | Apply a function to the 'Right' case of an 'Either'.
mapRight :: (right -> newRight) -> Either left right -> Either left newRight
mapRight :: forall right newRight left.
(right -> newRight) -> Either left right -> Either left newRight
mapRight right -> newRight
rightFn (Right right
right) = newRight -> Either left newRight
forall a b. b -> Either a b
Right (right -> newRight
rightFn right
right)
mapRight right -> newRight
_ (Left left
left)         = left -> Either left newRight
forall a b. a -> Either a b
Left left
left


-- | Swap the 'Left'/'Right' in an 'Either'
swap :: Either left right -> Either right left
swap :: forall left right. Either left right -> Either right left
swap (Left left
a)  = left -> Either right left
forall a b. b -> Either a b
Right left
a
swap (Right right
a) = right -> Either right left
forall a b. a -> Either a b
Left right
a


-- | Get the 'Left' case of an 'Either', or a default if the 'Either' is 'Right'.
leftWithDefault :: a -> Either a b -> a
leftWithDefault :: forall a b. a -> Either a b -> a
leftWithDefault a
dflt = \case
  Left a
a -> a
a
  Right b
_ -> a
dflt


-- | Get the 'Right' case of an 'Either', or a default if the 'Either' is 'Left'.
rightWithDefault :: b -> Either a b -> b
rightWithDefault :: forall b a. b -> Either a b -> b
rightWithDefault b
dflt = \case
  Left a
_ -> b
dflt
  Right b
b -> b
b


-- | Take a 'List' of 'Either left right' and create a Tuple with 'List left' and 'List right'.
partition :: List (Either left right) -> (List left, List right)
partition :: forall left right.
List (Either left right) -> (List left, List right)
partition = [Either left right] -> ([left], [right])
forall left right.
List (Either left right) -> (List left, List right)
Either.partitionEithers


-- | Take a 'List' of 'Either a b' and return a 'List' containing all of the values from the 'Left' cases.
filterLefts :: List (Either left right) -> List left
filterLefts :: forall left right. List (Either left right) -> List left
filterLefts = [Either left right] -> [left]
forall left right. List (Either left right) -> List left
Either.lefts


-- | Take a 'List' of 'Either a b' and return a 'List' containing all of the values from the 'Right' cases.
filterRights :: List (Either left right) -> List right
filterRights :: forall left right. List (Either left right) -> List right
filterRights = [Either left right] -> [right]
forall left right. List (Either left right) -> List right
Either.rights