Overhaul ghc api initialization error handling

exe/Rules.hs

@@ -22,8 +22,9 @@ import           Development.IDE.GHC.Util
 import           Development.IDE.Types.Location (fromNormalizedFilePath)
 import           Development.IDE.Types.Options  (IdeOptions(IdeOptions, optTesting))
 import           Development.Shake
+import           Exception                      (gtry)
 import           GHC
-import           GHC.Check                      (VersionCheck(..), makeGhcVersionChecker)
+import           GHC.Check                      (GhcVersionChecker, InstallationCheck(..), PackageMismatch(..), makeGhcVersionChecker)
 import           HIE.Bios
 import           HIE.Bios.Cradle
 import           HIE.Bios.Environment           (addCmdOpts)
@@ -102,40 +103,65 @@ getComponentOptions cradle = do
         -- That will require some more changes.
         CradleNone      -> fail "'none' cradle is not yet supported"
 
-ghcVersionChecker :: IO VersionCheck
-ghcVersionChecker = $$(makeGhcVersionChecker (pure <$> getLibdir))
-
-checkGhcVersion :: IO (Maybe HscEnvEq)
-checkGhcVersion = do
-    res <- ghcVersionChecker
-    case res of
-        Failure err -> do
-          putStrLn $ "Error while checking GHC version: " ++ show err
-          return Nothing
-        Mismatch {..} ->
-          return $ Just GhcVersionMismatch {..}
-        _ ->
-          return Nothing
+ghcVersionChecker :: GhcVersionChecker
+ghcVersionChecker = $$(makeGhcVersionChecker getLibdir)
 
 createSession :: ComponentOptions -> IO HscEnvEq
 createSession (ComponentOptions theOpts _) = do
     libdir <- getLibdir
-
     cacheDir <- getCacheDir theOpts
 
     hPutStrLn stderr $ "Interface files cache dir: " <> cacheDir
 
