-- | Either
module Music.Theory.Either where

import Data.Maybe {- base -}

-- | Maybe 'Left' of 'Either'.
from_left :: Either a b -> Maybe a
from_left :: forall a b. Either a b -> Maybe a
from_left Either a b
e =
    case Either a b
e of
      Left a
x -> forall a. a -> Maybe a
Just a
x
      Either a b
_ -> forall a. Maybe a
Nothing

-- | 'fromJust' of 'from_left'
from_left_err :: Either t e -> t
from_left_err :: forall t e. Either t e -> t
from_left_err = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"from_left_err") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Either a b -> Maybe a
from_left

-- | Maybe 'Right' of 'Either'.
from_right :: Either x t -> Maybe t
from_right :: forall x t. Either x t -> Maybe t
from_right Either x t
e =
    case Either x t
e of
      Left x
_ -> forall a. Maybe a
Nothing
      Right t
r -> forall a. a -> Maybe a
Just t
r

-- | 'fromJust' of 'from_right'
from_right_err :: Either e t -> t
from_right_err :: forall e t. Either e t -> t
from_right_err = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"from_right_err") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x t. Either x t -> Maybe t
from_right

-- | Flip from right to left, ie. 'either' 'Right' 'Left'
either_swap :: Either a b -> Either b a
either_swap :: forall a b. Either a b -> Either b a
either_swap = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. b -> Either a b
Right forall a b. a -> Either a b
Left

{- | Variant of 'Data.Either.rights' that preserves first 'Left'.

> all_right (map Right [1..3]) == Right [1..3]
> all_right [Right 1,Left 'a',Left 'b'] == Left 'a'
-}
all_right :: [Either a b] -> Either a [b]
all_right :: forall a b. [Either a b] -> Either a [b]
all_right [Either a b]
x =
    case [Either a b]
x of
      [] -> forall a b. b -> Either a b
Right []
      Right b
i:[Either a b]
x' -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b
i forall a. a -> [a] -> [a]
:) (forall a b. [Either a b] -> Either a [b]
all_right [Either a b]
x')
      Left a
i:[Either a b]
_ -> forall a b. a -> Either a b
Left a
i

-- | Lower 'Either' to 'Maybe' by discarding 'Left'.
either_to_maybe :: Either a b -> Maybe b
either_to_maybe :: forall x t. Either x t -> Maybe t
either_to_maybe = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just

-- | Data.Either.isLeft, which however hugs doesn't know of.
is_left :: Either a b -> Bool
is_left :: forall a b. Either a b -> Bool
is_left Either a b
e = case Either a b
e of { Left  a
_ -> Bool
True; Right b
_ -> Bool
False }

-- | Data.Either.isRight, which however hugs doesn't know of.
is_right :: Either a b -> Bool
is_right :: forall a b. Either a b -> Bool
is_right Either a b
e = case Either a b
e of { Left  a
_ -> Bool
False; Right b
_ -> Bool
True }

-- | Data.Either.partitionEithers, which however hugs doesn't know of.
partition_eithers :: [Either a b] -> ([a],[b])
partition_eithers :: forall a b. [Either a b] -> ([a], [b])
partition_eithers =
  let left :: a -> ([a], b) -> ([a], b)
left  a
a ~([a]
l, b
r) = (a
aforall a. a -> [a] -> [a]
:[a]
l, b
r)
      right :: a -> (a, [a]) -> (a, [a])
right a
a ~(a
l, [a]
r) = (a
l, a
aforall a. a -> [a] -> [a]
:[a]
r)
  in forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {a} {b}. a -> ([a], b) -> ([a], b)
left forall {a} {a}. a -> (a, [a]) -> (a, [a])
right) ([],[])