diff --git a/exe/Wrapper.hs b/exe/Wrapper.hs index d4b7f8f9fb..6de88abcc0 100644 --- a/exe/Wrapper.hs +++ b/exe/Wrapper.hs @@ -269,8 +269,7 @@ newtype ErrorLSPM c a = ErrorLSPM { unErrorLSPM :: (LspM c) a } -- to shut down the LSP. launchErrorLSP :: Recorder (WithPriority (Doc ())) -> T.Text -> IO () launchErrorLSP recorder errorMsg = do - cwd <- getCurrentDirectory - let defaultArguments = Main.defaultArguments (cmapWithPrio pretty recorder) cwd (IdePlugins []) + let defaultArguments = Main.defaultArguments (cmapWithPrio pretty recorder) (IdePlugins []) inH <- Main.argsHandleIn defaultArguments diff --git a/ghcide/exe/Main.hs b/ghcide/exe/Main.hs index 80913da190..b3b63fbaf5 100644 --- a/ghcide/exe/Main.hs +++ b/ghcide/exe/Main.hs @@ -112,11 +112,11 @@ main = withTelemetryRecorder $ \telemetryRecorder -> do let arguments = if argsTesting - then IDEMain.testing (cmapWithPrio LogIDEMain recorder) argsCwd hlsPlugins - else IDEMain.defaultArguments (cmapWithPrio LogIDEMain recorder) argsCwd hlsPlugins + then IDEMain.testing (cmapWithPrio LogIDEMain recorder) hlsPlugins + else IDEMain.defaultArguments (cmapWithPrio LogIDEMain recorder) hlsPlugins IDEMain.defaultMain (cmapWithPrio LogIDEMain recorder) arguments - { IDEMain.argsProjectRoot = argsCwd + { IDEMain.argsProjectRoot = Just argsCwd , IDEMain.argCommand = argsCommand , IDEMain.argsHlsPlugins = IDEMain.argsHlsPlugins arguments <> pluginDescToIdePlugins [lspRecorderPlugin] diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 99eadff1f1..71688afd1d 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -111,7 +111,6 @@ import Development.IDE.Types.Shake (WithHieDb, toNoFileKey) import HieDb.Create import HieDb.Types import HieDb.Utils -import Ide.PluginUtils (toAbsolute) import qualified System.Random as Random import System.Random (RandomGen) @@ -439,8 +438,7 @@ loadSession :: Recorder (WithPriority Log) -> FilePath -> IO (Action IdeGhcSessi loadSession recorder = loadSessionWithOptions recorder def loadSessionWithOptions :: Recorder (WithPriority Log) -> SessionLoadingOptions -> FilePath -> IO (Action IdeGhcSession) -loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir = do - let toAbsolutePath = toAbsolute rootDir +loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do cradle_files <- newIORef [] -- Mapping from hie.yaml file to HscEnv, one per hie.yaml file hscEnvs <- newVar Map.empty :: IO (Var HieMap) @@ -461,7 +459,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir = do -- Sometimes we get C:, sometimes we get c:, and sometimes we get a relative path -- try and normalise that -- e.g. see https://github.com/haskell/ghcide/issues/126 - let res' = toAbsolutePath <$> res + res' <- traverse makeAbsolute res return $ normalise <$> res' dummyAs <- async $ return (error "Uninitialised") @@ -523,7 +521,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir = do packageSetup (hieYaml, cfp, opts, libDir) = do -- Parse DynFlags for the newly discovered component hscEnv <- emptyHscEnv ideNc libDir - newTargetDfs <- evalGhcEnv hscEnv $ setOptions cfp opts (hsc_dflags hscEnv) rootDir + newTargetDfs <- evalGhcEnv hscEnv $ setOptions cfp opts (hsc_dflags hscEnv) let deps = componentDependencies opts ++ maybeToList hieYaml dep_info <- getDependencyInfo deps -- Now lookup to see whether we are combining with an existing HscEnv @@ -590,7 +588,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir = do -- HscEnv but set the active component accordingly hscEnv <- emptyHscEnv ideNc _libDir let new_cache = newComponentCache recorder optExtensions hieYaml _cfp hscEnv - all_target_details <- new_cache old_deps new_deps rootDir + all_target_details <- new_cache old_deps new_deps this_dep_info <- getDependencyInfo $ maybeToList hieYaml let (all_targets, this_flags_map, this_options) @@ -634,20 +632,25 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir = do let consultCradle :: Maybe FilePath -> FilePath -> IO (IdeResult HscEnvEq, [FilePath]) consultCradle hieYaml cfp = do - let lfpLog = makeRelative rootDir cfp + lfpLog <- flip makeRelative cfp <$> getCurrentDirectory logWith recorder Info $ LogCradlePath lfpLog + when (isNothing hieYaml) $ logWith recorder Warning $ LogCradleNotFound lfpLog - cradle <- loadCradle recorder hieYaml rootDir + + cradle <- loadCradle recorder hieYaml dir + -- TODO: Why are we repeating the same command we have on line 646? + lfp <- flip makeRelative cfp <$> getCurrentDirectory + when optTesting $ mRunLspT lspEnv $ sendNotification (SMethod_CustomMethod (Proxy @"ghcide/cradle/loaded")) (toJSON cfp) -- Display a user friendly progress message here: They probably don't know what a cradle is let progMsg = "Setting up " <> T.pack (takeBaseName (cradleRootDir cradle)) - <> " (for " <> T.pack lfpLog <> ")" + <> " (for " <> T.pack lfp <> ")" eopts <- mRunLspTCallback lspEnv (\act -> withIndefiniteProgress progMsg Nothing NotCancellable (const act)) $ withTrace "Load cradle" $ \addTag -> do - addTag "file" lfpLog + addTag "file" lfp old_files <- readIORef cradle_files res <- cradleToOptsAndLibDir recorder (sessionLoading clientConfig) cradle cfp old_files addTag "result" (show res) @@ -710,7 +713,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir = do modifyVar_ hscEnvs (const (return Map.empty)) v <- Map.findWithDefault HM.empty hieYaml <$> readVar fileToFlags - let cfp = toAbsolutePath file + cfp <- makeAbsolute file case HM.lookup (toNormalizedFilePath' cfp) v of Just (opts, old_di) -> do deps_ok <- checkDependencyInfo old_di @@ -732,7 +735,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir = do -- before attempting to do so. let getOptions :: FilePath -> IO (IdeResult HscEnvEq, [FilePath]) getOptions file = do - let ncfp = toNormalizedFilePath' (toAbsolutePath file) + ncfp <- toNormalizedFilePath' <$> makeAbsolute file cachedHieYamlLocation <- HM.lookup ncfp <$> readVar filesMap hieYaml <- cradleLoc file sessionOpts (join cachedHieYamlLocation <|> hieYaml, file) `Safe.catch` \e -> @@ -744,7 +747,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir = do void $ wait as asyncRes <- async $ getOptions file return (asyncRes, wait asyncRes) - pure $ (fmap . fmap) toAbsolutePath opts + pure opts -- | Run the specific cradle on a specific FilePath via hie-bios. -- This then builds dependencies or whatever based on the cradle, gets the @@ -811,20 +814,19 @@ fromTargetId :: [FilePath] -- ^ import paths -> TargetId -> IdeResult HscEnvEq -> DependencyInfo - -> FilePath -> IO [TargetDetails] -- For a target module we consider all the import paths -fromTargetId is exts (GHC.TargetModule modName) env dep dir = do +fromTargetId is exts (GHC.TargetModule modName) env dep = do let fps = [i moduleNameSlashes modName -<.> ext <> boot | ext <- exts , i <- is , boot <- ["", "-boot"] ] - let locs = fmap (toNormalizedFilePath' . toAbsolute dir) fps + locs <- mapM (fmap toNormalizedFilePath' . makeAbsolute) fps return [TargetDetails (TargetModule modName) env dep locs] -- For a 'TargetFile' we consider all the possible module names -fromTargetId _ _ (GHC.TargetFile f _) env deps dir = do - let nf = toNormalizedFilePath' $ toAbsolute dir f +fromTargetId _ _ (GHC.TargetFile f _) env deps = do + nf <- toNormalizedFilePath' <$> makeAbsolute f let other | "-boot" `isSuffixOf` f = toNormalizedFilePath' (L.dropEnd 5 $ fromNormalizedFilePath nf) | otherwise = toNormalizedFilePath' (fromNormalizedFilePath nf ++ "-boot") @@ -913,9 +915,8 @@ newComponentCache -> HscEnv -- ^ An empty HscEnv -> [ComponentInfo] -- ^ New components to be loaded -> [ComponentInfo] -- ^ old, already existing components - -> FilePath -- ^ root dir -> IO [ [TargetDetails] ] -newComponentCache recorder exts cradlePath _cfp hsc_env old_cis new_cis dir = do +newComponentCache recorder exts cradlePath _cfp hsc_env old_cis new_cis = do let cis = Map.unionWith unionCIs (mkMap new_cis) (mkMap old_cis) -- When we have multiple components with the same uid, -- prefer the new one over the old. @@ -960,7 +961,7 @@ newComponentCache recorder exts cradlePath _cfp hsc_env old_cis new_cis dir = do forM (Map.elems cis) $ \ci -> do let df = componentDynFlags ci - let createHscEnvEq = maybe newHscEnvEqPreserveImportPaths (newHscEnvEq dir) cradlePath + let createHscEnvEq = maybe newHscEnvEqPreserveImportPaths newHscEnvEq cradlePath thisEnv <- do #if MIN_VERSION_ghc(9,3,0) -- In GHC 9.4 we have multi component support, and we have initialised all the units @@ -985,7 +986,7 @@ newComponentCache recorder exts cradlePath _cfp hsc_env old_cis new_cis dir = do logWith recorder Debug $ LogNewComponentCache (targetEnv, targetDepends) evaluate $ liftRnf rwhnf $ componentTargets ci - let mk t = fromTargetId (importPaths df) exts (targetId t) targetEnv targetDepends dir + let mk t = fromTargetId (importPaths df) exts (targetId t) targetEnv targetDepends ctargets <- concatMapM mk (componentTargets ci) return (L.nubOrdOn targetTarget ctargets) @@ -1170,8 +1171,8 @@ addUnit unit_str = liftEwM $ do putCmdLineState (unit_str : units) -- | Throws if package flags are unsatisfiable -setOptions :: GhcMonad m => NormalizedFilePath -> ComponentOptions -> DynFlags -> FilePath -> m (NonEmpty (DynFlags, [GHC.Target])) -setOptions cfp (ComponentOptions theOpts compRoot _) dflags dir = do +setOptions :: GhcMonad m => NormalizedFilePath -> ComponentOptions -> DynFlags -> m (NonEmpty (DynFlags, [GHC.Target])) +setOptions cfp (ComponentOptions theOpts compRoot _) dflags = do ((theOpts',_errs,_warns),units) <- processCmdLineP unit_flags [] (map noLoc theOpts) case NE.nonEmpty units of Just us -> initMulti us @@ -1194,7 +1195,7 @@ setOptions cfp (ComponentOptions theOpts compRoot _) dflags dir = do -- -- If we don't end up with a target for the current file in the end, then -- we will report it as an error for that file - let abs_fp = toAbsolute dir (fromNormalizedFilePath cfp) + abs_fp <- liftIO $ makeAbsolute (fromNormalizedFilePath cfp) let special_target = Compat.mkSimpleTarget df abs_fp pure $ (df, special_target : targets) :| [] where diff --git a/ghcide/src/Development/IDE.hs b/ghcide/src/Development/IDE.hs index 547ac9a115..15cee28f04 100644 --- a/ghcide/src/Development/IDE.hs +++ b/ghcide/src/Development/IDE.hs @@ -31,7 +31,7 @@ import Development.IDE.Core.Shake as X (FastResult (..), defineNoDiagnostics, getClientConfig, getPluginConfigAction, - ideLogger, rootDir, + ideLogger, runIdeAction, shakeExtras, use, useNoFile, diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index c38a1cae3a..5b975ef058 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -164,7 +164,8 @@ import Language.LSP.Server (LspT) import qualified Language.LSP.Server as LSP import Language.LSP.VFS import Prelude hiding (mod) -import System.Directory (doesFileExist) +import System.Directory (doesFileExist, + makeAbsolute) import System.Info.Extra (isWindows) @@ -718,13 +719,13 @@ loadGhcSession recorder ghcSessionDepsConfig = do defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GhcSession file -> do IdeGhcSession{loadSessionFun} <- useNoFile_ GhcSessionIO - -- loading is always returning a absolute path now (val,deps) <- liftIO $ loadSessionFun $ fromNormalizedFilePath file -- add the deps to the Shake graph let addDependency fp = do -- VSCode uses absolute paths in its filewatch notifications - let nfp = toNormalizedFilePath' fp + afp <- liftIO $ makeAbsolute fp + let nfp = toNormalizedFilePath' afp itExists <- getFileExists nfp when itExists $ void $ do use_ GetModificationTime nfp @@ -852,7 +853,7 @@ getModIfaceFromDiskAndIndexRule recorder = hie_loc = Compat.ml_hie_file $ ms_location ms fileHash <- liftIO $ Util.getFileHash hie_loc mrow <- liftIO $ withHieDb (\hieDb -> HieDb.lookupHieFileFromSource hieDb (fromNormalizedFilePath f)) - let hie_loc' = HieDb.hieModuleHieFile <$> mrow + hie_loc' <- liftIO $ traverse (makeAbsolute . HieDb.hieModuleHieFile) mrow case mrow of Just row | fileHash == HieDb.modInfoHash (HieDb.hieModInfo row) diff --git a/ghcide/src/Development/IDE/Core/Service.hs b/ghcide/src/Development/IDE/Core/Service.hs index f59d0b4afa..cdb5ba72cb 100644 --- a/ghcide/src/Development/IDE/Core/Service.hs +++ b/ghcide/src/Development/IDE/Core/Service.hs @@ -67,9 +67,8 @@ initialise :: Recorder (WithPriority Log) -> WithHieDb -> IndexQueue -> Monitoring - -> FilePath -> IO IdeState -initialise recorder defaultConfig plugins mainRule lspEnv debouncer options withHieDb hiedbChan metrics rootDir = do +initialise recorder defaultConfig plugins mainRule lspEnv debouncer options withHieDb hiedbChan metrics = do shakeProfiling <- do let fromConf = optShakeProfiling options fromEnv <- lookupEnv "GHCIDE_BUILD_PROFILING" @@ -87,12 +86,11 @@ initialise recorder defaultConfig plugins mainRule lspEnv debouncer options with hiedbChan (optShakeOptions options) metrics - (do + $ do addIdeGlobal $ GlobalIdeOptions options ofInterestRules (cmapWithPrio LogOfInterest recorder) fileExistsRules (cmapWithPrio LogFileExists recorder) lspEnv - mainRule) - rootDir + mainRule -- | Shutdown the Compiler Service. shutdown :: IdeState -> IO () diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index aaa2294852..5325b14e7e 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -22,7 +22,7 @@ -- always stored as real Haskell values, whereas Shake serialises all 'A' values -- between runs. To deserialise a Shake value, we just consult Values. module Development.IDE.Core.Shake( - IdeState, shakeSessionInit, shakeExtras, shakeDb, rootDir, + IdeState, shakeSessionInit, shakeExtras, shakeDb, ShakeExtras(..), getShakeExtras, getShakeExtrasRules, KnownTargets, Target(..), toKnownFiles, IdeRule, IdeResult, @@ -535,7 +535,6 @@ data IdeState = IdeState ,shakeExtras :: ShakeExtras ,shakeDatabaseProfile :: ShakeDatabase -> IO (Maybe FilePath) ,stopMonitoring :: IO () - ,rootDir :: FilePath } @@ -624,12 +623,11 @@ shakeOpen :: Recorder (WithPriority Log) -> ShakeOptions -> Monitoring -> Rules () - -> FilePath -> IO IdeState shakeOpen recorder lspEnv defaultConfig idePlugins debouncer shakeProfileDir (IdeReportProgress reportProgress) ideTesting@(IdeTesting testing) - withHieDb indexQueue opts monitoring rules rootDir = mdo + withHieDb indexQueue opts monitoring rules = mdo #if MIN_VERSION_ghc(9,3,0) ideNc <- initNameCache 'r' knownKeyNames diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs index 528adbbf09..76893c38a0 100644 --- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs +++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs @@ -126,15 +126,14 @@ runLanguageServer recorder options inH outH defaultConfig parseConfig onConfigCh setupLSP :: forall config err. Recorder (WithPriority Log) - -> FilePath -- ^ root directory -> (FilePath -> IO FilePath) -- ^ Map root paths to the location of the hiedb for the project -> LSP.Handlers (ServerM config) - -> (LSP.LanguageContextEnv config -> FilePath -> WithHieDb -> IndexQueue -> IO IdeState) + -> (LSP.LanguageContextEnv config -> Maybe FilePath -> WithHieDb -> IndexQueue -> IO IdeState) -> MVar () -> IO (LSP.LanguageContextEnv config -> TRequestMessage Method_Initialize -> IO (Either err (LSP.LanguageContextEnv config, IdeState)), LSP.Handlers (ServerM config), (LanguageContextEnv config, IdeState) -> ServerM config <~> IO) -setupLSP recorder defaultRoot getHieDbLoc userHandlers getIdeState clientMsgVar = do +setupLSP recorder getHieDbLoc userHandlers getIdeState clientMsgVar = do -- Send everything over a channel, since you need to wait until after initialise before -- LspFuncs is available clientMsgChan :: Chan ReactorMessage <- newChan @@ -177,7 +176,7 @@ setupLSP recorder defaultRoot getHieDbLoc userHandlers getIdeState clientMsgVar -- Cancel requests are special since they need to be handled -- out of order to be useful. Existing handlers are run afterwards. - let doInitialize = handleInit recorder defaultRoot getHieDbLoc getIdeState reactorLifetime exit clearReqId waitForCancel clientMsgChan + let doInitialize = handleInit recorder getHieDbLoc getIdeState reactorLifetime exit clearReqId waitForCancel clientMsgChan let interpretHandler (env, st) = LSP.Iso (LSP.runLspT env . flip (runReaderT . unServerM) (clientMsgChan,st)) liftIO @@ -186,23 +185,19 @@ setupLSP recorder defaultRoot getHieDbLoc userHandlers getIdeState clientMsgVar handleInit :: Recorder (WithPriority Log) - -> FilePath -> (FilePath -> IO FilePath) - -> (LSP.LanguageContextEnv config -> FilePath -> WithHieDb -> IndexQueue -> IO IdeState) + -> (LSP.LanguageContextEnv config -> Maybe FilePath -> WithHieDb -> IndexQueue -> IO IdeState) -> MVar () -> IO () -> (SomeLspId -> IO ()) -> (SomeLspId -> IO ()) -> Chan ReactorMessage -> LSP.LanguageContextEnv config -> TRequestMessage Method_Initialize -> IO (Either err (LSP.LanguageContextEnv config, IdeState)) -handleInit recorder defaultRoot getHieDbLoc getIdeState lifetime exitClientMsg clearReqId waitForCancel clientMsgChan env (TRequestMessage _ _ m params) = otTracedHandler "Initialize" (show m) $ \sp -> do +handleInit recorder getHieDbLoc getIdeState lifetime exitClientMsg clearReqId waitForCancel clientMsgChan env (TRequestMessage _ _ m params) = otTracedHandler "Initialize" (show m) $ \sp -> do traceWithSpan sp params - let rootMaybe = LSP.resRootPath env - -- only shift if lsp root is different from the rootDir - root <- case rootMaybe of - Just lspRoot | lspRoot /= defaultRoot -> setCurrentDirectory lspRoot >> return lspRoot - _ -> pure defaultRoot - dbLoc <- getHieDbLoc root + let root = LSP.resRootPath env + dir <- maybe getCurrentDirectory return root + dbLoc <- getHieDbLoc dir let initConfig = parseConfiguration params logWith recorder Info $ LogRegisteringIdeConfig initConfig dbMVar <- newEmptyMVar diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index 649f6e422e..b4aa72f5fa 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -208,7 +208,7 @@ commandP plugins = data Arguments = Arguments - { argsProjectRoot :: FilePath + { argsProjectRoot :: Maybe FilePath , argCommand :: Command , argsRules :: Rules () , argsHlsPlugins :: IdePlugins IdeState @@ -226,9 +226,9 @@ data Arguments = Arguments , argsDisableKick :: Bool -- ^ flag to disable kick used for testing } -defaultArguments :: Recorder (WithPriority Log) -> FilePath -> IdePlugins IdeState -> Arguments -defaultArguments recorder fp plugins = Arguments - { argsProjectRoot = fp +defaultArguments :: Recorder (WithPriority Log) -> IdePlugins IdeState -> Arguments +defaultArguments recorder plugins = Arguments + { argsProjectRoot = Nothing , argCommand = LSP , argsRules = mainRule (cmapWithPrio LogRules recorder) def , argsGhcidePlugin = mempty @@ -263,11 +263,11 @@ defaultArguments recorder fp plugins = Arguments } -testing :: Recorder (WithPriority Log) -> FilePath -> IdePlugins IdeState -> Arguments -testing recorder fp plugins = +testing :: Recorder (WithPriority Log) -> IdePlugins IdeState -> Arguments +testing recorder plugins = let arguments@Arguments{ argsHlsPlugins, argsIdeOptions } = - defaultArguments recorder fp plugins + defaultArguments recorder plugins hlsPlugins = pluginDescToIdePlugins $ idePluginsToPluginDesc argsHlsPlugins ++ [Test.blockCommandDescriptor "block-command", Test.plugin] @@ -316,18 +316,22 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re logWith recorder Info $ LogLspStart (pluginId <$> ipMap argsHlsPlugins) ideStateVar <- newEmptyMVar - let getIdeState :: LSP.LanguageContextEnv Config -> FilePath -> WithHieDb -> IndexQueue -> IO IdeState + let getIdeState :: LSP.LanguageContextEnv Config -> Maybe FilePath -> WithHieDb -> IndexQueue -> IO IdeState getIdeState env rootPath withHieDb hieChan = do + traverse_ IO.setCurrentDirectory rootPath t <- ioT logWith recorder Info $ LogLspStartDuration t + + 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 _mlibdir <- - setInitialDynFlags (cmapWithPrio LogSession recorder) rootPath argsSessionLoadingOptions + setInitialDynFlags (cmapWithPrio LogSession recorder) dir argsSessionLoadingOptions -- TODO: should probably catch/log/rethrow at top level instead `catchAny` (\e -> logWith recorder Error (LogSetInitialDynFlagsException e) >> pure Nothing) - sessionLoader <- loadSessionWithOptions (cmapWithPrio LogSession recorder) argsSessionLoadingOptions rootPath + sessionLoader <- loadSessionWithOptions (cmapWithPrio LogSession recorder) argsSessionLoadingOptions dir config <- LSP.runLspT env LSP.getConfig let def_options = argsIdeOptions config sessionLoader @@ -353,11 +357,10 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re withHieDb hieChan monitoring - rootPath putMVar ideStateVar ide pure ide - let setup = setupLSP (cmapWithPrio LogLanguageServer recorder) argsProjectRoot argsGetHieDbLoc (pluginHandlers plugins) getIdeState + let setup = setupLSP (cmapWithPrio LogLanguageServer recorder) argsGetHieDbLoc (pluginHandlers plugins) getIdeState -- See Note [Client configuration in Rules] onConfigChange cfg = do -- TODO: this is nuts, we're converting back to JSON just to get a fingerprint @@ -375,7 +378,7 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re runLanguageServer (cmapWithPrio LogLanguageServer recorder) options inH outH argsDefaultHlsConfig argsParseConfig onConfigChange setup dumpSTMStats Check argFiles -> do - let dir = argsProjectRoot + dir <- maybe IO.getCurrentDirectory return argsProjectRoot dbLoc <- getHieDbLoc dir runWithDb (cmapWithPrio LogSession recorder) dbLoc $ \hiedb hieChan -> do -- GHC produces messages with UTF8 in them, so make sure the terminal doesn't error @@ -405,7 +408,7 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re , optCheckProject = pure False , optModifyDynFlags = optModifyDynFlags def_options <> pluginModifyDynflags plugins } - ide <- initialise (cmapWithPrio LogService recorder) argsDefaultHlsConfig argsHlsPlugins rules Nothing debouncer ideOptions hiedb hieChan mempty dir + ide <- initialise (cmapWithPrio LogService recorder) argsDefaultHlsConfig argsHlsPlugins rules Nothing debouncer ideOptions hiedb hieChan mempty shakeSessionInit (cmapWithPrio LogShake recorder) ide registerIdeConfiguration (shakeExtras ide) $ IdeConfiguration mempty (hashed Nothing) @@ -423,7 +426,7 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re unless (null failed) (exitWith $ ExitFailure (length failed)) Db opts cmd -> do - let root = argsProjectRoot + root <- maybe IO.getCurrentDirectory return argsProjectRoot dbLoc <- getHieDbLoc root hPutStrLn stderr $ "Using hiedb at: " ++ dbLoc mlibdir <- setInitialDynFlags (cmapWithPrio LogSession recorder) root def @@ -433,7 +436,7 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re Just libdir -> retryOnSqliteBusy (cmapWithPrio LogSession recorder) rng (HieDb.runCommand libdir opts{HieDb.database = dbLoc} cmd) Custom (IdeCommand c) -> do - let root = argsProjectRoot + root <- maybe IO.getCurrentDirectory return argsProjectRoot dbLoc <- getHieDbLoc root runWithDb (cmapWithPrio LogSession recorder) dbLoc $ \hiedb hieChan -> do sessionLoader <- loadSessionWithOptions (cmapWithPrio LogSession recorder) argsSessionLoadingOptions "." @@ -443,7 +446,7 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re , optCheckProject = pure False , optModifyDynFlags = optModifyDynFlags def_options <> pluginModifyDynflags plugins } - ide <- initialise (cmapWithPrio LogService recorder) argsDefaultHlsConfig argsHlsPlugins rules Nothing debouncer ideOptions hiedb hieChan mempty root + ide <- initialise (cmapWithPrio LogService recorder) argsDefaultHlsConfig argsHlsPlugins rules Nothing debouncer ideOptions hiedb hieChan mempty shakeSessionInit (cmapWithPrio LogShake recorder) ide registerIdeConfiguration (shakeExtras ide) $ IdeConfiguration mempty (hashed Nothing) c ide diff --git a/ghcide/src/Development/IDE/Types/HscEnvEq.hs b/ghcide/src/Development/IDE/Types/HscEnvEq.hs index ddd5a2e214..502c265077 100644 --- a/ghcide/src/Development/IDE/Types/HscEnvEq.hs +++ b/ghcide/src/Development/IDE/Types/HscEnvEq.hs @@ -28,8 +28,8 @@ import Development.IDE.GHC.Error (catchSrcErrors) import Development.IDE.GHC.Util (lookupPackageConfig) import Development.IDE.Graph.Classes import Development.IDE.Types.Exports (ExportsMap, createExportsMap) -import Ide.PluginUtils (toAbsolute) import OpenTelemetry.Eventlog (withSpan) +import System.Directory (makeAbsolute) import System.FilePath -- | An 'HscEnv' with equality. Two values are considered equal @@ -59,14 +59,14 @@ updateHscEnvEq oldHscEnvEq newHscEnv = do update <$> Unique.newUnique -- | Wrap an 'HscEnv' into an 'HscEnvEq'. -newHscEnvEq :: FilePath -> FilePath -> HscEnv -> [(UnitId, DynFlags)] -> IO HscEnvEq -newHscEnvEq root cradlePath hscEnv0 deps = do +newHscEnvEq :: FilePath -> HscEnv -> [(UnitId, DynFlags)] -> IO HscEnvEq +newHscEnvEq cradlePath hscEnv0 deps = do let relativeToCradle = (takeDirectory cradlePath ) hscEnv = removeImportPaths hscEnv0 -- Make Absolute since targets are also absolute importPathsCanon <- - mapM (return . toAbsolute root) $ relativeToCradle <$> importPaths (hsc_dflags hscEnv0) + mapM makeAbsolute $ relativeToCradle <$> importPaths (hsc_dflags hscEnv0) newHscEnvEqWithImportPaths (Just $ Set.fromList importPathsCanon) hscEnv deps diff --git a/ghcide/test/exe/ReferenceTests.hs b/ghcide/test/exe/ReferenceTests.hs index a1d6d8a0f7..b2501b4611 100644 --- a/ghcide/test/exe/ReferenceTests.hs +++ b/ghcide/test/exe/ReferenceTests.hs @@ -26,7 +26,6 @@ import qualified Data.Aeson as A import Data.Default (def) import Data.Tuple.Extra import GHC.TypeLits (symbolVal) -import Ide.PluginUtils (toAbsolute) import Ide.Types import System.FilePath (isAbsolute, ()) import Test.Hls (FromServerMessage' (..), @@ -214,7 +213,7 @@ expectSameLocations rootDir actual expected = do $ Set.fromList actual expected' <- Set.fromList <$> (forM expected $ \(file, l, c) -> do - fp <- canonicalizePath $ toAbsolute rootDir file + fp <- canonicalizePath $ file return (filePathToUri fp, l, c)) actual' @?= expected' diff --git a/hls-plugin-api/src/Ide/PluginUtils.hs b/hls-plugin-api/src/Ide/PluginUtils.hs index 9f365eeb35..a5f8d7ba54 100644 --- a/hls-plugin-api/src/Ide/PluginUtils.hs +++ b/hls-plugin-api/src/Ide/PluginUtils.hs @@ -32,8 +32,6 @@ module Ide.PluginUtils usePropertyLsp, -- * Escape unescape, - -- * toAbsolute - toAbsolute ) where @@ -52,7 +50,6 @@ import Ide.Types import qualified Language.LSP.Protocol.Lens as L import Language.LSP.Protocol.Types import Language.LSP.Server -import System.FilePath (isAbsolute, ()) import qualified Text.Megaparsec as P import qualified Text.Megaparsec.Char as P import qualified Text.Megaparsec.Char.Lexer as P @@ -319,10 +316,3 @@ escapedTextParser = concat <$> P.many (outsideStringLiteral P.<|> stringLiteral) inside' = concatMap f inside pure $ "\"" <> inside' <> "\"" - --- --------------------------------------------------------------------- - -toAbsolute :: FilePath -> FilePath -> FilePath -toAbsolute dir file - | isAbsolute file = file - | otherwise = dir file diff --git a/hls-test-utils/src/Test/Hls.hs b/hls-test-utils/src/Test/Hls.hs index fd0113fa7f..2a912880e7 100644 --- a/hls-test-utils/src/Test/Hls.hs +++ b/hls-test-utils/src/Test/Hls.hs @@ -473,7 +473,7 @@ runSessionWithServer config plugin fp act = instance Default (TestConfig b) where def = TestConfig { testDirLocation = Right $ VirtualFileTree [] "", - testShiftRoot = False, + testShiftRoot = True, testDisableKick = False, testDisableDefaultPlugin = False, testPluginDescriptor = mempty, @@ -682,7 +682,7 @@ runSessionWithTestConfig TestConfig{..} session = let plugins = testPluginDescriptor recorder <> lspRecorderPlugin let sconf' = testConfigSession { lspConfig = hlsConfigToClientConfig testLspConfig } - arguments = testingArgs root recorderIde plugins + arguments = testingArgs (Just root) recorderIde plugins server <- async $ IDEMain.defaultMain (cmapWithPrio LogIDEMain recorderIde) arguments { argsHandleIn = pure inR , argsHandleOut = pure outW } @@ -707,7 +707,7 @@ runSessionWithTestConfig TestConfig{..} session = runSessionInVFS (Right vfs) act = runWithLockInTempDir vfs $ \fs -> act (fsRoot fs) testingArgs prjRoot recorderIde plugins = let - arguments@Arguments{ argsHlsPlugins, argsIdeOptions } = defaultArguments (cmapWithPrio LogIDEMain recorderIde) prjRoot plugins + arguments@Arguments{ argsHlsPlugins, argsIdeOptions } = defaultArguments (cmapWithPrio LogIDEMain recorderIde) plugins argsHlsPlugins' = if testDisableDefaultPlugin then plugins else argsHlsPlugins diff --git a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs index 72941c2317..1192870b00 100644 --- a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs +++ b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs @@ -41,8 +41,8 @@ import Development.IDE (GetParsedModule (GetParse hscEnvWithImportPaths, logWith, realSrcSpanToRange, - rootDir, runAction, - useWithStale, (<+>)) + runAction, useWithStale, + (<+>)) import Development.IDE.Core.PluginUtils import Development.IDE.Core.PositionMapping (toCurrentRange) import Development.IDE.GHC.Compat (GenLocated (L), @@ -53,17 +53,16 @@ import Development.IDE.GHC.Compat (GenLocated (L), pm_parsed_source, unLoc) import Ide.Logger (Pretty (..)) import Ide.Plugin.Error -import Ide.PluginUtils (toAbsolute) import Ide.Types import Language.LSP.Protocol.Message import Language.LSP.Protocol.Types import Language.LSP.Server import Language.LSP.VFS (virtualFileText) -import System.FilePath (dropExtension, - isAbsolute, normalise, +import System.Directory (makeAbsolute) +import System.FilePath (dropExtension, normalise, pathSeparator, splitDirectories, - takeFileName, ()) + takeFileName) -- |Plugin descriptor descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState @@ -151,7 +150,7 @@ pathModuleNames recorder state normFilePath filePath let paths = map (normalise . (<> pure pathSeparator)) srcPaths logWith recorder Debug (NormalisedPaths paths) - let mdlPath = (toAbsolute $ rootDir state) filePath + mdlPath <- liftIO $ makeAbsolute filePath logWith recorder Debug (AbsoluteFilePath mdlPath) let suffixes = mapMaybe (`stripPrefix` mdlPath) paths diff --git a/plugins/hls-notes-plugin/test/NotesTest.hs b/plugins/hls-notes-plugin/test/NotesTest.hs index 8eae6b011c..e42ef407d7 100644 --- a/plugins/hls-notes-plugin/test/NotesTest.hs +++ b/plugins/hls-notes-plugin/test/NotesTest.hs @@ -17,14 +17,13 @@ main = defaultTestRunner $ gotoNoteTests :: TestTree gotoNoteTests = testGroup "Goto Note Definition" - [ - testCase "single_file" $ runSessionWithServer def plugin testDataDir $ do + [ testCase "single_file" $ runSessionWithServer def plugin testDataDir $ do doc <- openDoc "NoteDef.hs" "haskell" waitForBuildQueue waitForAllProgressDone defs <- getDefinitions doc (Position 3 41) liftIO $ do - fp <- canonicalizePath $ testDataDir "NoteDef.hs" + fp <- canonicalizePath "NoteDef.hs" defs @?= InL (Definition (InR [Location (filePathToUri fp) (Range (Position 8 9) (Position 8 9))])) , testCase "liberal_format" $ runSessionWithServer def plugin testDataDir $ do doc <- openDoc "NoteDef.hs" "haskell" @@ -32,7 +31,7 @@ gotoNoteTests = testGroup "Goto Note Definition" waitForAllProgressDone defs <- getDefinitions doc (Position 5 64) liftIO $ do - fp <- canonicalizePath $ testDataDir "NoteDef.hs" + fp <- canonicalizePath "NoteDef.hs" defs @?= InL (Definition (InR [Location (filePathToUri fp) (Range (Position 18 11) (Position 18 11))])) , testCase "invalid_note" $ runSessionWithServer def plugin testDataDir $ do @@ -57,7 +56,7 @@ gotoNoteTests = testGroup "Goto Note Definition" waitForAllProgressDone defs <- getDefinitions doc (Position 5 20) liftIO $ do - fp <- canonicalizePath $ testDataDir "NoteDef.hs" + fp <- canonicalizePath "NoteDef.hs" defs @?= InL (Definition (InR [Location (filePathToUri fp) (Range (Position 12 6) (Position 12 6))])) ] diff --git a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs index b88e79d2b0..48d2886ff0 100644 --- a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs +++ b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs @@ -129,6 +129,7 @@ import Retrie.SYB (everything, extQ, listify, mkQ) import Retrie.Types import Retrie.Universe (Universe) +import System.Directory (makeAbsolute) #if MIN_VERSION_ghc(9,3,0) import GHC.Types.PkgQual @@ -761,7 +762,7 @@ reuseParsedModule state f = do getCPPmodule :: Recorder (WithPriority Log) -> IdeState -> HscEnv -> FilePath -> IO (FixityEnv, CPP AnnotatedModule) getCPPmodule recorder state session t = do - let nt = toNormalizedFilePath' $ (toAbsolute $ rootDir state) t + nt <- toNormalizedFilePath' <$> makeAbsolute t let getParsedModule f contents = do modSummary <- msrModSummary <$> useOrFail state "Retrie.GetModSummary" (CallRetrieInternalError "file not found") GetModSummary nt diff --git a/src/Ide/Main.hs b/src/Ide/Main.hs index cbe3f33bb3..457e0dc4ec 100644 --- a/src/Ide/Main.hs +++ b/src/Ide/Main.hs @@ -131,7 +131,7 @@ runLspMode recorder ghcideArgs@GhcideArguments{..} idePlugins = withTelemetryRec log Info $ LogLspStart ghcideArgs (map pluginId $ ipMap idePlugins) let args = (if argsTesting then IDEMain.testing else IDEMain.defaultArguments) - (cmapWithPrio LogIDEMain recorder) dir idePlugins + (cmapWithPrio LogIDEMain recorder) idePlugins let telemetryRecorder = telemetryRecorder' & cmapWithPrio pretty