-    runGhc (Just libdir) $ do
-        dflags <- getSessionDynFlags
-        (dflags', _targets) <- addCmdOpts theOpts dflags
-        setupDynFlags cacheDir dflags'
-        versionMismatch <- liftIO checkGhcVersion
-        case versionMismatch of
-            Just mismatch -> return mismatch
-            Nothing ->  do
+    installationCheck <- ghcVersionChecker libdir
+
+    -- Lots of error handling below as there are multiple error cases:
+    --   - incompatible libdir (e.g. in Nix)
+    --   - unsatisfiable -fpackage-id flags
+    --   - missing symbols during dynamic linking of packages
+    --   - version mismatches
+    case installationCheck of
+        InstallationNotFound{..} ->
+            fail $ "GHC installation not found in libdir: " <> libdir
+        InstallationMismatch{..} ->
+            return GhcVersionMismatch{..}
+        InstallationChecked installationVersion ghcLibCheck ->
+            runGhc (Just libdir) $ do
+              -- Setting up the cradle options in the ghc session can fail
+              -- if --package-id options cannot be satisfied due to ghc
+              -- version mismatches
+              sessionSetupResult <- gtry $ do
+                dflags <- getSessionDynFlags
+                (dflags', _targets) <- addCmdOpts theOpts dflags
+                setupDynFlags cacheDir dflags'
+
+              case sessionSetupResult of
+                Left (err :: SomeException) ->
+                    return $ GhcInitializationError installationVersion $ show err
+                Right () -> do
+                    -- Even if all the cradle options were installed successfully,
+                    -- we still need to check the user package versions
+                    versionMismatch <- gtry ghcLibCheck
+
+                    case versionMismatch of
+                        Right (Just (packageName, VersionMismatch{..})) ->
+                            return PackageVersionMismatch{..}
+                        Right (Just (packageName, AbiMismatch{..})) ->
+                            return PackageAbiMismatch{..}
+                        Right Nothing ->
+                            setupSession installationVersion
+                        Left (err :: SomeException) -> do
+                            liftIO $ putStrLn $ "Warning: unable to validate GHC version: " ++ show err
+                            setupSession installationVersion
+    where
+        setupSession v =  do
                 env <- getSession
-                liftIO $ initDynLinker env
-                liftIO $ newHscEnvEq env
+                linkerInitRes <- liftIO $ try $ initDynLinker env
+                case linkerInitRes of
+                    Left (err::SomeException) ->
+                        return $ GhcInitializationError v (show err)
+                    Right () ->
+                        liftIO $ newHscEnvEq env
 
 getCacheDir :: [String] -> IO FilePath
 getCacheDir opts = IO.getXdgDirectory IO.XdgCache (cacheDir </> opts_hash)

ghcide.cabal

@@ -197,7 +197,7 @@ executable ghcide
         directory,
         extra,
         filepath,
-        ghc-check >= 0.3.0.1 && < 0.4,
+        ghc-check >= 0.4 && < 0.5,
         ghc-paths,
         ghc,
         gitrev,

src/Development/IDE/GHC/Util.hs

@@ -4,7 +4,9 @@
 -- | General utility functions, mostly focused around GHC operations.
 module Development.IDE.GHC.Util(
     -- * HcsEnv and environment
-    HscEnvEq(GhcVersionMismatch, compileTime, runTime), hscEnv, newHscEnvEq,
+    HscEnvEq(GhcInitializationError, GhcVersionMismatch, PackageVersionMismatch, PackageAbiMismatch
+            ,compileTime, runTime, compileTimeAbi, runTimeAbi, packageName),
+    hscEnv, newHscEnvEq,
     modifyDynFlags,
     evalGhcEnv,
     runGhcEnv,
@@ -166,45 +168,95 @@ moduleImportPath (takeDirectory . fromNormalizedFilePath -> pathDir) mn
 --   if they are created with the same call to 'newHscEnvEq'.
 data HscEnvEq
     = HscEnvEq !Unique !HscEnv
+    | GhcInitializationError { compileTime :: !Version
+                             , message     :: !String }
     | GhcVersionMismatch { compileTime :: !Version
                          , runTime     :: !Version
                          }
+    | PackageVersionMismatch { compileTime :: !Version
+                             , runTime     :: !Version
+                             , packageName :: !String
+                             }
+    | PackageAbiMismatch { compileTimeAbi :: !String
+                         , runTimeAbi     :: !String
+                         , packageName    :: !String
+                         }
 
 -- | Unwrap an 'HsEnvEq'.
 hscEnv :: HscEnvEq -> HscEnv
 hscEnv = either error id . hscEnv'
 
 hscEnv' :: HscEnvEq -> Either String HscEnv
 hscEnv' (HscEnvEq _ x) = Right x
+hscEnv' GhcInitializationError{compileTime, message} = Left $ unwords
+    [ "ghcide compiled by GHC ", showVersion compileTime
+    , "failed to load packages:", message
+    , ". Please ensure that ghci is compiled with the same GHC installation as the project."]
 hscEnv' GhcVersionMismatch{..} = Left $
     unwords
-        ["ghcide compiled against GHC"
+        ["ghcide compiled by GHC"
         ,showVersion compileTime
         ,"but currently using"
         ,showVersion runTime
-        ,". This is unsupported, ghcide must be compiled with the same GHC version as the project."
+        ,". This is unsupported, ghcide must be compiled with the same GHC installation as the project."
+        ]
+hscEnv' PackageVersionMismatch{..} = Left $
+    unwords
+        ["ghcide compiled with package "
+        , packageName <> "-" <> showVersion compileTime
+        ,"but project uses package"
+        , packageName <> "-" <> showVersion runTime
+        ,". This is unsupported, ghcide must be compiled with the same GHC installation as the project."
         ]
 
+hscEnv' PackageAbiMismatch{..} = Left $
+    unwords
+        ["ghcide compiled with package "
+        , packageName
+        , "and abi"
+        , compileTimeAbi
+        ,"but project has abi"
+        , runTimeAbi
+        ,". This is unsupported, ghcide must be compiled with the same GHC installation as the project."
+        ]
+
+
 -- | Wrap an 'HscEnv' into an 'HscEnvEq'.
 newHscEnvEq :: HscEnv -> IO HscEnvEq
 newHscEnvEq e = do u <- newUnique; return $ HscEnvEq u e
 
 instance Show HscEnvEq where
   show (HscEnvEq a _) = "HscEnvEq " ++ show (hashUnique a)
+  show GhcInitializationError{..} = "GhcInitializationError " <> show (compileTime, message)
   show GhcVersionMismatch{..} = "GhcVersionMismatch " <> show (compileTime, runTime)
+  show PackageVersionMismatch{..} = "PackageVersionMismatch " <> show (packageName, compileTime, runTime)
+  show PackageAbiMismatch{..} = "PackageAbiMismatch " <> show (packageName, compileTimeAbi, runTimeAbi)
 
 instance Eq HscEnvEq where
   HscEnvEq a _ == HscEnvEq b _ = a == b
-  GhcVersionMismatch a b == GhcVersionMismatch c d = a == c && b == d
+  GhcInitializationError a b == GhcInitializationError c d =
+      a == c && b == d
+  GhcVersionMismatch a b == GhcVersionMismatch c d =
+      a == c && b == d
+  PackageVersionMismatch p a b == PackageVersionMismatch p' c d =
+      p == p' && a == c && b == d
+  PackageAbiMismatch p a b == PackageAbiMismatch p' c d =
+      p == p' && a == c && b == d
   _ == _ = False
 
 instance NFData HscEnvEq where
   rnf (HscEnvEq a b) = rnf (hashUnique a) `seq` b `seq` ()
-  rnf GhcVersionMismatch{} = rnf runTime
+  rnf GhcInitializationError{..} = rnf compileTime `seq` rnf message
+  rnf GhcVersionMismatch{..} = rnf compileTime `seq` rnf runTime
+  rnf PackageVersionMismatch{..} = rnf compileTime `seq` rnf runTime `seq` rnf packageName
+  rnf PackageAbiMismatch{..} = rnf compileTimeAbi `seq` rnf runTimeAbi `seq` rnf packageName
 
 instance Hashable HscEnvEq where
-  hashWithSalt salt (HscEnvEq u _) = hashWithSalt salt u
-  hashWithSalt salt GhcVersionMismatch{..} = hashWithSalt salt (compileTime, runTime)
+  hashWithSalt salt (HscEnvEq u _) = hashWithSalt salt (1::Int,u)
+  hashWithSalt salt GhcInitializationError{..} = hashWithSalt salt (2::Int, compileTime, message)
+  hashWithSalt salt GhcVersionMismatch{..} = hashWithSalt salt (3::Int, compileTime, runTime)
+  hashWithSalt salt PackageVersionMismatch{..} = hashWithSalt salt (4::Int, packageName, compileTime, runTime)
+  hashWithSalt salt PackageAbiMismatch{..} = hashWithSalt salt (5::Int, packageName, compileTimeAbi, runTimeAbi)
 
 -- Fake instance needed to persuade Shake to accept this type as a key.
 -- No harm done as ghcide never persists these keys currently

stack-ghc-lib.yaml

@@ -13,7 +13,7 @@ extra-deps:
 - regex-base-0.94.0.0
 - regex-tdfa-1.3.1.0
 - haddock-library-1.8.0
-- ghc-check-0.3.0.1
+- ghc-check-0.4.0.0
 nix:
   packages: [zlib]
 flags:

stack.yaml

@@ -14,6 +14,6 @@ extra-deps:
 - parser-combinators-1.2.1
 - haddock-library-1.8.0
 - tasty-rerun-1.1.17
-- ghc-check-0.3.0.1
+- ghc-check-0.4.0.0
 nix:
   packages: [zlib]

stack810.yaml

@@ -7,7 +7,7 @@ extra-deps:
 - haskell-lsp-0.22.0.0
 - haskell-lsp-types-0.22.0.0
 - lsp-test-0.11.0.1
-- ghc-check-0.3.0.1
+- ghc-check-0.4.0.0
 
 # for ghc-8.10
 - Cabal-3.2.0.0

stack84.yaml

@@ -22,7 +22,7 @@ extra-deps:
 - unordered-containers-0.2.10.0
 - file-embed-0.0.11.2
 - heaps-0.3.6.1
-- ghc-check-0.3.0.1
+- ghc-check-0.4.0.0
 # For tasty-retun
 - ansi-terminal-0.10.3
 - ansi-wl-pprint-0.6.9

stack88.yaml

@@ -5,7 +5,7 @@ extra-deps:
 - haskell-lsp-0.22.0.0
 - haskell-lsp-types-0.22.0.0
 - lsp-test-0.11.0.1
-- ghc-check-0.3.0.1
+- ghc-check-0.4.0.0
 
 nix:
   packages: [zlib]