EitherT.hs

{- | Extension of a monad with the 'Either' ability to interrupt a sequence of
actions and terminate with a value
-}
module Mini.Transformers.EitherT (
  -- * Type
  EitherT,

  -- * Termination
  left,

  -- * Anticipation
  anticipate,

  -- * Runners
  runEitherT,
) where

import Control.Applicative (
  Alternative (
    empty,
    (<|>)
  ),
 )
import Control.Monad (
  ap,
  liftM,
  (>=>),
 )
import Mini.Transformers.Class (
  MonadTrans (
    lift
  ),
 )

{-
 - Type
 -}

{- | A monad with early termination type /e/, inner monad /m/, and return type
/a/
-}
newtype EitherT e m a = EitherT
  { runEitherT :: m (Either e a)
  -- ^ Unwrap an 'EitherT'
  }

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

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

instance (Monad m, Monoid e) => Alternative (EitherT e m) where
  empty = EitherT . pure $ Left mempty
  m <|> n =
    EitherT $
      runEitherT m
        >>= either
          (\e -> either (Left . mappend e) Right <$> runEitherT n)
          (pure . Right)

instance (Monad m) => Monad (EitherT e m) where
  m >>= k =
    EitherT $
      runEitherT m
        >>= either
          (pure . Left)
          (runEitherT . k)

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

{-
 - Termination
 -}

-- | Terminate an action sequence with the given value
left :: (Monad m) => e -> EitherT e m a
left = EitherT . pure . Left

{-
 - Anticipation
 -}

{- | Run the given action and decide what to do depending on the return type

> anticipate foo >>= either bar baz
-}
anticipate :: (Monad m) => EitherT e m a -> EitherT e m (Either e a)
anticipate = lift . runEitherT . (Right <$>) >=> either (pure . Left) pure