EitherT.hs

-- | Extend a monad with the ability to terminate a computation with a value
module Mini.Transformers.EitherT (
  -- * Type
  EitherT (
    EitherT
  ),
  runEitherT,

  -- * Operations
  eitherT,
  left,
  right,
) where

import Control.Applicative (
  Alternative,
  empty,
  (<|>),
 )
import Control.Monad (
  ap,
  liftM,
 )
import Control.Monad.IO.Class (
  MonadIO,
  liftIO,
 )
import Mini.Transformers.Class (
  MonadTrans,
  lift,
 )
import Prelude (
  Applicative,
  Either (
    Left,
    Right
  ),
  Functor,
  Monad,
  MonadFail,
  Monoid,
  either,
  fail,
  fmap,
  mappend,
  mempty,
  pure,
  ($),
  (.),
  (<*>),
  (>>=),
 )

-- Type

-- | A terminable transformer with termination /e/, inner monad /m/, return /a/
newtype EitherT e m a = EitherT
  { runEitherT :: m (Either e a)
  -- ^ Unwrap a transformer computation
  }

instance (Monad m) => Functor (EitherT e m) where
  fmap = liftM

instance (Monad m) => Applicative (EitherT e m) where
  pure = right
  (<*>) = ap

instance (Monad m, Monoid e) => Alternative (EitherT e m) where
  empty = left mempty
  m <|> n = eitherT (\e -> eitherT (left . mappend e) right n) right m

instance (Monad m) => Monad (EitherT e m) where
  m >>= k = eitherT left k m

instance MonadTrans (EitherT e) where
  lift = EitherT . fmap Right

instance (MonadFail m) => MonadFail (EitherT e m) where
  fail = EitherT . fail

instance (MonadIO m) => MonadIO (EitherT e m) where
  liftIO = lift . liftIO

-- Operations

-- | Case analysis on the result of a computation
eitherT
  :: (Monad m)
  => (e -> EitherT e' m b) -- ^ Function applied in case of @Left e@
  -> (a -> EitherT e' m b) -- ^ Function applied in case of @Right a@
  -> EitherT e m a -- ^ Object of the case analysis
  -> EitherT e' m b
eitherT l r m = EitherT $ runEitherT m >>= runEitherT . either l r

-- | Terminate the computation with a value
left :: (Applicative m) => e -> EitherT e m a
left = EitherT . pure . Left

-- | Return a value
right :: (Applicative m) => a -> EitherT e m a
right = EitherT . pure . Right