module EitherUtils where
import Data.Maybe
import Data.List(find)

type Cont c a = (a -> c) -> c

plookup :: (a -> Bool) -> t (a, b) -> Maybe b
plookup a -> Bool
p = ((a, b) -> b) -> Maybe (a, b) -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> b
forall a b. (a, b) -> b
snd (Maybe (a, b) -> Maybe b)
-> (t (a, b) -> Maybe (a, b)) -> t (a, b) -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> Bool) -> t (a, b) -> Maybe (a, b)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (a -> Bool
p(a -> Bool) -> ((a, b) -> a) -> (a, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a, b) -> a
forall a b. (a, b) -> a
fst)

-- mapfilter = Maybe.mapMaybe
-- stripMaybe = Maybe.fromJust
-- stripMaybeDef = Maybe.fromMaybe
-- isM = Maybe.isJust

--mapMaybe :: (a->b) -> Maybe a -> Maybe b
--mapMaybe = fmap

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

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

stripEither :: Either p p -> p
stripEither (Left p
a) = p
a
stripEither (Right p
b) = p
b

filterLeft :: [Either b b] -> [b]
filterLeft = (Either b b -> Maybe b) -> [Either b b] -> [b]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Either b b -> Maybe b
forall a b. Either a b -> Maybe a
stripLeft

filterRight :: [Either a b] -> [b]
filterRight = (Either a b -> Maybe b) -> [Either a b] -> [b]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Either a b -> Maybe b
forall a a. Either a a -> Maybe a
stripRight

isLeft :: Either a b -> Bool
isLeft (Left a
_) = Bool
True
isLeft Either a b
_ = Bool
False

isRight :: Either a b -> Bool
isRight (Right b
_) = Bool
True
isRight Either a b
_ = Bool
False

mapEither :: (t -> a) -> (t -> b) -> Either t t -> Either a b
mapEither t -> a
fl t -> b
fr (Left t
l) = a -> Either a b
forall a b. a -> Either a b
Left (t -> a
fl t
l)
mapEither t -> a
fl t -> b
fr (Right t
r) = b -> Either a b
forall a b. b -> Either a b
Right (t -> b
fr t
r)

swapEither :: Either b a -> Either a b
swapEither (Left b
x) = b -> Either a b
forall a b. b -> Either a b
Right b
x
swapEither (Right a
y) = a -> Either a b
forall a b. a -> Either a b
Left a
y

-- JSP 920929
splitEitherList :: [Either a a] -> ([a], [a])
splitEitherList [] = ([], [])
splitEitherList (Either a a
x : [Either a a]
xs) =
    let ([a]
lefts, [a]
rights) = [Either a a] -> ([a], [a])
splitEitherList [Either a a]
xs
    in  case Either a a
x of
          Left a
a -> (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
lefts, [a]
rights)
          Right a
a -> ([a]
lefts, a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
rights)

fromLeft :: Either a b -> a
fromLeft (Left a
x) = a
x
fromRight :: Either a b -> b
fromRight (Right b
y) = b
y