Handle ghc exceptions

hie-plugin-api/Haskell/Ide/Engine/Ghc.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE CPP                 #-}
 {-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies        #-}
 {-# LANGUAGE LambdaCase          #-}
 -- | This module provides the interface to GHC, mainly for loading
@@ -35,7 +34,6 @@ import           Haskell.Ide.Engine.PluginUtils
 
 import           DynFlags
 import           GHC
-import           IOEnv                             as G
 import qualified HscTypes
 import           Outputable                        (renderWithStyle)
 import           Language.Haskell.LSP.Types        ( NormalizedUri(..), toNormalizedUri )
@@ -49,7 +47,6 @@ import           Outputable hiding ((<>))
 -- to do with BIOS
 import qualified HIE.Bios.Ghc.Api as BIOS (withDynFlags, setDeferTypeErrors)
 import qualified HIE.Bios.Ghc.Load as BIOS
-import qualified HIE.Bios.Flags as BIOS (CradleError)
 
 import System.Directory
 
@@ -187,28 +184,6 @@ logDiag rfm eref dref df reason sev spn style msg = do
       modifyIORef' eref (msgTxt:)
       return ()
 
-
-errorHandlers :: (String -> m a) -> (HscTypes.SourceError -> m a) -> [ErrorHandler m a]
-errorHandlers ghcErrRes renderSourceError = handlers
-  where
-      -- ghc throws GhcException, SourceError, GhcApiError and
-      -- IOEnvFailure. hie-bios throws CradleError.
-      handlers =
-        [ ErrorHandler $ \(ex :: IOEnvFailure) ->
-            ghcErrRes (show ex)
-        , ErrorHandler $ \(ex :: HscTypes.GhcApiError) ->
-            ghcErrRes (show ex)
-        , ErrorHandler $ \(ex :: HscTypes.SourceError) ->
-            renderSourceError ex
-        , ErrorHandler $ \(ex :: IOError) ->
-            ghcErrRes (show ex)
-        , ErrorHandler $ \(ex :: BIOS.CradleError) ->
-            ghcErrRes (show ex)
-        , ErrorHandler $ \(ex :: GhcException) ->
-            ghcErrRes (showGhcException ex "")
-        ]
-
-
 -- | Load a module from a filepath into the cache, first check the cache
 -- to see if it's already there.
 setTypecheckedModule :: Uri -> IdeGhcM (IdeResult (Diagnostics, AdditionalErrs))

hie-plugin-api/Haskell/Ide/Engine/GhcUtils.hs

@@ -1,12 +1,19 @@
+{-# LANGUAGE ScopedTypeVariables #-}
 module Haskell.Ide.Engine.GhcUtils where
 
 import qualified Language.Haskell.LSP.Core as Core
 
 import qualified HscMain as G
 import           Module
 import           HscTypes
+import           GHC
+import           IOEnv   as G
 import qualified Data.Text as T
 
+import qualified HIE.Bios.Flags as BIOS (CradleError)
+
+import           Haskell.Ide.Engine.PluginUtils (ErrorHandler(..))
+
 -- Convert progress continuation to a messager
 toMessager :: (Core.Progress -> IO ()) -> G.Messager
 toMessager k _hsc_env (nk, n) _rc_reason ms =
@@ -32,3 +39,24 @@ toMessager hsc_env mod_index recomp mod_summary =
                               (recompileRequired recomp) mod_summary)
                 ++ reason
 -}
+
+-- Handlers for each type of error that ghc can throw
+errorHandlers :: (String -> m a) -> (HscTypes.SourceError -> m a) -> [ErrorHandler m a]
+errorHandlers onGhcError onSourceError = handlers
+  where
+      -- ghc throws GhcException, SourceError, GhcApiError and
+      -- IOEnvFailure. hie-bios throws CradleError.
+      handlers =
+        [ ErrorHandler $ \(ex :: IOEnvFailure) ->
+            onGhcError (show ex)
+        , ErrorHandler $ \(ex :: GhcApiError) ->
+            onGhcError (show ex)
+        , ErrorHandler $ \(ex :: SourceError) ->
+            onSourceError ex
+        , ErrorHandler $ \(ex :: IOError) ->
+            onGhcError (show ex)
+        , ErrorHandler $ \(ex :: BIOS.CradleError) ->
+            onGhcError (show ex)
+        , ErrorHandler $ \(ex :: GhcException) ->
+            onGhcError (showGhcException ex "")
+        ]

hie-plugin-api/Haskell/Ide/Engine/ModuleCache.hs

@@ -181,12 +181,20 @@ loadCradle iniDynFlags (NewCradle fp) def action = do
         -- while 'f' is still valid.
         liftIO (GHC.newHscEnv iniDynFlags) >>= GHC.setSession
         liftIO $ setCurrentDirectory (BIOS.cradleRootDir cradle)
-        init_res <- gcatches (Right <$> init_session)
-                [ErrorHandler (\(ex :: GHC.GhcException)
-                  -> return $ Left (GHC.showGhcException ex ""))]
+
+        let onGhcError = return . Left
+        let onSourceError srcErr = do
+              logm $ "Source error on cradle initialisation: " ++ show srcErr
+              return $ Right ()
+        -- We continue setting the cradle in case the file has source errors
+        -- cause they will be reported to user by diagnostics
+        init_res <- gcatches 
+                      (Right <$> init_session)
+                      (errorHandlers onGhcError onSourceError)
+
         case init_res of
           Left err -> do
-            logm $ "GhcException on cradle initialisation: " ++ show err
+            logm $ "Ghc error on cradle initialisation: " ++ show err
             return $ IdeResultFail $ IdeError
               { ideCode    = OtherError
               , ideMessage = Text.pack $ show err
@@ -198,6 +206,7 @@ loadCradle iniDynFlags (NewCradle fp) def action = do
             -- `.hi` files will be saved.
           Right () -> do
             setCurrentCradle cradle
+            logm $ "Cradle set succesfully"
             IdeResultOk <$> action
 
 -- | Sets the current cradle for caching.

src/Haskell/Ide/Engine/Scheduler.hs

@@ -308,14 +308,14 @@ ghcDispatcher env@DispatcherEnv { docVersionTVar } errorHandler callbackHandler
 
     let
       runner :: a -> IdeGhcM a -> IdeGhcM (IdeResult  a)
-      runner d act = case context of
-        Nothing  -> runActionWithContext iniDynFlags Nothing d act
+      runner a act = case context of
+        Nothing  -> runActionWithContext iniDynFlags Nothing a act
         Just uri -> case uriToFilePath uri of
-          Just fp -> runActionWithContext iniDynFlags (Just fp) d act
+          Just fp -> runActionWithContext iniDynFlags (Just fp) a act
           Nothing -> do
             debugm
               "ghcDispatcher:Got malformed uri, running action with default context"
-            runActionWithContext iniDynFlags Nothing d act
+            runActionWithContext iniDynFlags Nothing a act
 
     let
       runWithCallback = do