Fix a bunch of relate exception handling problems

should handle exceptions outside of runGmlT otherwise we don't catch ghc
load related ones.

Language/Haskell/GhcMod/Browse.hs

@@ -42,7 +42,7 @@ browse pkgmdl = do
       runGmPkgGhc $
         processExports opt =<< tryModuleInfo =<< G.findModule mdlname mpkgid
 
-    goHomeModule = runGmLoadedT [Right mdlname] $ do
+    goHomeModule = runGmlT [Right mdlname] $ do
       opt <- options
       processExports opt =<< tryModuleInfo =<< G.findModule mdlname Nothing
 

Language/Haskell/GhcMod/CaseSplit.hs

@@ -46,7 +46,7 @@ splits :: IOish m
        -> Int          -- ^ Column number.
        -> GhcModT m String
 splits file lineNo colNo =
-  runGmLoadedT' [Left file] deferErrors $ ghandle handler $ do
+  ghandle handler $ runGmlT' [Left file] deferErrors $ do
       opt <- options
       crdl <- cradle
       style <- getStyle

Language/Haskell/GhcMod/Check.hs

@@ -29,7 +29,7 @@ check :: IOish m
       => [FilePath]  -- ^ The target files.
       -> GhcModT m (Either String String)
 check files =
-    runGmLoadedTWith
+    runGmlTWith
       (map Left files)
       return
       ((fmap fst <$>) . withLogger (setAllWarningFlags . setNoMaxRelevantBindings))
@@ -49,7 +49,7 @@ expandTemplate files = either id id <$> expand files
 -- | Expanding Haskell Template.
 expand :: IOish m => [FilePath] -> GhcModT m (Either String String)
 expand files =
-    runGmLoadedTWith
+    runGmlTWith
       (map Left files)
       return
       ((fmap fst <$>) . withLogger (Gap.setDumpSplices . setNoWarningFlags))

Language/Haskell/GhcMod/FillSig.hs

@@ -69,7 +69,7 @@ sig :: IOish m
     -> Int          -- ^ Column number.
     -> GhcModT m String
 sig file lineNo colNo =
-    runGmLoadedT' [Left file] deferErrors $ ghandle handler $ do
+    runGmlT' [Left file] deferErrors $ ghandle fallback $ do
       opt <- options
       style <- getStyle
       dflag <- G.getSessionDynFlags
@@ -91,7 +91,7 @@ sig file lineNo colNo =
 
 
   where
-    handler (SomeException _) = do
+    fallback (SomeException _) = do
       opt <- options
       -- Code cannot be parsed by ghc module
       -- Fallback: try to get information via haskell-src-exts
@@ -332,7 +332,7 @@ refine :: IOish m
        -> Expression   -- ^ A Haskell expression.
        -> GhcModT m String
 refine file lineNo colNo expr =
-  runGmLoadedT' [Left file] deferErrors $ ghandle handler $ do
+  ghandle handler $ runGmlT' [Left file] deferErrors $ do
         opt <- options
         style <- getStyle
         dflag <- G.getSessionDynFlags
@@ -399,7 +399,7 @@ auto :: IOish m
      -> Int          -- ^ Column number.
      -> GhcModT m String
 auto file lineNo colNo =
-  runGmLoadedT' [Left file] deferErrors $ ghandle handler $ do
+  ghandle handler $ runGmlT' [Left file] deferErrors $ do
         opt <- options
         style <- getStyle
         dflag <- G.getSessionDynFlags

Language/Haskell/GhcMod/Info.hs

@@ -3,7 +3,7 @@ module Language.Haskell.GhcMod.Info (
   , types
   ) where
 
-import Control.Applicative ((<$>))
+import Control.Applicative
 import Data.Function (on)
 import Data.List (sortBy)
 import Data.Maybe (catMaybes)
@@ -29,14 +29,14 @@ info :: IOish m
      => FilePath     -- ^ A target file.
      -> Expression   -- ^ A Haskell expression.
      -> GhcModT m String
