Bring back GhcMod but this time it's a GhcModT with an ErrorT inside

Language/Haskell/GhcMod/Monad.hs

@@ -1,10 +1,14 @@
 {-# LANGUAGE CPP, GeneralizedNewtypeDeriving, FlexibleInstances #-}
 {-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, RankNTypes #-}
 {-# LANGUAGE TypeFamilies, UndecidableInstances, RecordWildCards #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Language.Haskell.GhcMod.Monad (
-   GhcModT
+   GhcMod
+ , runGhcMod
+ , liftGhcMod
+ , GhcModT
  , IOish
  , GhcModEnv(..)
  , GhcModWriter
@@ -16,6 +20,8 @@ module Language.Haskell.GhcMod.Monad (
  , toGhcMod
  , options
  , cradle
+ , Options(..)
+ , defaultOptions
  , module Control.Monad.Reader.Class
  , module Control.Monad.Writer.Class
  , module Control.Monad.State.Class
@@ -54,6 +60,7 @@ import Data.Monoid (Monoid)
 import Control.Applicative (Alternative)
 import Control.Monad (MonadPlus, liftM, void)
 import Control.Monad.Base (MonadBase, liftBase)
+import Control.Monad.Trans.RWS.Lazy (liftCatch)
 
 import Control.Monad.Reader.Class
 import Control.Monad.State.Class
@@ -62,6 +69,7 @@ import Control.Monad.Trans.Control (MonadBaseControl(..), StM, liftBaseWith,
   control, liftBaseOp, liftBaseOp_)
 import Control.Monad.Trans.RWS.Lazy (RWST(..), runRWST)
 import Control.Monad.Writer.Class
+import Control.Monad.Error
 
 import Data.Maybe (fromJust, isJust)
 import Data.IORef (IORef, readIORef, writeIORef, newIORef)
@@ -77,17 +85,29 @@ data GhcModEnv = GhcModEnv {
     , gmCradle     :: Cradle
     }
 
-data GhcModState = GhcModState
+data GhcModState = GhcModState deriving (Eq,Show,Read)
 
 defaultState :: GhcModState
 defaultState = GhcModState
 
 type GhcModWriter = ()
 
+data GhcModError = GMENoMsg
+                 | GMEString String
+                 | GMECabal
+                 | GMEGhc
+                   deriving (Eq,Show,Read)
+
+instance Error GhcModError where
+    noMsg = GMENoMsg
+    strMsg = GMEString
+
 ----------------------------------------------------------------
 
 type IOish m = (Functor m, MonadIO m, MonadBaseControl IO m)
 
+type GhcMod a = GhcModT (ErrorT GhcModError IO) a
+
 newtype GhcModT m a = GhcModT {
       unGhcModT :: RWST GhcModEnv GhcModWriter GhcModState m a
     } deriving (Functor
@@ -102,6 +122,8 @@ newtype GhcModT m a = GhcModT {
                , MonadTrans
                )
 
+deriving instance MonadError GhcModError m => MonadError GhcModError (GhcModT m)
+
 #if __GLASGOW_HASKELL__ < 708
 instance (Monoid w, MonadIO m) => MonadIO (RWST r w s m) where
 --  liftIO :: MonadIO m => IO a -> m a
@@ -154,15 +176,6 @@ initSession build Options {..} CompilerOptions {..} = do
 
 ----------------------------------------------------------------
 
-runGhcModT' :: IOish m
-           => GhcModEnv
-           -> GhcModState
-           -> GhcModT m a
-           -> m (a,(GhcModState, GhcModWriter))
-runGhcModT' r s a = do
-  (a',s',w) <- runRWST (unGhcModT $ initGhcMonad (Just libdir) >> a) r s
-  return (a',(s',w))
-
 newGhcModEnv :: Options -> FilePath -> IO GhcModEnv
 newGhcModEnv opt dir = do
       session <- newIORef (error "empty session")
@@ -173,6 +186,9 @@ newGhcModEnv opt dir = do
         , gmCradle = c
         }
 
+-- | Run a @GhcModT m@ computation, i.e. one with a custom underlying monad.
+--
+-- You probably don't want this, look at 'runGhcMod' instead.
 runGhcModT :: IOish m => Options -> GhcModT m a -> m a
 runGhcModT opt action = do
     env <- liftBase $ newGhcModEnv opt =<< getCurrentDirectory
@@ -182,6 +198,38 @@ runGhcModT opt action = do
             initializeFlagsWithCradle opt (gmCradle env)
             action
     return a
+
+-- | Run a computation inside @GhcModT@ providing the RWST environment and
+-- initial state. This is a low level function, use it only if you know what to
+-- do with 'GhcModEnv' and 'GhcModState'.
+--
+-- You should probably look at 'runGhcModT' instead.
+runGhcModT' :: IOish m
+           => GhcModEnv
+           -> GhcModState
+           -> GhcModT m a
+           -> m (a,(GhcModState, GhcModWriter))
+runGhcModT' r s a = do
+  (a',s',w) <- runRWST (unGhcModT $ initGhcMonad (Just libdir) >> a) r s
+  return (a',(s',w))
+
+-- | Run a 'GhcMod' computation. If you want an underlying monad other than
+-- 'ErrorT e IO' you should look at 'runGhcModT'
+runGhcMod :: Options
+          -> GhcMod a
+          -> IO (Either GhcModError a)
+runGhcMod o a =
+  runErrorT $ runGhcModT o a
+
+liftErrorT :: IOish m => GhcModT m a -> GhcModT (ErrorT GhcModError m) a
+liftErrorT action =
+    GhcModT $ RWST $ \e s -> ErrorT $ Right <$> (runRWST $ unGhcModT action) e s
+
+-- | Lift @(GhcModT IO)@ into @GhcMod@, which is an alias for @GhcModT (ErrorT
+-- GhcModError IO)@.
+liftGhcMod :: GhcModT IO a -> GhcMod a
+liftGhcMod = liftErrorT
+
 ----------------------------------------------------------------
 
 withErrorHandler :: IOish m => String -> GhcModT m a -> GhcModT m a
@@ -212,7 +260,7 @@ instance (MonadBaseControl IO m) => MonadBase IO (GhcModT m) where
 
 instance (MonadBaseControl IO m) => MonadBaseControl IO (GhcModT m) where
     newtype StM (GhcModT m) a = StGhcMod {
-          unStGhcMod :: StM (RWST GhcModEnv () GhcModState m) a }
+          unStGhcMod :: StM (RWST GhcModEnv GhcModWriter GhcModState m) a }
 
     liftBaseWith f = GhcModT . liftBaseWith $ \runInBase ->
         f $ liftM StGhcMod . runInBase . unGhcModT