diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index a7ef755a3f..acb8f4f5eb 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -106,7 +106,7 @@ data SessionLoadingOptions = SessionLoadingOptions -- or 'Nothing' to respect the cradle setting , getCacheDirs :: String -> [String] -> IO CacheDirs -- | Return the GHC lib dir to use for the 'unsafeGlobalDynFlags' - , getInitialGhcLibDir :: IO (Maybe LibDir) + , getInitialGhcLibDir :: FilePath -> IO (Maybe LibDir) , fakeUid :: GHC.InstalledUnitId -- ^ unit id used to tag the internal component built by ghcide -- To reuse external interface files the unit ids must match, @@ -151,26 +151,25 @@ loadWithImplicitCradle mHieYaml rootDir = do setCurrentDirectory rootDir loadImplicitHieCradle $ addTrailingPathSeparator rootDir -getInitialGhcLibDirDefault :: IO (Maybe LibDir) -getInitialGhcLibDirDefault = do - dir <- IO.getCurrentDirectory - hieYaml <- findCradle def dir - cradle <- loadCradle def hieYaml dir +getInitialGhcLibDirDefault :: FilePath -> IO (Maybe LibDir) +getInitialGhcLibDirDefault rootDir = do + hieYaml <- findCradle def rootDir + cradle <- loadCradle def hieYaml rootDir hPutStrLn stderr $ "setInitialDynFlags cradle: " ++ show cradle libDirRes <- getRuntimeGhcLibDir cradle case libDirRes of CradleSuccess libdir -> pure $ Just $ LibDir libdir CradleFail err -> do - hPutStrLn stderr $ "Couldn't load cradle for libdir: " ++ show (err,dir,hieYaml,cradle) + hPutStrLn stderr $ "Couldn't load cradle for libdir: " ++ show (err,rootDir,hieYaml,cradle) pure Nothing CradleNone -> do hPutStrLn stderr "Couldn't load cradle (CradleNone)" pure Nothing -- | Sets `unsafeGlobalDynFlags` on using the hie-bios cradle and returns the GHC libdir -setInitialDynFlags :: SessionLoadingOptions -> IO (Maybe LibDir) -setInitialDynFlags SessionLoadingOptions{..} = do - libdir <- getInitialGhcLibDir +setInitialDynFlags :: FilePath -> SessionLoadingOptions -> IO (Maybe LibDir) +setInitialDynFlags rootDir SessionLoadingOptions{..} = do + libdir <- getInitialGhcLibDir rootDir dynFlags <- mapM dynFlagsForPrinting libdir mapM_ setUnsafeGlobalDynFlags dynFlags pure libdir diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs index 9fcc520db2..6118805885 100644 --- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs +++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs @@ -122,8 +122,7 @@ runLanguageServer options inH outH getHieDbLoc defaultConfig onConfigurationChan handleInit exitClientMsg clearReqId waitForCancel clientMsgChan env (RequestMessage _ _ m params) = otTracedHandler "Initialize" (show m) $ \sp -> do traceWithSpan sp params let root = LSP.resRootPath env - - dir <- getCurrentDirectory + dir <- maybe getCurrentDirectory return root dbLoc <- getHieDbLoc dir -- The database needs to be open for the duration of the reactor thread, but we need to pass in a reference diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index cad2574d3a..a875bf76ce 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -206,14 +206,14 @@ defaultMain Arguments{..} = do t <- t hPutStrLn stderr $ "Started LSP server in " ++ showDuration t - dir <- IO.getCurrentDirectory + dir <- maybe IO.getCurrentDirectory return rootPath -- We want to set the global DynFlags right now, so that we can use -- `unsafeGlobalDynFlags` even before the project is configured -- We do it here since haskell-lsp changes our working directory to the correct place ('rootPath') -- before calling this function _mlibdir <- - setInitialDynFlags argsSessionLoadingOptions + setInitialDynFlags dir argsSessionLoadingOptions `catchAny` (\e -> (hPutStrLn stderr $ "setInitialDynFlags: " ++ displayException e) >> pure Nothing) @@ -307,7 +307,7 @@ defaultMain Arguments{..} = do Db dir opts cmd -> do dbLoc <- getHieDbLoc dir hPutStrLn stderr $ "Using hiedb at: " ++ dbLoc - mlibdir <- setInitialDynFlags def + mlibdir <- setInitialDynFlags dir def case mlibdir of Nothing -> exitWith $ ExitFailure 1 Just libdir -> HieDb.runCommand libdir opts{HieDb.database = dbLoc} cmd