-info file expr = runGmLoadedT' [Left file] deferErrors $ withContext $ do
+info file expr =
-    opt <- options
+    ghandle handler $ runGmlT' [Left file] deferErrors $ withContext $
-    convert opt <$> ghandle handler body
+      convert <$> options <*> body
   where
     handler (SomeException ex) = do
         gmLog GmException "info" $
                 text "" $$ nest 4 (showDoc ex)
-        return "Cannot show info"
+        convert' "Cannot show info"
 
     body = do
         sdoc <- Gap.infoThing expr
@@ -54,7 +54,7 @@ types :: IOish m
       -> Int          -- ^ Column number.
       -> GhcModT m String
 types file lineNo colNo =
-    runGmLoadedT' [Left file] deferErrors $ ghandle handler $ withContext $ do
+    ghandle handler $ runGmlT' [Left file] deferErrors $ withContext $ do
         crdl <- cradle
         modSum <- Gap.fileModSummary (cradleCurrentDir crdl </> file)
         srcSpanTypes <- getSrcSpanType modSum lineNo colNo

Language/Haskell/GhcMod/Monad.hs

@@ -20,9 +20,9 @@ module Language.Haskell.GhcMod.Monad (
   , runGhcModT'
   , runGhcModT''
   , hoistGhcModT
-  , runGmLoadedT
+  , runGmlT
-  , runGmLoadedT'
+  , runGmlT'
-  , runGmLoadedTWith
+  , runGmlTWith
   , runGmPkgGhc
   , withGhcModEnv
   , withGhcModEnv'

Language/Haskell/GhcMod/Monad/Types.hs

@@ -23,7 +23,7 @@
 module Language.Haskell.GhcMod.Monad.Types (
   -- * Monad Types
     GhcModT(..)
-  , GmLoadedT(..)
+  , GmlT(..)
   , LightGhc(..)
   , GmGhc
   , IOish
@@ -164,7 +164,7 @@ newtype GhcModT m a = GhcModT {
                , MonadError GhcModError
                )
 
-newtype GmLoadedT m a = GmLoadedT { unGmLoadedT :: GhcModT m a }
+newtype GmlT m a = GmlT { unGmlT :: GhcModT m a }
     deriving ( Functor
              , Applicative
              , Alternative
@@ -307,20 +307,20 @@ instance MonadIO m => MonadIO (MaybeT m) where
     liftIO = lift . liftIO
 #endif
 
-instance (MonadBaseControl IO m) => MonadBase IO (GmLoadedT m) where
+instance (MonadBaseControl IO m) => MonadBase IO (GmlT m) where
-    liftBase = GmLoadedT . liftBase
+    liftBase = GmlT . liftBase
 
-instance (MonadBaseControl IO m) => MonadBaseControl IO (GmLoadedT m) where
+instance (MonadBaseControl IO m) => MonadBaseControl IO (GmlT m) where
-    type StM (GmLoadedT m) a = StM (GhcModT m) a
+    type StM (GmlT m) a = StM (GhcModT m) a
     liftBaseWith = defaultLiftBaseWith
     restoreM = defaultRestoreM
     {-# INLINE liftBaseWith #-}
     {-# INLINE restoreM #-}
 
-instance MonadTransControl GmLoadedT where
+instance MonadTransControl GmlT where
-    type StT GmLoadedT a = StT GhcModT a
+    type StT GmlT a = StT GhcModT a
-    liftWith = defaultLiftWith GmLoadedT unGmLoadedT
+    liftWith = defaultLiftWith GmlT unGmlT
-    restoreT = defaultRestoreT GmLoadedT
+    restoreT = defaultRestoreT GmlT
 
 instance (MonadBaseControl IO m) => MonadBase IO (GhcModT m) where
     liftBase = GhcModT . liftBase
@@ -366,7 +366,7 @@ gmLiftWithInner f = liftWith f >>= restoreT . return
 
 type GmGhc m = (IOish m, GhcMonad m)
 
-instance (MonadIO m, MonadBaseControl IO m) => GhcMonad (GmLoadedT m) where
+instance (MonadIO m, MonadBaseControl IO m) => GhcMonad (GmlT m) where
     getSession = do
         ref <- gmgsSession . fromJust . gmGhcSession <$> gmsGet
         liftIO $ readIORef ref
@@ -379,7 +379,7 @@ instance GhcMonad LightGhc where
     setSession a = (liftIO . flip writeIORef a) =<< LightGhc ask
 
 #if __GLASGOW_HASKELL__ >= 706
-instance (MonadIO m, MonadBaseControl IO m) => HasDynFlags (GmLoadedT m) where
+instance (MonadIO m, MonadBaseControl IO m) => HasDynFlags (GmlT m) where
     getDynFlags = hsc_dflags <$> getSession
 
 instance HasDynFlags LightGhc where
@@ -393,7 +393,7 @@ instance (MonadIO m, MonadBaseControl IO m) => ExceptionMonad (GhcModT m) where
     gmask = liftBaseOp gmask . liftRestore
      where liftRestore f r = f $ liftBaseOp_ r
 
-instance (MonadIO m, MonadBaseControl IO m) => ExceptionMonad (GmLoadedT m) where
+instance (MonadIO m, MonadBaseControl IO m) => ExceptionMonad (GmlT m) where
     gcatch act handler = control $ \run ->
         run act `gcatch` (run . handler)
 

Language/Haskell/GhcMod/Target.hs

@@ -117,24 +117,23 @@ initSession opts mdf = do
 --       ( setModeSimple -- $ setEmptyLogger
 --                       df)
 
-runGmLoadedT :: IOish m
+runGmlT :: IOish m => [Either FilePath ModuleName] -> GmlT m a -> GhcModT m a
-             => [Either FilePath ModuleName] -> GmLoadedT m a -> GhcModT m a
+runGmlT fns action = runGmlT' fns return action
-runGmLoadedT fns action = runGmLoadedT' fns return action
 
-runGmLoadedT' :: IOish m
+runGmlT' :: IOish m
               => [Either FilePath ModuleName]
               -> (DynFlags -> Ghc DynFlags)
-              -> GmLoadedT m a
+              -> GmlT m a
               -> GhcModT m a
-runGmLoadedT' fns mdf action = runGmLoadedTWith fns mdf id action
+runGmlT' fns mdf action = runGmlTWith fns mdf id action
 
-runGmLoadedTWith :: IOish m
+runGmlTWith :: IOish m
                  => [Either FilePath ModuleName]
                  -> (DynFlags -> Ghc DynFlags)
-                 -> (GmLoadedT m a -> GmLoadedT m b)
+                 -> (GmlT m a -> GmlT m b)
-                 -> GmLoadedT m a
+                 -> GmlT m a
                  -> GhcModT m b
-runGmLoadedTWith efnmns' mdf wrapper action = do
+runGmlTWith efnmns' mdf wrapper action = do
     crdl <- cradle
     Options { ghcUserOptions } <- options
 
@@ -150,7 +149,7 @@ runGmLoadedTWith efnmns' mdf wrapper action = do
     initSession opts' $
         setModeSimple >>> setEmptyLogger >>> mdf
 
-    unGmLoadedT $ wrapper $ do
+    unGmlT $ wrapper $ do
       loadTargets (map moduleNameString mns ++ rfns)
       action
 
@@ -293,7 +292,7 @@ resolveGmComponents mumns cs = do
 
 
 -- | Set the files as targets and load them.
-loadTargets :: IOish m => [String] -> GmLoadedT m ()
+loadTargets :: IOish m => [String] -> GmlT m ()
 loadTargets filesOrModules = do
     gmLog GmDebug "loadTargets" $
           text "Loading" <+>: fsep (map text filesOrModules)