diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index e9320f6032..460dbf7d0d 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, @@ -140,31 +140,29 @@ loadWithImplicitCradle :: Maybe FilePath -- if no 'hie.yaml' location is given. -> IO (HieBios.Cradle Void) loadWithImplicitCradle mHieYaml rootDir = do - crdl <- case mHieYaml of + case mHieYaml of Just yaml -> HieBios.loadCradle yaml Nothing -> loadImplicitHieCradle $ addTrailingPathSeparator rootDir - return crdl -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 @@ -423,6 +421,7 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do logWarning logger $ implicitCradleWarning lfp cradle <- loadCradle hieYaml dir + lfp <- flip makeRelative cfp <$> getCurrentDirectory when optTesting $ mRunLspT lspEnv $ sendNotification (SCustomMethod "ghcide/cradle/loaded") (toJSON cfp) 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..1003b32c6e 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -14,12 +14,12 @@ import Control.Exception.Safe (Exception (displayExcept import Control.Monad.Extra (concatMapM, unless, when) import Data.Default (Default (def)) +import Data.Foldable (traverse_) import qualified Data.HashMap.Strict as HashMap import Data.Hashable (hashed) import Data.List.Extra (intercalate, isPrefixOf, nub, nubOrd, partition) -import Data.Maybe (catMaybes, fromMaybe, - isJust) +import Data.Maybe (catMaybes, isJust) import qualified Data.Text as T import qualified Data.Text.IO as T import Development.IDE (Action, Rules, @@ -203,21 +203,20 @@ defaultMain Arguments{..} = do hPutStrLn stderr "Starting LSP server..." hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run WITHOUT the --lsp option!" runLanguageServer options inH outH argsGetHieDbLoc argsDefaultHlsConfig argsOnConfigChange (pluginHandlers plugins) $ \env vfs rootPath hiedb hieChan -> do + traverse_ IO.setCurrentDirectory rootPath 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) - sessionLoader <- loadSessionWithOptions argsSessionLoadingOptions $ fromMaybe dir rootPath + sessionLoader <- loadSessionWithOptions argsSessionLoadingOptions dir config <- LSP.runLspT env LSP.getConfig let def_options = argsIdeOptions config sessionLoader @@ -307,7 +306,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