From 1e25507222b25a6edd4293e70486490f85ff4a5d Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 6 Jun 2021 11:12:13 +0100 Subject: [PATCH 1/4] loadCradle: change working dir to cradle location --- ghcide/session-loader/Development/IDE/Session.hs | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index e9320f6032..a7ef755a3f 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -140,10 +140,16 @@ loadWithImplicitCradle :: Maybe FilePath -- if no 'hie.yaml' location is given. -> IO (HieBios.Cradle Void) loadWithImplicitCradle mHieYaml rootDir = do - crdl <- case mHieYaml of - Just yaml -> HieBios.loadCradle yaml - Nothing -> loadImplicitHieCradle $ addTrailingPathSeparator rootDir - return crdl + case mHieYaml of + Just yaml -> do + -- change the cwd to the cradle location in order to support relative + -- paths in the cradle definition + setCurrentDirectory (takeDirectory yaml) + HieBios.loadCradle yaml + Nothing -> do + -- change the cwd to the workspace root for consistency with the Just case + setCurrentDirectory rootDir + loadImplicitHieCradle $ addTrailingPathSeparator rootDir getInitialGhcLibDirDefault :: IO (Maybe LibDir) getInitialGhcLibDirDefault = do From 41a3c7f2d469d74ff74d7bd8bf92782a7cb13454 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 6 Jun 2021 11:47:10 +0100 Subject: [PATCH 2/4] fix uses of getCurrentDirectory in ghcide fix uses of getCurrentDirectory in ghcide --- .../session-loader/Development/IDE/Session.hs | 19 +++++++++---------- .../src/Development/IDE/LSP/LanguageServer.hs | 3 +-- ghcide/src/Development/IDE/Main.hs | 6 +++--- 3 files changed, 13 insertions(+), 15 deletions(-) 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 From f5bc01a5965f760452e6b957786ffa7bbe75e28e Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 6 Jun 2021 13:16:13 +0100 Subject: [PATCH 3/4] clean up comment and fromMaybe --- ghcide/src/Development/IDE/Main.hs | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index a875bf76ce..e2cbe30417 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -18,8 +18,7 @@ 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, @@ -210,14 +209,12 @@ defaultMain Arguments{..} = do -- 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 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 From ab48a9943315c7807fe43105775d5afe004f42a3 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 6 Jun 2021 19:32:24 +0100 Subject: [PATCH 4/4] Set working directory to workspace root when argCommand is LSP --- ghcide/session-loader/Development/IDE/Session.hs | 12 +++--------- ghcide/src/Development/IDE/Main.hs | 2 ++ 2 files changed, 5 insertions(+), 9 deletions(-) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index acb8f4f5eb..460dbf7d0d 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -141,15 +141,8 @@ loadWithImplicitCradle :: Maybe FilePath -> IO (HieBios.Cradle Void) loadWithImplicitCradle mHieYaml rootDir = do case mHieYaml of - Just yaml -> do - -- change the cwd to the cradle location in order to support relative - -- paths in the cradle definition - setCurrentDirectory (takeDirectory yaml) - HieBios.loadCradle yaml - Nothing -> do - -- change the cwd to the workspace root for consistency with the Just case - setCurrentDirectory rootDir - loadImplicitHieCradle $ addTrailingPathSeparator rootDir + Just yaml -> HieBios.loadCradle yaml + Nothing -> loadImplicitHieCradle $ addTrailingPathSeparator rootDir getInitialGhcLibDirDefault :: FilePath -> IO (Maybe LibDir) getInitialGhcLibDirDefault rootDir = do @@ -428,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/Main.hs b/ghcide/src/Development/IDE/Main.hs index e2cbe30417..1003b32c6e 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -14,6 +14,7 @@ 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, @@ -202,6 +203,7 @@ 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