module Data.Either.Projections (
EitherProjection (toEither, toMaybe)
, LeftProjection, LeftProjection'
, RightProjection
, leftProjection, rightProjection
, mergeEither
) where
import Data.Typeable
class EitherProjection proj left right side | proj -> left
, proj -> right
, proj -> side
where toEither :: proj -> Either left right
toMaybe :: proj -> Maybe side
type LeftProjection l r = LeftProjection' r l
data LeftProjection' r l = LeftProjection l | LeftNothing r
deriving (Eq, Ord, Read, Show, Typeable)
data RightProjection l r = RightProjection r | RightNothing l
deriving (Eq, Ord, Read, Show, Typeable)
leftProjection :: Either l r -> LeftProjection l r
leftProjection x = case x of Left l -> LeftProjection l
Right r -> LeftNothing r
rightProjection :: Either l r -> RightProjection l r
rightProjection x = case x of Right r -> RightProjection r
Left l -> RightNothing l
instance EitherProjection (LeftProjection l r) l r l
where toEither (LeftProjection l) = Left l
toEither (LeftNothing r) = Right r
toMaybe (LeftProjection l) = Just l
toMaybe _ = Nothing
instance EitherProjection (RightProjection l r) l r r
where toEither (RightProjection r) = Right r
toEither (RightNothing l) = Left l
toMaybe (RightProjection r) = Just r
toMaybe _ = Nothing
instance Functor (LeftProjection' r) where
fmap f (LeftProjection l) = LeftProjection (f l)
fmap _ (LeftNothing r) = LeftNothing r
instance Functor (RightProjection l) where
fmap f (RightProjection r) = RightProjection (f r)
fmap _ (RightNothing l) = RightNothing l
mergeEither :: Either a a -> a
mergeEither x = case x of Left l -> l
Right r -> r