choirMail/app/Monad.hs

{-# LANGUAGE GeneralisedNewtypeDeriving #-}
module Monad(
    App
  ,module Control.Monad.Fail
  ,module Control.Monad.IO.Class
  ,handleE
  ,catchE
  ,throwE
  ,except
  ,runApp
  ) where
  
import qualified Control.Monad.Trans.Except as T
import Control.Monad.Fail
import Control.Monad.IO.Class


-- We need this type isomorphism, because we want a different
-- MonadFail implementation, if someone knows how to do this
-- without writing the isomorphism out explicitly for all
-- the other instances, (or without scary GeneralisedNewtypeDeriving)
--  I would be happy
newtype App a = App { runApp' :: T.ExceptT String IO a}
  deriving (Functor, Applicative, Monad, MonadIO)

instance MonadFail App where
  fail = throwE

-- reimplementing ExceptT interface
-- I would love not to have to do this but I don't know how
throwE :: String -> App a
throwE = App . T.throwE

catchE :: App a -> (String -> App a) -> App a
catchE a f = do
  result <- liftIO $ runApp a
  case result of
    Left err  -> f err
    Right res -> return res

handleE :: (String -> App a) -> App a -> App a
handleE = flip catchE

except :: Either String a -> App a
except = App . T.except

runApp :: App a -> IO (Either String a)
runApp = T.runExceptT . runApp'