module Control.Monad.Either.Plus
( EitherP (..)
, eitherP, emap
, leftP, rightP
) where
import Control.Applicative ((<$>), Applicative (..), Alternative (..))
import Control.Monad (MonadPlus (..))
import Data.Monoid (Monoid (..), (<>))
newtype EitherP e a = EitherP { unEitherP :: Either e a }
eitherP :: (a -> c) -> (b -> c) -> EitherP a b -> c
eitherP f g = either f g . unEitherP
emap :: (e0 -> e1) -> EitherP e0 a -> EitherP e1 a
emap f = EitherP . eitherP (Left . f) Right
leftP :: e -> EitherP e a
leftP = EitherP . Left
rightP :: a -> EitherP e a
rightP = EitherP . Right
instance Functor (EitherP e) where
fmap f (EitherP e) = EitherP $ f <$> e
instance Applicative (EitherP e) where
pure = EitherP . pure
EitherP a <*> EitherP b = EitherP $ a <*> b
instance Monad (EitherP e) where
(EitherP e) >>= f = EitherP (e >>= unEitherP . f)
return = EitherP . return
instance Monoid e => Alternative (EitherP e) where
empty = EitherP $ Left mempty
EitherP a <|> EitherP b = EitherP $ a `plus` b where
x@(Right _) `plus` _ = x
Left _ `plus` y@(Right _) = y
Left e1 `plus` Left e2 = Left $ e1 <> e2
instance Monoid e => MonadPlus (EitherP e) where
mzero = empty
mplus = (<|>)