From 804169f008bf6baba79e6c5e230eefef1d03a1b9 Mon Sep 17 00:00:00 2001 From: mangoiv Date: Wed, 16 Jul 2025 15:06:41 +0200 Subject: [PATCH 1/5] [fix] don't bake ide state mvar into setup and getIdeState This is the right thing to do because othewise it is not possible to create new ideStates in a single instance of the executable. This will be useful if the hls executable is supposed to talk to multiple clients and lives beyond a single client disconnecting. --- ghcide/src/Development/IDE/Main.hs | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index 872e957364..ad4a36327a 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -12,7 +12,7 @@ module Development.IDE.Main ) where import Control.Concurrent.Extra (withNumCapabilities) -import Control.Concurrent.MVar (newEmptyMVar, +import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, tryReadMVar) import Control.Concurrent.STM.Stats (dumpSTMStats) import Control.Monad.Extra (concatMapM, unless, @@ -318,9 +318,8 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re ioT <- offsetTime logWith recorder Info $ LogLspStart (pluginId <$> ipMap argsHlsPlugins) - ideStateVar <- newEmptyMVar - let getIdeState :: LSP.LanguageContextEnv Config -> FilePath -> WithHieDb -> Shake.ThreadQueue -> IO IdeState - getIdeState env rootPath withHieDb threadQueue = do + let getIdeState :: MVar IdeState -> LSP.LanguageContextEnv Config -> FilePath -> WithHieDb -> Shake.ThreadQueue -> IO IdeState + getIdeState ideStateVar env rootPath withHieDb threadQueue = do t <- ioT logWith recorder Info $ LogLspStartDuration t sessionLoader <- loadSessionWithOptions (cmapWithPrio LogSession recorder) argsSessionLoadingOptions rootPath (tLoaderQueue threadQueue) @@ -353,9 +352,9 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re putMVar ideStateVar ide pure ide - let setup = setupLSP (cmapWithPrio LogLanguageServer recorder) argsProjectRoot argsGetHieDbLoc (pluginHandlers plugins) getIdeState + let setup ideStateVar = setupLSP (cmapWithPrio LogLanguageServer recorder) argsProjectRoot argsGetHieDbLoc (pluginHandlers plugins) (getIdeState ideStateVar) -- See Note [Client configuration in Rules] - onConfigChange cfg = do + onConfigChange ideStateVar cfg = do -- TODO: this is nuts, we're converting back to JSON just to get a fingerprint let cfgObj = J.toJSON cfg mide <- liftIO $ tryReadMVar ideStateVar @@ -368,7 +367,9 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re modifyClientSettings ide (const $ Just cfgObj) return [toNoFileKey Rules.GetClientSettings] - runLanguageServer (cmapWithPrio LogLanguageServer recorder) options inH outH argsDefaultHlsConfig argsParseConfig onConfigChange setup + do + ideStateVar <- newEmptyMVar + runLanguageServer (cmapWithPrio LogLanguageServer recorder) options inH outH argsDefaultHlsConfig argsParseConfig (onConfigChange ideStateVar) (setup ideStateVar) dumpSTMStats Check argFiles -> do let dir = argsProjectRoot From dc9b00850206b6230e74b6f75d7a7abc87774800 Mon Sep 17 00:00:00 2001 From: mangoiv Date: Wed, 16 Jul 2025 15:08:56 +0200 Subject: [PATCH 2/5] [fix] don't throw hard errors when no shutdown message is handled Previously, when there was no shutdown message by a client and the client disconnected, resulting in the handlers to be GC'd the race that was supposed to free resources for the HieDB & co. would throw a hard error talking about the MVar being unreachable. We would like to instead finish gracefully because finishing the race as soon as the MVar was GC'd is the right thing to do anyway. --- ghcide/src/Development/IDE/LSP/LanguageServer.hs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs index cf7845ce08..33dd5b6672 100644 --- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs +++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs @@ -34,6 +34,7 @@ import UnliftIO.Directory import UnliftIO.Exception import qualified Colog.Core as Colog +import Control.Exception (BlockedIndefinitelyOnMVar (..)) import Control.Monad.IO.Unlift (MonadUnliftIO) import Control.Monad.Trans.Cont (evalContT) import Development.IDE.Core.IdeConfiguration @@ -265,11 +266,13 @@ runWithWorkerThreads recorder dbLoc f = evalContT $ do (WithHieDbShield hiedb, threadQueue) <- runWithDb recorder dbLoc liftIO $ f hiedb (ThreadQueue threadQueue sessionRestartTQueue sessionLoaderTQueue) --- | Runs the action until it ends or until the given MVar is put. +-- | Runs the action until it ends or until the given MVar is put or the thread to fill the mvar is dropped, in which case the MVar will never be filled. +-- This happens when the thread that handles the shutdown notification dies. Ideally, this should not rely on the RTS detecting the blocked MVar +-- and instead *also* run the shutdown inf a finally block enclosing the handlers. In which case the BlockedIndefinitelyOnMVar Exception also wouldn't +-- be thrown. -- Rethrows any exceptions. untilMVar :: MonadUnliftIO m => MVar () -> m () -> m () -untilMVar mvar io = void $ - waitAnyCancel =<< traverse async [ io , readMVar mvar ] +untilMVar mvar io = race_ (readMVar mvar `catch` \BlockedIndefinitelyOnMVar -> pure ()) io cancelHandler :: (SomeLspId -> IO ()) -> LSP.Handlers (ServerM c) cancelHandler cancelRequest = LSP.notificationHandler SMethod_CancelRequest $ \TNotificationMessage{_params=CancelParams{_id}} -> From f9d0d3d2de9aa14ff31c198d596655febca3d519 Mon Sep 17 00:00:00 2001 From: mangoiv Date: Sun, 8 Jun 2025 16:43:10 +0200 Subject: [PATCH 3/5] [feat] replace usages of NormalizedFilePath with NormalizedUri wherever possible --- ghcide-test/exe/Progress.hs | 13 +- ghcide-test/exe/UnitTests.hs | 2 +- .../session-loader/Development/IDE/Session.hs | 20 +- .../Development/IDE/Session/Diagnostics.hs | 2 +- ghcide/src/Development/IDE/Core/Actions.hs | 67 +++-- ghcide/src/Development/IDE/Core/Compile.hs | 124 ++++----- ghcide/src/Development/IDE/Core/FileExists.hs | 32 ++- ghcide/src/Development/IDE/Core/FileStore.hs | 135 +++++----- ghcide/src/Development/IDE/Core/OfInterest.hs | 14 +- .../src/Development/IDE/Core/PluginUtils.hs | 53 ++-- .../src/Development/IDE/Core/Preprocessor.hs | 31 ++- .../Development/IDE/Core/ProgressReporting.hs | 12 +- ghcide/src/Development/IDE/Core/RuleTypes.hs | 4 +- ghcide/src/Development/IDE/Core/Rules.hs | 189 +++++++------- ghcide/src/Development/IDE/Core/Shake.hs | 240 +++++++++--------- ghcide/src/Development/IDE/Core/Tracing.hs | 8 +- ghcide/src/Development/IDE/Core/UseStale.hs | 22 +- ghcide/src/Development/IDE/GHC/Error.hs | 19 +- .../IDE/Import/DependencyInformation.hs | 40 +-- .../src/Development/IDE/Import/FindImports.hs | 15 +- .../Development/IDE/LSP/HoverDefinition.hs | 26 +- .../src/Development/IDE/LSP/Notifications.hs | 42 +-- ghcide/src/Development/IDE/LSP/Outline.hs | 14 +- ghcide/src/Development/IDE/Main.hs | 9 +- .../src/Development/IDE/Plugin/Completions.hs | 36 +-- ghcide/src/Development/IDE/Plugin/Test.hs | 13 +- .../src/Development/IDE/Plugin/TypeLenses.hs | 10 +- ghcide/src/Development/IDE/Spans/AtPoint.hs | 26 +- ghcide/src/Development/IDE/Spans/Pragmas.hs | 10 +- .../src/Development/IDE/Types/Diagnostics.hs | 28 +- .../src/Development/IDE/Types/KnownTargets.hs | 6 +- ghcide/src/Development/IDE/Types/Shake.hs | 13 +- haskell-language-server.cabal | 1 + hls-plugin-api/src/Ide/Types.hs | 3 +- .../src/Ide/Plugin/AlternateNumberFormat.hs | 26 +- .../src/Ide/Plugin/CabalFmt.hs | 5 +- .../src/Ide/Plugin/CabalGild.hs | 5 +- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 212 ++++++++-------- .../src/Ide/Plugin/Cabal/CabalAdd.hs | 10 +- .../src/Ide/Plugin/Cabal/Definition.hs | 21 +- .../src/Ide/Plugin/Cabal/Diagnostics.hs | 16 +- .../src/Ide/Plugin/Cabal/Outline.hs | 21 +- .../src/Ide/Plugin/Cabal/Parse.hs | 2 +- plugins/hls-cabal-plugin/test/Context.hs | 3 +- .../src/Ide/Plugin/CallHierarchy/Internal.hs | 52 ++-- .../src/Ide/Plugin/ChangeTypeSignature.hs | 11 +- .../src/Ide/Plugin/Class/CodeAction.hs | 16 +- .../src/Ide/Plugin/Class/CodeLens.hs | 18 +- .../src/Ide/Plugin/Class/Utils.hs | 10 +- .../src/Ide/Plugin/CodeRange.hs | 21 +- .../src/Ide/Plugin/CodeRange/Rules.hs | 3 +- .../src/Ide/Plugin/Eval/Handlers.hs | 19 +- .../src/Ide/Plugin/Eval/Rules.hs | 20 +- .../src/Ide/Plugin/ExplicitFixity.hs | 7 +- .../src/Ide/Plugin/ExplicitImports.hs | 29 +-- .../src/Ide/Plugin/ExplicitFields.hs | 24 +- .../src/Ide/Plugin/Fourmolu.hs | 40 ++- .../hls-gadt-plugin/src/Ide/Plugin/GADT.hs | 24 +- .../hls-hlint-plugin/src/Ide/Plugin/Hlint.hs | 65 +++-- .../src/Ide/Plugin/ModuleName.hs | 20 +- .../hls-notes-plugin/src/Ide/Plugin/Notes.hs | 64 +++-- .../src/Ide/Plugin/Ormolu.hs | 29 ++- .../src/Ide/Plugin/OverloadedRecordDot.hs | 16 +- .../src/Ide/Plugin/Pragmas.hs | 9 +- .../src/Ide/Plugin/QualifyImportedNames.hs | 10 +- .../src/Development/IDE/Plugin/CodeAction.hs | 83 +++--- .../Development/IDE/Plugin/CodeAction/Args.hs | 10 +- .../src/Ide/Plugin/Rename.hs | 42 +-- .../src/Ide/Plugin/SemanticTokens/Internal.hs | 41 +-- .../hls-stan-plugin/src/Ide/Plugin/Stan.hs | 115 +++++---- .../src/Ide/Plugin/StylishHaskell.hs | 9 +- 71 files changed, 1234 insertions(+), 1173 deletions(-) diff --git a/ghcide-test/exe/Progress.hs b/ghcide-test/exe/Progress.hs index 08ad03c78b..abddd8e01f 100644 --- a/ghcide-test/exe/Progress.hs +++ b/ghcide-test/exe/Progress.hs @@ -4,7 +4,7 @@ module Progress (tests) where import Control.Concurrent.STM import Data.Foldable (for_) import qualified Data.HashMap.Strict as Map -import Development.IDE (NormalizedFilePath) +import Development.IDE import Development.IDE.Core.ProgressReporting import qualified "list-t" ListT import qualified StmContainers.Map as STM @@ -18,7 +18,7 @@ tests = testGroup "Progress" data InProgressModel = InProgressModel { done, todo :: Int, - current :: Map.HashMap NormalizedFilePath Int + current :: Map.HashMap NormalizedUri Int } reportProgressTests :: TestTree @@ -30,10 +30,11 @@ reportProgressTests = testGroup "recordProgress" ] where p0 = pure $ InProgressModel 0 0 mempty - addNew = recordProgressModel "A" succ p0 - increase = recordProgressModel "A" succ addNew - decrease = recordProgressModel "A" succ increase - done = recordProgressModel "A" pred decrease + aUri = filePathToUri' "A" + addNew = recordProgressModel aUri succ p0 + increase = recordProgressModel aUri succ addNew + decrease = recordProgressModel aUri succ increase + done = recordProgressModel aUri pred decrease recordProgressModel key change state = model state $ \st -> recordProgress st key change model stateModelIO k = do diff --git a/ghcide-test/exe/UnitTests.hs b/ghcide-test/exe/UnitTests.hs index b2940ab27f..c3cab353c3 100644 --- a/ghcide-test/exe/UnitTests.hs +++ b/ghcide-test/exe/UnitTests.hs @@ -51,7 +51,7 @@ tests = do let uri = Uri "file://" uriToFilePath' uri @?= Just "" , testCase "showDiagnostics prints ranges 1-based (like vscode)" $ do - let diag = Diagnostics.FileDiagnostic "" Diagnostics.ShowDiag Diagnostic + let diag = Diagnostics.FileDiagnostic (filePathToUri' "") Diagnostics.ShowDiag Diagnostic { _codeDescription = Nothing , _data_ = Nothing , _range = Range diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 77677ce3a0..4aec83a543 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -138,7 +138,7 @@ data Log | LogHieDbWriterThreadSQLiteError !SQLError | LogHieDbWriterThreadException !SomeException | LogInterfaceFilesCacheDir !FilePath - | LogKnownFilesUpdated !(HashMap Target (HashSet NormalizedFilePath)) + | LogKnownFilesUpdated !(HashMap Target (HashSet NormalizedUri)) | LogMakingNewHscEnv ![UnitId] | LogDLLLoadError !String | LogCradlePath !FilePath @@ -199,7 +199,7 @@ instance Pretty Log where nest 2 $ vcat [ "Known files updated:" - , viaShow $ (HM.map . Set.map) fromNormalizedFilePath targetToPathsMap + , viaShow $ (HM.map . Set.map) fromNormalizedUri targetToPathsMap ] LogMakingNewHscEnv inPlaceUnitIds -> "Making new HscEnv. In-place unit ids:" <+> pretty (map show inPlaceUnitIds) @@ -476,13 +476,13 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do -- 'TargetFile Foo.hs' in the 'knownTargetsVar', thus not find 'TargetFile Foo.hs-boot' -- and also not find 'TargetModule Foo'. fs <- filterM (IO.doesFileExist . fromNormalizedFilePath) targetLocations - pure $ map (\fp -> (TargetFile fp, Set.singleton fp)) (nubOrd (f:fs)) + pure $ map (\fp -> (TargetFile fp, Set.singleton $ filePathToUri' fp)) (nubOrd (f:fs)) TargetModule _ -> do found <- filterM (IO.doesFileExist . fromNormalizedFilePath) targetLocations - return [(targetTarget, Set.fromList found)] + return [(targetTarget, Set.fromList $ map filePathToUri' found)] hasUpdate <- atomically $ do known <- readTVar knownTargetsVar - let known' = flip mapHashed known $ \k -> unionKnownTargets k (mkKnownTargets knownTargets) + let known' = flip mapHashed known $ \k -> unionKnownTargets k (mkKnownTargets $ knownTargets) hasUpdate = if known /= known' then Just (unhashed known') else Nothing writeTVar knownTargetsVar known' pure hasUpdate @@ -566,7 +566,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do this_target_details = TargetDetails (TargetFile _cfp) this_error_env this_dep_info [_cfp] this_flags = (this_error_env, this_dep_info) this_error_env = ([this_error], Nothing) - this_error = ideErrorWithSource (Just "cradle") (Just DiagnosticSeverity_Error) _cfp + this_error = ideErrorWithSource (Just "cradle") (Just DiagnosticSeverity_Error) (filePathToUri' _cfp) (T.unlines [ "No cradle target found. Is this file listed in the targets of your cradle?" , "If you are using a .cabal file, please ensure that this module is listed in either the exposed-modules or other-modules section" @@ -587,8 +587,8 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do unless (null new_deps || not checkProject) $ do cfps' <- liftIO $ filterM (IO.doesFileExist . fromNormalizedFilePath) (concatMap targetLocations all_targets) void $ shakeEnqueue extras $ mkDelayedAction "InitialLoad" Debug $ void $ do - mmt <- uses GetModificationTime cfps' - let cs_exist = catMaybes (zipWith (<$) cfps' mmt) + mmt <- uses GetModificationTime $ map filePathToUri' cfps' + let cs_exist = mapMaybe (fmap filePathToUri') (zipWith (<$) cfps' mmt) modIfaces <- uses GetModIface cs_exist -- update exports map shakeExtras <- getShakeExtras @@ -887,7 +887,7 @@ newComponentCache recorder exts _cfp hsc_env old_cis new_cis = do let closure_errs = maybeToList $ checkHomeUnitsClosed' (hsc_unit_env hscEnv') (hsc_all_home_unit_ids hscEnv') closure_err_to_multi_err err = ideErrorWithSource - (Just "cradle") (Just DiagnosticSeverity_Warning) _cfp + (Just "cradle") (Just DiagnosticSeverity_Warning) (filePathToUri' _cfp) (T.pack (Compat.printWithoutUniques (singleMessage err))) (Just (fmap GhcDriverMessage err)) multi_errs = map closure_err_to_multi_err closure_errs @@ -1244,4 +1244,4 @@ showPackageSetupException PackageSetupException{..} = unwords renderPackageSetupException :: FilePath -> PackageSetupException -> FileDiagnostic renderPackageSetupException fp e = - ideErrorWithSource (Just "cradle") (Just DiagnosticSeverity_Error) (toNormalizedFilePath' fp) (T.pack $ showPackageSetupException e) Nothing + ideErrorWithSource (Just "cradle") (Just DiagnosticSeverity_Error) (filePathToUri' $ toNormalizedFilePath' fp) (T.pack $ showPackageSetupException e) Nothing diff --git a/ghcide/session-loader/Development/IDE/Session/Diagnostics.hs b/ghcide/session-loader/Development/IDE/Session/Diagnostics.hs index 2890c87966..2d7057c40f 100644 --- a/ghcide/session-loader/Development/IDE/Session/Diagnostics.hs +++ b/ghcide/session-loader/Development/IDE/Session/Diagnostics.hs @@ -30,7 +30,7 @@ data CradleErrorDetails = renderCradleError :: CradleError -> Cradle a -> NormalizedFilePath -> FileDiagnostic renderCradleError cradleError cradle nfp = let noDetails = - ideErrorWithSource (Just "cradle") (Just DiagnosticSeverity_Error) nfp (T.unlines $ map T.pack userFriendlyMessage) Nothing + ideErrorWithSource (Just "cradle") (Just DiagnosticSeverity_Error) (filePathToUri' nfp) (T.unlines $ map T.pack userFriendlyMessage) Nothing in if HieBios.isCabalCradle cradle then noDetails & fdLspDiagnosticL %~ \diag -> diag{_data_ = Just $ Aeson.toJSON CradleErrorDetails{cabalProjectFiles=absDeps}} diff --git a/ghcide/src/Development/IDE/Core/Actions.hs b/ghcide/src/Development/IDE/Core/Actions.hs index 0d55a73120..2be9b80f1c 100644 --- a/ghcide/src/Development/IDE/Core/Actions.hs +++ b/ghcide/src/Development/IDE/Core/Actions.hs @@ -30,9 +30,7 @@ import Development.IDE.Types.HscEnvEq (hscEnv) import Development.IDE.Types.Location import qualified HieDb import Language.LSP.Protocol.Types (DocumentHighlight (..), - SymbolInformation (..), - normalizedFilePathToUri, - uriToNormalizedFilePath) + SymbolInformation (..)) -- | Eventually this will lookup/generate URIs for files in dependencies, but not in the @@ -55,14 +53,14 @@ lookupMod _dbchan _hie_f _mod _uid _boot = MaybeT $ pure Nothing -- block waiting for the rule to be properly computed. -- | Try to get hover text for the name under point. -getAtPoint :: NormalizedFilePath -> Position -> IdeAction (Maybe (Maybe Range, [T.Text])) -getAtPoint file pos = runMaybeT $ do +getAtPoint :: NormalizedUri -> Position -> IdeAction (Maybe (Maybe Range, [T.Text])) +getAtPoint uri pos = runMaybeT $ do ide <- ask opts <- liftIO $ getIdeOptionsIO ide - (hf, mapping) <- useWithStaleFastMT GetHieAst file - env <- hscEnv . fst <$> useWithStaleFastMT GhcSession file - dkMap <- lift $ maybe (DKMap mempty mempty) fst <$> runMaybeT (useWithStaleFastMT GetDocMap file) + (hf, mapping) <- useWithStaleFastMT GetHieAst uri + env <- hscEnv . fst <$> useWithStaleFastMT GhcSession uri + dkMap <- lift $ maybe (DKMap mempty mempty) fst <$> runMaybeT (useWithStaleFastMT GetDocMap uri) !pos' <- MaybeT (return $ fromCurrentPosition mapping pos) MaybeT $ liftIO $ fmap (first (toCurrentRange mapping =<<)) <$> AtPoint.atPoint opts hf dkMap env pos' @@ -71,79 +69,78 @@ getAtPoint file pos = runMaybeT $ do -- taking into account changes that may have occurred due to edits. toCurrentLocation :: PositionMapping - -> NormalizedFilePath + -> NormalizedUri -> Location -> IdeAction (Maybe Location) -toCurrentLocation mapping file (Location uri range) = +toCurrentLocation mapping uri (Location locUri locRange) = -- The Location we are going to might be in a different -- file than the one we are calling gotoDefinition from. -- So we check that the location file matches the file -- we are in. - if nUri == normalizedFilePathToUri file + if nUri == uri -- The Location matches the file, so use the PositionMapping -- we have. - then pure $ Location uri <$> toCurrentRange mapping range + then pure $ Location locUri <$> toCurrentRange mapping locRange -- The Location does not match the file, so get the correct -- PositionMapping and use that instead. else do otherLocationMapping <- fmap (fmap snd) $ runMaybeT $ do - otherLocationFile <- MaybeT $ pure $ uriToNormalizedFilePath nUri - useWithStaleFastMT GetHieAst otherLocationFile - pure $ Location uri <$> (flip toCurrentRange range =<< otherLocationMapping) + useWithStaleFastMT GetHieAst nUri + pure $ Location locUri <$> (flip toCurrentRange locRange =<< otherLocationMapping) where nUri :: NormalizedUri - nUri = toNormalizedUri uri + nUri = toNormalizedUri locUri -- | Goto Definition. -getDefinition :: NormalizedFilePath -> Position -> IdeAction (Maybe [(Location, Identifier)]) -getDefinition file pos = runMaybeT $ do +getDefinition :: NormalizedUri -> Position -> IdeAction (Maybe [(Location, Identifier)]) +getDefinition uri pos = runMaybeT $ do ide@ShakeExtras{ withHieDb, hiedbWriter } <- ask opts <- liftIO $ getIdeOptionsIO ide - (hf, mapping) <- useWithStaleFastMT GetHieAst file - (ImportMap imports, _) <- useWithStaleFastMT GetImportMap file + (hf, mapping) <- useWithStaleFastMT GetHieAst uri + (ImportMap imports, _) <- useWithStaleFastMT GetImportMap uri !pos' <- MaybeT (pure $ fromCurrentPosition mapping pos) locationsWithIdentifier <- AtPoint.gotoDefinition withHieDb (lookupMod hiedbWriter) opts imports hf pos' mapMaybeM (\(location, identifier) -> do - fixedLocation <- MaybeT $ toCurrentLocation mapping file location + fixedLocation <- MaybeT $ toCurrentLocation mapping uri location pure $ Just (fixedLocation, identifier) ) locationsWithIdentifier -getTypeDefinition :: NormalizedFilePath -> Position -> IdeAction (Maybe [(Location, Identifier)]) -getTypeDefinition file pos = runMaybeT $ do +getTypeDefinition :: NormalizedUri -> Position -> IdeAction (Maybe [(Location, Identifier)]) +getTypeDefinition uri pos = runMaybeT $ do ide@ShakeExtras{ withHieDb, hiedbWriter } <- ask opts <- liftIO $ getIdeOptionsIO ide - (hf, mapping) <- useWithStaleFastMT GetHieAst file + (hf, mapping) <- useWithStaleFastMT GetHieAst uri !pos' <- MaybeT (return $ fromCurrentPosition mapping pos) locationsWithIdentifier <- AtPoint.gotoTypeDefinition withHieDb (lookupMod hiedbWriter) opts hf pos' mapMaybeM (\(location, identifier) -> do - fixedLocation <- MaybeT $ toCurrentLocation mapping file location + fixedLocation <- MaybeT $ toCurrentLocation mapping uri location pure $ Just (fixedLocation, identifier) ) locationsWithIdentifier -getImplementationDefinition :: NormalizedFilePath -> Position -> IdeAction (Maybe [Location]) -getImplementationDefinition file pos = runMaybeT $ do +getImplementationDefinition :: NormalizedUri -> Position -> IdeAction (Maybe [Location]) +getImplementationDefinition uri pos = runMaybeT $ do ide@ShakeExtras{ withHieDb, hiedbWriter } <- ask opts <- liftIO $ getIdeOptionsIO ide - (hf, mapping) <- useWithStaleFastMT GetHieAst file + (hf, mapping) <- useWithStaleFastMT GetHieAst uri !pos' <- MaybeT (pure $ fromCurrentPosition mapping pos) locs <- AtPoint.gotoImplementation withHieDb (lookupMod hiedbWriter) opts hf pos' - traverse (MaybeT . toCurrentLocation mapping file) locs + traverse (MaybeT . toCurrentLocation mapping uri) locs -highlightAtPoint :: NormalizedFilePath -> Position -> IdeAction (Maybe [DocumentHighlight]) -highlightAtPoint file pos = runMaybeT $ do - (HAR _ hf rf _ _,mapping) <- useWithStaleFastMT GetHieAst file +highlightAtPoint :: NormalizedUri -> Position -> IdeAction (Maybe [DocumentHighlight]) +highlightAtPoint uri pos = runMaybeT $ do + (HAR _ hf rf _ _,mapping) <- useWithStaleFastMT GetHieAst uri !pos' <- MaybeT (return $ fromCurrentPosition mapping pos) let toCurrentHighlight (DocumentHighlight range t) = flip DocumentHighlight t <$> toCurrentRange mapping range mapMaybe toCurrentHighlight <$>AtPoint.documentHighlight hf rf pos' -- Refs are not an IDE action, so it is OK to be slow and (more) accurate -refsAtPoint :: NormalizedFilePath -> Position -> Action [Location] -refsAtPoint file pos = do +refsAtPoint :: NormalizedUri -> Position -> Action [Location] +refsAtPoint uri pos = do ShakeExtras{withHieDb} <- getShakeExtras fs <- HM.keys <$> getFilesOfInterestUntracked asts <- HM.fromList . mapMaybe sequence . zip fs <$> usesWithStale GetHieAst fs - AtPoint.referencesAtPoint withHieDb file pos (AtPoint.FOIReferences asts) + AtPoint.referencesAtPoint withHieDb uri pos (AtPoint.BOIReferences asts) workspaceSymbols :: T.Text -> IdeAction (Maybe [SymbolInformation]) workspaceSymbols query = runMaybeT $ do diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 552409fbba..eb38d34887 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -97,7 +97,7 @@ import qualified GHC.LanguageExtensions as LangExt import GHC.Serialized import HieDb hiding (withHieDb) import qualified Language.LSP.Protocol.Message as LSP -import Language.LSP.Protocol.Types (DiagnosticTag (..)) +import Language.LSP.Protocol.Types (DiagnosticTag (..), uriToFilePath) import qualified Language.LSP.Server as LSP import Prelude hiding (mod) import System.Directory @@ -132,6 +132,7 @@ import Development.IDE.GHC.Compat hiding (assert, parseModule, tcRnModule, writeHieFile) +import Control.Monad.Except (throwError) #else import Development.IDE.GHC.Compat hiding (loadInterface, @@ -161,13 +162,13 @@ sourceParser = "parser" parseModule :: IdeOptions -> HscEnv - -> FilePath + -> Uri -> ModSummary -> IO (IdeResult ParsedModule) -parseModule IdeOptions{..} env filename ms = +parseModule IdeOptions{..} env uri ms = fmap (either (, Nothing) id) $ runExceptT $ do - (diag, modu) <- parseFileContents env optPreprocessor filename ms + (diag, modu) <- parseFileContents env optPreprocessor uri ms return (diag, Just modu) @@ -181,14 +182,14 @@ computePackageDeps env pkg = do Nothing -> return $ Left [ ideErrorText - (toNormalizedFilePath' noFilePath) + emptyPathUri (T.pack $ "unknown package: " ++ show pkg) ] Just pkgInfo -> return $ Right $ unitDepends pkgInfo data TypecheckHelpers = TypecheckHelpers - { getLinkables :: [NormalizedFilePath] -> IO [LinkableResult] -- ^ hls-graph action to get linkables for files + { getLinkables :: [NormalizedUri] -> IO [LinkableResult] -- ^ hls-graph action to get linkables for files , getModuleGraph :: IO DependencyInformation } @@ -791,8 +792,12 @@ atomicFileWrite se targetPath write = do let dir = takeDirectory targetPath createDirectoryIfMissing True dir (tempFilePath, cleanUp) <- newTempFileWithin dir - (write tempFilePath >>= \x -> renameFile tempFilePath targetPath >> atomically (resetInterfaceStore se (toNormalizedFilePath' targetPath)) >> pure x) - `onException` cleanUp + (do + x <- write tempFilePath + renameFile tempFilePath targetPath + _ <- atomically $ resetInterfaceStore se $ filePathToUri' $ toNormalizedFilePath' targetPath + pure x + ) `onException` cleanUp generateHieAsts :: HscEnv -> TcModuleResult #if MIN_VERSION_ghc(9,11,0) @@ -1068,19 +1073,19 @@ withBootSuffix _ = id -- Runs preprocessors as needed. getModSummaryFromImports :: HscEnv - -> FilePath + -> Uri -> UTCTime -> Maybe Util.StringBuffer -> ExceptT [FileDiagnostic] IO ModSummaryResult -- modTime is only used in GHC < 9.4 -getModSummaryFromImports env fp _modTime mContents = do +getModSummaryFromImports env uri _modTime mContents = do -- src_hash is only used in GHC >= 9.4 - (contents, opts, ppEnv, _src_hash) <- preprocessor env fp mContents + (contents, opts, ppEnv, _src_hash) <- preprocessor env uri mContents let dflags = hsc_dflags ppEnv -- The warns will hopefully be reported when we actually parse the module - (_warns, L main_loc hsmod) <- parseHeader dflags fp contents + (_warns, L main_loc hsmod) <- parseHeader dflags uri contents -- Copied from `HeaderInfo.getImports`, but we also need to keep the parsed imports let mb_mod = hsmodName hsmod @@ -1120,42 +1125,47 @@ getModSummaryFromImports env fp _modTime mContents = do liftIO $ evaluate $ rnf textualImports - modLoc <- liftIO $ if mod == mAIN_NAME - -- specially in tests it's common to have lots of nameless modules - -- mkHomeModLocation will map them to the same hi/hie locations - then mkHomeModLocation dflags (pathToModuleName fp) fp - else mkHomeModLocation dflags mod fp - - let modl = mkHomeModule (hscHomeUnit ppEnv) mod - sourceType = if "-boot" `isSuffixOf` takeExtension fp then HsBootFile else HsSrcFile - msrModSummary = - ModSummary - { ms_mod = modl - , ms_hie_date = Nothing - , ms_dyn_obj_date = Nothing - , ms_ghc_prim_import = ghc_prim_import - , ms_hs_hash = _src_hash - - , ms_hsc_src = sourceType - -- The contents are used by the GetModSummary rule - , ms_hspp_buf = Just contents - , ms_hspp_file = fp - , ms_hspp_opts = dflags - , ms_iface_date = Nothing - , ms_location = withBootSuffix sourceType modLoc - , ms_obj_date = Nothing - , ms_parsed_mod = Nothing - , ms_srcimps = srcImports - , ms_textual_imps = textualImports - } - - msrFingerprint <- liftIO $ computeFingerprint opts msrModSummary - msrHscEnv <- liftIO $ Loader.initializePlugins (hscSetFlags (ms_hspp_opts msrModSummary) ppEnv) - return ModSummaryResult{..} + case uriToFilePath' uri of + Nothing -> do + let nuri = toNormalizedUri uri + throwError [ideErrorText nuri $ "Uri is not a file uri: " <> getUri uri] + Just file -> do + modLoc <- liftIO $ if mod == mAIN_NAME + -- specially in tests it's common to have lots of nameless modules + -- mkHomeModLocation will map them to the same hi/hie locations + then mkHomeModLocation dflags (pathToModuleName uri) file + else mkHomeModLocation dflags mod file + + let modl = mkHomeModule (hscHomeUnit ppEnv) mod + sourceType = if "-boot" `isSuffixOf` takeExtension file then HsBootFile else HsSrcFile + msrModSummary = + ModSummary + { ms_mod = modl + , ms_hie_date = Nothing + , ms_dyn_obj_date = Nothing + , ms_ghc_prim_import = ghc_prim_import + , ms_hs_hash = _src_hash + + , ms_hsc_src = sourceType + -- The contents are used by the GetModSummary rule + , ms_hspp_buf = Just contents + , ms_hspp_file = file + , ms_hspp_opts = dflags + , ms_iface_date = Nothing + , ms_location = withBootSuffix sourceType modLoc + , ms_obj_date = Nothing + , ms_parsed_mod = Nothing + , ms_srcimps = srcImports + , ms_textual_imps = textualImports + } + + msrFingerprint <- liftIO $ computeFingerprint file opts msrModSummary + msrHscEnv <- liftIO $ Loader.initializePlugins (hscSetFlags (ms_hspp_opts msrModSummary) ppEnv) + return ModSummaryResult{..} where -- Compute a fingerprint from the contents of `ModSummary`, -- eliding the timestamps, the preprocessed source and other non relevant fields - computeFingerprint opts ModSummary{..} = do + computeFingerprint file opts ModSummary{..} = do fingerPrintImports <- fingerprintFromPut $ do put $ Util.uniq $ moduleNameFS $ moduleName ms_mod forM_ (ms_srcimps ++ ms_textual_imps) $ \(mb_p, m) -> do @@ -1165,7 +1175,7 @@ getModSummaryFromImports env fp _modTime mContents = do G.ThisPkg uid -> put $ getKey $ getUnique uid G.OtherPkg uid -> put $ getKey $ getUnique uid return $! Util.fingerprintFingerprints $ - [ Util.fingerprintString fp + [ Util.fingerprintString file , fingerPrintImports , modLocationFingerprint ms_location ] ++ map Util.fingerprintString opts @@ -1183,11 +1193,11 @@ getModSummaryFromImports env fp _modTime mContents = do parseHeader :: Monad m => DynFlags -- ^ flags to use - -> FilePath -- ^ the filename (for source locations) + -> Uri -- ^ the filename (for source locations) -> Util.StringBuffer -- ^ Haskell module source text (full Unicode is supported) -> ExceptT [FileDiagnostic] m ([FileDiagnostic], Located (HsModule GhcPs)) parseHeader dflags filename contents = do - let loc = mkRealSrcLoc (Util.mkFastString filename) 1 1 + let loc = mkRealSrcLoc (Util.mkFastString $ T.unpack $ getUri filename) 1 1 case unP Compat.parseHeader (initParserState (initParserOpts dflags) contents loc) of PFailedWithErrorMessages msgs -> throwE $ diagFromGhcErrorMessages sourceParser dflags $ msgs dflags @@ -1215,11 +1225,11 @@ parseHeader dflags filename contents = do parseFileContents :: HscEnv -> (GHC.ParsedSource -> IdePreprocessedSource) - -> FilePath -- ^ the filename (for source locations) + -> Uri -- ^ the filename (for source locations) -> ModSummary -> ExceptT [FileDiagnostic] IO ([FileDiagnostic], ParsedModule) parseFileContents env customPreprocessor filename ms = do - let loc = mkRealSrcLoc (Util.mkFastString filename) 1 1 + let loc = mkRealSrcLoc (Util.mkFastString $ T.unpack $ getUri filename) 1 1 dflags = ms_hspp_opts ms contents = fromJust $ ms_hspp_buf ms case unP Compat.parseModule (initParserState (initParserOpts dflags) contents loc) of @@ -1270,7 +1280,7 @@ parseFileContents env customPreprocessor filename ms = do -- - remove duplicates -- - filter out the .hs/.lhs source filename if we have one -- - let n_hspp = normalise filename + let n_hspp = maybe (T.unpack $ getUri filename) normalise $ uriToFilePath filename TempDir tmp_dir = tmpDir dflags srcs0 = nubOrd $ filter (not . (tmp_dir `isPrefixOf`)) $ filter (/= n_hspp) @@ -1362,8 +1372,8 @@ data RecompilationInfo m = RecompilationInfo { source_version :: FileVersion , old_value :: Maybe (HiFileResult, FileVersion) - , get_file_version :: NormalizedFilePath -> m (Maybe FileVersion) - , get_linkable_hashes :: [NormalizedFilePath] -> m [BS.ByteString] + , get_file_version :: NormalizedUri -> m (Maybe FileVersion) + , get_linkable_hashes :: [NormalizedUri] -> m [BS.ByteString] , get_module_graph :: m DependencyInformation , regenerate :: Maybe LinkableType -> m ([FileDiagnostic], Maybe HiFileResult) -- ^ Action to regenerate an interface } @@ -1402,7 +1412,7 @@ loadInterface session ms linkableNeeded RecompilationInfo{..} = do mb_dest_version <- case mb_old_version of Just ver -> pure $ Just ver - Nothing -> get_file_version (toNormalizedFilePath' iface_file) + Nothing -> get_file_version (filePathToUri' $ toNormalizedFilePath' iface_file) -- The source is modified if it is newer than the destination (iface file) -- A more precise check for the core file is performed later @@ -1484,7 +1494,7 @@ parseRuntimeDeps anns = mkModuleEnv $ mapMaybe go anns -- the runtime dependencies of the module, to check if any of them are out of date -- Hopefully 'runtime_deps' will be empty if the module didn't actually use TH -- See Note [Recompilation avoidance in the presence of TH] -checkLinkableDependencies :: MonadIO m => ([NormalizedFilePath] -> m [BS.ByteString]) -> m DependencyInformation -> ModuleEnv BS.ByteString -> m (Maybe RecompileRequired) +checkLinkableDependencies :: MonadIO m => ([NormalizedUri] -> m [BS.ByteString]) -> m DependencyInformation -> ModuleEnv BS.ByteString -> m (Maybe RecompileRequired) checkLinkableDependencies get_linkable_hashes get_module_graph runtime_deps = do graph <- get_module_graph let go (mod, hash) = (,hash) <$> lookupModuleFile mod graph @@ -1602,8 +1612,8 @@ lookupName hsc_env name = exceptionHandle $ do where exceptionHandle x = x `catch` \(_ :: IOEnvFailure) -> pure Nothing -pathToModuleName :: FilePath -> ModuleName -pathToModuleName = mkModuleName . map rep +pathToModuleName :: Uri -> ModuleName +pathToModuleName = mkModuleName . map rep . T.unpack . getUri where rep c | isPathSeparator c = '_' rep ':' = '_' diff --git a/ghcide/src/Development/IDE/Core/FileExists.hs b/ghcide/src/Development/IDE/Core/FileExists.hs index 280cd14028..88eba64dd1 100644 --- a/ghcide/src/Development/IDE/Core/FileExists.hs +++ b/ghcide/src/Development/IDE/Core/FileExists.hs @@ -83,7 +83,7 @@ fast path by a check that the path also matches our watching patterns. -- | A map for tracking the file existence. -- If a path maps to 'True' then it exists; if it maps to 'False' then it doesn't exist'; and -- if it's not in the map then we don't know. -type FileExistsMap = STM.Map NormalizedFilePath Bool +type FileExistsMap = STM.Map NormalizedUri Bool -- | A wrapper around a mutable 'FileExistsState' newtype FileExistsMapVar = FileExistsMapVar FileExistsMap @@ -107,7 +107,7 @@ getFileExistsMapUntracked = do return v -- | Modify the global store of file exists and return the keys that need to be marked as dirty -modifyFileExists :: IdeState -> [(NormalizedFilePath, FileChangeType)] -> IO [Key] +modifyFileExists :: IdeState -> [(NormalizedUri, FileChangeType)] -> IO [Key] modifyFileExists state changes = do FileExistsMapVar var <- getIdeGlobalState state -- Masked to ensure that the previous values are flushed together with the map update @@ -133,7 +133,7 @@ fromChange FileChangeType_Changed = Nothing ------------------------------------------------------------------------------------- -- | Returns True if the file exists -getFileExists :: NormalizedFilePath -> Action Bool +getFileExists :: NormalizedUri -> Action Bool getFileExists fp = use_ GetFileExists fp {- Note [Which files should we watch?] @@ -183,9 +183,11 @@ fileExistsRules recorder lspEnv = do patterns = fmap Glob.compile globs fpMatches fp = any (`Glob.match`fp) patterns isWatched = if supportsWatchedFiles - then \f -> do - isWF <- isWorkspaceFile f - return $ isWF && fpMatches (fromNormalizedFilePath f) + then \uri -> case uriToNormalizedFilePath uri of + Nothing -> pure False + Just nfp -> do + isWF <- isWorkspaceFile nfp + return $ isWF && fpMatches (fromNormalizedFilePath nfp) else const $ pure False if supportsWatchedFiles @@ -195,7 +197,7 @@ fileExistsRules recorder lspEnv = do fileStoreRules (cmapWithPrio LogFileStore recorder) isWatched -- Requires an lsp client that provides WatchedFiles notifications, but assumes that this has already been checked. -fileExistsRulesFast :: Recorder (WithPriority Log) -> (NormalizedFilePath -> Action Bool) -> Rules () +fileExistsRulesFast :: Recorder (WithPriority Log) -> (NormalizedUri -> Action Bool) -> Rules () fileExistsRulesFast recorder isWatched = defineEarlyCutoff (cmapWithPrio LogShake recorder) $ RuleNoDiagnostics $ \GetFileExists file -> do isWF <- isWatched file @@ -220,7 +222,7 @@ For the VFS lookup, however, we won't get prompted to flush the result, so inste we use 'alwaysRerun'. -} -fileExistsFast :: NormalizedFilePath -> Action (Maybe BS.ByteString, Maybe Bool) +fileExistsFast :: NormalizedUri -> Action (Maybe BS.ByteString, Maybe Bool) fileExistsFast file = do -- Could in principle use 'alwaysRerun' here, but it's too slwo, See Note [Invalidating file existence results] mp <- getFileExistsMapUntracked @@ -240,17 +242,19 @@ fileExistsRulesSlow :: Recorder (WithPriority Log) -> Rules () fileExistsRulesSlow recorder = defineEarlyCutoff (cmapWithPrio LogShake recorder) $ RuleNoDiagnostics $ \GetFileExists file -> fileExistsSlow file -fileExistsSlow :: NormalizedFilePath -> Action (Maybe BS.ByteString, Maybe Bool) +fileExistsSlow :: NormalizedUri -> Action (Maybe BS.ByteString, Maybe Bool) fileExistsSlow file = do -- See Note [Invalidating file existence results] alwaysRerun exist <- getFileExistsVFS file pure (summarizeExists exist, Just exist) -getFileExistsVFS :: NormalizedFilePath -> Action Bool -getFileExistsVFS file = do - vf <- getVirtualFile file +getFileExistsVFS :: NormalizedUri -> Action Bool +getFileExistsVFS uri = do + vf <- getVirtualFile uri if isJust vf then pure True - else liftIO $ handle (\(_ :: IOException) -> return False) $ - Dir.doesFileExist (fromNormalizedFilePath file) + else case uriToNormalizedFilePath uri of + Nothing -> pure False + Just nfp -> liftIO $ handle (\(_ :: IOException) -> return False) $ + Dir.doesFileExist (fromNormalizedFilePath nfp) diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index 7dad386ece..480b024557 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -35,11 +35,13 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import qualified Data.HashMap.Strict as HashMap import Data.IORef +import Data.Maybe (fromMaybe) import qualified Data.Text as T import qualified Data.Text as Text import Data.Text.Utf16.Rope.Mixed (Rope) import Data.Time import Data.Time.Clock.POSIX +import Data.Traversable (for) import Development.IDE.Core.FileUtils import Development.IDE.Core.IdeConfiguration (isWorkspaceFile) import Development.IDE.Core.RuleTypes @@ -80,8 +82,8 @@ import System.IO.Unsafe data Log - = LogCouldNotIdentifyReverseDeps !NormalizedFilePath - | LogTypeCheckingReverseDeps !NormalizedFilePath !(Maybe [NormalizedFilePath]) + = LogCouldNotIdentifyReverseDeps !NormalizedUri + | LogTypeCheckingReverseDeps !NormalizedUri !(Maybe [NormalizedUri]) | LogShake Shake.Log deriving Show @@ -96,71 +98,80 @@ instance Pretty Log where <+> pretty (fmap (fmap show) reverseDepPaths) LogShake msg -> pretty msg -addWatchedFileRule :: Recorder (WithPriority Log) -> (NormalizedFilePath -> Action Bool) -> Rules () -addWatchedFileRule recorder isWatched = defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \AddWatchedFile f -> do - isAlreadyWatched <- isWatched f - isWp <- isWorkspaceFile f +addWatchedFileRule :: Recorder (WithPriority Log) -> (NormalizedUri -> Action Bool) -> Rules () +addWatchedFileRule recorder isWatched = defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \AddWatchedFile uri -> do + isAlreadyWatched <- isWatched uri + let mfp = uriToNormalizedFilePath uri + isWp <- fromMaybe False <$> traverse isWorkspaceFile mfp if isAlreadyWatched then pure (Just True) else if not isWp then pure (Just False) else do ShakeExtras{lspEnv} <- getShakeExtras case lspEnv of Just env -> fmap Just $ liftIO $ LSP.runLspT env $ - registerFileWatches [fromNormalizedFilePath f] + fmap (fromMaybe False) $ for mfp $ \fp -> + registerFileWatches [fromNormalizedFilePath fp] Nothing -> pure $ Just False getModificationTimeRule :: Recorder (WithPriority Log) -> Rules () -getModificationTimeRule recorder = defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \(GetModificationTime_ missingFileDiags) file -> - getModificationTimeImpl missingFileDiags file +getModificationTimeRule recorder = defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \(GetModificationTime_ missingFileDiags) uri -> + getModificationTimeImpl missingFileDiags uri getModificationTimeImpl :: Bool - -> NormalizedFilePath + -> NormalizedUri -> Action (Maybe BS.ByteString, ([FileDiagnostic], Maybe FileVersion)) -getModificationTimeImpl missingFileDiags file = do - let file' = fromNormalizedFilePath file +getModificationTimeImpl missingFileDiags nuri = do + let uri = fromNormalizedUri nuri let wrap time = (Just $ LBS.toStrict $ B.encode $ toRational time, ([], Just $ ModificationTime time)) - mbVf <- getVirtualFile file + mbVf <- getVirtualFile nuri case mbVf of Just (virtualFileVersion -> ver) -> do alwaysRerun pure (Just $ LBS.toStrict $ B.encode ver, ([], Just $ VFSVersion ver)) Nothing -> do - isWF <- use_ AddWatchedFile file + isWF <- use_ AddWatchedFile nuri if isWF then -- the file is watched so we can rely on FileWatched notifications, -- but also need a dependency on IsFileOfInterest to reinstall -- alwaysRerun when the file becomes VFS - void (use_ IsFileOfInterest file) - else if isInterface file + void (use_ IsFileOfInterest nuri) + else if isInterface nuri then -- interface files are tracked specially using the closed world assumption pure () else -- in all other cases we will need to freshly check the file system alwaysRerun - liftIO $ fmap wrap (getModTime file') - `catch` \(e :: IOException) -> do - let err | isDoesNotExistError e = "File does not exist: " ++ file' - | otherwise = "IO error while reading " ++ file' ++ ", " ++ displayException e - diag = ideErrorText file (T.pack err) - if isDoesNotExistError e && not missingFileDiags - then return (Nothing, ([], Nothing)) - else return (Nothing, ([diag], Nothing)) + case LSP.uriToFilePath uri of + -- NOTE: if the URI is *not* in the virtual file system but is also not a file URI, then + -- we have no other choice but failing - in future it might be possible to resolve different + -- kinds of URIs here. + Nothing -> pure (Nothing, ([ideErrorText nuri "Uri is not a fileuri"], Nothing)) + Just f -> do + liftIO $ fmap wrap (getModTime f) + `catch` \(e :: IOException) -> do + let err | isDoesNotExistError e = "File does not exist: " ++ f + | otherwise = "IO error while reading " ++ f ++ ", " ++ displayException e + diag = ideErrorText nuri (T.pack err) + if isDoesNotExistError e && not missingFileDiags + then return (Nothing, ([], Nothing)) + else return (Nothing, ([diag], Nothing)) -- | Interface files cannot be watched, since they live outside the workspace. -- But interface files are private, in that only HLS writes them. -- So we implement watching ourselves, and bypass the need for alwaysRerun. -isInterface :: NormalizedFilePath -> Bool -isInterface f = takeExtension (fromNormalizedFilePath f) `elem` [".hi", ".hi-boot", ".hie", ".hie-boot", ".core"] +isInterface :: NormalizedUri -> Bool +isInterface uri = case uriToNormalizedFilePath uri of + Nothing -> False + Just f -> takeExtension (fromNormalizedFilePath f) `elem` [".hi", ".hi-boot", ".hie", ".hie-boot", ".core"] -- | Reset the GetModificationTime state of interface files -resetInterfaceStore :: ShakeExtras -> NormalizedFilePath -> STM [Key] -resetInterfaceStore state f = do - deleteValue state GetModificationTime f +resetInterfaceStore :: ShakeExtras -> NormalizedUri -> STM [Key] +resetInterfaceStore state uri = deleteValue state GetModificationTime uri -- | Reset the GetModificationTime state of watched files -- Assumes the list does not include any FOIs -resetFileStore :: IdeState -> [(NormalizedFilePath, LSP.FileChangeType)] -> IO [Key] +resetFileStore :: IdeState -> [(NormalizedUri, LSP.FileChangeType)] -> IO [Key] resetFileStore ideState changes = mask $ \_ -> do -- we record FOIs document versions in all the stored values -- so NEVER reset FOIs to avoid losing their versions @@ -179,41 +190,41 @@ modificationTime VFSVersion{} = Nothing modificationTime (ModificationTime posix) = Just $ posixSecondsToUTCTime posix getFileContentsRule :: Recorder (WithPriority Log) -> Rules () -getFileContentsRule recorder = define (cmapWithPrio LogShake recorder) $ \GetFileContents file -> getFileContentsImpl file +getFileContentsRule recorder = define (cmapWithPrio LogShake recorder) $ \GetFileContents uri -> getFileContentsImpl uri getFileContentsImpl - :: NormalizedFilePath + :: NormalizedUri -> Action ([FileDiagnostic], Maybe (FileVersion, Maybe Rope)) -getFileContentsImpl file = do +getFileContentsImpl uri = do -- need to depend on modification time to introduce a dependency with Cutoff - time <- use_ GetModificationTime file + time <- use_ GetModificationTime uri res <- do - mbVirtual <- getVirtualFile file + mbVirtual <- getVirtualFile uri pure $ _file_text <$> mbVirtual pure ([], Just (time, res)) -- | Returns the modification time and the contents. -- For VFS paths, the modification time is the current time. -getFileModTimeContents :: NormalizedFilePath -> Action (UTCTime, Maybe Rope) -getFileModTimeContents f = do - (fv, contents) <- use_ GetFileContents f +getFileModTimeContents :: NormalizedUri -> Action (UTCTime, Maybe Rope) +getFileModTimeContents uri = do + (fv, contents) <- use_ GetFileContents uri modTime <- case modificationTime fv of Just t -> pure t Nothing -> do - foi <- use_ IsFileOfInterest f + foi <- use_ IsFileOfInterest uri liftIO $ case foi of IsFOI Modified{} -> getCurrentTime - _ -> do - posix <- getModTime $ fromNormalizedFilePath f + _ | Just nfp <- uriToNormalizedFilePath uri -> do + posix <- getModTime $ fromNormalizedFilePath nfp pure $ posixSecondsToUTCTime posix + _ -> getCurrentTime return (modTime, contents) -getFileContents :: NormalizedFilePath -> Action (Maybe Rope) -getFileContents f = snd <$> use_ GetFileContents f +getFileContents :: NormalizedUri -> Action (Maybe Rope) +getFileContents = getUriContents getUriContents :: NormalizedUri -> Action (Maybe Rope) -getUriContents uri = - join <$> traverse getFileContents (uriToNormalizedFilePath uri) +getUriContents uri = snd <$> use_ GetFileContents uri -- | Given a text document identifier, annotate it with the latest version. -- @@ -222,15 +233,13 @@ getUriContents uri = getVersionedTextDoc :: TextDocumentIdentifier -> Action VersionedTextDocumentIdentifier getVersionedTextDoc doc = do let uri = doc ^. L.uri - mvf <- - maybe (pure Nothing) getVirtualFile $ - uriToNormalizedFilePath $ toNormalizedUri uri - let ver = case mvf of + vf <- getVirtualFile $ toNormalizedUri uri + let ver = case vf of Just (VirtualFile lspver _ _) -> lspver Nothing -> 0 return (VersionedTextDocumentIdentifier uri ver) -fileStoreRules :: Recorder (WithPriority Log) -> (NormalizedFilePath -> Action Bool) -> Rules () +fileStoreRules :: Recorder (WithPriority Log) -> (NormalizedUri -> Action Bool) -> Rules () fileStoreRules recorder isWatched = do getModificationTimeRule recorder getFileContentsRule recorder @@ -242,33 +251,33 @@ setFileModified :: Recorder (WithPriority Log) -> VFSModified -> IdeState -> Bool -- ^ Was the file saved? - -> NormalizedFilePath + -> NormalizedUri -> IO [Key] -> IO () -setFileModified recorder vfs state saved nfp actionBefore = do +setFileModified recorder vfs state saved nuri actionBefore = do ideOptions <- getIdeOptionsIO $ shakeExtras state doCheckParents <- optCheckParents ideOptions let checkParents = case doCheckParents of AlwaysCheck -> True CheckOnSave -> saved _ -> False - restartShakeSession (shakeExtras state) vfs (fromNormalizedFilePath nfp ++ " (modified)") [] $ do + restartShakeSession (shakeExtras state) vfs (Text.unpack (getUri (fromNormalizedUri nuri)) ++ " (modified)") [] $ do keys<-actionBefore - return (toKey GetModificationTime nfp:keys) + return (toKey GetModificationTime nuri : keys) when checkParents $ - typecheckParents recorder state nfp + typecheckParents recorder state nuri -typecheckParents :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> IO () -typecheckParents recorder state nfp = void $ shakeEnqueue (shakeExtras state) parents - where parents = mkDelayedAction "ParentTC" L.Debug (typecheckParentsAction recorder nfp) +typecheckParents :: Recorder (WithPriority Log) -> IdeState -> NormalizedUri -> IO () +typecheckParents recorder state nuri = void $ shakeEnqueue (shakeExtras state) parents + where parents = mkDelayedAction "ParentTC" L.Debug (typecheckParentsAction recorder nuri) -typecheckParentsAction :: Recorder (WithPriority Log) -> NormalizedFilePath -> Action () -typecheckParentsAction recorder nfp = do - revs <- transitiveReverseDependencies nfp <$> useWithSeparateFingerprintRule_ GetModuleGraphTransReverseDepsFingerprints GetModuleGraph nfp +typecheckParentsAction :: Recorder (WithPriority Log) -> NormalizedUri -> Action () +typecheckParentsAction recorder nuri = do + revs <- transitiveReverseDependencies nuri <$> useWithSeparateFingerprintRule_ GetModuleGraphTransReverseDepsFingerprints GetModuleGraph nuri case revs of - Nothing -> logWith recorder Info $ LogCouldNotIdentifyReverseDeps nfp + Nothing -> logWith recorder Info $ LogCouldNotIdentifyReverseDeps nuri Just rs -> do - logWith recorder Info $ LogTypeCheckingReverseDeps nfp revs + logWith recorder Info $ LogTypeCheckingReverseDeps nuri revs void $ uses GetModIface rs -- | Note that some keys have been modified and restart the session diff --git a/ghcide/src/Development/IDE/Core/OfInterest.hs b/ghcide/src/Development/IDE/Core/OfInterest.hs index 19e0f40e24..625752f8cf 100644 --- a/ghcide/src/Development/IDE/Core/OfInterest.hs +++ b/ghcide/src/Development/IDE/Core/OfInterest.hs @@ -57,7 +57,7 @@ instance Pretty Log where pretty = \case LogShake msg -> pretty msg -newtype OfInterestVar = OfInterestVar (Var (HashMap NormalizedFilePath FileOfInterestStatus)) +newtype OfInterestVar = OfInterestVar (Var (HashMap NormalizedUri FileOfInterestStatus)) instance IsIdeGlobal OfInterestVar @@ -86,24 +86,24 @@ instance IsIdeGlobal GarbageCollectVar ------------------------------------------------------------ -- Exposed API -getFilesOfInterest :: IdeState -> IO( HashMap NormalizedFilePath FileOfInterestStatus) +getFilesOfInterest :: IdeState -> IO( HashMap NormalizedUri FileOfInterestStatus) getFilesOfInterest state = do OfInterestVar var <- getIdeGlobalState state readVar var -- | Set the files-of-interest - not usually necessary or advisable. -- The LSP client will keep this information up to date. -setFilesOfInterest :: IdeState -> HashMap NormalizedFilePath FileOfInterestStatus -> IO () +setFilesOfInterest :: IdeState -> HashMap NormalizedUri FileOfInterestStatus -> IO () setFilesOfInterest state files = do OfInterestVar var <- getIdeGlobalState state writeVar var files -getFilesOfInterestUntracked :: Action (HashMap NormalizedFilePath FileOfInterestStatus) +getFilesOfInterestUntracked :: Action (HashMap NormalizedUri FileOfInterestStatus) getFilesOfInterestUntracked = do OfInterestVar var <- getIdeGlobalAction liftIO $ readVar var -addFileOfInterest :: IdeState -> NormalizedFilePath -> FileOfInterestStatus -> IO [Key] +addFileOfInterest :: IdeState -> NormalizedUri -> FileOfInterestStatus -> IO [Key] addFileOfInterest state f v = do OfInterestVar var <- getIdeGlobalState state (prev, files) <- modifyVar var $ \dict -> do @@ -116,7 +116,7 @@ addFileOfInterest state f v = do return [toKey IsFileOfInterest f] else return [] -deleteFileOfInterest :: IdeState -> NormalizedFilePath -> IO [Key] +deleteFileOfInterest :: IdeState -> NormalizedUri -> IO [Key] deleteFileOfInterest state f = do OfInterestVar var <- getIdeGlobalState state files <- modifyVar' var $ HashMap.delete f @@ -138,7 +138,7 @@ kick = do signal msg = when testing $ liftIO $ mRunLspT lspEnv $ LSP.sendNotification (LSP.SMethod_CustomMethod msg) $ - toJSON $ map fromNormalizedFilePath files + toJSON $ map fromNormalizedUri files signal (Proxy @"kick/start") liftIO $ progressUpdate progress ProgressNewStarted diff --git a/ghcide/src/Development/IDE/Core/PluginUtils.hs b/ghcide/src/Development/IDE/Core/PluginUtils.hs index 6ba633df26..c832700bfc 100644 --- a/ghcide/src/Development/IDE/Core/PluginUtils.hs +++ b/ghcide/src/Development/IDE/Core/PluginUtils.hs @@ -52,7 +52,7 @@ import qualified Development.IDE.Core.Shake as Shake import Development.IDE.GHC.Orphans () import Development.IDE.Graph hiding (ShakeValue) import Development.IDE.Types.Diagnostics -import Development.IDE.Types.Location (NormalizedFilePath) +import Development.IDE.Types.Location (NormalizedUri) import qualified Development.IDE.Types.Location as Location import qualified Ide.Logger as Logger import Ide.Plugin.Error @@ -80,30 +80,30 @@ runActionMT herald ide act = join $ shakeEnqueue (shakeExtras ide) (mkDelayedAction herald Logger.Debug $ runMaybeT act) -- |ExceptT version of `use` that throws a PluginRuleFailed upon failure -useE :: IdeRule k v => k -> NormalizedFilePath -> ExceptT PluginError Action v +useE :: IdeRule k v => k -> NormalizedUri -> ExceptT PluginError Action v useE k = maybeToExceptT (PluginRuleFailed (T.pack $ show k)) . useMT k -- |MaybeT version of `use` -useMT :: IdeRule k v => k -> NormalizedFilePath -> MaybeT Action v +useMT :: IdeRule k v => k -> NormalizedUri -> MaybeT Action v useMT k = MaybeT . Shake.use k -- |ExceptT version of `uses` that throws a PluginRuleFailed upon failure -usesE :: (Traversable f, IdeRule k v) => k -> f NormalizedFilePath -> ExceptT PluginError Action (f v) +usesE :: (Traversable f, IdeRule k v) => k -> f NormalizedUri -> ExceptT PluginError Action (f v) usesE k = maybeToExceptT (PluginRuleFailed (T.pack $ show k)) . usesMT k -- |MaybeT version of `uses` -usesMT :: (Traversable f, IdeRule k v) => k -> f NormalizedFilePath -> MaybeT Action (f v) +usesMT :: (Traversable f, IdeRule k v) => k -> f NormalizedUri -> MaybeT Action (f v) usesMT k xs = MaybeT $ sequence <$> Shake.uses k xs -- |ExceptT version of `useWithStale` that throws a PluginRuleFailed upon -- failure useWithStaleE :: IdeRule k v - => k -> NormalizedFilePath -> ExceptT PluginError Action (v, PositionMapping) + => k -> NormalizedUri -> ExceptT PluginError Action (v, PositionMapping) useWithStaleE key = maybeToExceptT (PluginRuleFailed (T.pack $ show key)) . useWithStaleMT key -- |MaybeT version of `useWithStale` useWithStaleMT :: IdeRule k v - => k -> NormalizedFilePath -> MaybeT Action (v, PositionMapping) + => k -> NormalizedUri -> MaybeT Action (v, PositionMapping) useWithStaleMT key file = MaybeT $ runIdentity <$> Shake.usesWithStale key (Identity file) -- ---------------------------------------------------------------------------- @@ -120,11 +120,11 @@ runIdeActionMT _herald s i = MaybeT $ liftIO $ runReaderT (Shake.runIdeActionT $ -- |ExceptT version of `useWithStaleFast` that throws a PluginRuleFailed upon -- failure -useWithStaleFastE :: IdeRule k v => k -> NormalizedFilePath -> ExceptT PluginError IdeAction (v, PositionMapping) +useWithStaleFastE :: IdeRule k v => k -> NormalizedUri -> ExceptT PluginError IdeAction (v, PositionMapping) useWithStaleFastE k = maybeToExceptT (PluginRuleFailed (T.pack $ show k)) . useWithStaleFastMT k -- |MaybeT version of `useWithStaleFast` -useWithStaleFastMT :: IdeRule k v => k -> NormalizedFilePath -> MaybeT IdeAction (v, PositionMapping) +useWithStaleFastMT :: IdeRule k v => k -> NormalizedUri -> MaybeT IdeAction (v, PositionMapping) useWithStaleFastMT k = MaybeT . Shake.useWithStaleFast k -- ---------------------------------------------------------------------------- @@ -207,10 +207,10 @@ fromCurrentRangeMT mapping = MaybeT . pure . fromCurrentRange mapping -- -- Thus, even when the client sends us the context, we should compute the -- diagnostics on the server side. -activeDiagnosticsInRangeMT :: MonadIO m => Shake.ShakeExtras -> NormalizedFilePath -> LSP.Range -> MaybeT m [FileDiagnostic] -activeDiagnosticsInRangeMT ide nfp range = do +activeDiagnosticsInRangeMT :: MonadIO m => Shake.ShakeExtras -> NormalizedUri -> LSP.Range -> MaybeT m [FileDiagnostic] +activeDiagnosticsInRangeMT ide nuri range = do MaybeT $ liftIO $ atomically $ do - mDiags <- STM.lookup (LSP.normalizedFilePathToUri nfp) (Shake.publishedDiagnostics ide) + mDiags <- STM.lookup nuri (Shake.publishedDiagnostics ide) case mDiags of Nothing -> pure Nothing Just fileDiags -> do @@ -220,8 +220,8 @@ activeDiagnosticsInRangeMT ide nfp range = do rangesOverlap range (fileDiag ^. fdLspDiagnosticL . LSP.range) -- | Just like 'activeDiagnosticsInRangeMT'. See the docs of 'activeDiagnosticsInRangeMT' for details. -activeDiagnosticsInRange :: MonadIO m => Shake.ShakeExtras -> NormalizedFilePath -> LSP.Range -> m (Maybe [FileDiagnostic]) -activeDiagnosticsInRange ide nfp range = runMaybeT (activeDiagnosticsInRangeMT ide nfp range) +activeDiagnosticsInRange :: MonadIO m => Shake.ShakeExtras -> NormalizedUri -> LSP.Range -> m (Maybe [FileDiagnostic]) +activeDiagnosticsInRange ide nuri range = runMaybeT (activeDiagnosticsInRangeMT ide nuri range) -- ---------------------------------------------------------------------------- -- Formatting handlers @@ -237,19 +237,18 @@ mkFormattingHandlers f = mkPluginHandler SMethod_TextDocumentFormatting ( provid <> mkPluginHandler SMethod_TextDocumentRangeFormatting (provider SMethod_TextDocumentRangeFormatting) where provider :: forall m. FormattingMethod m => SMethod m -> PluginMethodHandler IdeState m - provider m ide _pid params - | Just nfp <- LSP.uriToNormalizedFilePath $ LSP.toNormalizedUri uri = do - contentsMaybe <- liftIO $ runAction "mkFormattingHandlers" ide $ getFileContents nfp - case contentsMaybe of - Just contents -> do - let (typ, mtoken) = case m of - SMethod_TextDocumentFormatting -> (FormatText, params ^. LSP.workDoneToken) - SMethod_TextDocumentRangeFormatting -> (FormatRange (params ^. LSP.range), params ^. LSP.workDoneToken) - _ -> Prelude.error "mkFormattingHandlers: impossible" - f ide mtoken typ (Rope.toText contents) nfp opts - Nothing -> throwError $ PluginInvalidParams $ T.pack $ "Formatter plugin: could not get file contents for " ++ show uri - - | otherwise = throwError $ PluginInvalidParams $ T.pack $ "Formatter plugin: uriToFilePath failed for: " ++ show uri + provider m ide _pid params = do + let nuri = LSP.toNormalizedUri uri + contentsMaybe <- liftIO $ runAction "mkFormattingHandlers" ide $ getFileContents nuri + case contentsMaybe of + Just contents -> do + let (typ, mtoken) = case m of + SMethod_TextDocumentFormatting -> (FormatText, params ^. LSP.workDoneToken) + SMethod_TextDocumentRangeFormatting -> (FormatRange (params ^. LSP.range), params ^. LSP.workDoneToken) + _ -> Prelude.error "mkFormattingHandlers: impossible" + f ide mtoken typ (Rope.toText contents) nuri opts + Nothing -> throwError $ PluginInvalidParams $ T.pack $ "Formatter plugin: could not get file contents for " ++ show uri + where uri = params ^. LSP.textDocument . LSP.uri opts = params ^. LSP.options diff --git a/ghcide/src/Development/IDE/Core/Preprocessor.hs b/ghcide/src/Development/IDE/Core/Preprocessor.hs index b3614d89ad..943e79fb1b 100644 --- a/ghcide/src/Development/IDE/Core/Preprocessor.hs +++ b/ghcide/src/Development/IDE/Core/Preprocessor.hs @@ -11,10 +11,12 @@ import qualified Development.IDE.GHC.Compat.Util as Util import Development.IDE.GHC.CPP import Development.IDE.GHC.Orphans () import qualified Development.IDE.GHC.Util as Util +import Language.LSP.Protocol.Types (uriToFilePath) import Control.DeepSeq (NFData (rnf)) import Control.Exception (evaluate) import Control.Exception.Safe (catch, throw) +import Control.Monad.Except (throwError) import Control.Monad.IO.Class import Control.Monad.Trans.Except import Data.Char @@ -35,11 +37,15 @@ import System.IO.Extra -- | Given a file and some contents, apply any necessary preprocessors, -- e.g. unlit/cpp. Return the resulting buffer and the DynFlags it implies. -preprocessor :: HscEnv -> FilePath -> Maybe Util.StringBuffer -> ExceptT [FileDiagnostic] IO (Util.StringBuffer, [String], HscEnv, Util.Fingerprint) -preprocessor env filename mbContents = do +preprocessor :: HscEnv -> Uri -> Maybe Util.StringBuffer -> ExceptT [FileDiagnostic] IO (Util.StringBuffer, [String], HscEnv, Util.Fingerprint) +preprocessor env uri mbContents = case uriToFilePath uri of + Nothing -> do + let nuri = toNormalizedUri uri + throwError [ideErrorText nuri $ "Uri is not a file uri: " <> getUri uri] + Just filename -> do -- Perform unlit (isOnDisk, contents) <- - if isLiterate filename then do + if isLiterate uri then do newcontent <- liftIO $ runLhs env filename mbContents return (False, newcontent) else do @@ -52,7 +58,7 @@ preprocessor env filename mbContents = do !src_hash <- liftIO $ Util.fingerprintFromStringBuffer contents -- Perform cpp - (opts, pEnv) <- ExceptT $ parsePragmasIntoHscEnv env filename contents + (opts, pEnv) <- ExceptT $ parsePragmasIntoHscEnv env uri contents let dflags = hsc_dflags pEnv let logger = hsc_logger pEnv (newIsOnDisk, newContents, newOpts, newEnv) <- @@ -71,7 +77,7 @@ preprocessor env filename mbContents = do [] -> throw e diags -> return $ Left diags ) - (options, hscEnv) <- ExceptT $ parsePragmasIntoHscEnv pEnv filename con + (options, hscEnv) <- ExceptT $ parsePragmasIntoHscEnv pEnv uri con return (False, con, options, hscEnv) -- Perform preprocessor @@ -79,7 +85,7 @@ preprocessor env filename mbContents = do return (newContents, newOpts, newEnv, src_hash) else do con <- liftIO $ runPreprocessor newEnv filename $ if newIsOnDisk then Nothing else Just newContents - (options, hscEnv) <- ExceptT $ parsePragmasIntoHscEnv newEnv filename con + (options, hscEnv) <- ExceptT $ parsePragmasIntoHscEnv newEnv uri con return (con, options, hscEnv, src_hash) where logAction :: IORef [CPPLog] -> LogActionCompat @@ -104,7 +110,7 @@ data CPPDiag diagsFromCPPLogs :: FilePath -> [CPPLog] -> [FileDiagnostic] diagsFromCPPLogs filename logs = - map (\d -> ideErrorFromLspDiag (cppDiagToDiagnostic d) (toNormalizedFilePath' filename) Nothing) $ + map (\d -> ideErrorFromLspDiag (cppDiagToDiagnostic d) (filePathToUri' $ toNormalizedFilePath' filename) Nothing) $ go [] logs where -- On errors, CPP calls logAction with a real span for the initial log and @@ -133,18 +139,19 @@ diagsFromCPPLogs filename logs = } -isLiterate :: FilePath -> Bool -isLiterate x = takeExtension x `elem` [".lhs",".lhs-boot"] +isLiterate :: Uri -> Bool +isLiterate x | Just f <- uriToFilePath' x = takeExtension f `elem` [".lhs",".lhs-boot"] + | otherwise = False -- | This reads the pragma information directly from the provided buffer. parsePragmasIntoHscEnv :: HscEnv - -> FilePath + -> Uri -> Util.StringBuffer -> IO (Either [FileDiagnostic] ([String], HscEnv)) -parsePragmasIntoHscEnv env fp contents = catchSrcErrors dflags0 "pragmas" $ do - let (_warns,opts) = getOptions (initParserOpts dflags0) contents fp +parsePragmasIntoHscEnv env uri contents = catchSrcErrors dflags0 "pragmas" $ do + let (_warns,opts) = getOptions (initParserOpts dflags0) contents (fromMaybe (show uri) $ uriToFilePath uri) -- Force bits that might keep the dflags and stringBuffer alive unnecessarily evaluate $ rnf opts diff --git a/ghcide/src/Development/IDE/Core/ProgressReporting.hs b/ghcide/src/Development/IDE/Core/ProgressReporting.hs index 3d8a2bf989..f7863b7e78 100644 --- a/ghcide/src/Development/IDE/Core/ProgressReporting.hs +++ b/ghcide/src/Development/IDE/Core/ProgressReporting.hs @@ -56,7 +56,7 @@ data ProgressReporting = ProgressReporting data PerFileProgressReporting = PerFileProgressReporting { - inProgress :: forall a. NormalizedFilePath -> IO a -> IO a, + inProgress :: forall a. NormalizedUri -> IO a -> IO a, -- ^ see Note [ProgressReporting API and InProgressState] progressReportingInner :: ProgressReporting } @@ -127,13 +127,13 @@ data InProgressState todoVar :: TVar Int, -- | Number of files done doneVar :: TVar Int, - currentVar :: STM.Map NormalizedFilePath Int + currentVar :: STM.Map NormalizedUri Int } newInProgress :: IO InProgressState newInProgress = InProgressState <$> newTVarIO 0 <*> newTVarIO 0 <*> STM.newIO -recordProgress :: InProgressState -> NormalizedFilePath -> (Int -> Int) -> IO () +recordProgress :: InProgressState -> NormalizedUri -> (Int -> Int) -> IO () recordProgress InProgressState {..} file shift = do (prev, new) <- atomicallyNamed "recordProgress" $ STM.focus alterPrevAndNew file currentVar atomicallyNamed "recordProgress2" $ case (prev, new) of @@ -184,17 +184,17 @@ progressReporting (Just lspEnv) title optProgressStyle = do progressReportingInner <- progressReportingNoTrace (readTVar $ todoVar inProgressState) (readTVar $ doneVar inProgressState) (Just lspEnv) title optProgressStyle let - inProgress :: NormalizedFilePath -> IO a -> IO a + inProgress :: NormalizedUri -> IO a -> IO a inProgress = updateStateForFile inProgressState return PerFileProgressReporting {..} where - updateStateForFile inProgress file = UnliftIO.bracket (liftIO $ f succ) (const $ liftIO $ f pred) . const + updateStateForFile inProgress uri = UnliftIO.bracket (liftIO $ f succ) (const $ liftIO $ f pred) . const where -- This functions are deliberately eta-expanded to avoid space leaks. -- Do not remove the eta-expansion without profiling a session with at -- least 1000 modifications. - f = recordProgress inProgress file + f = recordProgress inProgress uri -- Kill this to complete the progress session progressCounter :: diff --git a/ghcide/src/Development/IDE/Core/RuleTypes.hs b/ghcide/src/Development/IDE/Core/RuleTypes.hs index 43b80be119..2669461a82 100644 --- a/ghcide/src/Development/IDE/Core/RuleTypes.hs +++ b/ghcide/src/Development/IDE/Core/RuleTypes.hs @@ -46,7 +46,7 @@ import GHC.Serialized (Serialized) import Ide.Logger (Pretty (..), viaShow) import Language.LSP.Protocol.Types (Int32, - NormalizedFilePath) + NormalizedUri) data LinkableType = ObjectLinkable | BCOLinkable deriving (Eq,Ord,Show, Generic) @@ -121,7 +121,7 @@ instance NFData GetImportMap type instance RuleResult GetImportMap = ImportMap newtype ImportMap = ImportMap - { importMap :: M.Map ModuleName NormalizedFilePath -- ^ Where are the modules imported by this file located? + { importMap :: M.Map ModuleName NormalizedUri -- ^ Where are the modules imported by this file located? } deriving stock Show deriving newtype NFData diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index f1b11d971b..e575dce397 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -162,7 +162,7 @@ import Ide.Types (DynFlagsModificat import qualified Language.LSP.Protocol.Lens as JL import Language.LSP.Protocol.Message (SMethod (SMethod_CustomMethod, SMethod_WindowShowMessage)) import Language.LSP.Protocol.Types (MessageType (MessageType_Info), - ShowMessageParams (ShowMessageParams)) + ShowMessageParams (ShowMessageParams), normalizedFilePathToUri, uriToNormalizedFilePath) import Language.LSP.Server (LspT) import qualified Language.LSP.Server as LSP import Language.LSP.VFS @@ -176,18 +176,18 @@ import GHC.Fingerprint data Log = LogShake Shake.Log - | LogReindexingHieFile !NormalizedFilePath + | LogReindexingHieFile !NormalizedUri | LogLoadingHieFile !NormalizedFilePath | LogLoadingHieFileFail !FilePath !SomeException | LogLoadingHieFileSuccess !FilePath - | LogTypecheckedFOI !NormalizedFilePath + | LogTypecheckedFOI !NormalizedUri deriving Show instance Pretty Log where pretty = \case LogShake msg -> pretty msg LogReindexingHieFile path -> - "Re-indexing hie file for" <+> pretty (fromNormalizedFilePath path) + "Re-indexing hie file for" <+> pretty (fromNormalizedUri path) LogLoadingHieFile path -> "LOADING HIE FILE FOR" <+> pretty (fromNormalizedFilePath path) LogLoadingHieFileFail path e -> @@ -198,7 +198,7 @@ instance Pretty Log where LogLoadingHieFileSuccess path -> "SUCCEEDED LOADING HIE FILE FOR" <+> pretty path LogTypecheckedFOI path -> vcat - [ "Typechecked a file which is not currently open in the editor:" <+> pretty (fromNormalizedFilePath path) + [ "Typechecked a file which is not currently open in the editor:" <+> pretty (fromNormalizedUri path) , "This can indicate a bug which results in excessive memory usage." , "This may be a spurious warning if you have recently closed the file." , "If you haven't opened this file recently, please file a report on the issue tracker mentioning" @@ -223,18 +223,18 @@ toIdeResult = either (, Nothing) (([],) . Just) -- TODO: return text --> return rope getSourceFileSource :: NormalizedFilePath -> Action BS.ByteString getSourceFileSource nfp = do - msource <- getFileContents nfp + msource <- getFileContents $ normalizedFilePathToUri nfp case msource of Nothing -> liftIO $ BS.readFile (fromNormalizedFilePath nfp) Just source -> pure $ T.encodeUtf8 $ Rope.toText source -- | Parse the contents of a haskell file. -getParsedModule :: NormalizedFilePath -> Action (Maybe ParsedModule) +getParsedModule :: NormalizedUri -> Action (Maybe ParsedModule) getParsedModule = use GetParsedModule -- | Parse the contents of a haskell file, -- ensuring comments are preserved in annotations -getParsedModuleWithComments :: NormalizedFilePath -> Action (Maybe ParsedModule) +getParsedModuleWithComments :: NormalizedUri -> Action (Maybe ParsedModule) getParsedModuleWithComments = use GetParsedModuleWithComments ------------------------------------------------------------ @@ -253,8 +253,8 @@ getParsedModuleWithComments = use GetParsedModuleWithComments getParsedModuleRule :: Recorder (WithPriority Log) -> Rules () getParsedModuleRule recorder = -- this rule does not have early cutoff since all its dependencies already have it - define (cmapWithPrio LogShake recorder) $ \GetParsedModule file -> do - ModSummaryResult{msrModSummary = ms', msrHscEnv = hsc} <- use_ GetModSummary file + define (cmapWithPrio LogShake recorder) $ \GetParsedModule uri -> do + ModSummaryResult{msrModSummary = ms', msrHscEnv = hsc} <- use_ GetModSummary uri opt <- getIdeOptions modify_dflags <- getModifyDynFlags dynFlagsModifyParser let ms = ms' { ms_hspp_opts = modify_dflags $ ms_hspp_opts ms' } @@ -262,7 +262,7 @@ getParsedModuleRule recorder = -- We still parse with Haddocks whether Opt_Haddock is True or False to collect information -- but we no longer need to parse with and without Haddocks separately for above GHC90. - liftIO $ (fmap.fmap.fmap) reset_ms $ getParsedModuleDefinition hsc opt file (withOptHaddock ms) + liftIO $ (fmap.fmap.fmap) reset_ms $ getParsedModuleDefinition hsc opt uri (withOptHaddock ms) withOptHaddock :: ModSummary -> ModSummary withOptHaddock = withOption Opt_Haddock @@ -301,11 +301,11 @@ getModifyDynFlags f = do getParsedModuleDefinition :: HscEnv -> IdeOptions - -> NormalizedFilePath + -> NormalizedUri -> ModSummary -> IO ([FileDiagnostic], Maybe ParsedModule) -getParsedModuleDefinition packageState opt file ms = do - let fp = fromNormalizedFilePath file - (diag, res) <- parseModule opt packageState fp ms +getParsedModuleDefinition packageState opt nuri ms = do + let uri = fromNormalizedUri nuri + (diag, res) <- parseModule opt packageState uri ms case res of Nothing -> pure (diag, Nothing) Just modu -> pure (diag, Just modu) @@ -321,20 +321,22 @@ getLocatedImportsRule recorder = let import_dirs = map (second homeUnitEnv_dflags) $ hugElts $ hsc_HUG env let dflags = hsc_dflags env opt <- getIdeOptions - let getTargetFor modName nfp + let getTargetFor modName (nfp :: NormalizedFilePath) | Just (TargetFile nfp') <- HM.lookup (TargetFile nfp) targetsMap = do -- reuse the existing NormalizedFilePath in order to maximize sharing - itExists <- getFileExists nfp' - return $ if itExists then Just nfp' else Nothing + itExists <- getFileExists (normalizedFilePathToUri nfp') + return $ if itExists then Just nfp else Nothing | Just tt <- HM.lookup (TargetModule modName) targets = do -- reuse the existing NormalizedFilePath in order to maximize sharing let ttmap = HM.mapWithKey const (HashSet.toMap tt) - nfp' = HM.lookupDefault nfp nfp ttmap - itExists <- getFileExists nfp' - return $ if itExists then Just nfp' else Nothing + nuri' = HM.lookupDefault nuri nuri ttmap + itExists <- getFileExists nuri' + return $ if itExists then Just nfp else Nothing | otherwise = do - itExists <- getFileExists nfp + itExists <- getFileExists nuri return $ if itExists then Just nfp else Nothing + where + nuri = normalizedFilePathToUri nfp (diags, imports') <- fmap unzip $ forM imports $ \(isSource, (mbPkgName, modName)) -> do diagOrImp <- locateModule (hscSetFlags dflags env) import_dirs (optExtensions opt) getTargetFor modName mbPkgName isSource case diagOrImp of @@ -370,7 +372,7 @@ execRawDepM act = -- | Given a target file path, construct the raw dependency results by following -- imports recursively. -rawDependencyInformation :: [NormalizedFilePath] -> Action (RawDependencyInformation, BootIdMap) +rawDependencyInformation :: [NormalizedUri] -> Action (RawDependencyInformation, BootIdMap) rawDependencyInformation fs = do (rdi, ss) <- execRawDepM (goPlural fs) let bm = IntMap.foldrWithKey (updateBootMap rdi) IntMap.empty ss @@ -380,7 +382,7 @@ rawDependencyInformation fs = do mss <- lift $ (fmap.fmap) msrModSummary <$> uses GetModSummaryWithoutTimestamps ff zipWithM go ff mss - go :: NormalizedFilePath -- ^ Current module being processed + go :: NormalizedUri -- ^ Current module being processed -> Maybe ModSummary -- ^ ModSummary of the module -> RawDepM FilePathId go f mbModSum = do @@ -415,7 +417,7 @@ rawDependencyInformation fs = do (mns, ls) = unzip with_file -- Recursively process all the imports we just learnt about -- and get back a list of their FilePathIds - fids <- goPlural $ map artifactFilePath ls + fids <- goPlural $ map artifactUri ls -- Associate together the ModuleName with the FilePathId let moduleImports' = map (,Nothing) no_file ++ zip mns (map Just fids) -- Insert into the map the information about this modules @@ -424,7 +426,7 @@ rawDependencyInformation fs = do return fId - checkAlreadyProcessed :: NormalizedFilePath -> RawDepM FilePathId -> RawDepM FilePathId + checkAlreadyProcessed :: NormalizedUri -> RawDepM FilePathId -> RawDepM FilePathId checkAlreadyProcessed nfp k = do (rawDepInfo, _) <- get maybe k return (lookupPathToId (rawPathIdMap rawDepInfo) nfp) @@ -458,14 +460,14 @@ rawDependencyInformation fs = do updateBootMap pm boot_mod_id ArtifactsLocation{..} bm = if not artifactIsSource then - let msource_mod_id = lookupPathToId (rawPathIdMap pm) (toNormalizedFilePath' $ dropBootSuffix $ fromNormalizedFilePath artifactFilePath) + let msource_mod_id = lookupPathToId (rawPathIdMap pm) (toNormalizedUri $ dropBootSuffix $ fromNormalizedUri artifactUri) in case msource_mod_id of Just source_mod_id -> insertBootId source_mod_id (FilePathId boot_mod_id) bm Nothing -> bm else bm - dropBootSuffix :: FilePath -> FilePath - dropBootSuffix hs_src = reverse . drop (length @[] "-boot") . reverse $ hs_src + dropBootSuffix :: Uri -> Uri + dropBootSuffix = Uri . T.dropEnd (length @[] "-boot") . getUri reportImportCyclesRule :: Recorder (WithPriority Log) -> Rules () reportImportCyclesRule recorder = @@ -491,7 +493,7 @@ reportImportCyclesRule recorder = ideErrorWithSource (Just "Import cycle detection") (Just DiagnosticSeverity_Error) fp ("Cyclic module dependency between " <> showCycle mods) Nothing & fdLspDiagnosticL %~ JL.range .~ rng where rng = fromMaybe noRange $ srcSpanToRange (getLoc imp) - fp = toNormalizedFilePath' $ fromMaybe noFilePath $ srcSpanToFilename (getLoc imp) + fp = filePathToUri' $ toNormalizedFilePath' $ fromMaybe noFilePath $ srcSpanToFilename (getLoc imp) getModuleName file = do ms <- msrModSummary <$> use_ GetModSummaryWithoutTimestamps file pure (moduleNameString . moduleName . ms_mod $ ms) @@ -505,19 +507,20 @@ getHieAstsRule recorder = getHieAstRuleDefinition f hsc tmr persistentHieFileRule :: Recorder (WithPriority Log) -> Rules () -persistentHieFileRule recorder = addPersistentRule GetHieAst $ \file -> runMaybeT $ do - res <- readHieFileForSrcFromDisk recorder file +persistentHieFileRule recorder = addPersistentRule GetHieAst $ \nuri -> runMaybeT $ do + res <- readHieFileForSrcFromDisk recorder nuri vfsRef <- asks vfsVar vfsData <- liftIO $ _vfsMap <$> readTVarIO vfsRef - (currentSource, ver) <- liftIO $ case M.lookup (filePathToUri' file) vfsData of - Nothing -> (,Nothing) . T.decodeUtf8 <$> BS.readFile (fromNormalizedFilePath file) + (currentSource, ver) <- liftIO $ case M.lookup nuri vfsData of + Nothing | Just nfp <- uriToNormalizedFilePath nuri -> (,Nothing) . T.decodeUtf8 <$> BS.readFile (fromNormalizedFilePath nfp) + | otherwise -> pure ("", Nothing) Just vf -> pure (virtualFileText vf, Just $ virtualFileVersion vf) let refmap = Compat.generateReferencesMap . Compat.getAsts . Compat.hie_asts $ res del = deltaFromDiff (T.decodeUtf8 $ Compat.hie_hs_src res) currentSource pure (HAR (Compat.hie_module res) (Compat.hie_asts res) refmap mempty (HieFromDisk res),del,ver) -getHieAstRuleDefinition :: NormalizedFilePath -> HscEnv -> TcModuleResult -> Action (IdeResult HieAstResult) -getHieAstRuleDefinition f hsc tmr = do +getHieAstRuleDefinition :: NormalizedUri -> HscEnv -> TcModuleResult -> Action (IdeResult HieAstResult) +getHieAstRuleDefinition nuri hsc tmr = do (diags, masts') <- liftIO $ generateHieAsts hsc tmr #if MIN_VERSION_ghc(9,11,0) let masts = fst <$> masts' @@ -526,14 +529,14 @@ getHieAstRuleDefinition f hsc tmr = do #endif se <- getShakeExtras - isFoi <- use_ IsFileOfInterest f + isFoi <- use_ IsFileOfInterest nuri diagsWrite <- case isFoi of IsFOI Modified{firstOpen = False} -> do when (coerce $ ideTesting se) $ liftIO $ mRunLspT (lspEnv se) $ LSP.sendNotification (SMethod_CustomMethod (Proxy @"ghcide/reference/ready")) $ - toJSON $ fromNormalizedFilePath f + toJSON $ fromNormalizedUri nuri pure [] - _ | Just asts <- masts' -> do + _ | Just asts <- masts', Just f <- uriToNormalizedFilePath nuri -> do source <- getSourceFileSource f let exports = tcg_exports $ tmrTypechecked tmr modSummary = tmrModSummary tmr @@ -547,7 +550,7 @@ getHieAstRuleDefinition f hsc tmr = do getImportMapRule :: Recorder (WithPriority Log) -> Rules () getImportMapRule recorder = define (cmapWithPrio LogShake recorder) $ \GetImportMap f -> do im <- use GetLocatedImports f - let mkImports fileImports = M.fromList $ mapMaybe (\(m, mfp) -> (unLoc m,) . artifactFilePath <$> mfp) fileImports + let mkImports fileImports = M.fromList $ mapMaybe (\(m, mfp) -> (unLoc m,) . artifactUri <$> mfp) fileImports pure ([], ImportMap . mkImports <$> im) -- | Ensure that go to definition doesn't block on startup @@ -578,9 +581,10 @@ getDocMapRule recorder = persistentDocMapRule :: Rules () persistentDocMapRule = addPersistentRule GetDocMap $ \_ -> pure $ Just (DKMap mempty mempty, idDelta, Nothing) -readHieFileForSrcFromDisk :: Recorder (WithPriority Log) -> NormalizedFilePath -> MaybeT IdeAction Compat.HieFile -readHieFileForSrcFromDisk recorder file = do +readHieFileForSrcFromDisk :: Recorder (WithPriority Log) -> NormalizedUri -> MaybeT IdeAction Compat.HieFile +readHieFileForSrcFromDisk recorder uri = do ShakeExtras{withHieDb} <- ask + file <- hoistMaybe $ uriToNormalizedFilePath uri row <- MaybeT $ liftIO $ withHieDb (\hieDb -> HieDb.lookupHieFileFromSource hieDb $ fromNormalizedFilePath file) let hie_loc = HieDb.hieModuleHieFile row liftIO $ logWith recorder Logger.Debug $ LogLoadingHieFile file @@ -616,17 +620,18 @@ knownFilesRule recorder = defineEarlyCutOffNoFile (cmapWithPrio LogShake recorde getFileHashRule :: Recorder (WithPriority Log) -> Rules () getFileHashRule recorder = - defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GetFileHash file -> do - void $ use_ GetModificationTime file - fileHash <- liftIO $ Util.getFileHash (fromNormalizedFilePath file) - return (Just (fingerprintToBS fileHash), ([], Just fileHash)) + defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GetFileHash uri -> do + void $ use_ GetModificationTime uri + let mfile = uriToNormalizedFilePath uri + fileHash <- traverse (liftIO . Util.getFileHash . fromNormalizedFilePath) mfile + return (fingerprintToBS <$> fileHash, ([], fileHash)) getModuleGraphRule :: Recorder (WithPriority Log) -> Rules () getModuleGraphRule recorder = defineEarlyCutOffNoFile (cmapWithPrio LogShake recorder) $ \GetModuleGraph -> do fs <- toKnownFiles <$> useNoFile_ GetKnownTargets dependencyInfoForFiles (HashSet.toList fs) -dependencyInfoForFiles :: [NormalizedFilePath] -> Action (BS.ByteString, DependencyInformation) +dependencyInfoForFiles :: [NormalizedUri] -> Action (BS.ByteString, DependencyInformation) dependencyInfoForFiles fs = do (rawDepInfo, bm) <- rawDependencyInformation fs let (all_fs, _all_ids) = unzip $ HM.toList $ pathToIdMap $ rawPathIdMap rawDepInfo @@ -653,7 +658,7 @@ dependencyInfoForFiles fs = do typeCheckRuleDefinition :: HscEnv -> ParsedModule - -> NormalizedFilePath + -> NormalizedUri -> Action (IdeResult TcModuleResult) typeCheckRuleDefinition hsc pm fp = do IdeOptions { optDefer = defer } <- getIdeOptions @@ -671,7 +676,7 @@ typeCheckRuleDefinition hsc pm fp = do r@(_, mtc) <- a forM_ mtc $ \tc -> do used_files <- liftIO $ readIORef $ tcg_dependent_files $ tmrTypechecked tc - void $ uses_ GetModificationTime (map toNormalizedFilePath' used_files) + void $ uses_ GetModificationTime (map (filePathToUri' . toNormalizedFilePath') used_files) return r -- | Get all the linkables stored in the graph, i.e. the ones we *do not* need to unload. @@ -704,26 +709,29 @@ loadGhcSession recorder ghcSessionDepsConfig = do ] return (fingerprint, res) - defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GhcSession file -> do + defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GhcSession uri -> do IdeGhcSession{loadSessionFun} <- useNoFile_ GhcSessionIO -- loading is always returning a absolute path now - (val,deps) <- liftIO $ loadSessionFun $ fromNormalizedFilePath file + (val,deps) <- case uriToNormalizedFilePath uri of + Just file -> liftIO $ loadSessionFun $ fromNormalizedFilePath file + Nothing -> pure (([], Nothing), []) + -- add the deps to the Shake graph let addDependency fp = do -- VSCode uses absolute paths in its filewatch notifications - let nfp = toNormalizedFilePath' fp - itExists <- getFileExists nfp + let uri' = filePathToUri' $ toNormalizedFilePath' fp + itExists <- getFileExists uri' when itExists $ void $ do - use_ GetModificationTime nfp + use_ GetModificationTime uri' mapM_ addDependency deps let cutoffHash = LBS.toStrict $ B.encode (hash (snd val)) return (Just cutoffHash, val) - defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \(GhcSessionDeps_ fullModSummary) file -> do - env <- use_ GhcSession file - ghcSessionDepsDefinition fullModSummary ghcSessionDepsConfig env file + defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \(GhcSessionDeps_ fullModSummary) uri -> do + env <- use_ GhcSession uri + ghcSessionDepsDefinition fullModSummary ghcSessionDepsConfig env uri newtype GhcSessionDepsConfig = GhcSessionDepsConfig { fullModuleGraph :: Bool @@ -742,11 +750,11 @@ instance Default GhcSessionDepsConfig where ghcSessionDepsDefinition :: -- | full mod summary Bool -> - GhcSessionDepsConfig -> HscEnvEq -> NormalizedFilePath -> Action (Maybe HscEnvEq) + GhcSessionDepsConfig -> HscEnvEq -> NormalizedUri -> Action (Maybe HscEnvEq) ghcSessionDepsDefinition fullModSummary GhcSessionDepsConfig{..} env file = do let hsc = hscEnv env - mbdeps <- mapM(fmap artifactFilePath . snd) <$> use_ GetLocatedImports file + mbdeps <- mapM(fmap artifactUri . snd) <$> use_ GetLocatedImports file case mbdeps of Nothing -> return Nothing Just deps -> do @@ -825,15 +833,17 @@ getModIfaceFromDiskRule recorder = defineEarlyCutoff (cmapWithPrio LogShake reco getModIfaceFromDiskAndIndexRule :: Recorder (WithPriority Log) -> Rules () getModIfaceFromDiskAndIndexRule recorder = -- doesn't need early cutoff since all its dependencies already have it - defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \GetModIfaceFromDiskAndIndex f -> do - x <- use_ GetModIfaceFromDisk f + defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \GetModIfaceFromDiskAndIndex uri -> do + x <- use_ GetModIfaceFromDisk uri se@ShakeExtras{withHieDb} <- getShakeExtras -- GetModIfaceFromDisk should have written a `.hie` file, must check if it matches version in db let ms = hirModSummary x hie_loc = Compat.ml_hie_file $ ms_location ms fileHash <- liftIO $ Util.getFileHash hie_loc - mrow <- liftIO $ withHieDb (\hieDb -> HieDb.lookupHieFileFromSource hieDb (fromNormalizedFilePath f)) + mrow <- runMaybeT $ do + f <- hoistMaybe $ uriToNormalizedFilePath uri + MaybeT $ liftIO $ withHieDb (\hieDb -> HieDb.lookupHieFileFromSource hieDb (fromNormalizedFilePath f)) let hie_loc' = HieDb.hieModuleHieFile <$> mrow case mrow of Just row @@ -843,7 +853,7 @@ getModIfaceFromDiskAndIndexRule recorder = -- All good, the db has indexed the file when (coerce $ ideTesting se) $ liftIO $ mRunLspT (lspEnv se) $ LSP.sendNotification (SMethod_CustomMethod (Proxy @"ghcide/reference/ready")) $ - toJSON $ fromNormalizedFilePath f + toJSON $ fromNormalizedUri uri -- Not in db, must re-index _ -> do ehf <- liftIO $ runIdeAction "GetModIfaceFromDiskAndIndex" se $ runExceptT $ @@ -853,8 +863,10 @@ getModIfaceFromDiskAndIndexRule recorder = Left err -> fail $ "failed to read .hie file " ++ show hie_loc ++ ": " ++ displayException err -- can just re-index the file we read from disk Right hf -> liftIO $ do - logWith recorder Logger.Debug $ LogReindexingHieFile f - indexHieFile se ms f fileHash hf + logWith recorder Logger.Debug $ LogReindexingHieFile uri + case uriToNormalizedFilePath uri of + Nothing -> pure () + Just fp -> indexHieFile se ms fp fileHash hf return (Just x) @@ -872,12 +884,12 @@ getModSummaryRule displayTHWarning recorder = do logItOnce <- liftIO $ once $ putStrLn "" addIdeGlobal (DisplayTHWarning logItOnce) - defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GetModSummary f -> do - session' <- hscEnv <$> use_ GhcSession f + defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GetModSummary uri -> do + session' <- hscEnv <$> use_ GhcSession uri modify_dflags <- getModifyDynFlags dynFlagsModifyGlobal let session = setNonHomeFCHook $ hscSetFlags (modify_dflags $ hsc_dflags session') session' -- TODO wz1000 - (modTime, mFileContent) <- getFileModTimeContents f - let fp = fromNormalizedFilePath f + (modTime, mFileContent) <- getFileModTimeContents uri + let fp = fromNormalizedUri uri modS <- liftIO $ runExceptT $ getModSummaryFromImports session fp modTime (textToStringBuffer . Rope.toText <$> mFileContent) case modS of @@ -903,11 +915,11 @@ getModSummaryRule displayTHWarning recorder = do return (Just fp, Just res{msrModSummary = ms}) Nothing -> return (Nothing, Nothing) -generateCore :: RunSimplifier -> NormalizedFilePath -> Action (IdeResult ModGuts) -generateCore runSimplifier file = do - packageState <- hscEnv <$> use_ GhcSessionDeps file +generateCore :: RunSimplifier -> NormalizedUri -> Action (IdeResult ModGuts) +generateCore runSimplifier furi = do + packageState <- hscEnv <$> use_ GhcSessionDeps furi hsc' <- setFileCacheHook packageState - tm <- use_ TypeCheck file + tm <- use_ TypeCheck furi liftIO $ compileModule runSimplifier hsc' (tmrModSummary tm) (tmrTypechecked tm) generateCoreRule :: Recorder (WithPriority Log) -> Rules () @@ -967,19 +979,19 @@ setFileCacheHook old_hsc_env = do -- | Also generates and indexes the `.hie` file, along with the `.o` file if needed -- Invariant maintained is that if the `.hi` file was successfully written, then the -- `.hie` and `.o` file (if needed) were also successfully written -regenerateHiFile :: HscEnvEq -> NormalizedFilePath -> ModSummary -> Maybe LinkableType -> Action ([FileDiagnostic], Maybe HiFileResult) -regenerateHiFile sess f ms compNeeded = do +regenerateHiFile :: HscEnvEq -> NormalizedUri -> ModSummary -> Maybe LinkableType -> Action ([FileDiagnostic], Maybe HiFileResult) +regenerateHiFile sess uri ms compNeeded = do hsc <- setFileCacheHook (hscEnv sess) opt <- getIdeOptions -- Embed haddocks in the interface file - (diags, mb_pm) <- liftIO $ getParsedModuleDefinition hsc opt f (withOptHaddock ms) + (diags, mb_pm) <- liftIO $ getParsedModuleDefinition hsc opt uri (withOptHaddock ms) case mb_pm of Nothing -> return (diags, Nothing) Just pm -> do -- Invoke typechecking directly to update it without incurring a dependency -- on the parsed module and the typecheck rules - (diags', mtmr) <- typeCheckRuleDefinition hsc pm f + (diags', mtmr) <- typeCheckRuleDefinition hsc pm uri case mtmr of Nothing -> pure (diags', Nothing) Just tmr -> do @@ -993,16 +1005,16 @@ regenerateHiFile sess f ms compNeeded = do -- Write hi file hiDiags <- case res of - Just !hiFile -> do + Just !hiFile | Just file <- uriToNormalizedFilePath uri -> do -- Write hie file. Do this before writing the .hi file to -- ensure that we always have a up2date .hie file if we have -- a .hi file se' <- getShakeExtras (gDiags, masts) <- liftIO $ generateHieAsts hsc tmr - source <- getSourceFileSource f + source <- getSourceFileSource file wDiags <- forM masts $ \asts -> - liftIO $ writeAndIndexHieFile hsc se' (tmrModSummary tmr) f (tcg_exports $ tmrTypechecked tmr) asts source + liftIO $ writeAndIndexHieFile hsc se' (tmrModSummary tmr) file (tcg_exports $ tmrTypechecked tmr) asts source -- We don't write the `.hi` file if there are deferred errors, since we won't get -- accurate diagnostics next time if we do @@ -1011,7 +1023,7 @@ regenerateHiFile sess f ms compNeeded = do else pure [] pure (hiDiags <> gDiags <> concat wDiags) - Nothing -> pure [] + _ -> pure [] return (diags <> diags' <> diags'' <> hiDiags, res) @@ -1129,12 +1141,12 @@ getLinkableRule recorder = return (fileHash <$ hmi, (warns, LinkableResult <$> hmi <*> pure fileHash)) -- | For now we always use bytecode unless something uses unboxed sums and tuples along with TH -getLinkableType :: NormalizedFilePath -> Action (Maybe LinkableType) +getLinkableType :: NormalizedUri -> Action (Maybe LinkableType) getLinkableType f = use_ NeedsCompilation f -needsCompilationRule :: NormalizedFilePath -> Action (IdeResultNoDiagnosticsEarlyCutoff (Maybe LinkableType)) +needsCompilationRule :: NormalizedUri -> Action (IdeResultNoDiagnosticsEarlyCutoff (Maybe LinkableType)) needsCompilationRule file - | "boot" `isSuffixOf` fromNormalizedFilePath file = + | "boot" `T.isSuffixOf` getUri (fromNormalizedUri file) = pure (Just $ encodeLinkableType Nothing, Just Nothing) needsCompilationRule file = do graph <- useWithSeparateFingerprintRule GetModuleGraphImmediateReverseDepsFingerprints GetModuleGraph file @@ -1266,10 +1278,11 @@ mainRule recorder RulesConfig{..} = do -- | Get HieFile for haskell file on NormalizedFilePath getHieFile :: NormalizedFilePath -> Action (Maybe HieFile) getHieFile nfp = runMaybeT $ do - HAR {hieAst} <- MaybeT $ use GetHieAst nfp - tmr <- MaybeT $ use TypeCheck nfp - ghc <- MaybeT $ use GhcSession nfp - msr <- MaybeT $ use GetModSummaryWithoutTimestamps nfp + let nuri = normalizedFilePathToUri nfp + HAR {hieAst} <- MaybeT $ use GetHieAst nuri + tmr <- MaybeT $ use TypeCheck nuri + ghc <- MaybeT $ use GhcSession nuri + msr <- MaybeT $ use GetModSummaryWithoutTimestamps nuri source <- lift $ getSourceFileSource nfp let exports = tcg_exports $ tmrTypechecked tmr typedAst <- MaybeT $ pure $ cast hieAst diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index 6fc9a4d00e..049efa533c 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -107,8 +107,7 @@ import Data.Hashable import qualified Data.HashMap.Strict as HMap import Data.HashSet (HashSet) import qualified Data.HashSet as HSet -import Data.List.Extra (foldl', partition, - takeEnd) +import Data.List.Extra (partition, takeEnd) import qualified Data.Map.Strict as Map import Data.Maybe import qualified Data.SortedList as SL @@ -130,6 +129,7 @@ import Development.IDE.Types.Options as Options import qualified Language.LSP.Protocol.Message as LSP import qualified Language.LSP.Server as LSP +import qualified Data.Text as Text import Development.IDE.Core.Tracing import Development.IDE.Core.WorkerThread import Development.IDE.GHC.Compat (NameCache, @@ -195,7 +195,7 @@ data Log | LogLookupPersistentKey !T.Text | LogShakeGarbageCollection !T.Text !Int !Seconds -- * OfInterest Log messages - | LogSetFilesOfInterest ![(NormalizedFilePath, FileOfInterestStatus)] + | LogSetFilesOfInterest ![(NormalizedUri, FileOfInterestStatus)] deriving Show instance Pretty Log where @@ -238,7 +238,7 @@ instance Pretty Log where pretty label <+> "of" <+> pretty number <+> "keys (took " <+> pretty (showDuration duration) <> ")" LogSetFilesOfInterest ofInterest -> "Set files of interst to" <> Pretty.line - <> indent 4 (pretty $ fmap (first fromNormalizedFilePath) ofInterest) + <> indent 4 (pretty $ fmap (first fromNormalizedUri) ofInterest) -- | We need to serialize writes to the database, so we send any function that -- needs to write to the database over the channel, where it will be picked up by @@ -286,7 +286,7 @@ data ShakeExtras = ShakeExtras -- ^ This represents the set of diagnostics that we have published. -- Due to debouncing not every change might get published. - ,semanticTokensCache:: STM.Map NormalizedFilePath SemanticTokens + ,semanticTokensCache:: STM.Map NormalizedUri SemanticTokens -- ^ Cache of last response of semantic tokens for each file, -- so we can compute deltas for semantic tokens(SMethod_TextDocumentSemanticTokensFullDelta). -- putting semantic tokens cache and id in shakeExtras might not be ideal @@ -341,7 +341,7 @@ type WithProgressFunc = forall a. type WithIndefiniteProgressFunc = forall a. T.Text -> LSP.ProgressCancellable -> IO a -> IO a -type GetStalePersistent = NormalizedFilePath -> IdeAction (Maybe (Dynamic,PositionDelta,Maybe Int32)) +type GetStalePersistent = NormalizedUri -> IdeAction (Maybe (Dynamic,PositionDelta,Maybe Int32)) getShakeExtras :: Action ShakeExtras getShakeExtras = do @@ -383,18 +383,18 @@ getPluginConfigAction plId = do -- This is called when we don't already have a result, or computing the rule failed. -- The result of this function will always be marked as 'stale', and a 'proper' rebuild of the rule will -- be queued if the rule hasn't run before. -addPersistentRule :: IdeRule k v => k -> (NormalizedFilePath -> IdeAction (Maybe (v,PositionDelta,Maybe Int32))) -> Rules () +addPersistentRule :: IdeRule k v => k -> (NormalizedUri -> IdeAction (Maybe (v,PositionDelta,Maybe Int32))) -> Rules () addPersistentRule k getVal = do ShakeExtras{persistentKeys} <- getShakeExtrasRules - void $ liftIO $ atomically $ modifyTVar' persistentKeys $ insertKeyMap (newKey k) (fmap (fmap (first3 toDyn)) . getVal) + liftIO $ atomically $ modifyTVar' persistentKeys $ insertKeyMap (newKey k) (fmap (fmap (first3 toDyn)) . getVal) class Typeable a => IsIdeGlobal a where -- | Read a virtual file from the current snapshot -getVirtualFile :: NormalizedFilePath -> Action (Maybe VirtualFile) -getVirtualFile nf = do +getVirtualFile :: NormalizedUri -> Action (Maybe VirtualFile) +getVirtualFile uri = do vfs <- fmap _vfsMap . liftIO . readTVarIO . vfsVar =<< getShakeExtras - pure $! Map.lookup (filePathToUri' nf) vfs -- Don't leak a reference to the entire map + pure $! Map.lookup uri vfs -- Don't leak a reference to the entire map -- Take a snapshot of the current LSP VFS vfsSnapshot :: Maybe (LSP.LanguageContextEnv a) -> IO VFS @@ -451,8 +451,8 @@ getIdeOptionsIO ide = do -- | Return the most recent, potentially stale, value and a PositionMapping -- for the version of that value. -lastValueIO :: IdeRule k v => ShakeExtras -> k -> NormalizedFilePath -> IO (Maybe (v, PositionMapping)) -lastValueIO s@ShakeExtras{positionMapping,persistentKeys,state} k file = do +lastValueIO :: IdeRule k v => ShakeExtras -> k -> NormalizedUri -> IO (Maybe (v, PositionMapping)) +lastValueIO s@ShakeExtras{positionMapping,persistentKeys,state} k uri = do let readPersistent | IdeTesting testing <- ideTesting s -- Don't read stale persistent values in tests @@ -461,21 +461,23 @@ lastValueIO s@ShakeExtras{positionMapping,persistentKeys,state} k file = do pmap <- readTVarIO persistentKeys mv <- runMaybeT $ do liftIO $ logWith (shakeRecorder s) Debug $ LogLookupPersistentKey (T.pack $ show k) - f <- MaybeT $ pure $ lookupKeyMap (newKey k) pmap - (dv,del,ver) <- MaybeT $ runIdeAction "lastValueIO" s $ f file + f <- hoistMaybe $ lookupKeyMap (newKey k) pmap + (dv,del,ver) <- MaybeT $ runIdeAction "lastValueIO" s $ f uri MaybeT $ pure $ (,del,ver) <$> fromDynamic dv case mv of Nothing -> atomicallyNamed "lastValueIO 1" $ do - STM.focus (Focus.alter (alterValue $ Failed True)) (toKey k file) state + STM.focus (Focus.alter (alterValue $ Failed True)) (toKey k uri) state return Nothing Just (v,del,mbVer) -> do actual_version <- case mbVer of Just ver -> pure (Just $ VFSVersion ver) - Nothing -> (Just . ModificationTime <$> getModTime (fromNormalizedFilePath file)) - `catch` (\(_ :: IOException) -> pure Nothing) + Nothing -> handle @IOException (const $ pure Nothing) $ runMaybeT $ do + nfp <- hoistMaybe $ uriToNormalizedFilePath uri + modTime <- liftIO $ getModTime $ fromNormalizedFilePath nfp + pure (ModificationTime modTime) atomicallyNamed "lastValueIO 2" $ do - STM.focus (Focus.alter (alterValue $ Stale (Just del) actual_version (toDyn v))) (toKey k file) state - Just . (v,) . addOldDelta del <$> mappingForVersion positionMapping file actual_version + STM.focus (Focus.alter (alterValue $ Stale (Just del) actual_version (toDyn v))) (toKey k uri) state + Just . (v,) . addOldDelta del <$> mappingForVersion positionMapping uri actual_version -- We got a new stale value from the persistent rule, insert it in the map without affecting diagnostics alterValue new Nothing = Just (ValueWithDiagnostics new mempty) -- If it wasn't in the map, give it empty diagnostics @@ -485,30 +487,30 @@ lastValueIO s@ShakeExtras{positionMapping,persistentKeys,state} k file = do -- Something already succeeded before, leave it alone _ -> old - atomicallyNamed "lastValueIO 4" (STM.lookup (toKey k file) state) >>= \case + atomicallyNamed "lastValueIO 4" (STM.lookup (toKey k uri) state) >>= \case Nothing -> readPersistent Just (ValueWithDiagnostics value _) -> case value of Succeeded ver (fromDynamic -> Just v) -> - atomicallyNamed "lastValueIO 5" $ Just . (v,) <$> mappingForVersion positionMapping file ver + atomicallyNamed "lastValueIO 5" $ Just . (v,) <$> mappingForVersion positionMapping uri ver Stale del ver (fromDynamic -> Just v) -> - atomicallyNamed "lastValueIO 6" $ Just . (v,) . maybe id addOldDelta del <$> mappingForVersion positionMapping file ver + atomicallyNamed "lastValueIO 6" $ Just . (v,) . maybe id addOldDelta del <$> mappingForVersion positionMapping uri ver Failed p | not p -> readPersistent _ -> pure Nothing -- | Return the most recent, potentially stale, value and a PositionMapping -- for the version of that value. -lastValue :: IdeRule k v => k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping)) -lastValue key file = do +lastValue :: IdeRule k v => k -> NormalizedUri -> Action (Maybe (v, PositionMapping)) +lastValue key uri = do s <- getShakeExtras - liftIO $ lastValueIO s key file + liftIO $ lastValueIO s key uri mappingForVersion :: STM.Map NormalizedUri (EnumMap Int32 (a, PositionMapping)) - -> NormalizedFilePath + -> NormalizedUri -> Maybe FileVersion -> STM PositionMapping -mappingForVersion allMappings file (Just (VFSVersion ver)) = do - mapping <- STM.lookup (filePathToUri' file) allMappings +mappingForVersion allMappings uri (Just (VFSVersion ver)) = do + mapping <- STM.lookup uri allMappings return $ maybe zeroMapping snd $ EM.lookup ver =<< mapping mappingForVersion _ _ _ = pure zeroMapping @@ -583,12 +585,12 @@ shakeDatabaseProfileIO mbProfileDir = do setValues :: IdeRule k v => Values -> k - -> NormalizedFilePath + -> NormalizedUri -> Value v -> Vector FileDiagnostic -> STM () -setValues state key file val diags = - STM.insert (ValueWithDiagnostics (fmap toDyn val) diags) (toKey key file) state +setValues state key uri val diags = + STM.insert (ValueWithDiagnostics (fmap toDyn val) diags) (toKey key uri) state -- | Delete the value stored for a given ide build key @@ -597,11 +599,11 @@ deleteValue :: Shake.ShakeValue k => ShakeExtras -> k - -> NormalizedFilePath + -> NormalizedUri -> STM [Key] -deleteValue ShakeExtras{state} key file = do - STM.delete (toKey key file) state - return [toKey key file] +deleteValue ShakeExtras{state} key uri = do + STM.delete (toKey key uri) state + return [toKey key uri] -- | We return Nothing if the rule has not run and Just Failed if it has failed to produce a value. @@ -610,10 +612,10 @@ getValues :: IdeRule k v => Values -> k -> - NormalizedFilePath -> + NormalizedUri -> STM (Maybe (Value v, Vector FileDiagnostic)) -getValues state key file = do - STM.lookup (toKey key file) state >>= \case +getValues state key uri = do + STM.lookup (toKey key uri) state >>= \case Nothing -> pure Nothing Just (ValueWithDiagnostics v diagsV) -> do let !r = seqValue $ fmap (fromJust . fromDynamic @v) v @@ -1010,23 +1012,23 @@ preservedKeys checkParents = HSet.fromList $ -- | Define a new Rule without early cutoff define :: IdeRule k v - => Recorder (WithPriority Log) -> (k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules () + => Recorder (WithPriority Log) -> (k -> NormalizedUri -> Action (IdeResult v)) -> Rules () define recorder op = defineEarlyCutoff recorder $ Rule $ \k v -> (Nothing,) <$> op k v defineNoDiagnostics :: IdeRule k v - => Recorder (WithPriority Log) -> (k -> NormalizedFilePath -> Action (Maybe v)) -> Rules () + => Recorder (WithPriority Log) -> (k -> NormalizedUri -> Action (Maybe v)) -> Rules () defineNoDiagnostics recorder op = defineEarlyCutoff recorder $ RuleNoDiagnostics $ \k v -> (Nothing,) <$> op k v -- | Request a Rule result if available use :: IdeRule k v - => k -> NormalizedFilePath -> Action (Maybe v) -use key file = runIdentity <$> uses key (Identity file) + => k -> NormalizedUri -> Action (Maybe v) +use key uri = runIdentity <$> uses key (Identity uri) -- | Request a Rule result, it not available return the last computed result, if any, which may be stale useWithStale :: IdeRule k v - => k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping)) -useWithStale key file = runIdentity <$> usesWithStale key (Identity file) + => k -> NormalizedUri -> Action (Maybe (v, PositionMapping)) +useWithStale key uri = runIdentity <$> usesWithStale key (Identity uri) -- |Request a Rule result, it not available return the last computed result -- which may be stale. @@ -1036,8 +1038,8 @@ useWithStale key file = runIdentity <$> usesWithStale key (Identity file) -- -- WARNING: Not suitable for PluginHandlers. Use `useWithStaleE` instead. useWithStale_ :: IdeRule k v - => k -> NormalizedFilePath -> Action (v, PositionMapping) -useWithStale_ key file = runIdentity <$> usesWithStale_ key (Identity file) + => k -> NormalizedUri -> Action (v, PositionMapping) +useWithStale_ key uri = runIdentity <$> usesWithStale_ key (Identity uri) -- |Plural version of 'useWithStale_' -- @@ -1045,9 +1047,9 @@ useWithStale_ key file = runIdentity <$> usesWithStale_ key (Identity file) -- none available. -- -- WARNING: Not suitable for PluginHandlers. -usesWithStale_ :: (Traversable f, IdeRule k v) => k -> f NormalizedFilePath -> Action (f (v, PositionMapping)) -usesWithStale_ key files = do - res <- usesWithStale key files +usesWithStale_ :: (Traversable f, IdeRule k v) => k -> f NormalizedUri -> Action (f (v, PositionMapping)) +usesWithStale_ key uris = do + res <- usesWithStale key uris case sequence res of Nothing -> liftIO $ throwIO $ BadDependency (show key) Just v -> return v @@ -1076,27 +1078,27 @@ data FastResult a = FastResult { stale :: Maybe (a,PositionMapping), uptoDate :: -- | Lookup value in the database and return with the stale value immediately -- Will queue an action to refresh the value. -- Might block the first time the rule runs, but never blocks after that. -useWithStaleFast :: IdeRule k v => k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping)) -useWithStaleFast key file = stale <$> useWithStaleFast' key file +useWithStaleFast :: IdeRule k v => k -> NormalizedUri -> IdeAction (Maybe (v, PositionMapping)) +useWithStaleFast key uri = stale <$> useWithStaleFast' key uri -- | Same as useWithStaleFast but lets you wait for an up to date result -useWithStaleFast' :: IdeRule k v => k -> NormalizedFilePath -> IdeAction (FastResult v) -useWithStaleFast' key file = do +useWithStaleFast' :: IdeRule k v => k -> NormalizedUri -> IdeAction (FastResult v) +useWithStaleFast' key uri = do -- This lookup directly looks up the key in the shake database and -- returns the last value that was computed for this key without -- checking freshness. -- Async trigger the key to be built anyway because we want to -- keep updating the value in the key. - waitValue <- delayedAction $ mkDelayedAction ("C:" ++ show key ++ ":" ++ fromNormalizedFilePath file) Debug $ use key file + waitValue <- delayedAction $ mkDelayedAction ("C:" ++ show key ++ ":" ++ Text.unpack (getUri (fromNormalizedUri uri))) Debug $ use key uri s@ShakeExtras{state} <- askShake - r <- liftIO $ atomicallyNamed "useStateFast" $ getValues state key file + r <- liftIO $ atomicallyNamed "useStateFast" $ getValues state key uri liftIO $ case r of -- block for the result if we haven't computed before Nothing -> do -- Check if we can get a stale value from disk - res <- lastValueIO s key file + res <- lastValueIO s key uri case res of Nothing -> do a <- waitValue @@ -1104,11 +1106,11 @@ useWithStaleFast' key file = do Just _ -> pure $ FastResult res waitValue -- Otherwise, use the computed value even if it's out of date. Just _ -> do - res <- lastValueIO s key file + res <- lastValueIO s key uri pure $ FastResult res waitValue useNoFile :: IdeRule k v => k -> Action (Maybe v) -useNoFile key = use key emptyFilePath +useNoFile key = use key emptyPathUri -- Requests a rule if available. -- @@ -1116,11 +1118,11 @@ useNoFile key = use key emptyFilePath -- none available. -- -- WARNING: Not suitable for PluginHandlers. Use `useE` instead. -use_ :: IdeRule k v => k -> NormalizedFilePath -> Action v +use_ :: IdeRule k v => k -> NormalizedUri -> Action v use_ key file = runIdentity <$> uses_ key (Identity file) useNoFile_ :: IdeRule k v => k -> Action v -useNoFile_ key = use_ key emptyFilePath +useNoFile_ key = use_ key emptyPathUri -- |Plural version of `use_` -- @@ -1128,58 +1130,58 @@ useNoFile_ key = use_ key emptyFilePath -- none available. -- -- WARNING: Not suitable for PluginHandlers. Use `usesE` instead. -uses_ :: (Traversable f, IdeRule k v) => k -> f NormalizedFilePath -> Action (f v) -uses_ key files = do - res <- uses key files +uses_ :: (Traversable f, IdeRule k v) => k -> f NormalizedUri -> Action (f v) +uses_ key uris = do + res <- uses key uris case sequence res of Nothing -> liftIO $ throwIO $ BadDependency (show key) Just v -> return v -- | Plural version of 'use' uses :: (Traversable f, IdeRule k v) - => k -> f NormalizedFilePath -> Action (f (Maybe v)) -uses key files = fmap (\(A value) -> currentValue value) <$> apply (fmap (Q . (key,)) files) + => k -> f NormalizedUri -> Action (f (Maybe v)) +uses key uris = fmap (\(A value) -> currentValue value) <$> apply (fmap (Q . (key,)) uris) -- | Return the last computed result which might be stale. usesWithStale :: (Traversable f, IdeRule k v) - => k -> f NormalizedFilePath -> Action (f (Maybe (v, PositionMapping))) -usesWithStale key files = do - _ <- apply (fmap (Q . (key,)) files) + => k -> f NormalizedUri -> Action (f (Maybe (v, PositionMapping))) +usesWithStale key uris = do + _ <- apply (fmap (Q . (key,)) uris) -- We don't look at the result of the 'apply' since 'lastValue' will -- return the most recent successfully computed value regardless of -- whether the rule succeeded or not. - traverse (lastValue key) files + traverse (lastValue key) uris -- we use separate fingerprint rules to trigger the rebuild of the rule useWithSeparateFingerprintRule :: (IdeRule k v, IdeRule k1 Fingerprint) - => k1 -> k -> NormalizedFilePath -> Action (Maybe v) -useWithSeparateFingerprintRule fingerKey key file = do - _ <- use fingerKey file - useWithoutDependency key emptyFilePath + => k1 -> k -> NormalizedUri -> Action (Maybe v) +useWithSeparateFingerprintRule fingerKey key uri = do + _ <- use fingerKey uri + useWithoutDependency key emptyPathUri -- we use separate fingerprint rules to trigger the rebuild of the rule useWithSeparateFingerprintRule_ :: (IdeRule k v, IdeRule k1 Fingerprint) - => k1 -> k -> NormalizedFilePath -> Action v + => k1 -> k -> NormalizedUri -> Action v useWithSeparateFingerprintRule_ fingerKey key file = do useWithSeparateFingerprintRule fingerKey key file >>= \case Just v -> return v Nothing -> liftIO $ throwIO $ BadDependency (show key) useWithoutDependency :: IdeRule k v - => k -> NormalizedFilePath -> Action (Maybe v) -useWithoutDependency key file = - (\(Identity (A value)) -> currentValue value) <$> applyWithoutDependency (Identity (Q (key, file))) + => k -> NormalizedUri -> Action (Maybe v) +useWithoutDependency key uri = + (\(Identity (A value)) -> currentValue value) <$> applyWithoutDependency (Identity (Q (key, uri))) data RuleBody k v - = Rule (k -> NormalizedFilePath -> Action (Maybe BS.ByteString, IdeResult v)) - | RuleNoDiagnostics (k -> NormalizedFilePath -> Action (Maybe BS.ByteString, Maybe v)) + = Rule (k -> NormalizedUri -> Action (Maybe BS.ByteString, IdeResult v)) + | RuleNoDiagnostics (k -> NormalizedUri -> Action (Maybe BS.ByteString, Maybe v)) | RuleWithCustomNewnessCheck { newnessCheck :: BS.ByteString -> BS.ByteString -> Bool - , build :: k -> NormalizedFilePath -> Action (Maybe BS.ByteString, Maybe v) + , build :: k -> NormalizedUri -> Action (Maybe BS.ByteString, Maybe v) } - | RuleWithOldValue (k -> NormalizedFilePath -> Value v -> Action (Maybe BS.ByteString, IdeResult v)) + | RuleWithOldValue (k -> NormalizedUri -> Value v -> Action (Maybe BS.ByteString, IdeResult v)) -- | Define a new Rule with early cutoff defineEarlyCutoff @@ -1187,12 +1189,12 @@ defineEarlyCutoff => Recorder (WithPriority Log) -> RuleBody k v -> Rules () -defineEarlyCutoff recorder (Rule op) = addRule $ \(Q (key, file)) (old :: Maybe BS.ByteString) mode -> otTracedAction key file mode traceA $ \traceDiagnostics -> do +defineEarlyCutoff recorder (Rule op) = addRule $ \(Q (key, uri)) (old :: Maybe BS.ByteString) mode -> otTracedAction key uri mode traceA $ \traceDiagnostics -> do extras <- getShakeExtras let diagnostics ver diags = do traceDiagnostics diags - updateFileDiagnostics recorder file ver (newKey key) extras diags - defineEarlyCutoff' diagnostics (==) key file old mode $ const $ op key file + updateDiagnostics recorder uri ver (newKey key) extras diags + defineEarlyCutoff' diagnostics (==) key uri old mode $ const $ op key uri defineEarlyCutoff recorder (RuleNoDiagnostics op) = addRule $ \(Q (key, file)) (old :: Maybe BS.ByteString) mode -> otTracedAction key file mode traceA $ \traceDiagnostics -> do let diagnostics _ver diags = do traceDiagnostics diags @@ -1210,17 +1212,17 @@ defineEarlyCutoff recorder (RuleWithOldValue op) = addRule $ \(Q (key, file)) (o extras <- getShakeExtras let diagnostics ver diags = do traceDiagnostics diags - updateFileDiagnostics recorder file ver (newKey key) extras diags + updateDiagnostics recorder file ver (newKey key) extras diags defineEarlyCutoff' diagnostics (==) key file old mode $ op key file defineNoFile :: IdeRule k v => Recorder (WithPriority Log) -> (k -> Action v) -> Rules () -defineNoFile recorder f = defineNoDiagnostics recorder $ \k file -> do - if file == emptyFilePath then do res <- f k; return (Just res) else +defineNoFile recorder f = defineNoDiagnostics recorder $ \k uri -> do + if uri == emptyPathUri then do res <- f k; return (Just res) else fail $ "Rule " ++ show k ++ " should always be called with the empty string for a file" defineEarlyCutOffNoFile :: IdeRule k v => Recorder (WithPriority Log) -> (k -> Action (BS.ByteString, v)) -> Rules () -defineEarlyCutOffNoFile recorder f = defineEarlyCutoff recorder $ RuleNoDiagnostics $ \k file -> do - if file == emptyFilePath then do (hashString, res) <- f k; return (Just hashString, Just res) else +defineEarlyCutOffNoFile recorder f = defineEarlyCutoff recorder $ RuleNoDiagnostics $ \k uri -> do + if uri == emptyPathUri then do (hashString, res) <- f k; return (Just hashString, Just res) else fail $ "Rule " ++ show k ++ " should always be called with the empty string for a file" defineEarlyCutoff' @@ -1229,24 +1231,24 @@ defineEarlyCutoff' -- | compare current and previous for freshness -> (BS.ByteString -> BS.ByteString -> Bool) -> k - -> NormalizedFilePath + -> NormalizedUri -> Maybe BS.ByteString -> RunMode -> (Value v -> Action (Maybe BS.ByteString, IdeResult v)) -> Action (RunResult (A (RuleResult k))) -defineEarlyCutoff' doDiagnostics cmp key file mbOld mode action = do +defineEarlyCutoff' doDiagnostics cmp key uri mbOld mode action = do ShakeExtras{state, progress, dirtyKeys} <- getShakeExtras options <- getIdeOptions let trans g x = withRunInIO $ \run -> g (run x) - (if optSkipProgress options key then id else trans (inProgress progress file)) $ do + (if optSkipProgress options key then id else trans (inProgress progress uri)) $ do val <- case mbOld of Just old | mode == RunDependenciesSame -> do - mbValue <- liftIO $ atomicallyNamed "define - read 1" $ getValues state key file + mbValue <- liftIO $ atomicallyNamed "define - read 1" $ getValues state key uri case mbValue of -- No changes in the dependencies and we have -- an existing successful result. Just (v@(Succeeded _ x), diags) -> do - ver <- estimateFileVersionUnsafely key (Just x) file + ver <- estimateFileVersionUnsafely key (Just x) uri doDiagnostics (vfsVersion =<< ver) $ Vector.toList diags return $ Just $ RunResult ChangedNothing old (A v) $ return () _ -> return Nothing @@ -1257,7 +1259,7 @@ defineEarlyCutoff' doDiagnostics cmp key file mbOld mode action = do res <- case val of Just res -> return res Nothing -> do - staleV <- liftIO $ atomicallyNamed "define -read 3" $ getValues state key file <&> \case + staleV <- liftIO $ atomicallyNamed "define -read 3" $ getValues state key uri <&> \case Nothing -> Failed False Just (Succeeded ver v, _) -> Stale Nothing ver v Just (Stale d ver v, _) -> Stale d ver v @@ -1265,9 +1267,9 @@ defineEarlyCutoff' doDiagnostics cmp key file mbOld mode action = do (mbBs, (diags, mbRes)) <- actionCatch (do v <- action staleV; liftIO $ evaluate $ force v) $ \(e :: SomeException) -> do - pure (Nothing, ([ideErrorText file (T.pack $ show (key, file) ++ show e) | not $ isBadDependency e],Nothing)) + pure (Nothing, ([ideErrorText uri (T.pack $ show (key, uri) ++ show e) | not $ isBadDependency e],Nothing)) - ver <- estimateFileVersionUnsafely key mbRes file + ver <- estimateFileVersionUnsafely key mbRes uri (bs, res) <- case mbRes of Nothing -> do pure (toShakeValue ShakeStale mbBs, staleV) @@ -1285,8 +1287,8 @@ defineEarlyCutoff' doDiagnostics cmp key file mbOld mode action = do (A res) $ do -- this hook needs to be run in the same transaction as the key is marked clean -- see Note [Housekeeping rule cache and dirty key outside of hls-graph] - setValues state key file res (Vector.fromList diags) - modifyTVar' dirtyKeys (deleteKeySet $ toKey key file) + setValues state key uri res (Vector.fromList diags) + modifyTVar' dirtyKeys (deleteKeySet $ toKey key uri) return res where -- Highly unsafe helper to compute the version of a file @@ -1295,10 +1297,10 @@ defineEarlyCutoff' doDiagnostics cmp key file mbOld mode action = do estimateFileVersionUnsafely :: k -> Maybe v - -> NormalizedFilePath + -> NormalizedUri -> Action (Maybe FileVersion) estimateFileVersionUnsafely _k v fp - | fp == emptyFilePath = pure Nothing + | fp == emptyPathUri = pure Nothing | Just Refl <- eqT @k @GetModificationTime = pure v -- GetModificationTime depends on these rules, so avoid creating a cycle | Just Refl <- eqT @k @AddWatchedFile = pure Nothing @@ -1341,19 +1343,18 @@ traceA (A Failed{}) = "Failed" traceA (A Stale{}) = "Stale" traceA (A Succeeded{}) = "Success" -updateFileDiagnostics :: MonadIO m +updateDiagnostics :: MonadIO m => Recorder (WithPriority Log) - -> NormalizedFilePath + -> NormalizedUri -> Maybe Int32 -> Key -> ShakeExtras -> [FileDiagnostic] -- ^ current results -> m () -updateFileDiagnostics recorder fp ver k ShakeExtras{diagnostics, hiddenDiagnostics, publishedDiagnostics, debouncer, lspEnv, ideTesting} current0 = do - liftIO $ withTrace ("update diagnostics " <> fromString(fromNormalizedFilePath fp)) $ \ addTag -> do +updateDiagnostics recorder uri ver k ShakeExtras{diagnostics, hiddenDiagnostics, publishedDiagnostics, debouncer, lspEnv, ideTesting} current0 = do + liftIO $ withTrace (Text.unpack $ "update diagnostics " <> getUri (fromNormalizedUri uri)) $ \ addTag -> do addTag "key" (show k) let (currentShown, currentHidden) = partition ((== ShowDiag) . fdShouldShowDiagnostic) current - uri = filePathToUri' fp addTagUnsafe :: String -> String -> String -> a -> a addTagUnsafe msg t x v = unsafePerformIO(addTag (msg <> t) x) `seq` v update :: (forall a. String -> String -> a -> a) -> [FileDiagnostic] -> STMDiagnosticStore -> STM [FileDiagnostic] @@ -1367,11 +1368,10 @@ updateFileDiagnostics recorder fp ver k ShakeExtras{diagnostics, hiddenDiagnosti -- publishDiagnosticsNotification. newDiags <- liftIO $ atomicallyNamed "diagnostics - update" $ update (addTagUnsafe "shown ") currentShown diagnostics _ <- liftIO $ atomicallyNamed "diagnostics - hidden" $ update (addTagUnsafe "hidden ") currentHidden hiddenDiagnostics - let uri' = filePathToUri' fp let delay = if null newDiags then 0.1 else 0 - registerEvent debouncer delay uri' $ withTrace ("report diagnostics " <> fromString (fromNormalizedFilePath fp)) $ \tag -> do + registerEvent debouncer delay uri $ withTrace (Text.unpack $ "report diagnostics " <> getUri (fromNormalizedUri uri)) $ \tag -> do join $ mask_ $ do - lastPublish <- atomicallyNamed "diagnostics - publish" $ STM.focus (Focus.lookupWithDefault [] <* Focus.insert newDiags) uri' publishedDiagnostics + lastPublish <- atomicallyNamed "diagnostics - publish" $ STM.focus (Focus.lookupWithDefault [] <* Focus.insert newDiags) uri publishedDiagnostics let action = when (lastPublish /= newDiags) $ case lspEnv of Nothing -> -- Print an LSP event. logWith recorder Info $ LogDiagsDiffButNoLspEnv newDiags @@ -1379,7 +1379,7 @@ updateFileDiagnostics recorder fp ver k ShakeExtras{diagnostics, hiddenDiagnosti liftIO $ tag "count" (show $ Prelude.length newDiags) liftIO $ tag "key" (show k) LSP.sendNotification SMethod_TextDocumentPublishDiagnostics $ - LSP.PublishDiagnosticsParams (fromNormalizedUri uri') (fmap fromIntegral ver) (map fdLspDiagnostic newDiags) + LSP.PublishDiagnosticsParams (fromNormalizedUri uri) (fmap fromIntegral ver) (map fdLspDiagnostic newDiags) return action where diagsFromRule :: Diagnostic -> Diagnostic @@ -1387,7 +1387,7 @@ updateFileDiagnostics recorder fp ver k ShakeExtras{diagnostics, hiddenDiagnosti | coerce ideTesting = c & L.relatedInformation ?~ [ DiagnosticRelatedInformation (Location - (filePathToUri $ fromNormalizedFilePath fp) + (fromNormalizedUri uri) _range ) (T.pack $ show k) @@ -1469,15 +1469,15 @@ updatePositionMappingHelper ver changes mappingForUri = snd $ -- | sends a signal whenever shake session is run/restarted -- being used in cabal and hlint plugin tests to know when its time -- to look for file diagnostics -kickSignal :: KnownSymbol s => Bool -> Maybe (LSP.LanguageContextEnv c) -> [NormalizedFilePath] -> Proxy s -> Action () -kickSignal testing lspEnv files msg = when testing $ liftIO $ mRunLspT lspEnv $ +kickSignal :: KnownSymbol s => Bool -> Maybe (LSP.LanguageContextEnv c) -> [NormalizedUri] -> Proxy s -> Action () +kickSignal testing lspEnv uris msg = when testing $ liftIO $ mRunLspT lspEnv $ LSP.sendNotification (LSP.SMethod_CustomMethod msg) $ - toJSON $ map fromNormalizedFilePath files + toJSON $ map fromNormalizedUri uris -- | Add kick start/done signal to rule -runWithSignal :: (KnownSymbol s0, KnownSymbol s1, IdeRule k v) => Proxy s0 -> Proxy s1 -> [NormalizedFilePath] -> k -> Action () -runWithSignal msgStart msgEnd files rule = do +runWithSignal :: (KnownSymbol s0, KnownSymbol s1, IdeRule k v) => Proxy s0 -> Proxy s1 -> [NormalizedUri] -> k -> Action () +runWithSignal msgStart msgEnd uris rule = do ShakeExtras{ideTesting = Options.IdeTesting testing, lspEnv} <- getShakeExtras - kickSignal testing lspEnv files msgStart - void $ uses rule files - kickSignal testing lspEnv files msgEnd + kickSignal testing lspEnv uris msgStart + void $ uses rule uris + kickSignal testing lspEnv uris msgEnd diff --git a/ghcide/src/Development/IDE/Core/Tracing.hs b/ghcide/src/Development/IDE/Core/Tracing.hs index 34839faaee..37c0f7940f 100644 --- a/ghcide/src/Development/IDE/Core/Tracing.hs +++ b/ghcide/src/Development/IDE/Core/Tracing.hs @@ -28,8 +28,8 @@ import Development.IDE.Types.Diagnostics (FileDiagnostic, import Development.IDE.Types.Location (Uri (..)) import Ide.Logger import Ide.Types (PluginId (..)) -import Language.LSP.Protocol.Types (NormalizedFilePath, - fromNormalizedFilePath) +import Language.LSP.Protocol.Types (NormalizedUri, + fromNormalizedUri) import OpenTelemetry.Eventlog (SpanInFlight (..), addEvent, beginSpan, endSpan, setTag, withSpan) @@ -91,7 +91,7 @@ otSetUri sp (Uri t) = setTag sp "uri" (encodeUtf8 t) otTracedAction :: Show k => k -- ^ The Action's Key - -> NormalizedFilePath -- ^ Path to the file the action was run for + -> NormalizedUri -- ^ Path to the file the action was run for -> RunMode -> (a -> String) -> (([FileDiagnostic] -> Action ()) -> Action (RunResult a)) -- ^ The action @@ -101,7 +101,7 @@ otTracedAction key file mode result act generalBracket (do sp <- beginSpan (fromString (show key)) - setTag sp "File" (fromString $ fromNormalizedFilePath file) + setTag sp "File" (encodeUtf8 $ getUri $ fromNormalizedUri file) setTag sp "Mode" (fromString $ show mode) return sp ) diff --git a/ghcide/src/Development/IDE/Core/UseStale.hs b/ghcide/src/Development/IDE/Core/UseStale.hs index 498ea44bee..bf3ec74054 100644 --- a/ghcide/src/Development/IDE/Core/UseStale.hs +++ b/ghcide/src/Development/IDE/Core/UseStale.hs @@ -27,11 +27,13 @@ import Data.Functor ((<&>)) import Data.Functor.Identity (Identity (Identity)) import Data.Kind (Type) import Data.String (fromString) +import qualified Data.Text as T import Development.IDE (Action, IdeRule, - NormalizedFilePath, - Range, + NormalizedUri, Range, + Uri (Uri), rangeToRealSrcSpan, - realSrcSpanToRange) + realSrcSpanToRange, + toNormalizedUri) import qualified Development.IDE.Core.PositionMapping as P import qualified Development.IDE.Core.Shake as IDE import Development.IDE.GHC.Compat (RealSrcSpan, srcSpanFile) @@ -111,7 +113,7 @@ instance MapAge Range where instance MapAge RealSrcSpan where mapAgeFrom = - invMapAge (\fs -> rangeToRealSrcSpan (fromString $ unpackFS fs)) + invMapAge (\fs -> rangeToRealSrcSpan (toNormalizedUri $ Uri $ T.pack $ fromString $ unpackFS fs)) (srcSpanFile &&& realSrcSpanToRange) . mapAgeFrom @@ -144,17 +146,17 @@ unsafeCopyAge _ = coerce -- | Request a Rule result, it not available return the last computed result, if any, which may be stale useWithStale :: IdeRule k v - => k -> NormalizedFilePath -> Action (Maybe (TrackedStale v)) -useWithStale key file = do - x <- IDE.useWithStale key file + => k -> NormalizedUri -> Action (Maybe (TrackedStale v)) +useWithStale key uri = do + x <- IDE.useWithStale key uri pure $ x <&> \(v, pm) -> TrackedStale (coerce v) (coerce pm) -- | Request a Rule result, it not available return the last computed result which may be stale. -- Errors out if none available. useWithStale_ :: IdeRule k v - => k -> NormalizedFilePath -> Action (TrackedStale v) -useWithStale_ key file = do - (v, pm) <- IDE.useWithStale_ key file + => k -> NormalizedUri -> Action (TrackedStale v) +useWithStale_ key uri = do + (v, pm) <- IDE.useWithStale_ key uri pure $ TrackedStale (coerce v) (coerce pm) diff --git a/ghcide/src/Development/IDE/GHC/Error.hs b/ghcide/src/Development/IDE/GHC/Error.hs index 048987f8ae..096826248b 100644 --- a/ghcide/src/Development/IDE/GHC/Error.hs +++ b/ghcide/src/Development/IDE/GHC/Error.hs @@ -39,7 +39,6 @@ module Development.IDE.GHC.Error import Control.Lens import Data.Maybe -import Data.String (fromString) import qualified Data.Text as T import Data.Tuple.Extra (uncurry3) import Development.IDE.GHC.Compat (GhcMessage, MsgEnvelope, @@ -62,7 +61,7 @@ diagFromText :: T.Text -> D.DiagnosticSeverity -> SrcSpan -> T.Text -> Maybe (Ms diagFromText diagSource sev loc msg origMsg = D.ideErrorWithSource (Just diagSource) (Just sev) - (toNormalizedFilePath' $ fromMaybe noFilePath $ srcSpanToFilename loc) + (filePathToUri' $ toNormalizedFilePath' $ fromMaybe noFilePath $ srcSpanToFilename loc) msg origMsg & fdLspDiagnosticL %~ \diag -> diag { D._range = fromMaybe noRange $ srcSpanToRange loc } @@ -153,19 +152,19 @@ srcSpanToLocation src = do -- important that the URI's we produce have been properly normalized, otherwise they point at weird places in VS Code pure $ Location (fromNormalizedUri $ filePathToUri' $ toNormalizedFilePath' fs) rng -rangeToSrcSpan :: NormalizedFilePath -> Range -> SrcSpan +rangeToSrcSpan :: NormalizedUri -> Range -> SrcSpan rangeToSrcSpan = fmap (\x -> Compat.RealSrcSpan x Nothing) . rangeToRealSrcSpan rangeToRealSrcSpan - :: NormalizedFilePath -> Range -> RealSrcSpan -rangeToRealSrcSpan nfp = + :: NormalizedUri -> Range -> RealSrcSpan +rangeToRealSrcSpan nuri = Compat.mkRealSrcSpan - <$> positionToRealSrcLoc nfp . _start - <*> positionToRealSrcLoc nfp . _end + <$> positionToRealSrcLoc nuri . _start + <*> positionToRealSrcLoc nuri . _end -positionToRealSrcLoc :: NormalizedFilePath -> Position -> RealSrcLoc -positionToRealSrcLoc nfp (Position l c)= - Compat.mkRealSrcLoc (fromString $ fromNormalizedFilePath nfp) (fromIntegral $ l + 1) (fromIntegral $ c + 1) +positionToRealSrcLoc :: NormalizedUri -> Position -> RealSrcLoc +positionToRealSrcLoc nuri (Position l c)= + Compat.mkRealSrcLoc (Compat.mkFastString $ T.unpack $ getUri $ fromNormalizedUri nuri) (fromIntegral $ l + 1) (fromIntegral $ c + 1) isInsideSrcSpan :: Position -> SrcSpan -> Bool p `isInsideSrcSpan` r = case srcSpanToRange r of diff --git a/ghcide/src/Development/IDE/Import/DependencyInformation.hs b/ghcide/src/Development/IDE/Import/DependencyInformation.hs index 471cf52eab..59d9e74214 100644 --- a/ghcide/src/Development/IDE/Import/DependencyInformation.hs +++ b/ghcide/src/Development/IDE/Import/DependencyInformation.hs @@ -81,7 +81,7 @@ type FilePathIdSet = IntSet data PathIdMap = PathIdMap { idToPathMap :: !(FilePathIdMap ArtifactsLocation) - , pathToIdMap :: !(HashMap NormalizedFilePath FilePathId) + , pathToIdMap :: !(HashMap NormalizedUri FilePathId) , nextFreshId :: !Int } deriving (Show, Generic) @@ -93,7 +93,7 @@ emptyPathIdMap = PathIdMap IntMap.empty HMS.empty 0 getPathId :: ArtifactsLocation -> PathIdMap -> (FilePathId, PathIdMap) getPathId path m@PathIdMap{..} = - case HMS.lookup (artifactFilePath path) pathToIdMap of + case HMS.lookup (artifactUri path) pathToIdMap of Nothing -> let !newId = FilePathId nextFreshId in (newId, insertPathId newId ) @@ -103,20 +103,20 @@ getPathId path m@PathIdMap{..} = insertPathId fileId = PathIdMap (IntMap.insert (getFilePathId fileId) path idToPathMap) - (HMS.insert (artifactFilePath path) fileId pathToIdMap) + (HMS.insert (artifactUri path) fileId pathToIdMap) (succ nextFreshId) insertImport :: FilePathId -> Either ModuleParseError ModuleImports -> RawDependencyInformation -> RawDependencyInformation insertImport (FilePathId k) v rawDepInfo = rawDepInfo { rawImports = IntMap.insert k v (rawImports rawDepInfo) } -pathToId :: PathIdMap -> NormalizedFilePath -> Maybe FilePathId +pathToId :: PathIdMap -> NormalizedUri -> Maybe FilePathId pathToId PathIdMap{pathToIdMap} path = pathToIdMap HMS.!? path -lookupPathToId :: PathIdMap -> NormalizedFilePath -> Maybe FilePathId +lookupPathToId :: PathIdMap -> NormalizedUri -> Maybe FilePathId lookupPathToId PathIdMap{pathToIdMap} path = HMS.lookup path pathToIdMap -idToPath :: PathIdMap -> FilePathId -> NormalizedFilePath -idToPath pathIdMap filePathId = artifactFilePath $ idToModLocation pathIdMap filePathId +idToPath :: PathIdMap -> FilePathId -> NormalizedUri +idToPath pathIdMap filePathId = artifactUri $ idToModLocation pathIdMap filePathId idToModLocation :: PathIdMap -> FilePathId -> ArtifactsLocation idToModLocation PathIdMap{idToPathMap} (FilePathId i) = idToPathMap IntMap.! i @@ -162,7 +162,7 @@ data DependencyInformation = -- ^ Map from FilePathId to the fingerprint of the immediate reverse dependencies of the module. } deriving (Show, Generic) -lookupFingerprint :: NormalizedFilePath -> DependencyInformation -> FilePathIdMap Fingerprint -> Maybe Fingerprint +lookupFingerprint :: NormalizedUri -> DependencyInformation -> FilePathIdMap Fingerprint -> Maybe Fingerprint lookupFingerprint fileId DependencyInformation {..} depFingerprintMap = do FilePathId cur_id <- lookupPathToId depPathIdMap fileId @@ -182,7 +182,7 @@ instance NFData a => NFData (ShowableModuleEnv a) where instance Show ShowableModule where show = moduleNameString . moduleName . showableModule -reachableModules :: DependencyInformation -> [NormalizedFilePath] +reachableModules :: DependencyInformation -> [NormalizedUri] reachableModules DependencyInformation{..} = map (idToPath depPathIdMap . FilePathId) $ IntMap.keys depErrorNodes <> IntMap.keys depModuleDeps @@ -341,9 +341,9 @@ partitionSCC (AcyclicSCC x:rest) = first (x:) $ partitionSCC rest partitionSCC [] = ([], []) -- | Transitive reverse dependencies of a file -transitiveReverseDependencies :: NormalizedFilePath -> DependencyInformation -> Maybe [NormalizedFilePath] -transitiveReverseDependencies file DependencyInformation{..} = do - FilePathId cur_id <- lookupPathToId depPathIdMap file +transitiveReverseDependencies :: NormalizedUri -> DependencyInformation -> Maybe [NormalizedUri] +transitiveReverseDependencies uri DependencyInformation{..} = do + FilePathId cur_id <- lookupPathToId depPathIdMap uri return $ map (idToPath depPathIdMap . FilePathId) (IntSet.toList (go cur_id IntSet.empty)) where go :: Int -> IntSet -> IntSet @@ -354,15 +354,15 @@ transitiveReverseDependencies file DependencyInformation{..} = do in IntSet.foldr go res new -- | Immediate reverse dependencies of a file -immediateReverseDependencies :: NormalizedFilePath -> DependencyInformation -> Maybe [NormalizedFilePath] -immediateReverseDependencies file DependencyInformation{..} = do - FilePathId cur_id <- lookupPathToId depPathIdMap file +immediateReverseDependencies :: NormalizedUri -> DependencyInformation -> Maybe [NormalizedUri] +immediateReverseDependencies uri DependencyInformation{..} = do + FilePathId cur_id <- lookupPathToId depPathIdMap uri return $ map (idToPath depPathIdMap . FilePathId) (maybe mempty IntSet.toList (IntMap.lookup cur_id depReverseModuleDeps)) -- | returns all transitive dependencies in topological order. -transitiveDeps :: DependencyInformation -> NormalizedFilePath -> Maybe TransitiveDependencies -transitiveDeps DependencyInformation{..} file = do - !fileId <- pathToId depPathIdMap file +transitiveDeps :: DependencyInformation -> NormalizedUri -> Maybe TransitiveDependencies +transitiveDeps DependencyInformation{..} uri = do + !fileId <- pathToId depPathIdMap uri reachableVs <- -- Delete the starting node IntSet.delete (getFilePathId fileId) . @@ -385,12 +385,12 @@ transitiveDeps DependencyInformation{..} file = do vs = topSort g -lookupModuleFile :: Module -> DependencyInformation -> Maybe NormalizedFilePath +lookupModuleFile :: Module -> DependencyInformation -> Maybe NormalizedUri lookupModuleFile mod DependencyInformation{..} = idToPath depPathIdMap <$> lookupModuleEnv (showableModuleEnv depModuleFiles) mod newtype TransitiveDependencies = TransitiveDependencies - { transitiveModuleDeps :: [NormalizedFilePath] + { transitiveModuleDeps :: [NormalizedUri] -- ^ Transitive module dependencies in topological order. -- The module itself is not included. } deriving (Eq, Show, Generic) diff --git a/ghcide/src/Development/IDE/Import/FindImports.hs b/ghcide/src/Development/IDE/Import/FindImports.hs index 7c4046a63a..7b14ce647f 100644 --- a/ghcide/src/Development/IDE/Import/FindImports.hs +++ b/ghcide/src/Development/IDE/Import/FindImports.hs @@ -26,6 +26,8 @@ import Development.IDE.Types.Diagnostics import Development.IDE.Types.Location import GHC.Types.PkgQual import GHC.Unit.State +import Language.LSP.Protocol.Types (normalizedFilePathToUri, + uriToNormalizedFilePath) import System.FilePath @@ -39,14 +41,14 @@ data Import deriving (Show) data ArtifactsLocation = ArtifactsLocation - { artifactFilePath :: !NormalizedFilePath + { artifactUri :: !NormalizedUri , artifactModLocation :: !(Maybe ModLocation) , artifactIsSource :: !Bool -- ^ True if a module is a source input , artifactModule :: !(Maybe Module) } deriving Show instance NFData ArtifactsLocation where - rnf ArtifactsLocation{..} = rnf artifactFilePath `seq` rwhnf artifactModLocation `seq` rnf artifactIsSource `seq` rnf artifactModule + rnf ArtifactsLocation{..} = rnf artifactUri `seq` rwhnf artifactModLocation `seq` rnf artifactIsSource `seq` rnf artifactModule isBootLocation :: ArtifactsLocation -> Bool isBootLocation = not . artifactIsSource @@ -55,13 +57,14 @@ instance NFData Import where rnf (FileImport x) = rnf x rnf PackageImport = () -modSummaryToArtifactsLocation :: NormalizedFilePath -> Maybe ModSummary -> ArtifactsLocation -modSummaryToArtifactsLocation nfp ms = ArtifactsLocation nfp (ms_location <$> ms) source mbMod +modSummaryToArtifactsLocation :: NormalizedUri -> Maybe ModSummary -> ArtifactsLocation +modSummaryToArtifactsLocation nuri ms = ArtifactsLocation nuri (ms_location <$> ms) source mbMod where isSource HsSrcFile = True isSource _ = False source = case ms of - Nothing -> "-boot" `isSuffixOf` fromNormalizedFilePath nfp + Nothing | Just nfp <- uriToNormalizedFilePath nuri -> "-boot" `isSuffixOf` fromNormalizedFilePath nfp + | otherwise -> False Just modSum -> isSource (ms_hsc_src modSum) mbMod = ms_mod <$> ms @@ -166,7 +169,7 @@ locateModule env comp_info exts targetFor modName mbPkgName isSource = do toModLocation uid file = liftIO $ do loc <- mkHomeModLocation dflags (unLoc modName) (fromNormalizedFilePath file) let genMod = mkModule (RealUnit $ Definite uid) (unLoc modName) -- TODO support backpack holes - return $ Right $ FileImport $ ArtifactsLocation file (Just loc) (not isSource) (Just genMod) + return $ Right $ FileImport $ ArtifactsLocation (normalizedFilePathToUri file) (Just loc) (not isSource) (Just genMod) lookupLocal uid dirs reexports = do mbFile <- locateModuleFile [(uid, dirs, reexports)] exts targetFor isSource $ unLoc modName diff --git a/ghcide/src/Development/IDE/LSP/HoverDefinition.hs b/ghcide/src/Development/IDE/LSP/HoverDefinition.hs index 0ba6e22530..bcc1b96c38 100644 --- a/ghcide/src/Development/IDE/LSP/HoverDefinition.hs +++ b/ghcide/src/Development/IDE/LSP/HoverDefinition.hs @@ -35,7 +35,7 @@ import qualified Data.Text as T data Log = LogWorkspaceSymbolRequest !T.Text - | LogRequest !T.Text !Position !NormalizedFilePath + | LogRequest !T.Text !Position !NormalizedUri deriving (Show) instance Pretty Log where @@ -43,7 +43,7 @@ instance Pretty Log where LogWorkspaceSymbolRequest query -> "Workspace symbols request:" <+> pretty query LogRequest label pos nfp -> pretty label <+> "request at position" <+> pretty (showPosition pos) <+> - "in file:" <+> pretty (fromNormalizedFilePath nfp) + "in file:" <+> pretty (fromNormalizedUri nfp) gotoDefinition :: Recorder (WithPriority Log) -> IdeState -> TextDocumentPositionParams -> ExceptT PluginError (HandlerM c) (MessageResult Method_TextDocumentDefinition) hover :: Recorder (WithPriority Log) -> IdeState -> TextDocumentPositionParams -> ExceptT PluginError (HandlerM c) (Hover |? Null) @@ -58,9 +58,9 @@ documentHighlight = request "DocumentHighlight" highlightAtPoint (InR Null) InL references :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentReferences references recorder ide _ (ReferenceParams (TextDocumentIdentifier uri) pos _ _ _) = do - nfp <- getNormalizedFilePathE uri - liftIO $ logWith recorder Debug $ LogRequest "References" pos nfp - InL <$> (liftIO $ Shake.runAction "references" ide $ refsAtPoint nfp pos) + let nuri = toNormalizedUri uri + liftIO $ logWith recorder Debug $ LogRequest "References" pos nuri + InL <$> (liftIO $ Shake.runAction "references" ide $ refsAtPoint nuri pos) wsSymbols :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_WorkspaceSymbol wsSymbols recorder ide _ (WorkspaceSymbolParams _ _ query) = liftIO $ do @@ -74,7 +74,7 @@ foundHover (mbRange, contents) = -- | Respond to and log a hover or go-to-definition request request :: T.Text - -> (NormalizedFilePath -> Position -> IdeAction (Maybe a)) + -> (NormalizedUri -> Position -> IdeAction (Maybe a)) -> b -> (a -> b) -> Recorder (WithPriority Log) @@ -82,13 +82,11 @@ request -> TextDocumentPositionParams -> ExceptT PluginError (HandlerM c) b request label getResults notFound found recorder ide (TextDocumentPositionParams (TextDocumentIdentifier uri) pos) = liftIO $ do - mbResult <- case uriToFilePath' uri of - Just path -> logAndRunRequest recorder label getResults ide pos path - Nothing -> pure Nothing - pure $ maybe notFound found mbResult + res <- logAndRunRequest recorder label getResults ide pos uri + pure $ maybe notFound found res -logAndRunRequest :: Recorder (WithPriority Log) -> T.Text -> (NormalizedFilePath -> Position -> IdeAction b) -> IdeState -> Position -> String -> IO b +logAndRunRequest :: Recorder (WithPriority Log) -> T.Text -> (NormalizedUri -> Position -> IdeAction b) -> IdeState -> Position -> Uri -> IO b logAndRunRequest recorder label getResults ide pos path = do - let filePath = toNormalizedFilePath' path - logWith recorder Debug $ LogRequest label pos filePath - runIdeAction (T.unpack label) (shakeExtras ide) (getResults filePath pos) + let nuri = toNormalizedUri path + logWith recorder Debug $ LogRequest label pos nuri + runIdeAction (T.unpack label) (shakeExtras ide) (getResults nuri pos) diff --git a/ghcide/src/Development/IDE/LSP/Notifications.hs b/ghcide/src/Development/IDE/LSP/Notifications.hs index 4f5475442c..e5a639445c 100644 --- a/ghcide/src/Development/IDE/LSP/Notifications.hs +++ b/ghcide/src/Development/IDE/LSP/Notifications.hs @@ -67,37 +67,38 @@ descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeSta descriptor recorder plId = (defaultPluginDescriptor plId desc) { pluginNotificationHandlers = mconcat [ mkPluginNotificationHandler LSP.SMethod_TextDocumentDidOpen $ \ide vfs _ (DidOpenTextDocumentParams TextDocumentItem{_uri,_version}) -> liftIO $ do + let nuri = toNormalizedUri _uri atomically $ updatePositionMapping ide (VersionedTextDocumentIdentifier _uri _version) [] - whenUriFile _uri $ \file -> do - -- We don't know if the file actually exists, or if the contents match those on disk - -- For example, vscode restores previously unsaved contents on open - setFileModified (cmapWithPrio LogFileStore recorder) (VFSModified vfs) ide False file $ - addFileOfInterest ide file Modified{firstOpen=True} + -- We don't know if the file actually exists, or if the contents match those on disk + -- For example, vscode restores previously unsaved contents on open + setFileModified (cmapWithPrio LogFileStore recorder) (VFSModified vfs) ide False nuri $ + addFileOfInterest ide nuri Modified{firstOpen=True} + logWith recorder Debug $ LogOpenedTextDocument _uri , mkPluginNotificationHandler LSP.SMethod_TextDocumentDidChange $ \ide vfs _ (DidChangeTextDocumentParams identifier@VersionedTextDocumentIdentifier{_uri} changes) -> liftIO $ do atomically $ updatePositionMapping ide identifier changes - whenUriFile _uri $ \file -> do - setFileModified (cmapWithPrio LogFileStore recorder) (VFSModified vfs) ide False file $ - addFileOfInterest ide file Modified{firstOpen=False} + let nuri = toNormalizedUri _uri + setFileModified (cmapWithPrio LogFileStore recorder) (VFSModified vfs) ide False nuri $ + addFileOfInterest ide nuri Modified{firstOpen=False} logWith recorder Debug $ LogModifiedTextDocument _uri , mkPluginNotificationHandler LSP.SMethod_TextDocumentDidSave $ \ide vfs _ (DidSaveTextDocumentParams TextDocumentIdentifier{_uri} _) -> liftIO $ do - whenUriFile _uri $ \file -> do - setFileModified (cmapWithPrio LogFileStore recorder) (VFSModified vfs) ide True file $ - addFileOfInterest ide file OnDisk + let nuri = toNormalizedUri _uri + setFileModified (cmapWithPrio LogFileStore recorder) (VFSModified vfs) ide True nuri $ + addFileOfInterest ide nuri OnDisk logWith recorder Debug $ LogSavedTextDocument _uri , mkPluginNotificationHandler LSP.SMethod_TextDocumentDidClose $ \ide vfs _ (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> liftIO $ do - whenUriFile _uri $ \file -> do - let msg = "Closed text document: " <> getUri _uri - setSomethingModified (VFSModified vfs) ide (Text.unpack msg) $ do - scheduleGarbageCollection ide - deleteFileOfInterest ide file - logWith recorder Debug $ LogClosedTextDocument _uri + let msg = "Closed text document: " <> getUri _uri + nuri = toNormalizedUri _uri + setSomethingModified (VFSModified vfs) ide (Text.unpack msg) $ do + scheduleGarbageCollection ide + deleteFileOfInterest ide nuri + logWith recorder Debug $ LogClosedTextDocument _uri , mkPluginNotificationHandler LSP.SMethod_WorkspaceDidChangeWatchedFiles $ \ide vfs _ (DidChangeWatchedFilesParams fileEvents) -> liftIO $ do @@ -107,10 +108,9 @@ descriptor recorder plId = (defaultPluginDescriptor plId desc) { pluginNotificat -- filter also uris that do not map to filenames, since we cannot handle them filesOfInterest <- getFilesOfInterest ide let fileEvents' = - [ (nfp, event) | (FileEvent uri event) <- fileEvents - , Just fp <- [uriToFilePath uri] - , let nfp = toNormalizedFilePath fp - , not $ HM.member nfp filesOfInterest + [ (nuri, event) | (FileEvent uri event) <- fileEvents + , let nuri = toNormalizedUri uri + , not $ HM.member nuri filesOfInterest ] unless (null fileEvents') $ do let msg = show fileEvents' diff --git a/ghcide/src/Development/IDE/LSP/Outline.hs b/ghcide/src/Development/IDE/LSP/Outline.hs index af2a0f1c97..23b28ad18f 100644 --- a/ghcide/src/Development/IDE/LSP/Outline.hs +++ b/ghcide/src/Development/IDE/LSP/Outline.hs @@ -27,16 +27,15 @@ import Language.LSP.Protocol.Types (DocumentSymbol (..), DocumentSymbolParams (DocumentSymbolParams, _textDocument), SymbolKind (..), TextDocumentIdentifier (TextDocumentIdentifier), - type (|?) (InL, InR), - uriToFilePath) + type (|?) (InL, InR)) moduleOutline :: PluginMethodHandler IdeState Method_TextDocumentDocumentSymbol moduleOutline ideState _ DocumentSymbolParams{ _textDocument = TextDocumentIdentifier uri } - = liftIO $ case uriToFilePath uri of - Just (toNormalizedFilePath' -> fp) -> do - mb_decls <- fmap fst <$> runAction "Outline" ideState (useWithStale GetParsedModule fp) + = liftIO $ do + let nuri = toNormalizedUri uri + mb_decls <- fmap fst <$> runAction "Outline" ideState (useWithStale GetParsedModule nuri) pure $ case mb_decls of Nothing -> InL [] Just ParsedModule { pm_parsed_source = L _ltop HsModule { hsmodName, hsmodDecls, hsmodImports } } @@ -62,9 +61,6 @@ moduleOutline ideState _ DocumentSymbolParams{ _textDocument = TextDocumentIdent in InR (InL allSymbols) - - Nothing -> pure $ InL [] - documentSymbolForDecl :: LHsDecl GhcPs -> Maybe DocumentSymbol documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ FamDecl { tcdFam = FamilyDecl { fdLName = L _ n, fdInfo, fdTyVars } })) = Just (defDocumentSymbol l :: DocumentSymbol) @@ -187,7 +183,7 @@ documentSymbolForImportSummary importSymbols = mergeRanges xs = Range (minimum $ map _start xs) (maximum $ map _end xs) importRange = mergeRanges $ map (\DocumentSymbol{_range} -> _range) importSymbols in - Just (defDocumentSymbol (rangeToRealSrcSpan "" importRange)) + Just (defDocumentSymbol (rangeToRealSrcSpan emptyPathUri importRange)) { _name = "imports" , _kind = SymbolKind_Module , _children = Just importSymbols diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index ad4a36327a..a3b43b6b25 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -110,6 +110,7 @@ import Ide.Types (IdeCommand (IdeComman PluginDescriptor (PluginDescriptor, pluginCli), PluginId (PluginId), ipMap, pluginId) +import Language.LSP.Protocol.Types (normalizedFilePathToUri) import qualified Language.LSP.Server as LSP import Numeric.Natural (Natural) import Options.Applicative hiding (action) @@ -407,10 +408,10 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re registerIdeConfiguration (shakeExtras ide) $ IdeConfiguration mempty (hashed Nothing) putStrLn "\nStep 4/4: Type checking the files" - setFilesOfInterest ide $ HashMap.fromList $ map ((,OnDisk) . toNormalizedFilePath') absoluteFiles - results <- runAction "User TypeCheck" ide $ uses TypeCheck (map toNormalizedFilePath' absoluteFiles) - _results <- runAction "GetHie" ide $ uses GetHieAst (map toNormalizedFilePath' absoluteFiles) - _results <- runAction "GenerateCore" ide $ uses GenerateCore (map toNormalizedFilePath' absoluteFiles) + setFilesOfInterest ide $ HashMap.fromList $ map ((,OnDisk) . normalizedFilePathToUri . toNormalizedFilePath') absoluteFiles + results <- runAction "User TypeCheck" ide $ uses TypeCheck (map (normalizedFilePathToUri . toNormalizedFilePath') absoluteFiles) + _results <- runAction "GetHie" ide $ uses GetHieAst (map (normalizedFilePathToUri . toNormalizedFilePath') absoluteFiles) + _results <- runAction "GenerateCore" ide $ uses GenerateCore (map (normalizedFilePathToUri . toNormalizedFilePath') absoluteFiles) let (worked, failed) = partition fst $ zip (map isJust results) absoluteFiles when (failed /= []) $ putStr $ unlines $ "Files that failed:" : map ((++) " * " . snd) failed diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index d92bf1da85..4b5ce34fe1 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -81,20 +81,20 @@ descriptor recorder plId = (defaultPluginDescriptor plId desc) produceCompletions :: Recorder (WithPriority Log) -> Rules () produceCompletions recorder = do - define (cmapWithPrio LogShake recorder) $ \LocalCompletions file -> do - let uri = fromNormalizedUri $ normalizedFilePathToUri file - mbPm <- useWithStale GetParsedModule file + define (cmapWithPrio LogShake recorder) $ \LocalCompletions nuri -> do + let uri = fromNormalizedUri nuri + mbPm <- useWithStale GetParsedModule nuri case mbPm of Just (pm, _) -> do let cdata = localCompletionsForParsedModule uri pm return ([], Just cdata) _ -> return ([], Nothing) - define (cmapWithPrio LogShake recorder) $ \NonLocalCompletions file -> do + define (cmapWithPrio LogShake recorder) $ \NonLocalCompletions nuri -> do -- For non local completions we avoid depending on the parsed module, -- synthesizing a fake module with an empty body from the buffer -- in the ModSummary, which preserves all the imports - ms <- fmap fst <$> useWithStale GetModSummaryWithoutTimestamps file - mbSess <- fmap fst <$> useWithStale GhcSessionDeps file + ms <- fmap fst <$> useWithStale GetModSummaryWithoutTimestamps nuri + mbSess <- fmap fst <$> useWithStale GhcSessionDeps nuri case (ms, mbSess) of (Just ModSummaryResult{..}, Just sess) -> do @@ -104,7 +104,7 @@ produceCompletions recorder = do case (global, inScope) of ((_, Just globalEnv), (_, Just inScopeEnv)) -> do visibleMods <- liftIO $ fmap (fromMaybe []) $ envVisibleModuleNames sess - let uri = fromNormalizedUri $ normalizedFilePathToUri file + let uri = fromNormalizedUri nuri let cdata = cacheDataProducer uri visibleMods (ms_mod msrModSummary) globalEnv inScopeEnv msrImports return ([], Just cdata) (_diag, _) -> @@ -124,13 +124,13 @@ dropListFromImportDecl iDecl = let resolveCompletion :: ResolveFunction IdeState CompletionResolveData Method_CompletionItemResolve resolveCompletion ide _pid comp@CompletionItem{_detail,_documentation,_data_} uri (CompletionResolveData _ needType (NameDetails mod occ)) = do - file <- getNormalizedFilePathE uri + let nuri = toNormalizedUri uri (sess,_) <- withExceptT (const PluginStaleResolve) $ runIdeActionE "CompletionResolve.GhcSessionDeps" (shakeExtras ide) - $ useWithStaleFastE GhcSessionDeps file + $ useWithStaleFastE GhcSessionDeps nuri let nc = ideNc $ shakeExtras ide name <- liftIO $ lookupNameCache nc mod occ - mdkm <- liftIO $ runIdeAction "CompletionResolve.GetDocMap" (shakeExtras ide) $ useWithStaleFast GetDocMap file + mdkm <- liftIO $ runIdeAction "CompletionResolve.GetDocMap" (shakeExtras ide) $ useWithStaleFast GetDocMap nuri let (dm,km) = case mdkm of Just (DKMap docMap tyThingMap, _) -> (docMap,tyThingMap) Nothing -> (mempty, mempty) @@ -165,18 +165,18 @@ getCompletionsLSP ide plId liftIO $ runAction "Completion" ide $ getUriContents $ toNormalizedUri uri fmap Right $ case (contentsMaybe, uriToFilePath' uri) of (Just cnts, Just path) -> do - let npath = toNormalizedFilePath' path + let nuri = filePathToUri' $ toNormalizedFilePath' path (ideOpts, compls, moduleExports, astres) <- liftIO $ runIdeAction "Completion" (shakeExtras ide) $ do opts <- liftIO $ getIdeOptionsIO $ shakeExtras ide - localCompls <- useWithStaleFast LocalCompletions npath - nonLocalCompls <- useWithStaleFast NonLocalCompletions npath - pm <- useWithStaleFast GetParsedModule npath - binds <- fromMaybe (mempty, zeroMapping) <$> useWithStaleFast GetBindings npath + localCompls <- useWithStaleFast LocalCompletions nuri + nonLocalCompls <- useWithStaleFast NonLocalCompletions nuri + pm <- useWithStaleFast GetParsedModule nuri + binds <- fromMaybe (mempty, zeroMapping) <$> useWithStaleFast GetBindings nuri knownTargets <- liftIO $ runAction "Completion" ide $ useNoFile GetKnownTargets let localModules = maybe [] (Map.keys . targetMap) knownTargets let lModules = mempty{importableModules = map toModueNameText localModules} -- set up the exports map including both package and project-level identifiers - packageExportsMapIO <- fmap(envPackageExports . fst) <$> useWithStaleFast GhcSession npath + packageExportsMapIO <- fmap(envPackageExports . fst) <$> useWithStaleFast GhcSession nuri packageExportsMap <- mapM liftIO packageExportsMapIO projectExportsMap <- liftIO $ readTVarIO (exportsMap $ shakeExtras ide) let exportsMap = fromMaybe mempty packageExportsMap <> projectExportsMap @@ -188,10 +188,10 @@ getCompletionsLSP ide plId -- get HieAst if OverloadedRecordDot is enabled let uses_overloaded_record_dot (ms_hspp_opts . msrModSummary -> dflags) = xopt LangExt.OverloadedRecordDot dflags - ms <- fmap fst <$> useWithStaleFast GetModSummaryWithoutTimestamps npath + ms <- fmap fst <$> useWithStaleFast GetModSummaryWithoutTimestamps nuri astres <- case ms of Just ms' | uses_overloaded_record_dot ms' - -> useWithStaleFast GetHieAst npath + -> useWithStaleFast GetHieAst nuri _ -> return Nothing pure (opts, fmap (,pm,binds) compls, moduleExports, astres) diff --git a/ghcide/src/Development/IDE/Plugin/Test.hs b/ghcide/src/Development/IDE/Plugin/Test.hs index e24bcfeee9..0d948eba3b 100644 --- a/ghcide/src/Development/IDE/Plugin/Test.hs +++ b/ghcide/src/Development/IDE/Plugin/Test.hs @@ -43,7 +43,6 @@ import Development.IDE.Graph.Internal.Types (Result (resultBuilt, resu import qualified Development.IDE.Graph.Internal.Types as Graph import Development.IDE.Types.Action import Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv)) -import Development.IDE.Types.Location (fromUri) import GHC.Generics (Generic) import Ide.Plugin.Error import Ide.Types @@ -97,8 +96,8 @@ testRequestHandler _ (BlockSeconds secs) = do liftIO $ sleep secs return (Right A.Null) testRequestHandler s (GetInterfaceFilesDir file) = liftIO $ do - let nfp = fromUri $ toNormalizedUri file - sess <- runAction "Test - GhcSession" s $ use_ GhcSession nfp + let nuri = toNormalizedUri file + sess <- runAction "Test - GhcSession" s $ use_ GhcSession nuri let hiPath = hiDir $ hsc_dflags $ hscEnv sess return $ Right (toJSON hiPath) testRequestHandler s GetShakeSessionQueueCount = liftIO $ do @@ -110,8 +109,8 @@ testRequestHandler s WaitForShakeQueue = liftIO $ do when (n>0) retry return $ Right A.Null testRequestHandler s (WaitForIdeRule k file) = liftIO $ do - let nfp = fromUri $ toNormalizedUri file - success <- runAction ("WaitForIdeRule " <> k <> " " <> show file) s $ parseAction (fromString k) nfp + let nuri = toNormalizedUri file + success <- runAction ("WaitForIdeRule " <> k <> " " <> show file) s $ parseAction (fromString k) nuri let res = WaitForIdeRuleResult <$> success return $ bimap PluginInvalidParams toJSON res testRequestHandler s GetBuildKeysBuilt = liftIO $ do @@ -134,7 +133,7 @@ testRequestHandler s GetStoredKeys = do return $ Right $ toJSON $ map show keys testRequestHandler s GetFilesOfInterest = do ff <- liftIO $ getFilesOfInterest s - return $ Right $ toJSON $ map fromNormalizedFilePath $ HM.keys ff + return $ Right $ toJSON $ map fromNormalizedUri $ HM.keys ff testRequestHandler s GetRebuildsCount = do count <- liftIO $ runAction "get build count" s getRebuildCount return $ Right $ toJSON count @@ -147,7 +146,7 @@ getDatabaseKeys field db = do step <- shakeGetBuildStep db return [ k | (k, res) <- keys, field res == Step step] -parseAction :: CI String -> NormalizedFilePath -> Action (Either Text Bool) +parseAction :: CI String -> NormalizedUri -> Action (Either Text Bool) parseAction "typecheck" fp = Right . isJust <$> use TypeCheck fp parseAction "getLocatedImports" fp = Right . isJust <$> use GetLocatedImports fp parseAction "getmodsummary" fp = Right . isJust <$> use GetModSummary fp diff --git a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs index c596d1fb82..5216d896e1 100644 --- a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs +++ b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs @@ -89,6 +89,7 @@ import Language.LSP.Protocol.Types (ApplyWorkspaceEditParams TextDocumentIdentifier (TextDocumentIdentifier), TextEdit (TextEdit), WorkspaceEdit (WorkspaceEdit), + toNormalizedUri, type (|?) (..)) import Text.Regex.TDFA ((=~)) @@ -125,7 +126,7 @@ properties = emptyProperties codeLensProvider :: PluginMethodHandler IdeState Method_TextDocumentCodeLens codeLensProvider ideState pId CodeLensParams{_textDocument = TextDocumentIdentifier uri} = do mode <- liftIO $ runAction "codeLens.config" ideState $ usePropertyAction #mode pId properties - nfp <- getNormalizedFilePathE uri + let nuri = toNormalizedUri uri -- We have two ways we can possibly generate code lenses for type lenses. -- Different options are with different "modes" of the type-lenses plugin. -- (Remember here, as the code lens is not resolved yet, we only really need @@ -138,7 +139,7 @@ codeLensProvider ideState pId CodeLensParams{_textDocument = TextDocumentIdentif [ CodeLens _range Nothing (Just $ toJSON TypeLensesResolve) | diag <- diags , let Diagnostic {_range} = fdLspDiagnostic diag - , fdFilePath diag == nfp + , fdUri diag == nuri , isGlobalDiagnostic diag] -- The second option is to generate lenses from the GlobalBindingTypeSig -- rule. This is the only type that needs to have the range adjusted @@ -159,7 +160,7 @@ codeLensProvider ideState pId CodeLensParams{_textDocument = TextDocumentIdentif -- GlobalBindingTypeSigs rule. (GlobalBindingTypeSigsResult gblSigs, gblSigsMp) <- runActionE "codeLens.GetGlobalBindingTypeSigs" ideState - $ useWithStaleE GetGlobalBindingTypeSigs nfp + $ useWithStaleE GetGlobalBindingTypeSigs nuri -- Depending on whether we only want exported or not we filter our list -- of signatures to get what we want let relevantGlobalSigs = @@ -177,10 +178,9 @@ codeLensProvider ideState pId CodeLensParams{_textDocument = TextDocumentIdentif codeLensResolveProvider :: ResolveFunction IdeState TypeLensesResolve Method_CodeLensResolve codeLensResolveProvider ideState pId lens@CodeLens{_range} uri TypeLensesResolve = do - nfp <- getNormalizedFilePathE uri (gblSigs@(GlobalBindingTypeSigsResult _), pm) <- runActionE "codeLens.GetGlobalBindingTypeSigs" ideState - $ useWithStaleE GetGlobalBindingTypeSigs nfp + $ useWithStaleE GetGlobalBindingTypeSigs $ toNormalizedUri uri -- regardless of how the original lens was generated, we want to get the range -- that the global bindings rule would expect here, hence the need to reverse -- position map the range, regardless of whether it was position mapped in the diff --git a/ghcide/src/Development/IDE/Spans/AtPoint.hs b/ghcide/src/Development/IDE/Spans/AtPoint.hs index 16b4f65b11..0ad1de5531 100644 --- a/ghcide/src/Development/IDE/Spans/AtPoint.hs +++ b/ghcide/src/Development/IDE/Spans/AtPoint.hs @@ -15,7 +15,7 @@ module Development.IDE.Spans.AtPoint ( , pointCommand , referencesAtPoint , computeTypeReferences - , FOIReferences(..) + , BOIReferences(..) , defRowToSymbolInfo , getNamesAtPoint , toCurrentLocation @@ -75,8 +75,8 @@ import System.Directory (doesFileExist) -- The Bool denotes if it is a boot module type LookupModule m = FilePath -> ModuleName -> Unit -> Bool -> MaybeT m Uri --- | HieFileResult for files of interest, along with the position mappings -newtype FOIReferences = FOIReferences (HM.HashMap NormalizedFilePath (HieAstResult, PositionMapping)) +-- | HieFileResult for buffers of interest, along with the position mappings +newtype BOIReferences = BOIReferences (HM.HashMap NormalizedUri (HieAstResult, PositionMapping)) computeTypeReferences :: Foldable f => f (HieAST Type) -> M.Map Name [Span] computeTypeReferences = foldr (\ast m -> M.unionWith (++) (go ast) m) M.empty @@ -93,12 +93,12 @@ computeTypeReferences = foldr (\ast m -> M.unionWith (++) (go ast) m) M.empty -- | Given a file and position, return the names at a point, the references for -- those names in the FOIs, and a list of file paths we already searched through foiReferencesAtPoint - :: NormalizedFilePath + :: NormalizedUri -> Position - -> FOIReferences + -> BOIReferences -> ([Name],[Location],[FilePath]) -foiReferencesAtPoint file pos (FOIReferences asts) = - case HM.lookup file asts of +foiReferencesAtPoint uri pos (BOIReferences asts) = + case HM.lookup uri asts of Nothing -> ([],[],[]) Just (HAR _ hf _ _ _,mapping) -> let names = getNamesAtPoint hf pos mapping @@ -109,7 +109,7 @@ foiReferencesAtPoint file pos (FOIReferences asts) = (mapMaybe (\n -> M.lookup (Right n) rf) names) typerefs = concatMap (mapMaybe (toCurrentLocation goMapping . realSrcSpanToLocation)) (mapMaybe (`M.lookup` tr) names) - in (names, adjustedLocs,map fromNormalizedFilePath $ HM.keys asts) + in (names, adjustedLocs,mapMaybe (uriToFilePath . fromNormalizedUri) $ HM.keys asts) getNamesAtPoint :: HieASTs a -> Position -> PositionMapping -> [Name] getNamesAtPoint hf pos mapping = @@ -124,9 +124,9 @@ toCurrentLocation mapping (Location uri range) = referencesAtPoint :: MonadIO m => WithHieDb - -> NormalizedFilePath -- ^ The file the cursor is in + -> NormalizedUri -- ^ The file the cursor is in -> Position -- ^ position in the file - -> FOIReferences -- ^ references data for FOIs + -> BOIReferences -- ^ references data for FOIs -> m [Location] referencesAtPoint withHieDb nfp pos refs = do -- The database doesn't have up2date references data for the FOIs so we must collect those @@ -211,7 +211,7 @@ gotoDefinition => WithHieDb -> LookupModule m -> IdeOptions - -> M.Map ModuleName NormalizedFilePath + -> M.Map ModuleName NormalizedUri -> HieAstResult -> Position -> MaybeT m [(Location, Identifier)] @@ -461,7 +461,7 @@ locationsAtPoint => WithHieDb -> LookupModule m -> IdeOptions - -> M.Map ModuleName NormalizedFilePath + -> M.Map ModuleName NormalizedUri -> Position -> HieAstResult -> m [(Location, Identifier)] @@ -469,7 +469,7 @@ locationsAtPoint withHieDb lookupModule _ideOptions imports pos (HAR _ ast _rm _ let ns = concat $ pointCommand ast pos (M.keys . getNodeIds) zeroPos = Position 0 0 zeroRange = Range zeroPos zeroPos - modToLocation m = fmap (\fs -> pure (Location (fromNormalizedUri $ filePathToUri' fs) zeroRange)) $ M.lookup m imports + modToLocation m = fmap (\fs -> pure (Location (fromNormalizedUri fs) zeroRange)) $ M.lookup m imports in fmap (nubOrd . concat) $ mapMaybeM (either (\m -> pure ((fmap $ fmap (,Left m)) (modToLocation m))) (\n -> fmap (fmap $ fmap (,Right n)) (nameToLocation withHieDb lookupModule n))) diff --git a/ghcide/src/Development/IDE/Spans/Pragmas.hs b/ghcide/src/Development/IDE/Spans/Pragmas.hs index 4df16c6704..ccc9833742 100644 --- a/ghcide/src/Development/IDE/Spans/Pragmas.hs +++ b/ghcide/src/Development/IDE/Spans/Pragmas.hs @@ -17,7 +17,7 @@ import Data.Text (Text, pack) import qualified Data.Text as Text import Data.Text.Utf16.Rope.Mixed (Rope) import qualified Data.Text.Utf16.Rope.Mixed as Rope -import Development.IDE (srcSpanToRange, IdeState, NormalizedFilePath, GhcSession (..), getFileContents, hscEnv, runAction) +import Development.IDE (srcSpanToRange, IdeState, GhcSession (..), getFileContents, hscEnv, runAction, NormalizedUri) import Development.IDE.GHC.Compat import Development.IDE.GHC.Compat.Util import qualified Language.LSP.Protocol.Types as LSP @@ -55,10 +55,10 @@ insertNewPragma (NextPragmaInfo nextPragmaLine _) newPragma = LSP.TextEdit prag pragmaInsertPosition = LSP.Position (fromIntegral nextPragmaLine) 0 pragmaInsertRange = LSP.Range pragmaInsertPosition pragmaInsertPosition -getFirstPragma :: MonadIO m => PluginId -> IdeState -> NormalizedFilePath -> ExceptT PluginError m NextPragmaInfo -getFirstPragma (PluginId pId) state nfp = do - (hscEnv -> hsc_dflags -> sessionDynFlags, _) <- runActionE (T.unpack pId <> ".GhcSession") state $ useWithStaleE GhcSession nfp - fileContents <- liftIO $ runAction (T.unpack pId <> ".GetFileContents") state $ getFileContents nfp +getFirstPragma :: MonadIO m => PluginId -> IdeState -> NormalizedUri -> ExceptT PluginError m NextPragmaInfo +getFirstPragma (PluginId pId) state nuri = do + (hscEnv -> hsc_dflags -> sessionDynFlags, _) <- runActionE (T.unpack pId <> ".GhcSession") state $ useWithStaleE GhcSession nuri + fileContents <- liftIO $ runAction (T.unpack pId <> ".GetFileContents") state $ getFileContents nuri pure $ getNextPragmaInfo sessionDynFlags fileContents -- Pre-declaration comments parser ----------------------------------------------------- diff --git a/ghcide/src/Development/IDE/Types/Diagnostics.hs b/ghcide/src/Development/IDE/Types/Diagnostics.hs index 5072fa7ffa..2de84ad3f6 100644 --- a/ghcide/src/Development/IDE/Types/Diagnostics.hs +++ b/ghcide/src/Development/IDE/Types/Diagnostics.hs @@ -9,7 +9,7 @@ module Development.IDE.Types.Diagnostics ( LSP.Diagnostic(..), ShowDiagnostic(..), FileDiagnostic(..), - fdFilePathL, + fdUriL, fdLspDiagnosticL, fdShouldShowDiagnosticL, fdStructuredMessageL, @@ -73,14 +73,14 @@ type IdeResult v = ([FileDiagnostic], Maybe v) -- | an IdeResult with a fingerprint type IdeResultNoDiagnosticsEarlyCutoff v = (Maybe ByteString, Maybe v) --- | Produce a 'FileDiagnostic' for the given 'NormalizedFilePath' +-- | Produce a 'FileDiagnostic' for the given 'NormalizedUri' -- with an error message. -ideErrorText :: NormalizedFilePath -> T.Text -> FileDiagnostic -ideErrorText nfp msg = - ideErrorWithSource (Just "compiler") (Just DiagnosticSeverity_Error) nfp msg Nothing +ideErrorText :: NormalizedUri -> T.Text -> FileDiagnostic +ideErrorText nuri msg = + ideErrorWithSource (Just "compiler") (Just DiagnosticSeverity_Error) nuri msg Nothing -- | Create a 'FileDiagnostic' from an existing 'LSP.Diagnostic' for a --- specific 'NormalizedFilePath'. +-- specific 'NormalizedUri'. -- The optional 'MsgEnvelope GhcMessage' is the original error message -- that was used for creating the 'LSP.Diagnostic'. -- It is included here, to allow downstream consumers, such as HLS plugins, @@ -90,10 +90,10 @@ ideErrorText nfp msg = -- to provide documentation and explanations for error messages. ideErrorFromLspDiag :: LSP.Diagnostic - -> NormalizedFilePath + -> NormalizedUri -> Maybe (MsgEnvelope GhcMessage) -> FileDiagnostic -ideErrorFromLspDiag lspDiag fdFilePath mbOrigMsg = +ideErrorFromLspDiag lspDiag fdUri mbOrigMsg = let fdShouldShowDiagnostic = ShowDiag fdStructuredMessage = case mbOrigMsg of @@ -145,11 +145,11 @@ showFlag flag = ("-W" <>) . T.pack . flagSpecName <$> find ((== flag) . flagSpec ideErrorWithSource :: Maybe T.Text -> Maybe DiagnosticSeverity - -> NormalizedFilePath + -> NormalizedUri -> T.Text -> Maybe (MsgEnvelope GhcMessage) -> FileDiagnostic -ideErrorWithSource source sev fdFilePath msg origMsg = +ideErrorWithSource source sev fdUri msg origMsg = let lspDiagnostic = LSP.Diagnostic { _range = noRange, @@ -163,7 +163,7 @@ ideErrorWithSource source sev fdFilePath msg origMsg = _data_ = Nothing } in - ideErrorFromLspDiag lspDiagnostic fdFilePath origMsg + ideErrorFromLspDiag lspDiagnostic fdUri origMsg -- | Defines whether a particular diagnostic should be reported -- back to the user. @@ -235,7 +235,7 @@ instance NFData StructuredMessage where -- StructuredMessage. -- data FileDiagnostic = FileDiagnostic - { fdFilePath :: NormalizedFilePath + { fdUri :: NormalizedUri , fdShouldShowDiagnostic :: ShowDiagnostic , fdLspDiagnostic :: Diagnostic -- | The original diagnostic that was used to produce 'fdLspDiagnostic'. @@ -271,9 +271,9 @@ prettyDiagnostics :: [FileDiagnostic] -> Doc Terminal.AnsiStyle prettyDiagnostics = vcat . map prettyDiagnostic prettyDiagnostic :: FileDiagnostic -> Doc Terminal.AnsiStyle -prettyDiagnostic FileDiagnostic { fdFilePath, fdShouldShowDiagnostic, fdLspDiagnostic = LSP.Diagnostic{..} } = +prettyDiagnostic FileDiagnostic { fdUri, fdShouldShowDiagnostic, fdLspDiagnostic = LSP.Diagnostic{..} } = vcat - [ slabel_ "File: " $ pretty (fromNormalizedFilePath fdFilePath) + [ slabel_ "File: " $ pretty (fromNormalizedUri fdUri) , slabel_ "Hidden: " $ if fdShouldShowDiagnostic == ShowDiag then "no" else "yes" , slabel_ "Range: " $ prettyRange _range , slabel_ "Source: " $ pretty _source diff --git a/ghcide/src/Development/IDE/Types/KnownTargets.hs b/ghcide/src/Development/IDE/Types/KnownTargets.hs index 6ae6d52ba3..1a1b74a9c9 100644 --- a/ghcide/src/Development/IDE/Types/KnownTargets.hs +++ b/ghcide/src/Development/IDE/Types/KnownTargets.hs @@ -20,7 +20,7 @@ import GHC.Generics -- | A mapping of module name to known files data KnownTargets = KnownTargets - { targetMap :: !(HashMap Target (HashSet NormalizedFilePath)) + { targetMap :: !(HashMap Target (HashSet NormalizedUri)) -- | 'normalisingMap' is a cached copy of `HMap.mapKey const targetMap` -- -- At startup 'GetLocatedImports' is called on all known files. Say you have 10000 @@ -48,7 +48,7 @@ unionKnownTargets :: KnownTargets -> KnownTargets -> KnownTargets unionKnownTargets (KnownTargets tm nm) (KnownTargets tm' nm') = KnownTargets (HMap.unionWith (<>) tm tm') (HMap.union nm nm') -mkKnownTargets :: [(Target, HashSet NormalizedFilePath)] -> KnownTargets +mkKnownTargets :: [(Target, HashSet NormalizedUri)] -> KnownTargets mkKnownTargets vs = KnownTargets (HMap.fromList vs) (HMap.fromList [(k,k) | (k,_) <- vs ]) instance NFData KnownTargets where @@ -67,5 +67,5 @@ data Target = TargetModule ModuleName | TargetFile NormalizedFilePath deriving ( Eq, Ord, Generic, Show ) deriving anyclass (Hashable, NFData) -toKnownFiles :: KnownTargets -> HashSet NormalizedFilePath +toKnownFiles :: KnownTargets -> HashSet NormalizedUri toKnownFiles = HSet.unions . HMap.elems . targetMap diff --git a/ghcide/src/Development/IDE/Types/Shake.hs b/ghcide/src/Development/IDE/Types/Shake.hs index cc8f84e3b6..c4dc732ae8 100644 --- a/ghcide/src/Development/IDE/Types/Shake.hs +++ b/ghcide/src/Development/IDE/Types/Shake.hs @@ -20,6 +20,7 @@ import Control.Exception import qualified Data.ByteString.Char8 as BS import Data.Dynamic import Data.Hashable +import qualified Data.Text as Text import Data.Typeable (cast) import Data.Vector (Vector) import Development.IDE.Core.PositionMapping @@ -75,16 +76,16 @@ isBadDependency x | Just (_ :: BadDependency) <- fromException x = True | otherwise = False -toKey :: Shake.ShakeValue k => k -> NormalizedFilePath -> Key +toKey :: Shake.ShakeValue k => k -> NormalizedUri -> Key toKey = (newKey.) . curry Q -fromKey :: Typeable k => Key -> Maybe (k, NormalizedFilePath) +fromKey :: Typeable k => Key -> Maybe (k, NormalizedUri) fromKey (Key k) | Just (Q (k', f)) <- cast k = Just (k', f) | otherwise = Nothing -- | fromKeyType (Q (k,f)) = (typeOf k, f) -fromKeyType :: Key -> Maybe (SomeTypeRep, NormalizedFilePath) +fromKeyType :: Key -> Maybe (SomeTypeRep, NormalizedUri) fromKeyType (Key k) | App tc a <- typeOf k , Just HRefl <- tc `eqTypeRep` (typeRep @Q) @@ -93,13 +94,13 @@ fromKeyType (Key k) | otherwise = Nothing toNoFileKey :: (Show k, Typeable k, Eq k, Hashable k) => k -> Key -toNoFileKey k = newKey $ Q (k, emptyFilePath) +toNoFileKey k = newKey $ Q (k, emptyPathUri) -newtype Q k = Q (k, NormalizedFilePath) +newtype Q k = Q (k, NormalizedUri) deriving newtype (Eq, Hashable, NFData) instance Show k => Show (Q k) where - show (Q (k, file)) = show k ++ "; " ++ fromNormalizedFilePath file + show (Q (k, uri)) = show k ++ "; " ++ Text.unpack (getUri (fromNormalizedUri uri)) -- | Invariant: the @v@ must be in normal form (fully evaluated). -- Otherwise we keep repeatedly 'rnf'ing values taken from the Shake database diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index f4066dca94..a204556805 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -1116,6 +1116,7 @@ library hls-code-range-plugin Ide.Plugin.CodeRange.ASTPreProcess hs-source-dirs: plugins/hls-code-range-plugin/src build-depends: + , text , containers , deepseq , extra diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index 3a06656a77..93957dab62 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -420,6 +420,7 @@ pluginSupportsFileType :: (L.HasTextDocument m doc, L.HasUri doc Uri) => m -> Pl pluginSupportsFileType msgParams pluginDesc = case mfp of Just fp | T.pack (takeExtension fp) `elem` pluginFileType pluginDesc -> HandlesRequest + Nothing -> HandlesRequest -- NOTE: if there's no file path, we have to at least try the plugin on the respective buffer _ -> DoesNotHandleRequest $ DoesNotSupportFileType (maybe "(unable to determine file type)" (T.pack . takeExtension) mfp) where mfp = uriToFilePath uri @@ -1184,7 +1185,7 @@ type FormattingHandler a -> Maybe ProgressToken -> FormattingType -> T.Text - -> NormalizedFilePath + -> NormalizedUri -> FormattingOptions -> ExceptT PluginError (HandlerM Config) ([TextEdit] |? Null) diff --git a/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs b/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs index 3b00d79d1b..b20f2b844b 100644 --- a/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs +++ b/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs @@ -70,8 +70,8 @@ instance Show CollectLiteralsResult where instance NFData CollectLiteralsResult collectLiteralsRule :: Recorder (WithPriority Log) -> Rules () -collectLiteralsRule recorder = define (cmapWithPrio LogShake recorder) $ \CollectLiterals nfp -> do - pm <- use GetParsedModule nfp +collectLiteralsRule recorder = define (cmapWithPrio LogShake recorder) $ \CollectLiterals nuri -> do + pm <- use GetParsedModule nuri -- get the current extensions active and transform them into FormatTypes let exts = map GhcExtension . getExtensions <$> pm -- collect all the literals for a file @@ -81,25 +81,25 @@ collectLiteralsRule recorder = define (cmapWithPrio LogShake recorder) $ \Collec codeActionHandler :: PluginMethodHandler IdeState 'Method_TextDocumentCodeAction codeActionHandler state pId (CodeActionParams _ _ docId currRange _) = do - nfp <- getNormalizedFilePathE (docId ^. L.uri) - CLR{..} <- requestLiterals pId state nfp - pragma <- getFirstPragma pId state nfp + let nuri = toNormalizedUri (docId ^. L.uri) + CLR{..} <- requestLiterals pId state nuri + pragma <- getFirstPragma pId state nuri -- remove any invalid literals (see validTarget comment) let litsInRange = RangeMap.filterByRange currRange literals -- generate alternateFormats and zip with the literal that generated the alternates literalPairs = map (\lit -> (lit, alternateFormat lit)) litsInRange -- make a code action for every literal and its' alternates (then flatten the result) - actions = concatMap (\(lit, alts) -> map (mkCodeAction nfp lit enabledExtensions pragma) alts) literalPairs + actions = concatMap (\(lit, alts) -> map (mkCodeAction nuri lit enabledExtensions pragma) alts) literalPairs pure $ InL actions where - mkCodeAction :: NormalizedFilePath -> Literal -> [GhcExtension] -> NextPragmaInfo -> AlternateFormat -> Command |? CodeAction - mkCodeAction nfp lit enabled npi af@(alt, ext) = InR CodeAction { + mkCodeAction :: NormalizedUri -> Literal -> [GhcExtension] -> NextPragmaInfo -> AlternateFormat -> Command |? CodeAction + mkCodeAction nuri lit enabled npi af@(alt, ext) = InR CodeAction { _title = mkCodeActionTitle lit af enabled , _kind = Just $ CodeActionKind_Custom "quickfix.literals.style" , _diagnostics = Nothing , _isPreferred = Nothing , _disabled = Nothing - , _edit = Just $ mkWorkspaceEdit nfp edits + , _edit = Just $ mkWorkspaceEdit nuri edits , _command = Nothing , _data_ = Nothing } @@ -109,10 +109,10 @@ codeActionHandler state pId (CodeActionParams _ _ docId currRange _) = do NeedsExtension ext' -> [insertNewPragma npi ext' | needsExtension ext' enabled] NoExtension -> [] - mkWorkspaceEdit :: NormalizedFilePath -> [TextEdit] -> WorkspaceEdit - mkWorkspaceEdit nfp edits = WorkspaceEdit changes Nothing Nothing + mkWorkspaceEdit :: NormalizedUri -> [TextEdit] -> WorkspaceEdit + mkWorkspaceEdit nuri edits = WorkspaceEdit changes Nothing Nothing where - changes = Just $ Map.singleton (filePathToUri $ fromNormalizedFilePath nfp) edits + changes = Just $ Map.singleton (fromNormalizedUri nuri) edits mkCodeActionTitle :: Literal -> AlternateFormat -> [GhcExtension] -> Text mkCodeActionTitle lit (alt, ext) ghcExts @@ -127,7 +127,7 @@ mkCodeActionTitle lit (alt, ext) ghcExts needsExtension :: Extension -> [GhcExtension] -> Bool needsExtension ext ghcExts = ext `notElem` map unExt ghcExts -requestLiterals :: MonadIO m => PluginId -> IdeState -> NormalizedFilePath -> ExceptT PluginError m CollectLiteralsResult +requestLiterals :: MonadIO m => PluginId -> IdeState -> NormalizedUri -> ExceptT PluginError m CollectLiteralsResult requestLiterals (PluginId pId) state = runActionE (unpack pId <> ".CollectLiterals") state . useE CollectLiterals diff --git a/plugins/hls-cabal-fmt-plugin/src/Ide/Plugin/CabalFmt.hs b/plugins/hls-cabal-fmt-plugin/src/Ide/Plugin/CabalFmt.hs index 8c49f379d7..dc8d4adc9e 100644 --- a/plugins/hls-cabal-fmt-plugin/src/Ide/Plugin/CabalFmt.hs +++ b/plugins/hls-cabal-fmt-plugin/src/Ide/Plugin/CabalFmt.hs @@ -63,8 +63,9 @@ provider :: Recorder (WithPriority Log) -> PluginId -> FormattingHandler IdeStat provider recorder _ _ _ (FormatRange _) _ _ _ = do logWith recorder Info LogInvalidInvocationInfo throwError $ PluginInvalidParams "You cannot format a text-range using cabal-fmt." -provider recorder plId ideState _ FormatText contents nfp opts = do +provider recorder plId ideState _ FormatText contents nuri opts | Just nfp <- uriToNormalizedFilePath nuri = do let cabalFmtArgs = [ "--indent", show tabularSize] + fp = fromNormalizedFilePath nfp cabalFmtExePath <- fmap T.unpack $ liftIO $ runAction "cabal-fmt" ideState $ usePropertyAction #path plId properties x <- liftIO $ findExecutable cabalFmtExePath case x of @@ -88,6 +89,6 @@ provider recorder plId ideState _ FormatText contents nfp opts = do log Error $ LogFormatterBinNotFound cabalFmtExePath throwError (PluginInternalError "No installation of cabal-fmt could be found. Please install it globally, or provide the full path to the executable") where - fp = fromNormalizedFilePath nfp tabularSize = opts ^. L.tabSize log = logWith recorder +provider _ _ _ _ _ _ nuri _ = throwError $ PluginInternalError $ "Cabal fmt can only be invoked on files, but uri " <> getUri (fromNormalizedUri nuri) <> " was not a file URI" diff --git a/plugins/hls-cabal-gild-plugin/src/Ide/Plugin/CabalGild.hs b/plugins/hls-cabal-gild-plugin/src/Ide/Plugin/CabalGild.hs index 1d698d637b..384db719c4 100644 --- a/plugins/hls-cabal-gild-plugin/src/Ide/Plugin/CabalGild.hs +++ b/plugins/hls-cabal-gild-plugin/src/Ide/Plugin/CabalGild.hs @@ -63,8 +63,9 @@ provider :: Recorder (WithPriority Log) -> PluginId -> FormattingHandler IdeStat provider recorder _ _ _ (FormatRange _) _ _ _ = do logWith recorder Info LogInvalidInvocationInfo throwError $ PluginInvalidParams "You cannot format a text-range using cabal-gild." -provider recorder plId ideState _ FormatText contents nfp _ = do +provider recorder plId ideState _ FormatText contents nuri _ | Just nfp <- uriToNormalizedFilePath nuri = do let cabalGildArgs = ["--stdin=" <> fp, "--input=-"] -- < Read from stdin + fp = fromNormalizedFilePath nfp cabalGildExePath <- fmap T.unpack $ liftIO $ runAction "cabal-gild" ideState $ usePropertyAction #path plId properties x <- liftIO $ findExecutable cabalGildExePath @@ -89,5 +90,5 @@ provider recorder plId ideState _ FormatText contents nfp _ = do log Error $ LogFormatterBinNotFound cabalGildExePath throwError (PluginInternalError "No installation of cabal-gild could be found. Please install it globally, or provide the full path to the executable.") where - fp = fromNormalizedFilePath nfp log = logWith recorder +provider _ _ _ _ _ _ nuri _ = throwError $ PluginInternalError $ "Cabal gild can only be invoked on files, but uri " <> getUri (fromNormalizedUri nuri) <> " was not a file URI" diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 9a56467f3f..9189d851dc 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -61,7 +61,6 @@ import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest import Ide.Plugin.Cabal.Orphans () import Ide.Plugin.Cabal.Outline import qualified Ide.Plugin.Cabal.Parse as Parse -import Ide.Plugin.Error import Ide.Types import qualified Language.LSP.Protocol.Lens as JL import qualified Language.LSP.Protocol.Message as LSP @@ -70,13 +69,13 @@ import qualified Language.LSP.VFS as VFS import Text.Regex.TDFA data Log - = LogModificationTime NormalizedFilePath FileVersion + = LogModificationTime NormalizedUri FileVersion | LogShake Shake.Log | LogDocOpened Uri | LogDocModified Uri | LogDocSaved Uri | LogDocClosed Uri - | LogFOI (HashMap NormalizedFilePath FileOfInterestStatus) + | LogFOI (HashMap NormalizedUri FileOfInterestStatus) | LogCompletionContext Types.Context Position | LogCompletions Types.Log | LogCabalAdd CabalAdd.Log @@ -85,8 +84,8 @@ data Log instance Pretty Log where pretty = \case LogShake log' -> pretty log' - LogModificationTime nfp modTime -> - "Modified:" <+> pretty (fromNormalizedFilePath nfp) <+> pretty (show modTime) + LogModificationTime nuri modTime -> + "Modified:" <+> pretty (fromNormalizedUri nuri) <+> pretty (show modTime) LogDocOpened uri -> "Opened text document:" <+> pretty (getUri uri) LogDocModified uri -> @@ -140,28 +139,28 @@ descriptor recorder plId = mconcat [ mkPluginNotificationHandler LSP.SMethod_TextDocumentDidOpen $ \ide vfs _ (DidOpenTextDocumentParams TextDocumentItem{_uri, _version}) -> liftIO $ do - whenUriFile _uri $ \file -> do log' Debug $ LogDocOpened _uri - restartCabalShakeSession (shakeExtras ide) vfs file "(opened)" $ - addFileOfInterest recorder ide file Modified{firstOpen = True} + let nuri = toNormalizedUri _uri + restartCabalShakeSession (shakeExtras ide) vfs nuri "(opened)" $ + addFileOfInterest recorder ide nuri Modified{firstOpen = True} , mkPluginNotificationHandler LSP.SMethod_TextDocumentDidChange $ \ide vfs _ (DidChangeTextDocumentParams VersionedTextDocumentIdentifier{_uri} _) -> liftIO $ do - whenUriFile _uri $ \file -> do log' Debug $ LogDocModified _uri - restartCabalShakeSession (shakeExtras ide) vfs file "(changed)" $ - addFileOfInterest recorder ide file Modified{firstOpen = False} + let nuri = toNormalizedUri _uri + restartCabalShakeSession (shakeExtras ide) vfs nuri "(changed)" $ + addFileOfInterest recorder ide nuri Modified{firstOpen = False} , mkPluginNotificationHandler LSP.SMethod_TextDocumentDidSave $ \ide vfs _ (DidSaveTextDocumentParams TextDocumentIdentifier{_uri} _) -> liftIO $ do - whenUriFile _uri $ \file -> do log' Debug $ LogDocSaved _uri - restartCabalShakeSession (shakeExtras ide) vfs file "(saved)" $ - addFileOfInterest recorder ide file OnDisk + let nuri = toNormalizedUri _uri + restartCabalShakeSession (shakeExtras ide) vfs nuri "(saved)" $ + addFileOfInterest recorder ide nuri OnDisk , mkPluginNotificationHandler LSP.SMethod_TextDocumentDidClose $ \ide vfs _ (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> liftIO $ do - whenUriFile _uri $ \file -> do + let nuri = toNormalizedUri _uri log' Debug $ LogDocClosed _uri - restartCabalShakeSession (shakeExtras ide) vfs file "(closed)" $ - deleteFileOfInterest recorder ide file + restartCabalShakeSession (shakeExtras ide) vfs nuri "(closed)" $ + deleteFileOfInterest recorder ide nuri ] , pluginConfigDescriptor = defaultConfigDescriptor { configHasDiagnostics = True @@ -170,9 +169,6 @@ descriptor recorder plId = where log' = logWith recorder - whenUriFile :: Uri -> (NormalizedFilePath -> IO ()) -> IO () - whenUriFile uri act = whenJust (uriToFilePath uri) $ act . toNormalizedFilePath' - {- | Helper function to restart the shake session, specifically for modifying .cabal files. No special logic, just group up a bunch of functions you need for the base Notification Handlers. @@ -182,11 +178,11 @@ needs to be re-parsed. That's what we do when we record the dirty key that our p rule depends on. Then we restart the shake session, so that changes to our virtual files are actually picked up. -} -restartCabalShakeSession :: ShakeExtras -> VFS.VFS -> NormalizedFilePath -> String -> IO [Key] -> IO () -restartCabalShakeSession shakeExtras vfs file actionMsg actionBetweenSession = do - restartShakeSession shakeExtras (VFSModified vfs) (fromNormalizedFilePath file ++ " " ++ actionMsg) [] $ do +restartCabalShakeSession :: ShakeExtras -> VFS.VFS -> NormalizedUri -> String -> IO [Key] -> IO () +restartCabalShakeSession shakeExtras vfs uri actionMsg actionBetweenSession = do + restartShakeSession shakeExtras (VFSModified vfs) (T.unpack (getUri $ fromNormalizedUri uri) ++ " " ++ actionMsg) [] $ do keys <- actionBetweenSession - return (toKey GetModificationTime file:keys) + return (toKey GetModificationTime uri:keys) -- ---------------------------------------------------------------- -- Plugin Rules @@ -197,94 +193,98 @@ cabalRules recorder plId = do -- Make sure we initialise the cabal files-of-interest. ofInterestRules recorder -- Rule to produce diagnostics for cabal files. - define (cmapWithPrio LogShake recorder) $ \ParseCabalFields file -> do + define (cmapWithPrio LogShake recorder) $ \ParseCabalFields uri -> do config <- getPluginConfigAction plId if not (plcGlobalOn config && plcDiagnosticsOn config) then pure ([], Nothing) else do -- whenever this key is marked as dirty (e.g., when a user writes stuff to it), -- we rerun this rule because this rule *depends* on GetModificationTime. - (t, mCabalSource) <- use_ GetFileContents file - log' Debug $ LogModificationTime file t + (t, mCabalSource) <- use_ GetFileContents uri + log' Debug $ LogModificationTime uri t contents <- case mCabalSource of Just sources -> - pure $ Encoding.encodeUtf8 $ Rope.toText sources - Nothing -> do - liftIO $ BS.readFile $ fromNormalizedFilePath file - - case Parse.readCabalFields file contents of - Left _ -> - pure ([], Nothing) - Right fields -> - pure ([], Just fields) - - define (cmapWithPrio LogShake recorder) $ \ParseCabalCommonSections file -> do - fields <- use_ ParseCabalFields file + pure $ Just $ Encoding.encodeUtf8 $ Rope.toText sources + Nothing | Just fp <- uriToNormalizedFilePath uri -> Just <$> do + liftIO $ BS.readFile $ fromNormalizedFilePath fp + _ -> pure Nothing + + pure $ case Parse.readCabalFields uri <$> contents of + Nothing -> ([], Nothing) + Just (Left _) -> ([], Nothing) + Just (Right fields) -> ([], Just fields) + + define (cmapWithPrio LogShake recorder) $ \ParseCabalCommonSections uri -> do + fields <- use_ ParseCabalFields uri let commonSections = Maybe.mapMaybe (\case commonSection@(Syntax.Section (Syntax.Name _ "common") _ _) -> Just commonSection _ -> Nothing) fields pure ([], Just commonSections) - define (cmapWithPrio LogShake recorder) $ \ParseCabalFile file -> do + define (cmapWithPrio LogShake recorder) $ \ParseCabalFile uri -> do config <- getPluginConfigAction plId if not (plcGlobalOn config && plcDiagnosticsOn config) then pure ([], Nothing) else do -- whenever this key is marked as dirty (e.g., when a user writes stuff to it), -- we rerun this rule because this rule *depends* on GetModificationTime. - (t, mCabalSource) <- use_ GetFileContents file - log' Debug $ LogModificationTime file t - contents <- case mCabalSource of + (t, mCabalSource) <- use_ GetFileContents uri + log' Debug $ LogModificationTime uri t + mcontents <- case mCabalSource of Just sources -> - pure $ Encoding.encodeUtf8 $ Rope.toText sources - Nothing -> do - liftIO $ BS.readFile $ fromNormalizedFilePath file + pure $ Just $ Encoding.encodeUtf8 $ Rope.toText sources + Nothing | Just fp <- uriToNormalizedFilePath uri -> Just <$> do + liftIO $ BS.readFile $ fromNormalizedFilePath fp + _ -> pure Nothing -- Instead of fully reparsing the sources to get a 'GenericPackageDescription', -- we would much rather re-use the already parsed results of 'ParseCabalFields'. -- Unfortunately, Cabal-syntax doesn't expose the function 'parseGenericPackageDescription'' -- which allows us to resume the parsing pipeline with '[Field Position]'. - (pWarnings, pm) <- liftIO $ Parse.parseCabalFileContents contents - let warningDiags = fmap (Diagnostics.warningDiagnostic file) pWarnings - case pm of - Left (_cabalVersion, pErrorNE) -> do - let regexUnknownCabalBefore310 :: T.Text - -- We don't support the cabal version, this should not be an error, as the - -- user did not do anything wrong. Instead we cast it to a warning - regexUnknownCabalBefore310 = "Unsupported cabal-version [0-9]+.[0-9]*" - regexUnknownCabalVersion :: T.Text - regexUnknownCabalVersion = "Unsupported cabal format version in cabal-version field: [0-9]+.[0-9]+" - unsupportedCabalHelpText = unlines - [ "The used `cabal-version` is not fully supported by this `HLS` binary." - , "Either the `cabal-version` is unknown, or too new for this executable." - , "This means that some functionality might not work as expected." - , "If you face any issues, try downgrading to a supported `cabal-version` or upgrading `HLS` if possible." - , "" - , "Supported versions are: " <> - List.intercalate ", " - (fmap Cabal.showCabalSpecVersion Data.supportedCabalVersions) - ] - errorDiags = - NE.toList $ - NE.map - ( \pe@(PError pos text) -> - if any (text =~) - [ regexUnknownCabalBefore310 - , regexUnknownCabalVersion - ] - then Diagnostics.warningDiagnostic file (Syntax.PWarning Syntax.PWTOther pos $ - unlines - [ text - , unsupportedCabalHelpText - ]) - else Diagnostics.errorDiagnostic file pe - ) - pErrorNE - allDiags = errorDiags <> warningDiags - pure (allDiags, Nothing) - Right gpd -> do - pure (warningDiags, Just gpd) + case mcontents of + Nothing -> pure ([ideErrorText uri $ "tried to open uri " <> getUri (fromNormalizedUri uri) <> " but it is not a file uri"], Nothing) + Just contents -> do + (pWarnings, pm) <- liftIO $ Parse.parseCabalFileContents contents + let warningDiags = fmap (Diagnostics.warningDiagnostic uri) pWarnings + case pm of + Left (_cabalVersion, pErrorNE) -> do + let regexUnknownCabalBefore310 :: T.Text + -- We don't support the cabal version, this should not be an error, as the + -- user did not do anything wrong. Instead we cast it to a warning + regexUnknownCabalBefore310 = "Unsupported cabal-version [0-9]+.[0-9]*" + regexUnknownCabalVersion :: T.Text + regexUnknownCabalVersion = "Unsupported cabal format version in cabal-version field: [0-9]+.[0-9]+" + unsupportedCabalHelpText = unlines + [ "The used `cabal-version` is not fully supported by this `HLS` binary." + , "Either the `cabal-version` is unknown, or too new for this executable." + , "This means that some functionality might not work as expected." + , "If you face any issues, try downgrading to a supported `cabal-version` or upgrading `HLS` if possible." + , "" + , "Supported versions are: " <> + List.intercalate ", " + (fmap Cabal.showCabalSpecVersion Data.supportedCabalVersions) + ] + errorDiags = + NE.toList $ + NE.map + ( \pe@(PError pos text) -> + if any (text =~) + [ regexUnknownCabalBefore310 + , regexUnknownCabalVersion + ] + then Diagnostics.warningDiagnostic uri (Syntax.PWarning Syntax.PWTOther pos $ + unlines + [ text + , unsupportedCabalHelpText + ]) + else Diagnostics.errorDiagnostic uri pe + ) + pErrorNE + allDiags = errorDiags <> warningDiags + pure (allDiags, Nothing) + Right gpd -> do + pure (warningDiags, Just gpd) action $ do -- Run the cabal kick. This code always runs when 'shakeRestart' is run. @@ -326,13 +326,14 @@ licenseSuggestCodeAction ideState _ (CodeActionParams _ _ (TextDocumentIdentifie -- use some sort of fuzzy matching in the future, see issue #4357. fieldSuggestCodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction fieldSuggestCodeAction recorder ide _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics=diags}) = do - mContents <- liftIO $ runAction "cabal-plugin.getUriContents" ide $ getUriContents $ toNormalizedUri uri + let nuri = toNormalizedUri uri + mContents <- liftIO $ runAction "cabal-plugin.getUriContents" ide $ getUriContents nuri case (,) <$> mContents <*> uriToFilePath' uri of Nothing -> pure $ InL [] Just (fileContents, path) -> do -- We decide on `useWithStale` here, since `useWithStaleFast` often leads to the wrong completions being suggested. -- In case it fails, we still will get some completion results instead of an error. - mFields <- liftIO $ runAction "cabal-plugin.fields" ide $ useWithStale ParseCabalFields $ toNormalizedFilePath path + mFields <- liftIO $ runAction "cabal-plugin.fields" ide $ useWithStale ParseCabalFields nuri case mFields of Nothing -> pure $ InL [] @@ -346,7 +347,7 @@ fieldSuggestCodeAction recorder ide _ (CodeActionParams _ _ (TextDocumentIdentif fakeLspCursorPosition = Position lineNr (col + fromIntegral (T.length fieldName)) lspPrefixInfo = Ghcide.getCompletionPrefixFromRope fakeLspCursorPosition fileContents cabalPrefixInfo = Completions.getCabalPrefixInfo fp lspPrefixInfo - completions <- liftIO $ computeCompletionsAt recorder ide cabalPrefixInfo fp cabalFields + completions <- liftIO $ computeCompletionsAt recorder ide cabalPrefixInfo uri cabalFields let completionTexts = fmap (^. JL.label) completions pure $ FieldSuggest.fieldErrorAction uri fieldName completionTexts _range @@ -364,9 +365,10 @@ cabalAddCodeAction state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) case mbCabalFile of Nothing -> pure $ InL [] Just cabalFilePath -> do + let fileUri = filePathToUri cabalFilePath verTxtDocId <- runActionE "cabalAdd.getVersionedTextDoc" state $ - lift $ getVersionedTextDoc $ TextDocumentIdentifier (filePathToUri cabalFilePath) - mbGPD <- liftIO $ runAction "cabal.cabal-add" state $ useWithStale ParseCabalFile $ toNormalizedFilePath cabalFilePath + lift $ getVersionedTextDoc $ TextDocumentIdentifier fileUri + mbGPD <- liftIO $ runAction "cabal.cabal-add" state $ useWithStale ParseCabalFile $ toNormalizedUri fileUri case mbGPD of Nothing -> pure $ InL [] Just (gpd, _) -> do @@ -383,13 +385,13 @@ cabalAddCodeAction state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) -- adds a Documentation link. hover :: PluginMethodHandler IdeState LSP.Method_TextDocumentHover hover ide _ msgParam = do - nfp <- getNormalizedFilePathE uri - cabalFields <- runActionE "cabal.cabal-hover" ide $ useE ParseCabalFields nfp + let nuri = toNormalizedUri uri + cabalFields <- runActionE "cabal.cabal-hover" ide $ useE ParseCabalFields nuri case CabalFields.findTextWord cursor cabalFields of Nothing -> pure $ InR Null Just cursorText -> do - gpd <- runActionE "cabal.GPD" ide $ useE ParseCabalFile nfp + gpd <- runActionE "cabal.GPD" ide $ useE ParseCabalFile nuri let depsNames = map dependencyName $ allBuildDepends $ flattenPackageDescription gpd case filterVersion cursorText of Nothing -> pure $ InR Null @@ -437,7 +439,7 @@ such as generating diagnostics, re-parsing, etc... We need to store the open files to parse them again if we restart the shake session. Restarting of the shake session happens whenever these files are modified. -} -newtype OfInterestCabalVar = OfInterestCabalVar (Var (HashMap NormalizedFilePath FileOfInterestStatus)) +newtype OfInterestCabalVar = OfInterestCabalVar (Var (HashMap NormalizedUri FileOfInterestStatus)) instance Shake.IsIdeGlobal OfInterestCabalVar @@ -473,12 +475,12 @@ ofInterestRules recorder = do summarize (IsCabalFOI (Modified False)) = BS.singleton 2 summarize (IsCabalFOI (Modified True)) = BS.singleton 3 -getCabalFilesOfInterestUntracked :: Action (HashMap NormalizedFilePath FileOfInterestStatus) +getCabalFilesOfInterestUntracked :: Action (HashMap NormalizedUri FileOfInterestStatus) getCabalFilesOfInterestUntracked = do OfInterestCabalVar var <- Shake.getIdeGlobalAction liftIO $ readVar var -addFileOfInterest :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> FileOfInterestStatus -> IO [Key] +addFileOfInterest :: Recorder (WithPriority Log) -> IdeState -> NormalizedUri -> FileOfInterestStatus -> IO [Key] addFileOfInterest recorder state f v = do OfInterestCabalVar var <- Shake.getIdeGlobalState state (prev, files) <- modifyVar var $ \dict -> do @@ -492,7 +494,7 @@ addFileOfInterest recorder state f v = do where log' = logWith recorder -deleteFileOfInterest :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> IO [Key] +deleteFileOfInterest :: Recorder (WithPriority Log) -> IdeState -> NormalizedUri -> IO [Key] deleteFileOfInterest recorder state f = do OfInterestCabalVar var <- Shake.getIdeGlobalState state files <- modifyVar' var $ HashMap.delete f @@ -509,24 +511,26 @@ completion :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.M completion recorder ide _ complParams = do let TextDocumentIdentifier uri = complParams ^. JL.textDocument position = complParams ^. JL.position + nuri = toNormalizedUri uri mContents <- liftIO $ runAction "cabal-plugin.getUriContents" ide $ getUriContents $ toNormalizedUri uri case (,) <$> mContents <*> uriToFilePath' uri of Just (cnts, path) -> do -- We decide on `useWithStale` here, since `useWithStaleFast` often leads to the wrong completions being suggested. -- In case it fails, we still will get some completion results instead of an error. - mFields <- liftIO $ runAction "cabal-plugin.fields" ide $ useWithStale ParseCabalFields $ toNormalizedFilePath path + mFields <- liftIO $ runAction "cabal-plugin.fields" ide $ useWithStale ParseCabalFields nuri case mFields of Nothing -> pure . InR $ InR Null Just (fields, _) -> do let lspPrefInfo = Ghcide.getCompletionPrefixFromRope position cnts cabalPrefInfo = Completions.getCabalPrefixInfo path lspPrefInfo - let res = computeCompletionsAt recorder ide cabalPrefInfo path fields + let res = computeCompletionsAt recorder ide cabalPrefInfo uri fields liftIO $ fmap InL res Nothing -> pure . InR $ InR Null -computeCompletionsAt :: Recorder (WithPriority Log) -> IdeState -> Types.CabalPrefixInfo -> FilePath -> [Syntax.Field Syntax.Position] -> IO [CompletionItem] -computeCompletionsAt recorder ide prefInfo fp fields = do +computeCompletionsAt :: Recorder (WithPriority Log) -> IdeState -> Types.CabalPrefixInfo -> Uri -> [Syntax.Field Syntax.Position] -> IO [CompletionItem] +computeCompletionsAt recorder ide prefInfo uri fields = do + let nuri = toNormalizedUri uri runMaybeT (context fields) >>= \case Nothing -> pure [] Just ctx -> do @@ -537,9 +541,9 @@ computeCompletionsAt recorder ide prefInfo fp fields = do -- We decide on useWithStaleFast here, since we mostly care about the file's meta information, -- thus, a quick response gives us the desired result most of the time. -- The `withStale` option is very important here, since we often call this rule with invalid cabal files. - mGPD <- runAction "cabal-plugin.modulesCompleter.gpd" ide $ useWithStale ParseCabalFile $ toNormalizedFilePath fp + mGPD <- runAction "cabal-plugin.modulesCompleter.gpd" ide $ useWithStale ParseCabalFile nuri pure $ fmap fst mGPD - , getCabalCommonSections = runAction "cabal-plugin.commonSections" ide $ use ParseCabalCommonSections $ toNormalizedFilePath fp + , getCabalCommonSections = runAction "cabal-plugin.commonSections" ide $ use ParseCabalCommonSections nuri , cabalPrefixInfo = prefInfo , stanzaName = case fst ctx of diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs index 3b46eec128..ea20ce9713 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs @@ -72,7 +72,8 @@ import Language.LSP.Protocol.Types (ApplyWorkspaceEd Null (Null), VersionedTextDocumentIdentifier, WorkspaceEdit, - toNormalizedFilePath, + filePathToUri, + toNormalizedUri, type (|?) (InR)) import System.Directory (doesFileExist, listDirectory) @@ -246,9 +247,10 @@ getDependencyEdit :: MonadIO m => Recorder (WithPriority Log) -> (IdeState, Clie getDependencyEdit recorder env cabalFilePath buildTarget dependency = do let (state, caps, verTxtDocId) = env (mbCnfOrigContents, mbFields, mbPackDescr) <- liftIO $ runAction "cabal.cabal-add" state $ do - contents <- getFileContents $ toNormalizedFilePath cabalFilePath - inFields <- useWithStale ParseCabalFields $ toNormalizedFilePath cabalFilePath - inPackDescr <- useWithStale ParseCabalFile $ toNormalizedFilePath cabalFilePath + let nuri = toNormalizedUri $ filePathToUri cabalFilePath + contents <- getFileContents nuri + inFields <- useWithStale ParseCabalFields nuri + inPackDescr <- useWithStale ParseCabalFile nuri let mbCnfOrigContents = case contents of (Just txt) -> Just $ encodeUtf8 $ Rope.toText txt _ -> Nothing diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs index 5f85151199..8aad830f7d 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs @@ -10,6 +10,7 @@ import Control.Lens ((^.)) import Control.Monad.Extra import Control.Monad.IO.Class import Data.List (find) +import Data.Maybe import qualified Data.Maybe as Maybe import qualified Data.Text as T import Development.IDE as D @@ -36,7 +37,6 @@ import Ide.Plugin.Cabal.Completion.Types (ParseCabalCommon ParseCabalFile (..)) import qualified Ide.Plugin.Cabal.Completion.Types as Types import Ide.Plugin.Cabal.Orphans () -import Ide.Plugin.Error import Ide.Types import qualified Language.LSP.Protocol.Lens as JL import qualified Language.LSP.Protocol.Message as LSP @@ -54,19 +54,19 @@ import System.FilePath (joinPath, -- TODO: Resolve more cases for go-to definition. gotoDefinition :: PluginMethodHandler IdeState LSP.Method_TextDocumentDefinition gotoDefinition ide _ msgParam = do - nfp <- getNormalizedFilePathE uri - cabalFields <- runActionE "cabal-plugin.commonSections" ide $ useE ParseCabalFields nfp + let nuri = toNormalizedUri uri + cabalFields <- runActionE "cabal-plugin.commonSections" ide $ useE ParseCabalFields nuri -- Trim the AST tree, so multiple passes in subfunctions won't hurt the performance. let fieldsOfInterest = maybe cabalFields (:[] ) $ CabalFields.findFieldSection cursor cabalFields - commonSections <- runActionE "cabal-plugin.commonSections" ide $ useE ParseCabalCommonSections nfp + commonSections <- runActionE "cabal-plugin.commonSections" ide $ useE ParseCabalCommonSections nuri let mCommonSectionsDef = gotoCommonSectionDefinition uri commonSections cursor fieldsOfInterest mModuleDef <- do - mGPD <- liftIO $ runAction "cabal.GPD" ide $ useWithStale ParseCabalFile nfp + mGPD <- liftIO $ runAction "cabal.GPD" ide $ useWithStale ParseCabalFile nuri case mGPD of Nothing -> pure Nothing - Just (gpd, _) -> liftIO $ gotoModulesDefinition nfp gpd cursor fieldsOfInterest + Just (gpd, _) -> liftIO $ gotoModulesDefinition nuri gpd cursor fieldsOfInterest let defs = Maybe.catMaybes [ mCommonSectionsDef , mModuleDef @@ -114,12 +114,12 @@ gotoCommonSectionDefinition uri commonSections cursor fieldsOfInterest = do -- -- See resolving @Config@ module in tests. gotoModulesDefinition - :: NormalizedFilePath -- ^ Normalized FilePath to the cabal file + :: NormalizedUri -- ^ Normalized Uri to the cabal file -> GenericPackageDescription -> Syntax.Position -- ^ Cursor position -> [Syntax.Field Syntax.Position] -- ^ Trimmed cabal AST on a cursor -> IO (Maybe Definition) -gotoModulesDefinition nfp gpd cursor fieldsOfInterest = do +gotoModulesDefinition nuri gpd cursor fieldsOfInterest = do let mCursorText = CabalFields.findTextWord cursor fieldsOfInterest moduleNames = CabalFields.getModulesNames fieldsOfInterest mModuleName = find (isModuleName mCursorText) moduleNames @@ -131,7 +131,10 @@ gotoModulesDefinition nfp gpd cursor fieldsOfInterest = do (flattenPackageDescription gpd)) mBuildTargetNames sourceDirs = map getSymbolicPath $ concatMap hsSourceDirs buildInfos - potentialPaths = map (\dir -> takeDirectory (fromNormalizedFilePath nfp) dir toHaskellFile moduleName) sourceDirs + potentialPaths = mapMaybe (\dir -> do + nfp <- uriToNormalizedFilePath nuri + pure $ takeDirectory (fromNormalizedFilePath nfp) dir toHaskellFile moduleName + ) sourceDirs allPaths <- liftIO $ filterM doesFileExist potentialPaths -- Don't provide the range, since there is little benefit for it let locations = map (\pth -> Location (filePathToUri pth) (mkRange 0 0 0 0)) allPaths diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Diagnostics.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Diagnostics.hs index 5429ac0bb9..ee4a1750ea 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Diagnostics.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Diagnostics.hs @@ -22,29 +22,29 @@ import Ide.PluginUtils (extendNextLine) import Language.LSP.Protocol.Lens (range) import Language.LSP.Protocol.Types (Diagnostic (..), DiagnosticSeverity (..), - NormalizedFilePath, + NormalizedUri, Position (Position), Range (Range), - fromNormalizedFilePath) + fromNormalizedUri, getUri) -- | Produce a diagnostic for a fatal Cabal parser error. -fatalParseErrorDiagnostic :: NormalizedFilePath -> T.Text -> FileDiagnostic +fatalParseErrorDiagnostic :: NormalizedUri -> T.Text -> FileDiagnostic fatalParseErrorDiagnostic fp msg = mkDiag fp "cabal" DiagnosticSeverity_Error (toBeginningOfNextLine Syntax.zeroPos) msg -- | Produce a diagnostic from a Cabal parser error -errorDiagnostic :: NormalizedFilePath -> Syntax.PError -> FileDiagnostic +errorDiagnostic :: NormalizedUri -> Syntax.PError -> FileDiagnostic errorDiagnostic fp err@(Syntax.PError pos _) = mkDiag fp "cabal" DiagnosticSeverity_Error (toBeginningOfNextLine pos) msg where - msg = T.pack $ showPError (fromNormalizedFilePath fp) err + msg = T.pack $ showPError (T.unpack $ getUri $ fromNormalizedUri fp) err -- | Produce a diagnostic from a Cabal parser warning -warningDiagnostic :: NormalizedFilePath -> Syntax.PWarning -> FileDiagnostic +warningDiagnostic :: NormalizedUri -> Syntax.PWarning -> FileDiagnostic warningDiagnostic fp warning@(Syntax.PWarning _ pos _) = mkDiag fp "cabal" DiagnosticSeverity_Warning (toBeginningOfNextLine pos) msg where - msg = T.pack $ showPWarning (fromNormalizedFilePath fp) warning + msg = T.pack $ showPWarning (T.unpack $ getUri $ fromNormalizedUri fp) warning -- | The Cabal parser does not output a _range_ for a warning/error, -- only a single source code 'Lib.Position'. @@ -72,7 +72,7 @@ positionFromCabalPosition (Syntax.Position line column) = Position (fromIntegral -- | Create a 'FileDiagnostic' mkDiag - :: NormalizedFilePath + :: NormalizedUri -- ^ Cabal file path -> T.Text -- ^ Where does the diagnostic come from? diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs index 40f348f88c..db5ce37e2a 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs @@ -3,7 +3,6 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ViewPatterns #-} module Ide.Plugin.Cabal.Outline where @@ -15,7 +14,6 @@ import Development.IDE.Core.Rules import Development.IDE.Core.Shake (IdeState (shakeExtras), runIdeAction, useWithStaleFast) -import Development.IDE.Types.Location (toNormalizedFilePath') import Distribution.Fields.Field (Field (Field, Section), Name (Name)) import Distribution.Parsec.Position (Position) @@ -25,20 +23,19 @@ import Ide.Plugin.Cabal.Completion.Types (ParseCabalFields (..), import Ide.Plugin.Cabal.Orphans () import Ide.Types (PluginMethodHandler) import Language.LSP.Protocol.Message (Method (..)) -import Language.LSP.Protocol.Types (DocumentSymbol (..)) +import Language.LSP.Protocol.Types (DocumentSymbol (..), + toNormalizedUri) import qualified Language.LSP.Protocol.Types as LSP moduleOutline :: PluginMethodHandler IdeState Method_TextDocumentDocumentSymbol -moduleOutline ideState _ LSP.DocumentSymbolParams {_textDocument = LSP.TextDocumentIdentifier uri} = - case LSP.uriToFilePath uri of - Just (toNormalizedFilePath' -> fp) -> do - mFields <- liftIO $ runIdeAction "cabal-plugin.fields" (shakeExtras ideState) (useWithStaleFast ParseCabalFields fp) - case fmap fst mFields of - Just fieldPositions -> pure $ LSP.InR (LSP.InL allSymbols) - where - allSymbols = mapMaybe documentSymbolForField fieldPositions - Nothing -> pure $ LSP.InL [] +moduleOutline ideState _ LSP.DocumentSymbolParams {_textDocument = LSP.TextDocumentIdentifier uri} = do + let nuri = toNormalizedUri uri + mFields <- liftIO $ runIdeAction "cabal-plugin.fields" (shakeExtras ideState) (useWithStaleFast ParseCabalFields nuri) + case fmap fst mFields of + Just fieldPositions -> pure $ LSP.InR (LSP.InL allSymbols) + where + allSymbols = mapMaybe documentSymbolForField fieldPositions Nothing -> pure $ LSP.InL [] -- | Creates a @DocumentSymbol@ object for the diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Parse.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Parse.hs index e949af1b1d..0daee1e8c0 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Parse.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Parse.hs @@ -27,7 +27,7 @@ parseCabalFileContents bs = pure $ runParseResult (parseGenericPackageDescription bs) readCabalFields :: - NormalizedFilePath -> + NormalizedUri -> BS.ByteString -> Either FileDiagnostic [Syntax.Field Syntax.Position] readCabalFields file contents = do diff --git a/plugins/hls-cabal-plugin/test/Context.hs b/plugins/hls-cabal-plugin/test/Context.hs index 8e6176bc5b..b650d773bf 100644 --- a/plugins/hls-cabal-plugin/test/Context.hs +++ b/plugins/hls-cabal-plugin/test/Context.hs @@ -17,6 +17,7 @@ import Ide.Plugin.Cabal.Completion.Types (Context, import qualified Ide.Plugin.Cabal.Parse as Parse import Test.Hls import Utils as T +import Development.IDE.Types.Location ( filePathToUri' ) cabalPlugin :: PluginTestDescriptor Ide.Plugin.Cabal.Log cabalPlugin = mkPluginTestDescriptor descriptor "cabal context" @@ -207,7 +208,7 @@ getContextTests = where callGetContext :: Position -> T.Text -> T.Text -> IO Context callGetContext pos pref ls = do - case Parse.readCabalFields "not-real" (Text.encodeUtf8 ls) of + case Parse.readCabalFields (filePathToUri' "not-real") (Text.encodeUtf8 ls) of Left err -> fail $ show err Right fields -> do getContext mempty (simpleCabalPrefixInfoFromPos pos pref) fields diff --git a/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs b/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs index 06e9d99679..99b31f72b8 100644 --- a/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs +++ b/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs @@ -27,7 +27,6 @@ import Development.IDE.Spans.AtPoint import HieDb (Symbol (Symbol)) import qualified Ide.Plugin.CallHierarchy.Query as Q import Ide.Plugin.CallHierarchy.Types -import Ide.Plugin.Error import Ide.Types import qualified Language.LSP.Protocol.Lens as L import Language.LSP.Protocol.Message @@ -38,22 +37,22 @@ import Text.Read (readMaybe) -- | Render prepare call hierarchy request. prepareCallHierarchy :: PluginMethodHandler IdeState Method_TextDocumentPrepareCallHierarchy prepareCallHierarchy state _ param = do - nfp <- getNormalizedFilePathE (param ^. (L.textDocument . L.uri)) + let nuri = toNormalizedUri (param ^. (L.textDocument . L.uri)) items <- liftIO $ runAction "CallHierarchy.prepareHierarchy" state - $ prepareCallHierarchyItem nfp (param ^. L.position) + $ prepareCallHierarchyItem nuri (param ^. L.position) pure $ InL items -prepareCallHierarchyItem :: NormalizedFilePath -> Position -> Action [CallHierarchyItem] -prepareCallHierarchyItem nfp pos = use GetHieAst nfp <&> \case +prepareCallHierarchyItem :: NormalizedUri -> Position -> Action [CallHierarchyItem] +prepareCallHierarchyItem nuri pos = use GetHieAst nuri <&> \case Nothing -> mempty - Just (HAR _ hf _ _ _) -> prepareByAst hf pos nfp + Just (HAR _ hf _ _ _) -> prepareByAst hf pos nuri -prepareByAst :: HieASTs a -> Position -> NormalizedFilePath -> [CallHierarchyItem] -prepareByAst hf pos nfp = +prepareByAst :: HieASTs a -> Position -> NormalizedUri -> [CallHierarchyItem] +prepareByAst hf pos nuri = case listToMaybe $ pointCommand hf pos extract of Nothing -> mempty - Just infos -> mapMaybe (construct nfp hf) infos + Just infos -> mapMaybe (construct nuri hf) infos extract :: HieAST a -> [(Identifier, [ContextInfo], Span)] extract ast = let span = nodeSpan ast @@ -71,7 +70,7 @@ patternBindInfo ctxs = listToMaybe [ctx | ctx@PatternBind{} <- ctxs] tyDeclInfo ctxs = listToMaybe [TyDecl | TyDecl <- ctxs] matchBindInfo ctxs = listToMaybe [MatchBind | MatchBind <- ctxs] -construct :: NormalizedFilePath -> HieASTs a -> (Identifier, [ContextInfo], Span) -> Maybe CallHierarchyItem +construct :: NormalizedUri -> HieASTs a -> (Identifier, [ContextInfo], Span) -> Maybe CallHierarchyItem construct nfp hf (ident, contexts, ssp) | isInternalIdentifier ident = Nothing @@ -129,14 +128,14 @@ construct nfp hf (ident, contexts, ssp) Nothing -> Nothing Just sp -> listToMaybe $ prepareByAst hf (realSrcSpanToRange sp ^. L.start) nfp -mkCallHierarchyItem :: NormalizedFilePath -> Identifier -> SymbolKind -> Span -> Span -> CallHierarchyItem +mkCallHierarchyItem :: NormalizedUri -> Identifier -> SymbolKind -> Span -> Span -> CallHierarchyItem mkCallHierarchyItem nfp ident kind span selSpan = CallHierarchyItem (T.pack $ optimizeDisplay $ identifierName ident) kind Nothing (Just $ T.pack $ identifierToDetail ident) - (fromNormalizedUri $ normalizedFilePathToUri nfp) + (fromNormalizedUri nfp) (realSrcSpanToRange span) (realSrcSpanToRange selSpan) (toJSON . show <$> mkSymbol ident) @@ -215,14 +214,14 @@ mergeCalls constructor target = mkCallHierarchyCall :: (CallHierarchyItem -> [Range] -> a) -> Vertex -> Action (Maybe a) mkCallHierarchyCall mk v@Vertex{..} = do let pos = Position (fromIntegral $ sl - 1) (fromIntegral $ sc - 1) - nfp = toNormalizedFilePath' hieSrc + nuri = normalizedFilePathToUri $ toNormalizedFilePath' hieSrc range = mkRange (fromIntegral $ casl - 1) (fromIntegral $ casc - 1) (fromIntegral $ cael - 1) (fromIntegral $ caec - 1) - prepareCallHierarchyItem nfp pos >>= + prepareCallHierarchyItem nuri pos >>= \case [item] -> pure $ Just $ mk item [range] _ -> do @@ -231,7 +230,7 @@ mkCallHierarchyCall mk v@Vertex{..} = do case sps of (x:_) -> do items <- prepareCallHierarchyItem - nfp + nuri (Position (fromIntegral $ psl x - 1) (fromIntegral $ psc x - 1)) case items of [item] -> pure $ Just $ mk item [range] @@ -245,17 +244,16 @@ queryCalls :: -> (Vertex -> Action (Maybe a)) -> ([a] -> [a]) -> Action [a] -queryCalls item queryFunc makeFunc merge - | Just nfp <- uriToNormalizedFilePath $ toNormalizedUri uri = do - ShakeExtras{withHieDb} <- getShakeExtras - maySymbol <- getSymbol nfp - case maySymbol of - Nothing -> pure mempty - Just symbol -> do - vs <- liftIO $ withHieDb (`queryFunc` symbol) - items <- catMaybes <$> mapM makeFunc vs - pure $ merge items - | otherwise = pure mempty +queryCalls item queryFunc makeFunc merge = do + let nuri = toNormalizedUri uri + ShakeExtras{withHieDb} <- getShakeExtras + maySymbol <- getSymbol nuri + case maySymbol of + Nothing -> pure mempty + Just symbol -> do + vs <- liftIO $ withHieDb (`queryFunc` symbol) + items <- catMaybes <$> mapM makeFunc vs + pure $ merge items where uri = item ^. L.uri pos = item ^. (L.selectionRange . L.start) @@ -266,7 +264,7 @@ queryCalls item queryFunc makeFunc merge A.Error _ -> getSymbolFromAst nfp pos Nothing -> getSymbolFromAst nfp pos -- Fallback if xdata lost, some editor(VSCode) will drop it - getSymbolFromAst :: NormalizedFilePath -> Position -> Action (Maybe Symbol) + getSymbolFromAst :: NormalizedUri -> Position -> Action (Maybe Symbol) getSymbolFromAst nfp pos_ = use GetHieAst nfp <&> \case Nothing -> Nothing Just (HAR _ hf _ _ _) -> do diff --git a/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs b/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs index 8b8b7e7d3a..067e001b2b 100644 --- a/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs +++ b/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs @@ -43,8 +43,7 @@ import Generics.SYB (extQ, something) import GHC.Tc.Errors.Types (ErrInfo (..), TcRnMessageDetailed (..)) import qualified Ide.Logger as Logger -import Ide.Plugin.Error (PluginError, - getNormalizedFilePathE) +import Ide.Plugin.Error (PluginError) import Ide.Types (Config, HandlerM, PluginDescriptor (..), PluginId (PluginId), @@ -80,16 +79,16 @@ codeActionHandler -> PluginMethodHandler IdeState 'Method_TextDocumentCodeAction codeActionHandler recorder plId ideState _ CodeActionParams{_textDocument, _range} = do let TextDocumentIdentifier uri = _textDocument - nfp <- getNormalizedFilePathE uri - decls <- getDecls plId ideState nfp + let nuri = toNormalizedUri uri + decls <- getDecls plId ideState nuri - activeDiagnosticsInRange (shakeExtras ideState) nfp _range >>= \case + activeDiagnosticsInRange (shakeExtras ideState) nuri _range >>= \case Nothing -> pure (InL []) Just fileDiags -> do actions <- lift $ mapM (generateAction recorder plId uri decls) fileDiags pure (InL (catMaybes actions)) -getDecls :: MonadIO m => PluginId -> IdeState -> NormalizedFilePath -> ExceptT PluginError m [LHsDecl GhcPs] +getDecls :: MonadIO m => PluginId -> IdeState -> NormalizedUri -> ExceptT PluginError m [LHsDecl GhcPs] getDecls (PluginId changeTypeSignatureId) state = runActionE (T.unpack changeTypeSignatureId <> ".GetParsedModule") state . fmap (hsmodDecls . unLoc . pm_parsed_source) diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs index ecbd495246..8a4e3c8397 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs @@ -50,15 +50,15 @@ import Language.LSP.Protocol.Types addMethodPlaceholders :: PluginId -> CommandFunction IdeState AddMinimalMethodsParams addMethodPlaceholders _ state _ param@AddMinimalMethodsParams{..} = do caps <- lift pluginGetClientCapabilities - nfp <- getNormalizedFilePathE (verTxtDocId ^. L.uri) + let nuri = toNormalizedUri (verTxtDocId ^. L.uri) pm <- runActionE "classplugin.addMethodPlaceholders.GetParsedModule" state - $ useE GetParsedModule nfp + $ useE GetParsedModule nuri (hsc_dflags . hscEnv -> df) <- runActionE "classplugin.addMethodPlaceholders.GhcSessionDeps" state - $ useE GhcSessionDeps nfp + $ useE GhcSessionDeps nuri (old, new) <- handleMaybeM (PluginInternalError "Unable to makeEditText") $ liftIO $ runMaybeT $ makeEditText pm df param - pragmaInsertion <- insertPragmaIfNotPresent state nfp InstanceSigs + pragmaInsertion <- insertPragmaIfNotPresent state nuri InstanceSigs let edit = if withSig then mergeEdit (workspaceEdit caps old new) pragmaInsertion @@ -88,19 +88,19 @@ addMethodPlaceholders _ state _ param@AddMinimalMethodsParams{..} = do codeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeAction codeAction recorder state plId (CodeActionParams _ _ docId caRange _) = do verTxtDocId <- liftIO $ runAction "classplugin.codeAction.getVersionedTextDoc" state $ getVersionedTextDoc docId - nfp <- getNormalizedFilePathE (verTxtDocId ^. L.uri) - activeDiagnosticsInRange (shakeExtras state) nfp caRange + let nuri = toNormalizedUri (verTxtDocId ^. L.uri) + activeDiagnosticsInRange (shakeExtras state) nuri caRange >>= \case Nothing -> pure $ InL [] Just fileDiags -> do - actions <- join <$> mapM (mkActions nfp verTxtDocId) (methodDiags fileDiags) + actions <- join <$> mapM (mkActions nuri verTxtDocId) (methodDiags fileDiags) pure $ InL actions where methodDiags fileDiags = mapMaybe (\d -> (d,) <$> isClassMethodWarning (d ^. fdStructuredMessageL)) fileDiags mkActions - :: NormalizedFilePath + :: NormalizedUri -> VersionedTextDocumentIdentifier -> (FileDiagnostic, ClassMinimalDef) -> ExceptT PluginError (HandlerM Ide.Plugin.Config.Config) [Command |? CodeAction] diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeLens.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeLens.hs index 9410469516..2fe5764759 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeLens.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeLens.hs @@ -28,12 +28,12 @@ import Language.LSP.Protocol.Types -- lenses matched to a unique id codeLens :: PluginMethodHandler IdeState Method_TextDocumentCodeLens codeLens state _plId clp = do - nfp <- getNormalizedFilePathE $ clp ^. L.textDocument . L.uri + let nuri = toNormalizedUri $ clp ^. L.textDocument . L.uri (InstanceBindLensResult (InstanceBindLens{lensRange}), pm) <- runActionE "classplugin.GetInstanceBindLens" state -- Using stale results means that we can almost always return a -- value. In practice this means the lenses don't 'flicker' - $ useWithStaleE GetInstanceBindLens nfp + $ useWithStaleE GetInstanceBindLens nuri pure $ InL $ mapMaybe (toCodeLens pm) lensRange where toCodeLens pm (range, int) = let newRange = toCurrentRange pm range @@ -42,12 +42,12 @@ codeLens state _plId clp = do -- The code lens resolve method matches a title to each unique id codeLensResolve:: ResolveFunction IdeState Int Method_CodeLensResolve codeLensResolve state plId cl uri uniqueID = do - nfp <- getNormalizedFilePathE uri + let nuri = toNormalizedUri uri (InstanceBindLensResult (InstanceBindLens{lensDetails}), pm) <- runActionE "classplugin.GetInstanceBindLens" state - $ useWithStaleE GetInstanceBindLens nfp - (tmrTypechecked -> gblEnv, _) <- runActionE "classplugin.codeAction.TypeCheck" state $ useWithStaleE TypeCheck nfp - (hscEnv -> hsc, _) <- runActionE "classplugin.codeAction.GhcSession" state $ useWithStaleE GhcSession nfp + $ useWithStaleE GetInstanceBindLens nuri + (tmrTypechecked -> gblEnv, _) <- runActionE "classplugin.codeAction.TypeCheck" state $ useWithStaleE TypeCheck nuri + (hscEnv -> hsc, _) <- runActionE "classplugin.codeAction.GhcSession" state $ useWithStaleE GhcSession nuri (range, name, typ) <- handleMaybe PluginStaleResolve $ IntMap.lookup uniqueID lensDetails let title = prettyBindingNameString (printOutputable name) <> " :: " <> T.pack (showDoc hsc gblEnv typ) @@ -68,15 +68,15 @@ codeLensResolve state plId cl uri uniqueID = do -- specified unique id. codeLensCommandHandler :: PluginId -> CommandFunction IdeState InstanceBindLensCommand codeLensCommandHandler plId state _ InstanceBindLensCommand{commandUri, commandEdit} = do - nfp <- getNormalizedFilePathE commandUri + let nuri = toNormalizedUri commandUri (InstanceBindLensResult (InstanceBindLens{lensEnabledExtensions}), _) <- runActionE "classplugin.GetInstanceBindLens" state - $ useWithStaleE GetInstanceBindLens nfp + $ useWithStaleE GetInstanceBindLens nuri -- We are only interested in the pragma information if the user does not -- have the InstanceSigs extension enabled mbPragma <- if InstanceSigs `elem` lensEnabledExtensions then pure Nothing - else Just <$> getFirstPragma plId state nfp + else Just <$> getFirstPragma plId state nuri let -- By mapping over our Maybe NextPragmaInfo value, we only compute this -- edit if we actually need to. pragmaInsertion = diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class/Utils.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class/Utils.hs index e73344c341..1ee622925b 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/Utils.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/Utils.hs @@ -58,16 +58,16 @@ toMethodName n -- if the module parsed success. insertPragmaIfNotPresent :: (MonadIO m) => IdeState - -> NormalizedFilePath + -> NormalizedUri -> Extension -> ExceptT PluginError m [TextEdit] -insertPragmaIfNotPresent state nfp pragma = do +insertPragmaIfNotPresent state nuri pragma = do (hscEnv -> hsc_dflags -> sessionDynFlags, _) <- runActionE "classplugin.insertPragmaIfNotPresent.GhcSession" state - $ useWithStaleE GhcSession nfp + $ useWithStaleE GhcSession nuri fileContents <- liftIO $ runAction "classplugin.insertPragmaIfNotPresent.GetFileContents" state - $ getFileContents nfp + $ getFileContents nuri (pm, _) <- runActionE "classplugin.insertPragmaIfNotPresent.GetParsedModuleWithComments" state - $ useWithStaleE GetParsedModuleWithComments nfp + $ useWithStaleE GetParsedModuleWithComments nuri let exts = getExtensions pm info = getNextPragmaInfo sessionDynFlags fileContents pure [insertNewPragma info pragma | pragma `notElem` exts] diff --git a/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange.hs b/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange.hs index 52bcc2226b..5c8614b9f2 100644 --- a/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange.hs +++ b/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange.hs @@ -43,13 +43,14 @@ import Language.LSP.Protocol.Message (Method (Method_TextDocume SMethod (SMethod_TextDocumentFoldingRange, SMethod_TextDocumentSelectionRange)) import Language.LSP.Protocol.Types (FoldingRange (..), FoldingRangeParams (..), - NormalizedFilePath, Null, + NormalizedUri, Null, Position (..), Range (_start), SelectionRange (..), SelectionRangeParams (..), TextDocumentIdentifier (TextDocumentIdentifier), - Uri, type (|?) (InL)) + Uri, toNormalizedUri, + type (|?) (InL)) import Prelude hiding (log, span) descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState @@ -68,14 +69,14 @@ instance Pretty Log where foldingRangeHandler :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'Method_TextDocumentFoldingRange foldingRangeHandler _ ide _ FoldingRangeParams{..} = do - filePath <- getNormalizedFilePathE uri - foldingRanges <- runActionE "FoldingRange" ide $ getFoldingRanges filePath + foldingRanges <- runActionE "FoldingRange" ide $ getFoldingRanges nuri pure . InL $ foldingRanges where uri :: Uri + nuri = toNormalizedUri uri TextDocumentIdentifier uri = _textDocument -getFoldingRanges :: NormalizedFilePath -> ExceptT PluginError Action [FoldingRange] +getFoldingRanges :: NormalizedUri -> ExceptT PluginError Action [FoldingRange] getFoldingRanges file = do codeRange <- useE GetCodeRange file pure $ findFoldingRanges codeRange @@ -83,8 +84,8 @@ getFoldingRanges file = do selectionRangeHandler :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'Method_TextDocumentSelectionRange selectionRangeHandler _ ide _ SelectionRangeParams{..} = do do - filePath <- getNormalizedFilePathE uri - mapExceptT liftIO $ getSelectionRanges ide filePath positions + let nuri = toNormalizedUri uri + mapExceptT liftIO $ getSelectionRanges ide nuri positions where uri :: Uri TextDocumentIdentifier uri = _textDocument @@ -93,9 +94,9 @@ selectionRangeHandler _ ide _ SelectionRangeParams{..} = do positions = _positions -getSelectionRanges :: IdeState -> NormalizedFilePath -> [Position] -> ExceptT PluginError IO ([SelectionRange] |? Null) -getSelectionRanges ide file positions = do - (codeRange, positionMapping) <- runIdeActionE "SelectionRange" (shakeExtras ide) $ useWithStaleFastE GetCodeRange file +getSelectionRanges :: IdeState -> NormalizedUri -> [Position] -> ExceptT PluginError IO ([SelectionRange] |? Null) +getSelectionRanges ide nuri positions = do + (codeRange, positionMapping) <- runIdeActionE "SelectionRange" (shakeExtras ide) $ useWithStaleFastE GetCodeRange nuri -- 'positionMapping' should be applied to the input before using them positions' <- traverse (fromCurrentPositionE positionMapping) positions diff --git a/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs b/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs index 86d5923011..34481747d3 100644 --- a/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs +++ b/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs @@ -49,6 +49,7 @@ import Ide.Plugin.CodeRange.ASTPreProcess (CustomNodeType (..), preProcessAST) import Language.LSP.Protocol.Types (FoldingRangeKind (FoldingRangeKind_Comment, FoldingRangeKind_Imports, FoldingRangeKind_Region)) +import qualified Data.Text as T import Language.LSP.Protocol.Lens (HasEnd (end), HasStart (start)) import Prelude hiding (log) @@ -171,7 +172,7 @@ codeRangeRule recorder = -- See https://gitlab.haskell.org/ghc/ghc/-/wikis/api-annotations HAR{hieAst, refMap} <- lift $ use_ GetHieAst file ast <- maybeToExceptT LogNoAST . MaybeT . pure $ - getAsts hieAst Map.!? (coerce . mkFastString . fromNormalizedFilePath) file + getAsts hieAst Map.!? (coerce . mkFastString . T.unpack . getUri . fromNormalizedUri) file let (codeRange, warnings) = runWriter (buildCodeRange ast refMap) traverse_ (logWith recorder Warning) warnings diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs index 1f19b5b476..dbcc785bac 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs @@ -52,7 +52,6 @@ import Development.IDE.GHC.Util (evalGhcEnv, modifyDynFlags) import Development.IDE.Import.DependencyInformation (transitiveDeps, transitiveModuleDeps) -import Development.IDE.Types.Location (toNormalizedFilePath') import GHC (ClsInst, ExecOptions (execLineNumber, execSourceFile), FamInst, @@ -154,11 +153,11 @@ mkRangeCommands recorder st plId textDocument = do let TextDocumentIdentifier uri = textDocument fp <- uriToFilePathE uri - let nfp = toNormalizedFilePath' fp + let nuri = toNormalizedUri uri isLHS = isLiterate fp dbg $ LogCodeLensFp fp (comments, _) <- - runActionE "eval.GetParsedModuleWithComments" st $ useWithStaleE GetEvalComments nfp + runActionE "eval.GetParsedModuleWithComments" st $ useWithStaleE GetEvalComments nuri dbg $ LogCodeLensComments comments -- Extract tests from source code @@ -209,20 +208,20 @@ runEvalCmd recorder plId st mtoken EvalParams{..} = let TextDocumentIdentifier{_uri} = module_ fp <- uriToFilePathE _uri - let nfp = toNormalizedFilePath' fp + let nuri = toNormalizedUri _uri mdlText <- moduleText st _uri -- enable codegen for the module which we need to evaluate. final_hscEnv <- liftIO $ bracket_ (setSomethingModified VFSUnmodified st "Eval" $ do - queueForEvaluation st nfp - return [toKey IsEvaluating nfp] + queueForEvaluation st nuri + return [toKey IsEvaluating nuri] ) (setSomethingModified VFSUnmodified st "Eval" $ do - unqueueForEvaluation st nfp - return [toKey IsEvaluating nfp] + unqueueForEvaluation st nuri + return [toKey IsEvaluating nuri] ) - (initialiseSessionForEval (needsQuickCheck tests) st nfp) + (initialiseSessionForEval (needsQuickCheck tests) st nuri) evalCfg <- liftIO $ runAction "eval: config" st $ getEvalConfig plId @@ -246,7 +245,7 @@ runEvalCmd recorder plId st mtoken EvalParams{..} = -- also be loaded into the environment. -- -- The interactive context and interactive dynamic flags are also set appropiately. -initialiseSessionForEval :: Bool -> IdeState -> NormalizedFilePath -> IO HscEnv +initialiseSessionForEval :: Bool -> IdeState -> NormalizedUri -> IO HscEnv initialiseSessionForEval needs_quickcheck st nfp = do (ms, env1) <- runAction "runEvalCmd" st $ do diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Rules.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Rules.hs index d01ddbc55c..4fac9c0f94 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Rules.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Rules.hs @@ -13,6 +13,7 @@ import qualified Data.HashSet as Set import Data.IORef import qualified Data.Map.Strict as Map import Data.String (fromString) +import qualified Data.Text as T import Development.IDE (GetParsedModuleWithComments (GetParsedModuleWithComments), IdeState, LinkableType (BCOLinkable), @@ -39,6 +40,9 @@ import GHC.Parser.Annotation import Ide.Logger (Recorder, WithPriority, cmapWithPrio) import Ide.Plugin.Eval.Types +import Language.LSP.Protocol.Types (NormalizedUri, + fromNormalizedUri, + getUri) rules :: Recorder (WithPriority Log) -> Rules () @@ -48,15 +52,15 @@ rules recorder = do isEvaluatingRule recorder addIdeGlobal . EvaluatingVar =<< liftIO(newIORef mempty) -newtype EvaluatingVar = EvaluatingVar (IORef (HashSet NormalizedFilePath)) +newtype EvaluatingVar = EvaluatingVar (IORef (HashSet NormalizedUri)) instance IsIdeGlobal EvaluatingVar -queueForEvaluation :: IdeState -> NormalizedFilePath -> IO () -queueForEvaluation ide nfp = do +queueForEvaluation :: IdeState -> NormalizedUri -> IO () +queueForEvaluation ide nuri = do EvaluatingVar var <- getIdeGlobalState ide - atomicModifyIORef' var (\fs -> (Set.insert nfp fs, ())) + atomicModifyIORef' var (\fs -> (Set.insert nuri fs, ())) -unqueueForEvaluation :: IdeState -> NormalizedFilePath -> IO () +unqueueForEvaluation :: IdeState -> NormalizedUri -> IO () unqueueForEvaluation ide nfp = do EvaluatingVar var <- getIdeGlobalState ide -- remove the module from the Evaluating state, so that next time it won't evaluate to True @@ -80,12 +84,12 @@ pattern RealSrcSpanAlready :: SrcLoc.RealSrcSpan -> SrcLoc.RealSrcSpan pattern RealSrcSpanAlready x = x evalParsedModuleRule :: Recorder (WithPriority Log) -> Rules () -evalParsedModuleRule recorder = defineEarlyCutoff (cmapWithPrio LogShake recorder) $ RuleNoDiagnostics $ \GetEvalComments nfp -> do - (pm, posMap) <- useWithStale_ GetParsedModuleWithComments nfp +evalParsedModuleRule recorder = defineEarlyCutoff (cmapWithPrio LogShake recorder) $ RuleNoDiagnostics $ \GetEvalComments nuri -> do + (pm, posMap) <- useWithStale_ GetParsedModuleWithComments nuri let comments = foldMap (\case L (RealSrcSpanAlready real) bdy | FastString.unpackFS (srcSpanFile real) == - fromNormalizedFilePath nfp + T.unpack (getUri (fromNormalizedUri nuri)) , let ran0 = realSrcSpanToRange real , Just curRan <- toCurrentRange posMap ran0 -> diff --git a/plugins/hls-explicit-fixity-plugin/src/Ide/Plugin/ExplicitFixity.hs b/plugins/hls-explicit-fixity-plugin/src/Ide/Plugin/ExplicitFixity.hs index 92bc37f743..3ad0dd9137 100644 --- a/plugins/hls-explicit-fixity-plugin/src/Ide/Plugin/ExplicitFixity.hs +++ b/plugins/hls-explicit-fixity-plugin/src/Ide/Plugin/ExplicitFixity.hs @@ -27,7 +27,6 @@ import qualified Development.IDE.GHC.Compat.Util as Util import Development.IDE.LSP.Notifications (ghcideNotificationsPluginPriority) import Development.IDE.Spans.AtPoint import GHC.Generics (Generic) -import Ide.Plugin.Error import Ide.Types hiding (pluginId) import Language.LSP.Protocol.Message import Language.LSP.Protocol.Types @@ -43,10 +42,10 @@ descriptor recorder pluginId = (defaultPluginDescriptor pluginId "Provides fixit hover :: PluginMethodHandler IdeState Method_TextDocumentHover hover state _ (HoverParams (TextDocumentIdentifier uri) pos _) = do - nfp <- getNormalizedFilePathE uri + let nuri = toNormalizedUri uri runIdeActionE "ExplicitFixity" (shakeExtras state) $ do - (FixityMap fixmap, _) <- useWithStaleFastE GetFixity nfp - (HAR{hieAst}, mapping) <- useWithStaleFastE GetHieAst nfp + (FixityMap fixmap, _) <- useWithStaleFastE GetFixity nuri + (HAR{hieAst}, mapping) <- useWithStaleFastE GetHieAst nuri let ns = getNamesAtPoint hieAst pos mapping fs = mapMaybe (\n -> (n,) <$> M.lookup n fixmap) ns pure $ maybeToNull $ toHover fs diff --git a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs index 17634491fe..3489d97b5f 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -48,7 +48,6 @@ import Development.IDE.GHC.Compat hiding ((<+>)) import Development.IDE.Graph.Classes import GHC.Generics (Generic) import Ide.Plugin.Error (PluginError (..), - getNormalizedFilePathE, handleMaybe) import qualified Ide.Plugin.RangeMap as RM (RangeMap, filterByRange, @@ -145,8 +144,8 @@ runImportCommand _ _ _ rd = do -- > Refine imports to import Control.Monad.IO.Class (liftIO) lensProvider :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'Method_TextDocumentCodeLens lensProvider _ state _ CodeLensParams {_textDocument = TextDocumentIdentifier {_uri}} = do - nfp <- getNormalizedFilePathE _uri - (ImportActionsResult{forLens}, pm) <- runActionE "ImportActions" state $ useWithStaleE ImportActions nfp + let nuri = toNormalizedUri _uri + (ImportActionsResult{forLens}, pm) <- runActionE "ImportActions" state $ useWithStaleE ImportActions nuri let lens = [ generateLens _uri newRange int -- provide ExplicitImport only if the client does not support inlay hints | not (isInlayHintsSupported state) @@ -169,8 +168,8 @@ lensProvider _ state _ CodeLensParams {_textDocument = TextDocumentIdentifier {_ lensResolveProvider :: Recorder (WithPriority Log) -> ResolveFunction IdeState IAResolveData 'Method_CodeLensResolve lensResolveProvider _ ideState plId cl uri rd@(ResolveOne _ uid) = do - nfp <- getNormalizedFilePathE uri - (ImportActionsResult{forResolve}, _) <- runActionE "ImportActions" ideState $ useWithStaleE ImportActions nfp + let nuri = toNormalizedUri uri + (ImportActionsResult{forResolve}, _) <- runActionE "ImportActions" ideState $ useWithStaleE ImportActions nuri target <- handleMaybe PluginStaleResolve $ forResolve IM.!? uid let updatedCodeLens = cl & L.command ?~ mkCommand plId target pure updatedCodeLens @@ -196,8 +195,8 @@ inlayHintProvider :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState inlayHintProvider _ state _ InlayHintParams {_textDocument = TextDocumentIdentifier {_uri}, _range = visibleRange} = if isInlayHintsSupported state then do - nfp <- getNormalizedFilePathE _uri - (ImportActionsResult {forLens, forResolve}, pm) <- runActionE "ImportActions" state $ useWithStaleE ImportActions nfp + let nuri = toNormalizedUri _uri + (ImportActionsResult {forLens, forResolve}, pm) <- runActionE "ImportActions" state $ useWithStaleE ImportActions nuri let inlayHints = [ inlayHint | (range, (int, _)) <- forLens , Just newRange <- [toCurrentRange pm range] @@ -243,8 +242,8 @@ inlayHintProvider _ state _ InlayHintParams {_textDocument = TextDocumentIdentif -- that specific import, and one code action to refine all imports. codeActionProvider :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'Method_TextDocumentCodeAction codeActionProvider _ ideState _pId (CodeActionParams _ _ TextDocumentIdentifier {_uri} range _context) = do - nfp <- getNormalizedFilePathE _uri - (ImportActionsResult{forCodeActions}, pm) <- runActionE "ImportActions" ideState $ useWithStaleE ImportActions nfp + let nuri = toNormalizedUri _uri + (ImportActionsResult{forCodeActions}, pm) <- runActionE "ImportActions" ideState $ useWithStaleE ImportActions nuri newRange <- toCurrentRangeE pm range let relevantCodeActions = RM.filterByRange newRange forCodeActions allExplicit = @@ -286,18 +285,18 @@ resolveWTextEdit :: IdeState -> IAResolveData -> ExceptT PluginError (HandlerM C -- Providing the edit for the command, or the resolve for the code action is -- completely generic, as all we need is the unique id and the text edit. resolveWTextEdit ideState (ResolveOne uri int) = do - nfp <- getNormalizedFilePathE uri - (ImportActionsResult{forResolve}, pm) <- runActionE "ImportActions" ideState $ useWithStaleE ImportActions nfp + let nuri = toNormalizedUri uri + (ImportActionsResult{forResolve}, pm) <- runActionE "ImportActions" ideState $ useWithStaleE ImportActions nuri iEdit <- handleMaybe PluginStaleResolve $ forResolve IM.!? int pure $ mkWorkspaceEdit uri [iEdit] pm resolveWTextEdit ideState (ExplicitAll uri) = do - nfp <- getNormalizedFilePathE uri - (ImportActionsResult{forResolve}, pm) <- runActionE "ImportActions" ideState $ useWithStaleE ImportActions nfp + let nuri = toNormalizedUri uri + (ImportActionsResult{forResolve}, pm) <- runActionE "ImportActions" ideState $ useWithStaleE ImportActions nuri let edits = [ ie | ie@ImportEdit{ieResType = ExplicitImport} <- IM.elems forResolve] pure $ mkWorkspaceEdit uri edits pm resolveWTextEdit ideState (RefineAll uri) = do - nfp <- getNormalizedFilePathE uri - (ImportActionsResult{forResolve}, pm) <- runActionE "ImportActions" ideState $ useWithStaleE ImportActions nfp + let nuri = toNormalizedUri uri + (ImportActionsResult{forResolve}, pm) <- runActionE "ImportActions" ideState $ useWithStaleE ImportActions nuri let edits = [ re | re@ImportEdit{ieResType = RefineImport} <- IM.elems forResolve] pure $ mkWorkspaceEdit uri edits pm mkWorkspaceEdit :: Uri -> [ImportEdit] -> PositionMapping -> WorkspaceEdit diff --git a/plugins/hls-explicit-record-fields-plugin/src/Ide/Plugin/ExplicitFields.hs b/plugins/hls-explicit-record-fields-plugin/src/Ide/Plugin/ExplicitFields.hs index a761f648af..dcae1be85b 100644 --- a/plugins/hls-explicit-record-fields-plugin/src/Ide/Plugin/ExplicitFields.hs +++ b/plugins/hls-explicit-record-fields-plugin/src/Ide/Plugin/ExplicitFields.hs @@ -94,7 +94,6 @@ import Ide.Logger (Priority (..), cmapWithPrio, logWith, (<+>)) import Ide.Plugin.Error (PluginError (PluginInternalError, PluginStaleResolve), - getNormalizedFilePathE, handleMaybe) import Ide.Plugin.RangeMap (RangeMap) import qualified Ide.Plugin.RangeMap as RangeMap @@ -117,6 +116,7 @@ import Language.LSP.Protocol.Types (CodeAction (..), TextDocumentIdentifier (TextDocumentIdentifier), TextEdit (TextEdit), WorkspaceEdit (WorkspaceEdit), + toNormalizedUri, type (|?) (InL, InR)) #if __GLASGOW_HASKELL__ < 910 @@ -151,8 +151,8 @@ descriptor recorder plId = codeActionProvider :: PluginMethodHandler IdeState 'Method_TextDocumentCodeAction codeActionProvider ideState _ (CodeActionParams _ _ docId range _) = do - nfp <- getNormalizedFilePathE (docId ^. L.uri) - CRR {crCodeActions, crCodeActionResolve, enabledExtensions} <- runActionE "ExplicitFields.CollectRecords" ideState $ useE CollectRecords nfp + let nuri = toNormalizedUri $ docId ^. L.uri + CRR {crCodeActions, crCodeActionResolve, enabledExtensions} <- runActionE "ExplicitFields.CollectRecords" ideState $ useE CollectRecords nuri -- All we need to build a code action is the list of extensions, and a int to -- allow us to resolve it later. let recordUids = [ uid @@ -184,9 +184,9 @@ codeActionProvider ideState _ (CodeActionParams _ _ docId range _) = do codeActionResolveProvider :: ResolveFunction IdeState Int 'Method_CodeActionResolve codeActionResolveProvider ideState pId ca uri uid = do - nfp <- getNormalizedFilePathE uri - pragma <- getFirstPragma pId ideState nfp - CRR {crCodeActionResolve, nameMap, enabledExtensions} <- runActionE "ExplicitFields.CollectRecords" ideState $ useE CollectRecords nfp + let nuri = toNormalizedUri uri + pragma <- getFirstPragma pId ideState nuri + CRR {crCodeActionResolve, nameMap, enabledExtensions} <- runActionE "ExplicitFields.CollectRecords" ideState $ useE CollectRecords nuri -- If we are unable to find the unique id in our IntMap of records, it means -- that this resolve is stale. record <- handleMaybe PluginStaleResolve $ IntMap.lookup uid crCodeActionResolve @@ -205,17 +205,17 @@ codeActionResolveProvider ideState pId ca uri uid = do inlayHintDotdotProvider :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'Method_TextDocumentInlayHint inlayHintDotdotProvider _ state pId InlayHintParams {_textDocument = TextDocumentIdentifier uri, _range = visibleRange} = do - nfp <- getNormalizedFilePathE uri - pragma <- getFirstPragma pId state nfp + let nuri = toNormalizedUri uri + pragma <- getFirstPragma pId state nuri runIdeActionE "ExplicitFields.CollectRecords" (shakeExtras state) $ do - (crr@CRR {crCodeActions, crCodeActionResolve}, pm) <- useWithStaleFastE CollectRecords nfp + (crr@CRR {crCodeActions, crCodeActionResolve}, pm) <- useWithStaleFastE CollectRecords nuri let -- Get all records with dotdot in current nfp records = [ record | Just range <- [toCurrentRange pm visibleRange] , uid <- RangeMap.elementsInRange range crCodeActions , Just record <- [IntMap.lookup uid crCodeActionResolve] ] -- Get the definition of each dotdot of record - locations = [ fmap (,record) (getDefinition nfp pos) + locations = [ fmap (,record) (getDefinition nuri pos) | record <- records , pos <- maybeToList $ fmap _start $ recordInfoToDotDotRange record ] defnLocsList <- lift $ sequence locations @@ -256,9 +256,9 @@ inlayHintDotdotProvider _ state pId InlayHintParams {_textDocument = TextDocumen inlayHintPosRecProvider :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'Method_TextDocumentInlayHint inlayHintPosRecProvider _ state _pId InlayHintParams {_textDocument = TextDocumentIdentifier uri, _range = visibleRange} = do - nfp <- getNormalizedFilePathE uri + let nuri = toNormalizedUri uri runIdeActionE "ExplicitFields.CollectRecords" (shakeExtras state) $ do - (CRR {crCodeActions, nameMap, crCodeActionResolve}, pm) <- useWithStaleFastE CollectRecords nfp + (CRR {crCodeActions, nameMap, crCodeActionResolve}, pm) <- useWithStaleFastE CollectRecords nuri let records = [ record | Just range <- [toCurrentRange pm visibleRange] , uid <- RangeMap.elementsInRange range crCodeActions diff --git a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs index c12866d7f3..94bcf64019 100644 --- a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs +++ b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs @@ -74,10 +74,10 @@ properties = False provider :: Recorder (WithPriority LogEvent) -> PluginId -> FormattingHandler IdeState -provider recorder plId ideState token typ contents fp fo = ExceptT $ pluginWithIndefiniteProgress title token Cancellable $ \_updater -> runExceptT $ do +provider recorder plId ideState token typ contents nuri fo = ExceptT $ pluginWithIndefiniteProgress title token Cancellable $ \_updater -> runExceptT $ do fileOpts <- maybe [] (convertDynFlags . hsc_dflags . hscEnv) - <$> liftIO (runAction "Fourmolu" ideState $ use GhcSession fp) + <$> liftIO (runAction "Fourmolu" ideState $ use GhcSession nuri) useCLI <- liftIO $ runAction "Fourmolu" ideState $ usePropertyAction #external plId properties fourmoluExePath <- fmap T.unpack $ liftIO $ runAction "Fourmolu" ideState $ usePropertyAction #path plId properties if useCLI @@ -86,7 +86,7 @@ provider recorder plId ideState token typ contents fp fo = ExceptT $ pluginWithI runExceptT (cliHandler fourmoluExePath fileOpts) else do logWith recorder Debug $ LogCompiledInVersion (showVersion Fourmolu.version) - FourmoluConfig{..} <- loadConfig recorder fp' + FourmoluConfig{..} <- loadConfig recorder uri let config = refineConfig ModuleSource Nothing Nothing Nothing $ defaultConfig @@ -98,10 +98,10 @@ provider recorder plId ideState token typ contents fp fo = ExceptT $ pluginWithI } ExceptT . liftIO $ bimap (PluginInternalError . T.pack . show) (InL . makeDiffTextEdit contents) - <$> try @OrmoluException (ormolu config fp' contents) + <$> try @OrmoluException (ormolu config (T.unpack $ getUri uri) contents) where - fp' = fromNormalizedFilePath fp - title = "Formatting " <> T.pack (takeFileName fp') + uri = fromNormalizedUri nuri + title = "Formatting " <> getUri uri lspPrinterOpts = mempty{poIndentation = Just $ fromIntegral $ fo ^. tabSize} region = case typ of FormatText -> @@ -128,6 +128,10 @@ provider recorder plId ideState token typ contents fp fo = ExceptT $ pluginWithI pure CLIVersionInfo { noCabal = True } + fp <- case uriToFilePath uri of + Just fp -> pure fp + Nothing -> + throwError $ PluginInternalError $ "Tried to run Fourmolu in CLI mode but " <> getUri uri <> " was not a file URI" (exitCode, out, err) <- -- run Fourmolu liftIO $ readCreateProcessWithExitCode ( proc path $ @@ -137,7 +141,7 @@ provider recorder plId ideState token typ contents fp fo = ExceptT $ pluginWithI [ ("--start-line=" <>) . show <$> regionStartLine region , ("--end-line=" <>) . show <$> regionEndLine region ] - ){cwd = Just $ takeDirectory fp'} + ){cwd = Just $ takeDirectory fp} contents case exitCode of ExitSuccess -> do @@ -149,10 +153,10 @@ provider recorder plId ideState token typ contents fp fo = ExceptT $ pluginWithI loadConfig :: Recorder (WithPriority LogEvent) -> - FilePath -> + Uri -> ExceptT PluginError (HandlerM Ide.Types.Config) FourmoluConfig #if MIN_VERSION_fourmolu(0,16,0) -loadConfig recorder fp = do +loadConfig recorder uri | Just fp <- uriToFilePath uri = do liftIO (findConfigFile fp) >>= \case Left (ConfigNotFound searchDirs) -> do logWith recorder Info $ NoConfigPath searchDirs @@ -170,8 +174,16 @@ loadConfig recorder fp = do throwError $ PluginInternalError errorMessage Right cfg -> do pure cfg +loadConfig _ uri = do + let errorMessage = "Uri is not a file: " <> getUri uri + lift $ pluginSendNotification SMethod_WindowShowMessage $ + ShowMessageParams + { _type_ = MessageType_Error + , _message = errorMessage + } + throwError $ PluginInternalError errorMessage #else -loadConfig recorder fp = do +loadConfig recorder uri | Just fp <- uriToFilePath uri = do liftIO (loadConfigFile fp) >>= \case ConfigLoaded file opts -> do logWith recorder Info $ ConfigPath file @@ -188,6 +200,14 @@ loadConfig recorder fp = do throwError $ PluginInternalError errorMessage where errorMessage = "Failed to load " <> T.pack f <> ": " <> T.pack (show err) +loadConfig _ uri = do + let errorMessage = "Uri is not a file: " <> getUri uri + lift $ pluginSendNotification SMethod_WindowShowMessage $ + ShowMessageParams + { _type_ = MessageType_Error + , _message = errorMessage + } + throwError $ PluginInternalError errorMessage #endif data LogEvent diff --git a/plugins/hls-gadt-plugin/src/Ide/Plugin/GADT.hs b/plugins/hls-gadt-plugin/src/Ide/Plugin/GADT.hs index 7aefa2c524..7b2e3341a2 100644 --- a/plugins/hls-gadt-plugin/src/Ide/Plugin/GADT.hs +++ b/plugins/hls-gadt-plugin/src/Ide/Plugin/GADT.hs @@ -53,39 +53,39 @@ toGADTSyntaxCommandId = "GADT.toGADT" -- | A command replaces H98 data decl with GADT decl in place toGADTCommand :: PluginId -> CommandFunction IdeState ToGADTParams toGADTCommand pId@(PluginId pId') state _ ToGADTParams{..} = withExceptT handleGhcidePluginError $ do - nfp <- withExceptT GhcidePluginErrors $ getNormalizedFilePathE uri - (decls, exts) <- getInRangeH98DeclsAndExts state range nfp + let nuri = toNormalizedUri uri + (decls, exts) <- getInRangeH98DeclsAndExts state range nuri (L ann decl) <- case decls of [d] -> pure d _ -> throwError $ UnexpectedNumberOfDeclarations (Prelude.length decls) deps <- withExceptT GhcidePluginErrors $ runActionE (T.unpack pId' <> ".GhcSessionDeps") state - $ useE GhcSessionDeps nfp + $ useE GhcSessionDeps nuri (hsc_dflags . hscEnv -> df) <- pure deps txt <- withExceptT (PrettyGadtError . T.pack) $ liftEither $ T.pack <$> (prettyGADTDecl df . h98ToGADTDecl) decl range <- liftEither $ maybeToEither FailedToFindDataDeclRange $ srcSpanToRange $ locA ann - pragma <- withExceptT GhcidePluginErrors $ getFirstPragma pId state nfp + pragma <- withExceptT GhcidePluginErrors $ getFirstPragma pId state nuri let insertEdit = [insertNewPragma pragma GADTs | all (`notElem` exts) [GADTSyntax, GADTs]] _ <- lift $ pluginSendRequest SMethod_WorkspaceApplyEdit - (ApplyWorkspaceEditParams Nothing (workSpaceEdit nfp (TextEdit range txt : insertEdit))) + (ApplyWorkspaceEditParams Nothing (workSpaceEdit nuri (TextEdit range txt : insertEdit))) (\_ -> pure ()) pure $ InR Null where - workSpaceEdit nfp edits = WorkspaceEdit + workSpaceEdit nuri edits = WorkspaceEdit (pure $ Map.fromList - [(filePathToUri $ fromNormalizedFilePath nfp, + [(fromNormalizedUri nuri, edits)]) Nothing Nothing codeActionHandler :: PluginMethodHandler IdeState Method_TextDocumentCodeAction codeActionHandler state plId (CodeActionParams _ _ doc range _) = withExceptT handleGhcidePluginError $ do - nfp <- withExceptT GhcidePluginErrors $ getNormalizedFilePathE (doc ^. L.uri) - (inRangeH98Decls, _) <- getInRangeH98DeclsAndExts state range nfp + let nuri = toNormalizedUri (doc ^. L.uri) + (inRangeH98Decls, _) <- getInRangeH98DeclsAndExts state range nuri let actions = map (mkAction . printOutputable . tcdLName . unLoc) inRangeH98Decls pure $ InL actions where @@ -108,12 +108,12 @@ codeActionHandler state plId (CodeActionParams _ _ doc range _) = withExceptT ha getInRangeH98DeclsAndExts :: (MonadIO m) => IdeState -> Range - -> NormalizedFilePath + -> NormalizedUri -> ExceptT GadtPluginError m ([LTyClDecl GP], [Extension]) -getInRangeH98DeclsAndExts state range nfp = do +getInRangeH98DeclsAndExts state range nuri = do pm <- withExceptT GhcidePluginErrors $ runActionE "GADT.GetParsedModuleWithComments" state - $ useE GetParsedModuleWithComments nfp + $ useE GetParsedModuleWithComments nuri let (L _ hsDecls) = hsmodDecls <$> pm_parsed_source pm decls = filter isH98DataDecl $ mapMaybe getDataDecl diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index 5a72455eb5..8a4b246502 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -131,8 +131,8 @@ data Log #if APPLY_REFACT | LogGeneratedIdeas NormalizedFilePath [[Refact.Refactoring Refact.SrcSpan]] #endif - | LogGetIdeas NormalizedFilePath - | LogUsingExtensions NormalizedFilePath [String] -- Extension is only imported conditionally, so we just stringify them + | LogGetIdeas NormalizedUri + | LogUsingExtensions NormalizedUri [String] -- Extension is only imported conditionally, so we just stringify them | forall a. (Pretty a) => LogResolve a instance Pretty Log where @@ -215,7 +215,7 @@ rules recorder plugin = do where - diagnostics :: NormalizedFilePath -> Either ParseError [Idea] -> [FileDiagnostic] + diagnostics :: NormalizedUri -> Either ParseError [Idea] -> [FileDiagnostic] diagnostics file (Right ideas) = [ideErrorFromLspDiag diag file Nothing | i <- ideas, Just diag <- [ideaToDiagnostic i]] diagnostics file (Left parseErr) = @@ -289,9 +289,9 @@ rules recorder plugin = do } srcSpanToRange (UnhelpfulSpan _) = noRange -getIdeas :: Recorder (WithPriority Log) -> NormalizedFilePath -> Action (Either ParseError [Idea]) -getIdeas recorder nfp = do - logWith recorder Debug $ LogGetIdeas nfp +getIdeas :: Recorder (WithPriority Log) -> NormalizedUri -> Action (Either ParseError [Idea]) +getIdeas recorder nuri = do + logWith recorder Debug $ LogGetIdeas nuri (flags, classify, hint) <- useNoFile_ GetHlintSettings let applyHints' (Just (Right modEx)) = Right $ applyHints classify hint [modEx] @@ -302,20 +302,20 @@ getIdeas recorder nfp = do where moduleEx :: ParseFlags -> Action (Maybe (Either ParseError ModuleEx)) moduleEx flags = do - mbpm <- getParsedModuleWithComments nfp + mbpm <- getParsedModuleWithComments nuri -- If ghc was not able to parse the module, we disable hlint diagnostics if isNothing mbpm then return Nothing else do flags' <- setExtensions flags - contents <- getFileContents nfp - let fp = fromNormalizedFilePath nfp + contents <- getFileContents nuri + let fp = T.unpack $ getUri $ fromNormalizedUri nuri let contents' = T.unpack . Rope.toText <$> contents Just <$> liftIO (parseModuleEx flags' fp contents') setExtensions flags = do - hlintExts <- getExtensions nfp - logWith recorder Debug $ LogUsingExtensions nfp (fmap show hlintExts) + hlintExts <- getExtensions nuri + logWith recorder Debug $ LogUsingExtensions nuri (fmap show hlintExts) return $ flags { enabledExtensions = hlintExts } -- Gets extensions from ModSummary dynflags for the file. @@ -323,7 +323,7 @@ getIdeas recorder nfp = do -- and the ModSummary dynflags. However using the parsedFlags extensions -- can sometimes interfere with the hlint parsing of the file. -- See https://github.com/haskell/haskell-language-server/issues/1279 -getExtensions :: NormalizedFilePath -> Action [Extension] +getExtensions :: NormalizedUri -> Action [Extension] getExtensions nfp = do dflags <- getFlags let hscExts = EnumSet.toList (extensionFlags dflags) @@ -365,10 +365,9 @@ getHlintConfig pId = -- --------------------------------------------------------------------- codeActionProvider :: PluginMethodHandler IdeState Method_TextDocumentCodeAction -codeActionProvider ideState _pluginId (CodeActionParams _ _ documentId _ context) - | let TextDocumentIdentifier uri = documentId - , Just docNormalizedFilePath <- uriToNormalizedFilePath (toNormalizedUri uri) - = do +codeActionProvider ideState _pluginId (CodeActionParams _ _ documentId _ context) = do + let TextDocumentIdentifier uri = documentId + nuri = toNormalizedUri uri verTxtDocId <- liftIO $ runAction "Hlint.getVersionedTextDoc" ideState $ @@ -381,7 +380,7 @@ codeActionProvider ideState _pluginId (CodeActionParams _ _ documentId _ context | diag <- allDiagnostics , let lspDiagnostic = fdLspDiagnostic diag , validCommand lspDiagnostic - , fdFilePath diag == docNormalizedFilePath + , fdUri diag == nuri ] let numHintsInContext = length [diagnostic | diagnostic <- diags @@ -392,8 +391,6 @@ codeActionProvider ideState _pluginId (CodeActionParams _ _ documentId _ context pure $ singleHintCodeActions ++ [applyAllAction verTxtDocId] else pure singleHintCodeActions - | otherwise - = pure $ InL [] where applyAllAction verTxtDocId = @@ -410,13 +407,13 @@ codeActionProvider ideState _pluginId (CodeActionParams _ _ documentId _ context resolveProvider :: Recorder (WithPriority Log) -> ResolveFunction IdeState HlintResolveCommands Method_CodeActionResolve resolveProvider recorder ideState _plId ca uri resolveValue = do - file <- getNormalizedFilePathE uri + let nuri = toNormalizedUri uri case resolveValue of (ApplyHint verTxtDocId oneHint) -> do - edit <- ExceptT $ liftIO $ applyHint recorder ideState file oneHint verTxtDocId + edit <- ExceptT $ liftIO $ applyHint recorder ideState nuri oneHint verTxtDocId pure $ ca & LSP.edit ?~ edit (IgnoreHint verTxtDocId hintTitle ) -> do - edit <- ExceptT $ liftIO $ ignoreHint recorder ideState file verTxtDocId hintTitle + edit <- ExceptT $ liftIO $ ignoreHint recorder ideState nuri verTxtDocId hintTitle pure $ ca & LSP.edit ?~ edit applyRefactAvailable :: Bool @@ -481,10 +478,10 @@ mkSuppressHintTextEdits dynFlags fileContents hint = combinedTextEdit : lineSplitTextEditList -- --------------------------------------------------------------------- -ignoreHint :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> VersionedTextDocumentIdentifier -> HintTitle -> IO (Either PluginError WorkspaceEdit) -ignoreHint _recorder ideState nfp verTxtDocId ignoreHintTitle = runExceptT $ do - (_, fileContents) <- runActionE "Hlint.GetFileContents" ideState $ useE GetFileContents nfp - (msr, _) <- runActionE "Hlint.GetModSummaryWithoutTimestamps" ideState $ useWithStaleE GetModSummaryWithoutTimestamps nfp +ignoreHint :: Recorder (WithPriority Log) -> IdeState -> NormalizedUri -> VersionedTextDocumentIdentifier -> HintTitle -> IO (Either PluginError WorkspaceEdit) +ignoreHint _recorder ideState nuri verTxtDocId ignoreHintTitle = runExceptT $ do + (_, fileContents) <- runActionE "Hlint.GetFileContents" ideState $ useE GetFileContents nuri + (msr, _) <- runActionE "Hlint.GetModSummaryWithoutTimestamps" ideState $ useWithStaleE GetModSummaryWithoutTimestamps nuri case fileContents of Just contents -> do let dynFlags = ms_hspp_opts $ msrModSummary msr @@ -518,27 +515,27 @@ data OneHint = , oneHintTitle :: HintTitle } deriving (Generic, Eq, Show, ToJSON, FromJSON) -applyHint :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> Maybe OneHint -> VersionedTextDocumentIdentifier -> IO (Either PluginError WorkspaceEdit) +applyHint :: Recorder (WithPriority Log) -> IdeState -> NormalizedUri -> Maybe OneHint -> VersionedTextDocumentIdentifier -> IO (Either PluginError WorkspaceEdit) #if !APPLY_REFACT applyHint _ _ _ _ _ = -- https://github.com/ndmitchell/hlint/pull/1594#issuecomment-2338898673 evaluate $ error "Cannot apply refactoring: apply-refact does not work on GHC 9.10" #else -applyHint recorder ide nfp mhint verTxtDocId = +applyHint recorder ide nuri mhint verTxtDocId = runExceptT $ do let runAction' :: Action a -> IO a runAction' = runAction "applyHint" ide let errorHandlers = [ Handler $ \e -> return (Left (show (e :: IOException))) , Handler $ \e -> return (Left (show (e :: ErrorCall))) ] - ideas <- bimapExceptT (PluginInternalError . T.pack . showParseError) id $ ExceptT $ runAction' $ getIdeas recorder nfp + ideas <- bimapExceptT (PluginInternalError . T.pack . showParseError) id $ ExceptT $ runAction' $ getIdeas recorder nuri let ideas' = maybe ideas (`filterIdeas` ideas) mhint let commands = map ideaRefactoring ideas' - logWith recorder Debug $ LogGeneratedIdeas nfp commands - let fp = fromNormalizedFilePath nfp - mbOldContent <- fmap (fmap Rope.toText) $ liftIO $ runAction' $ getFileContents nfp + logWith recorder Debug $ LogGeneratedIdeas nuri commands + let fp = fromNormalizedFilePath nuri + mbOldContent <- fmap (fmap Rope.toText) $ liftIO $ runAction' $ getFileContents nuri oldContent <- maybe (liftIO $ fmap T.decodeUtf8 (BS.readFile fp)) return mbOldContent - modsum <- liftIO $ runAction' $ use_ GetModSummary nfp + modsum <- liftIO $ runAction' $ use_ GetModSummary nuri let dflags = ms_hspp_opts $ msrModSummary modsum -- set Nothing as "position" for "applyRefactorings" because @@ -556,7 +553,7 @@ applyHint recorder ide nfp mhint verTxtDocId = liftIO $ withSystemTempFile (takeFileName fp) $ \temp h -> do hClose h writeFileUTF8NoNewLineTranslation temp oldContent - exts <- runAction' $ getExtensions nfp + exts <- runAction' $ getExtensions nuri -- We have to reparse extensions to remove the invalid ones let (enabled, disabled, _invalid) = Refact.parseExtensions $ map show exts let refactExts = map show $ enabled ++ disabled 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 5dc053f47d..7f40298b9f 100644 --- a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs +++ b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs @@ -107,18 +107,18 @@ data Action = Replace -- | Required action (that can be converted to either CodeLenses or CodeActions) action :: Recorder (WithPriority Log) -> IdeState -> Uri -> ExceptT PluginError (HandlerM c) [Action] action recorder state uri = do - nfp <- getNormalizedFilePathE uri fp <- uriToFilePathE uri + let nuri = toNormalizedUri uri - contents <- liftIO $ runAction "ModuleName.getFileContents" state $ getFileContents nfp + contents <- liftIO $ runAction "ModuleName.getFileContents" state $ getFileContents nuri let emptyModule = maybe True (T.null . T.strip . Rope.toText) contents - correctNames <- mapExceptT liftIO $ pathModuleNames recorder state nfp fp + correctNames <- mapExceptT liftIO $ pathModuleNames recorder state nuri fp logWith recorder Debug (CorrectNames correctNames) let bestName = minimumBy (comparing T.length) <$> NE.nonEmpty correctNames logWith recorder Debug (BestName bestName) - statedNameMaybe <- liftIO $ codeModuleName state nfp + statedNameMaybe <- liftIO $ codeModuleName state nuri logWith recorder Debug (ModuleName $ snd <$> statedNameMaybe) case (bestName, statedNameMaybe) of (Just bestName, Just (nameRange, statedName)) @@ -133,11 +133,11 @@ action recorder state uri = do -- | Possible module names, as derived by the position of the module in the -- source directories. There may be more than one possible name, if the source -- directories are nested inside each other. -pathModuleNames :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> FilePath -> ExceptT PluginError IO [T.Text] -pathModuleNames recorder state normFilePath filePath +pathModuleNames :: Recorder (WithPriority Log) -> IdeState -> NormalizedUri -> FilePath -> ExceptT PluginError IO [T.Text] +pathModuleNames recorder state nuri filePath | firstLetter isLower $ takeFileName filePath = return ["Main"] | otherwise = do - (session, _) <- runActionE "ModuleName.ghcSession" state $ useWithStaleE GhcSession normFilePath + (session, _) <- runActionE "ModuleName.ghcSession" state $ useWithStaleE GhcSession nuri srcPaths <- liftIO $ evalGhcEnv (hscEnv session) $ importPaths <$> getSessionDynFlags logWith recorder Debug (SrcPaths srcPaths) @@ -170,9 +170,9 @@ pathModuleNames recorder state normFilePath filePath . dropExtension -- | The module name, as stated in the module -codeModuleName :: IdeState -> NormalizedFilePath -> IO (Maybe (Range, T.Text)) -codeModuleName state nfp = runMaybeT $ do - (pm, mp) <- MaybeT . runAction "ModuleName.GetParsedModule" state $ useWithStale GetParsedModule nfp +codeModuleName :: IdeState -> NormalizedUri -> IO (Maybe (Range, T.Text)) +codeModuleName state nuri = runMaybeT $ do + (pm, mp) <- MaybeT . runAction "ModuleName.GetParsedModule" state $ useWithStale GetParsedModule nuri L (locA -> (RealSrcSpan l _)) m <- MaybeT . pure . hsmodName . unLoc $ pm_parsed_source pm range <- MaybeT . pure $ toCurrentRange mp (realSrcSpanToRange l) pure (range, T.pack $ moduleNameString m) diff --git a/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs b/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs index db1696d94b..df87fa548b 100644 --- a/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs +++ b/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs @@ -5,7 +5,6 @@ import Control.Monad.Except (ExceptT, MonadError, throwError) import Control.Monad.IO.Class (liftIO) import qualified Data.Array as A -import Data.Foldable (foldl') import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HM import qualified Data.HashSet as HS @@ -35,8 +34,8 @@ import Text.Regex.TDFA (Regex, caseSensitive, data Log = LogShake Shake.Log - | LogNotesFound NormalizedFilePath [(Text, [Position])] - | LogNoteReferencesFound NormalizedFilePath [(Text, [Position])] + | LogNotesFound NormalizedUri [(Text, [Position])] + | LogNoteReferencesFound NormalizedUri [(Text, [Position])] deriving Show data GetNotesInFile = MkGetNotesInFile @@ -52,14 +51,14 @@ data GetNotes = MkGetNotes deriving anyclass (Hashable, NFData) -- GetNotes collects all note definition across all files in the -- project. It returns a map from note name to pair of (filepath, position). -type instance RuleResult GetNotes = HashMap Text (NormalizedFilePath, Position) +type instance RuleResult GetNotes = HashMap Text (NormalizedUri, Position) data GetNoteReferences = MkGetNoteReferences deriving (Show, Generic, Eq, Ord) deriving anyclass (Hashable, NFData) -- GetNoteReferences collects all note references across all files in the -- project. It returns a map from note name to list of (filepath, position). -type instance RuleResult GetNoteReferences = HashMap Text [(NormalizedFilePath, Position)] +type instance RuleResult GetNoteReferences = HashMap Text [(NormalizedUri, Position)] instance Pretty Log where pretty = \case @@ -103,11 +102,11 @@ findNotesRules recorder = do err :: MonadError PluginError m => Text -> Maybe a -> m a err s = maybe (throwError $ PluginInternalError s) pure -getNote :: NormalizedFilePath -> IdeState -> Position -> ExceptT PluginError (HandlerM c) (Maybe Text) -getNote nfp state (Position l c) = do +getNote :: NormalizedUri -> IdeState -> Position -> ExceptT PluginError (HandlerM c) (Maybe Text) +getNote nuri state (Position l c) = do contents <- err "Error getting file contents" - =<< liftIO (runAction "notes.getfileContents" state (getFileContents nfp)) + =<< liftIO (runAction "notes.getfileContents" state (getFileContents nuri)) line <- err "Line not found in file" (listToMaybe $ Rope.lines $ fst (Rope.splitAtLine 1 $ snd $ Rope.splitAtLine (fromIntegral l) contents)) pure $ listToMaybe $ mapMaybe (atPos $ fromIntegral c) $ matchAllText noteRefRegex line @@ -121,53 +120,50 @@ getNote nfp state (Position l c) = do then Just (fst (arr A.! 1)) else Nothing listReferences :: PluginMethodHandler IdeState Method_TextDocumentReferences -listReferences state _ param - | Just nfp <- uriToNormalizedFilePath uriOrig - = do +listReferences state _ param = do let pos@(Position l _) = param ^. L.position - noteOpt <- getNote nfp state pos + noteOpt <- getNote uriOrig state pos case noteOpt of Nothing -> pure (InR Null) Just note -> do - notes <- runActionE "notes.definedNoteReferencess" state $ useE MkGetNoteReferences nfp + notes <- runActionE "notes.definedNoteReferencess" state $ useE MkGetNoteReferences uriOrig poss <- err ("Note reference (a comment of the form `{- Note [" <> note <> "] -}`) not found") (HM.lookup note notes) - pure $ InL (mapMaybe (\(noteFp, pos@(Position l' _)) -> if l' == l then Nothing else Just ( - Location (fromNormalizedUri $ normalizedFilePathToUri noteFp) (Range pos pos))) poss) + pure $ InL (mapMaybe (\(noteUri, pos@(Position l' _)) -> if l' == l then Nothing else Just ( + Location (fromNormalizedUri noteUri) (Range pos pos))) poss) where uriOrig = toNormalizedUri $ param ^. (L.textDocument . L.uri) -listReferences _ _ _ = throwError $ PluginInternalError "conversion to normalized file path failed" jumpToNote :: PluginMethodHandler IdeState Method_TextDocumentDefinition jumpToNote state _ param - | Just nfp <- uriToNormalizedFilePath uriOrig = do - noteOpt <- getNote nfp state (param ^. L.position) + noteOpt <- getNote uriOrig state (param ^. L.position) case noteOpt of Nothing -> pure (InR (InR Null)) Just note -> do - notes <- runActionE "notes.definedNotes" state $ useE MkGetNotes nfp - (noteFp, pos) <- err ("Note definition (a comment of the form `{- Note [" <> note <> "]\\n~~~ ... -}`) not found") (HM.lookup note notes) + notes <- runActionE "notes.definedNotes" state $ useE MkGetNotes uriOrig + (noteUri, pos) <- err ("Note definition (a comment of the form `{- Note [" <> note <> "]\\n~~~ ... -}`) not found") (HM.lookup note notes) pure $ InL (Definition (InL - (Location (fromNormalizedUri $ normalizedFilePathToUri noteFp) (Range pos pos)) + (Location (fromNormalizedUri $ noteUri) (Range pos pos)) )) where uriOrig = toNormalizedUri $ param ^. (L.textDocument . L.uri) -jumpToNote _ _ _ = throwError $ PluginInternalError "conversion to normalized file path failed" -findNotesInFile :: NormalizedFilePath -> Recorder (WithPriority Log) -> Action (Maybe (HM.HashMap Text Position, HM.HashMap Text [Position])) -findNotesInFile file recorder = do +findNotesInFile :: NormalizedUri -> Recorder (WithPriority Log) -> Action (Maybe (HM.HashMap Text Position, HM.HashMap Text [Position])) +findNotesInFile nuri recorder = do -- GetFileContents only returns a value if the file is open in the editor of -- the user. If not, we need to read it from disk. - contentOpt <- (snd =<<) <$> use GetFileContents file - content <- case contentOpt of - Just x -> pure $ Rope.toText x - Nothing -> liftIO $ readFileUtf8 $ fromNormalizedFilePath file - let noteMatches = (A.! 1) <$> matchAllText noteRegex content - notes = toPositions noteMatches content - logWith recorder Debug $ LogNotesFound file (HM.toList notes) - let refMatches = (A.! 1) <$> matchAllText noteRefRegex content - refs = toPositions refMatches content - logWith recorder Debug $ LogNoteReferencesFound file (HM.toList refs) + contentOpt <- (snd =<<) <$> use GetFileContents nuri + mcontent <- case contentOpt of + Just x -> pure $ Just $ Rope.toText x + Nothing | Just nfp <- uriToNormalizedFilePath nuri -> Just <$> do + liftIO $ readFileUtf8 $ fromNormalizedFilePath nfp + _ -> pure Nothing + let noteMatches = (A.! 1) <$> foldMap (matchAllText noteRegex) mcontent + notes = foldMap (toPositions noteMatches) mcontent + logWith recorder Debug $ LogNotesFound nuri (HM.toList notes) + let refMatches = (A.! 1) <$> foldMap (matchAllText noteRefRegex) mcontent + refs = foldMap (toPositions refMatches) mcontent + logWith recorder Debug $ LogNoteReferencesFound nuri (HM.toList refs) pure $ Just (HM.mapMaybe (fmap fst . uncons) notes, refs) where uint = fromIntegral . toInteger diff --git a/plugins/hls-ormolu-plugin/src/Ide/Plugin/Ormolu.hs b/plugins/hls-ormolu-plugin/src/Ide/Plugin/Ormolu.hs index 90c5214d8e..9cf8e17e93 100644 --- a/plugins/hls-ormolu-plugin/src/Ide/Plugin/Ormolu.hs +++ b/plugins/hls-ormolu-plugin/src/Ide/Plugin/Ormolu.hs @@ -64,17 +64,18 @@ properties = -- --------------------------------------------------------------------- provider :: Recorder (WithPriority LogEvent) -> PluginId -> FormattingHandler IdeState -provider recorder plId ideState token typ contents fp _ = ExceptT $ pluginWithIndefiniteProgress title token Cancellable $ \_updater -> runExceptT $ do +provider recorder plId ideState token typ contents nuri _ = ExceptT $ pluginWithIndefiniteProgress title token Cancellable $ \_updater -> runExceptT $ do fileOpts <- maybe [] (fromDyn . hsc_dflags . hscEnv) - <$> liftIO (runAction "Ormolu" ideState $ use GhcSession fp) + <$> liftIO (runAction "Ormolu" ideState $ use GhcSession nuri) useCLI <- liftIO $ runAction "Ormolu" ideState $ usePropertyAction #external plId properties - - if useCLI + case uriToFilePath uri of + Nothing -> throwError $ PluginInternalError $ "Ormolu can only be used to file Uris, but " <> getUri uri <> " was not a file Uri" + Just fp -> if useCLI then mapExceptT liftIO $ ExceptT $ handle @IOException (pure . Left . PluginInternalError . T.pack . show) - $ runExceptT $ cliHandler fileOpts + $ runExceptT $ cliHandler fileOpts fp else do logWith recorder Debug $ LogCompiledInVersion VERSION_ormolu @@ -82,12 +83,12 @@ provider recorder plId ideState token typ contents fp _ = ExceptT $ pluginWithIn fmt :: T.Text -> Config RegionIndices -> IO (Either SomeException T.Text) fmt cont conf = flip catches handlers $ do #if MIN_VERSION_ormolu(0,5,3) - cabalInfo <- getCabalInfoForSourceFile fp' <&> \case + cabalInfo <- getCabalInfoForSourceFile fp <&> \case CabalNotFound -> Nothing CabalDidNotMention cabalInfo -> Just cabalInfo CabalFound cabalInfo -> Just cabalInfo #if MIN_VERSION_ormolu(0,7,0) - (fixityOverrides, moduleReexports) <- getDotOrmoluForSourceFile fp' + (fixityOverrides, moduleReexports) <- getDotOrmoluForSourceFile fp let conf' = refineConfig ModuleSource cabalInfo (Just fixityOverrides) (Just moduleReexports) conf #else fixityOverrides <- traverse getFixityOverridesForSourceFile cabalInfo @@ -98,7 +99,7 @@ provider recorder plId ideState token typ contents fp _ = ExceptT $ pluginWithIn let conf' = conf cont' = T.unpack cont #endif - Right <$> ormolu conf' fp' cont' + Right <$> ormolu conf' fp cont' handlers = [ Handler $ pure . Left . SomeException @OrmoluException , Handler $ pure . Left . SomeException @IOException @@ -107,7 +108,7 @@ provider recorder plId ideState token typ contents fp _ = ExceptT $ pluginWithIn res <- liftIO $ fmt contents defaultConfig { cfgDynOptions = map DynOption fileOpts, cfgRegion = region } ret res where - fp' = fromNormalizedFilePath fp + uri = fromNormalizedUri nuri region :: RegionIndices region = case typ of @@ -116,7 +117,7 @@ provider recorder plId ideState token typ contents fp _ = ExceptT $ pluginWithIn FormatRange (Range (Position sl _) (Position el _)) -> RegionIndices (Just $ fromIntegral $ sl + 1) (Just $ fromIntegral $ el + 1) - title = T.pack $ "Formatting " <> takeFileName (fromNormalizedFilePath fp) + title = "Formatting " <> getUri (fromNormalizedUri nuri) ret :: Either SomeException T.Text -> ExceptT PluginError (HandlerM Types.Config) ([TextEdit] |? Null) ret (Left err) = throwError $ PluginInternalError . T.pack $ "ormoluCmd: " ++ show err @@ -132,8 +133,8 @@ provider recorder plId ideState token typ contents fp _ = ExceptT $ pluginWithIn ex = showExtension <$> S.toList (D.extensionFlags df) in pp <> pm <> ex - cliHandler :: [String] -> ExceptT PluginError IO ([TextEdit] |? Null) - cliHandler fileOpts = do + cliHandler :: [String] -> FilePath -> ExceptT PluginError IO ([TextEdit] |? Null) + cliHandler fileOpts fp = do CLIVersionInfo{noCabal} <- do -- check Ormolu version so that we know which flags to use (exitCode, out, _err) <- liftIO $ readCreateProcessWithExitCode ( proc "ormolu" ["--version"] ) "" let version = do @@ -156,12 +157,12 @@ provider recorder plId ideState token typ contents fp _ = ExceptT $ pluginWithIn let commandArgs = map ("-o" <>) fileOpts -- "The --stdin-input-file option is necessary when using input from -- stdin and accounting for .cabal files" as per Ormolu documentation - <> (if noCabal then ["--no-cabal"] else ["--stdin-input-file", fp']) + <> (if noCabal then ["--no-cabal"] else ["--stdin-input-file", fp]) <> catMaybes [ ("--start-line=" <>) . show <$> regionStartLine region , ("--end-line=" <>) . show <$> regionEndLine region ] - cwd = takeDirectory fp' + cwd = takeDirectory fp logWith recorder Debug $ LogOrmoluCommand commandArgs cwd liftIO $ readCreateProcessWithExitCode (proc "ormolu" commandArgs) {cwd = Just cwd} contents case exitCode of diff --git a/plugins/hls-overloaded-record-dot-plugin/src/Ide/Plugin/OverloadedRecordDot.hs b/plugins/hls-overloaded-record-dot-plugin/src/Ide/Plugin/OverloadedRecordDot.hs index 8ead286b67..f70257b905 100644 --- a/plugins/hls-overloaded-record-dot-plugin/src/Ide/Plugin/OverloadedRecordDot.hs +++ b/plugins/hls-overloaded-record-dot-plugin/src/Ide/Plugin/OverloadedRecordDot.hs @@ -26,7 +26,6 @@ import Data.Maybe (mapMaybe, maybeToList) import Data.Text (Text) import Data.Unique (hashUnique, newUnique) import Development.IDE (IdeState, - NormalizedFilePath, Pretty (..), Range, Recorder (..), Rules, WithPriority (..), @@ -60,7 +59,6 @@ import Ide.Logger (Priority (..), cmapWithPrio, logWith, (<+>)) import Ide.Plugin.Error (PluginError (..), - getNormalizedFilePathE, handleMaybe) import Ide.Plugin.RangeMap (RangeMap) import qualified Ide.Plugin.RangeMap as RangeMap @@ -77,7 +75,7 @@ import Language.LSP.Protocol.Types (CodeAction (..), CodeActionParams (..), TextEdit (..), Uri (..), WorkspaceEdit (WorkspaceEdit, _changeAnnotations, _changes, _documentChanges), - type (|?) (..)) + type (|?) (..), toNormalizedUri, NormalizedUri) #if __GLASGOW_HASKELL__ < 910 @@ -167,17 +165,17 @@ descriptor recorder plId = resolveProvider :: ResolveFunction IdeState ORDResolveData 'Method_CodeActionResolve resolveProvider ideState plId ca uri (ORDRD _ int) = do - nfp <- getNormalizedFilePathE uri - CRSR _ crsDetails exts <- collectRecSelResult ideState nfp - pragma <- getFirstPragma plId ideState nfp + let nuri = toNormalizedUri uri + CRSR _ crsDetails exts <- collectRecSelResult ideState nuri + pragma <- getFirstPragma plId ideState nuri rse <- handleMaybe PluginStaleResolve $ IntMap.lookup int crsDetails pure $ ca {_edit = mkWorkspaceEdit uri rse exts pragma} codeActionProvider :: PluginMethodHandler IdeState 'Method_TextDocumentCodeAction codeActionProvider ideState _ (CodeActionParams _ _ caDocId caRange _) = do - nfp <- getNormalizedFilePathE (caDocId ^. L.uri) - CRSR crsMap _ exts <- collectRecSelResult ideState nfp + let nuri = toNormalizedUri $ caDocId ^. L.uri + CRSR crsMap _ exts <- collectRecSelResult ideState nuri let mkCodeAction (crsM, nse) = InR CodeAction { -- We pass the record selector to the title function, so that -- we can have the name of the record selector in the title of @@ -310,7 +308,7 @@ getRecSels e@(unLoc -> OpApp _ se@(unLoc -> HsRecSel _ _) | RealSrcSpan realSpan' _ <- [ getLoc e ] ], False ) getRecSels _ = ([], False) -collectRecSelResult :: MonadIO m => IdeState -> NormalizedFilePath +collectRecSelResult :: MonadIO m => IdeState -> NormalizedUri -> ExceptT PluginError m CollectRecordSelectorsResult collectRecSelResult ideState = runActionE "overloadedRecordDot.collectRecordSelectors" ideState diff --git a/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs b/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs index 23bfd727cf..8698add215 100644 --- a/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs +++ b/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs @@ -33,7 +33,6 @@ import Development.IDE.Plugin.Completions (ghcideCompletionsPlug import Development.IDE.Plugin.Completions.Logic (getCompletionPrefixFromRope) import Development.IDE.Plugin.Completions.Types (PosPrefixInfo (..)) import qualified Development.IDE.Spans.Pragmas as Pragmas -import Ide.Plugin.Error import Ide.Types import qualified Language.LSP.Protocol.Lens as L import qualified Language.LSP.Protocol.Message as LSP @@ -77,12 +76,12 @@ suggestDisableWarningProvider = mkCodeActionProvider $ const suggestDisableWarni mkCodeActionProvider :: (Maybe DynFlags -> Diagnostic -> [PragmaEdit]) -> PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction mkCodeActionProvider mkSuggest state _plId (LSP.CodeActionParams _ _ LSP.TextDocumentIdentifier{ _uri = uri } _ (LSP.CodeActionContext diags _monly _)) = do - normalizedFilePath <- getNormalizedFilePathE uri + let nuri = toNormalizedUri uri -- ghc session to get some dynflags even if module isn't parsed (hscEnv -> hsc_dflags -> sessionDynFlags, _) <- - runActionE "Pragmas.GhcSession" state $ useWithStaleE GhcSession normalizedFilePath - fileContents <- liftIO $ runAction "Pragmas.GetFileContents" state $ getFileContents normalizedFilePath - parsedModule <- liftIO $ runAction "Pragmas.GetParsedModule" state $ getParsedModule normalizedFilePath + runActionE "Pragmas.GhcSession" state $ useWithStaleE GhcSession nuri + fileContents <- liftIO $ runAction "Pragmas.GetFileContents" state $ getFileContents nuri + parsedModule <- liftIO $ runAction "Pragmas.GetParsedModule" state $ getParsedModule nuri let parsedModuleDynFlags = ms_hspp_opts . pm_mod_summary <$> parsedModule nextPragmaInfo = Pragmas.getNextPragmaInfo sessionDynFlags fileContents pedits = nubOrdOn snd $ concatMap (mkSuggest parsedModuleDynFlags) diags diff --git a/plugins/hls-qualify-imported-names-plugin/src/Ide/Plugin/QualifyImportedNames.hs b/plugins/hls-qualify-imported-names-plugin/src/Ide/Plugin/QualifyImportedNames.hs index 011910b880..2912489aea 100644 --- a/plugins/hls-qualify-imported-names-plugin/src/Ide/Plugin/QualifyImportedNames.hs +++ b/plugins/hls-qualify-imported-names-plugin/src/Ide/Plugin/QualifyImportedNames.hs @@ -59,7 +59,6 @@ import Development.IDE.GHC.Compat (ContextInfo (Use), import Development.IDE.Types.Location (Position (Position), Range (Range), Uri) import Ide.Plugin.Error (PluginError (PluginRuleFailed), - getNormalizedFilePathE, handleMaybe) import Ide.Types (PluginDescriptor (pluginHandlers), PluginId, @@ -74,6 +73,7 @@ import Language.LSP.Protocol.Types (CodeAction (CodeAction, _comm CodeActionParams (CodeActionParams), TextEdit (TextEdit), WorkspaceEdit (WorkspaceEdit, _changeAnnotations, _changes, _documentChanges), + toNormalizedUri, type (|?) (InL, InR)) #if !MIN_VERSION_base(4,20,0) @@ -227,12 +227,12 @@ usedIdentifiersToTextEdits range nameToImportedByMap source usedIdentifiers -- at the origin of the code action. codeActionProvider :: PluginMethodHandler IdeState Method_TextDocumentCodeAction codeActionProvider ideState _pluginId (CodeActionParams _ _ documentId range _) = do - normalizedFilePath <- getNormalizedFilePathE (documentId ^. L.uri) - TcModuleResult { tmrParsed, tmrTypechecked } <- runActionE "QualifyImportedNames.TypeCheck" ideState $ useE TypeCheck normalizedFilePath + let nuri = toNormalizedUri (documentId ^. L.uri) + TcModuleResult { tmrParsed, tmrTypechecked } <- runActionE "QualifyImportedNames.TypeCheck" ideState $ useE TypeCheck nuri if isJust (findLImportDeclAt range tmrParsed) then do - HAR {..} <- runActionE "QualifyImportedNames.GetHieAst" ideState (useE GetHieAst normalizedFilePath) - (_, sourceM) <- runActionE "QualifyImportedNames.GetFileContents" ideState (useE GetFileContents normalizedFilePath) + HAR {..} <- runActionE "QualifyImportedNames.GetHieAst" ideState (useE GetHieAst nuri) + (_, sourceM) <- runActionE "QualifyImportedNames.GetFileContents" ideState (useE GetFileContents nuri) source <- handleMaybe (PluginRuleFailed "GetFileContents") sourceM let globalRdrEnv = tcg_rdr_env tmrTypechecked nameToImportedByMap = globalRdrEnvToNameToImportedByMap globalRdrEnv diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs index e471d1781a..79a0aaa06e 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -95,8 +95,7 @@ import Language.LSP.Protocol.Types (ApplyWorkspa TextEdit (TextEdit, _range), UInt, WorkspaceEdit (WorkspaceEdit, _changeAnnotations, _changes, _documentChanges), - type (|?) (InL, InR), - uriToFilePath) + type (|?) (InL, InR)) import qualified Text.Fuzzy.Parallel as TFP import Text.Regex.TDFA ((=~), (=~~)) @@ -135,9 +134,9 @@ codeAction :: PluginMethodHandler IdeState 'Method_TextDocumentCodeAction codeAction state _ (CodeActionParams _ _ (TextDocumentIdentifier uri) range _) = do contents <- liftIO $ runAction "hls-refactor-plugin.codeAction.getUriContents" state $ getUriContents $ toNormalizedUri uri liftIO $ do - let mbFile = toNormalizedFilePath' <$> uriToFilePath uri - allDiags <- atomically $ fmap fdLspDiagnostic . filter (\d -> mbFile == Just (fdFilePath d)) <$> getDiagnostics state - (join -> parsedModule) <- runAction "GhcideCodeActions.getParsedModule" state $ getParsedModule `traverse` mbFile + let nuri = toNormalizedUri uri + allDiags <- atomically $ fmap fdLspDiagnostic . filter (\d -> nuri == fdUri d) <$> getDiagnostics state + parsedModule <- runAction "GhcideCodeActions.getParsedModule" state $ getParsedModule nuri let textContents = fmap Rope.toText contents actions = caRemoveRedundantImports parsedModule textContents allDiags range uri @@ -210,9 +209,9 @@ extendImportCommand = extendImportHandler :: CommandFunction IdeState ExtendImport extendImportHandler ideState _ edit@ExtendImport {..} = ExceptT $ do res <- liftIO $ runMaybeT $ extendImportHandler' ideState edit - whenJust res $ \(nfp, wedit@WorkspaceEdit {_changes}) -> do + whenJust res $ \(nuri, wedit@WorkspaceEdit {_changes}) -> do whenJust (listToMaybe =<< listToMaybe . M.elems =<< _changes) $ \TextEdit {_range} -> do - let srcSpan = rangeToSrcSpan nfp _range + let srcSpan = rangeToSrcSpan nuri _range pluginSendNotification SMethod_WindowShowMessage $ ShowMessageParams MessageType_Info $ "Import " @@ -225,45 +224,41 @@ extendImportHandler ideState _ edit@ExtendImport {..} = ExceptT $ do void $ pluginSendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wedit) (\_ -> pure ()) return $ Right $ InR Null -extendImportHandler' :: IdeState -> ExtendImport -> MaybeT IO (NormalizedFilePath, WorkspaceEdit) -extendImportHandler' ideState ExtendImport {..} - | Just fp <- uriToFilePath doc, - nfp <- toNormalizedFilePath' fp = - do - (ModSummaryResult {..}, ps, contents) <- MaybeT $ liftIO $ - runAction "extend import" ideState $ - runMaybeT $ do - -- We want accurate edits, so do not use stale data here - msr <- MaybeT $ use GetModSummaryWithoutTimestamps nfp - ps <- MaybeT $ use GetAnnotatedParsedSource nfp - (_, contents) <- MaybeT $ use GetFileContents nfp - return (msr, ps, contents) - let df = ms_hspp_opts msrModSummary - wantedModule = mkModuleName (T.unpack importName) - wantedQual = mkModuleName . T.unpack <$> importQual - existingImport = find (isWantedModule wantedModule wantedQual) msrImports - case existingImport of - Just imp -> do - fmap (nfp,) $ liftEither $ - rewriteToWEdit df doc $ - extendImport (T.unpack <$> thingParent) (T.unpack newThing) +extendImportHandler' :: IdeState -> ExtendImport -> MaybeT IO (NormalizedUri, WorkspaceEdit) +extendImportHandler' ideState ExtendImport {..} = do + let nuri = toNormalizedUri doc + (ModSummaryResult {..}, ps, contents) <- MaybeT $ liftIO $ + runAction "extend import" ideState $ + runMaybeT $ do + -- We want accurate edits, so do not use stale data here + msr <- MaybeT $ use GetModSummaryWithoutTimestamps nuri + ps <- MaybeT $ use GetAnnotatedParsedSource nuri + (_, contents) <- MaybeT $ use GetFileContents nuri + return (msr, ps, contents) + let df = ms_hspp_opts msrModSummary + wantedModule = mkModuleName (T.unpack importName) + wantedQual = mkModuleName . T.unpack <$> importQual + existingImport = find (isWantedModule wantedModule wantedQual) msrImports + case existingImport of + Just imp -> do + fmap (nuri,) $ liftEither $ + rewriteToWEdit df doc $ + extendImport (T.unpack <$> thingParent) (T.unpack newThing) #if MIN_VERSION_ghc(9,9,0) - imp + imp #else - (makeDeltaAst imp) + (makeDeltaAst imp) #endif - Nothing -> do - let qns = (,) <$> importQual <*> Just (qualifiedImportStyle df) - n = newImport importName sym qns False - sym = if isNothing importQual then Just it else Nothing - it = case thingParent of - Nothing -> newThing - Just p -> p <> "(" <> newThing <> ")" - t <- liftMaybe $ snd <$> newImportToEdit n ps (Rope.toText (fromMaybe mempty contents)) - return (nfp, WorkspaceEdit {_changes=Just (M.singleton doc [t]), _documentChanges=Nothing, _changeAnnotations=Nothing}) - | otherwise = - mzero + Nothing -> do + let qns = (,) <$> importQual <*> Just (qualifiedImportStyle df) + n = newImport importName sym qns False + sym = if isNothing importQual then Just it else Nothing + it = case thingParent of + Nothing -> newThing + Just p -> p <> "(" <> newThing <> ")" + t <- liftMaybe $ snd <$> newImportToEdit n ps (Rope.toText (fromMaybe mempty contents)) + return (nuri, WorkspaceEdit {_changes=Just (M.singleton doc [t]), _documentChanges=Nothing, _changeAnnotations=Nothing}) isWantedModule :: ModuleName -> Maybe ModuleName -> GenLocated l (ImportDecl GhcPs) -> Bool isWantedModule wantedModule Nothing (L _ it@ImportDecl{ ideclName @@ -1175,12 +1170,12 @@ disambiguateSymbol ps fileContents Diagnostic {..} (T.unpack -> symbol) = \case let occSym = mkVarOcc symbol rdr = Qual qualMod occSym in Right <$> [ if parensed - then Rewrite (rangeToSrcSpan "" _range) $ \df -> + then Rewrite (rangeToSrcSpan emptyPathUri _range) $ \df -> liftParseAST @(HsExpr GhcPs) df $ T.unpack $ printOutputable $ HsVar @GhcPs noExtField $ reLocA $ L (mkGeneralSrcSpan "") rdr - else Rewrite (rangeToSrcSpan "" _range) $ \df -> + else Rewrite (rangeToSrcSpan emptyPathUri _range) $ \df -> liftParseAST @RdrName df $ T.unpack $ printOutputable $ L (mkGeneralSrcSpan "") rdr ] diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Args.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Args.hs index a4132dd787..416356029a 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Args.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Args.hs @@ -55,9 +55,10 @@ type GhcideCodeAction = ExceptT PluginError (ReaderT CodeActionArgs IO) GhcideCo ------------------------------------------------------------------------------------------------- runGhcideCodeAction :: IdeState -> MessageParams Method_TextDocumentCodeAction -> GhcideCodeAction -> HandlerM Config GhcideCodeActionResult -runGhcideCodeAction state (CodeActionParams _ _ (TextDocumentIdentifier uri) _range _) codeAction - | Just nfp <- toNormalizedFilePath' <$> uriToFilePath uri = do - let runRule key = runAction ("GhcideCodeActions." <> show key) state $ runMaybeT $ MaybeT (pure (Just nfp)) >>= MaybeT . use key +runGhcideCodeAction state (CodeActionParams _ _ (TextDocumentIdentifier uri) _range _) codeAction = do + let + nuri = toNormalizedUri uri + runRule key = runAction ("GhcideCodeActions." <> show key) state $ runMaybeT $ MaybeT (pure (Just nuri)) >>= MaybeT . use key caaGhcSession <- onceIO $ runRule GhcSession caaExportsMap <- onceIO $ @@ -80,7 +81,7 @@ runGhcideCodeAction state (CodeActionParams _ _ (TextDocumentIdentifier uri) _ra caaHar <- onceIO $ runRule GetHieAst caaBindings <- onceIO $ runRule GetBindings caaGblSigs <- onceIO $ runRule GetGlobalBindingTypeSigs - diags <- concat . maybeToList <$> activeDiagnosticsInRange (shakeExtras state) nfp _range + diags <- concat . maybeToList <$> activeDiagnosticsInRange (shakeExtras state) nuri _range results <- liftIO $ sequence [ @@ -89,7 +90,6 @@ runGhcideCodeAction state (CodeActionParams _ _ (TextDocumentIdentifier uri) _ra ] let (_errs, successes) = partitionEithers results pure $ concat successes - | otherwise = pure [] mkCA :: T.Text -> Maybe CodeActionKind -> Maybe Bool -> [Diagnostic] -> WorkspaceEdit -> (Command |? CodeAction) diff --git a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs index 2fdbee3ebc..6b0013985e 100644 --- a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs +++ b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs @@ -67,8 +67,8 @@ descriptor recorder pluginId = mkExactprintPluginDescriptor recorder $ prepareRenameProvider :: PluginMethodHandler IdeState Method_TextDocumentPrepareRename prepareRenameProvider state _pluginId (PrepareRenameParams (TextDocumentIdentifier uri) pos _progressToken) = do - nfp <- getNormalizedFilePathE uri - namesUnderCursor <- getNamesAtPos state nfp pos + let nuri = toNormalizedUri uri + namesUnderCursor <- getNamesAtPos state nuri pos -- When this handler says that rename is invalid, VSCode shows "The element can't be renamed" -- and doesn't even allow you to create full rename request. -- This handler deliberately approximates "things that definitely can't be renamed" @@ -81,16 +81,16 @@ prepareRenameProvider state _pluginId (PrepareRenameParams (TextDocumentIdentifi renameProvider :: PluginMethodHandler IdeState Method_TextDocumentRename renameProvider state pluginId (RenameParams _prog (TextDocumentIdentifier uri) pos newNameText) = do - nfp <- getNormalizedFilePathE uri - directOldNames <- getNamesAtPos state nfp pos - directRefs <- concat <$> mapM (refsAtName state nfp) directOldNames + let nuri = toNormalizedUri uri + directOldNames <- getNamesAtPos state nuri pos + directRefs <- concat <$> mapM (refsAtName state nuri) directOldNames {- References in HieDB are not necessarily transitive. With `NamedFieldPuns`, we can have indirect references through punned names. To find the transitive closure, we do a pass of the direct references to find the references for any punned names. See the `IndirectPuns` test for an example. -} indirectOldNames <- concat . filter ((>1) . length) <$> - mapM (uncurry (getNamesAtPos state) <=< locToFilePos) directRefs + mapM (uncurry (getNamesAtPos state) . locToFilePos) directRefs let oldNames = filter matchesDirect indirectOldNames ++ directOldNames where matchesDirect n = occNameFS (nameOccName n) `elem` directFS @@ -100,11 +100,11 @@ renameProvider state pluginId (RenameParams _prog (TextDocumentIdentifier uri) p -- There were no Names at given position (e.g. rename triggered within a comment or on a keyword) [] -> throwError $ PluginInvalidParams "No symbol to rename at given position" _ -> do - refs <- HS.fromList . concat <$> mapM (refsAtName state nfp) oldNames + refs <- HS.fromList . concat <$> mapM (refsAtName state nuri) oldNames -- Validate rename crossModuleEnabled <- liftIO $ runAction "rename: config" state $ usePropertyAction #crossModule pluginId properties - unless crossModuleEnabled $ failWhenImportOrExport state nfp refs oldNames + unless crossModuleEnabled $ failWhenImportOrExport state nuri refs oldNames when (any isBuiltInSyntax oldNames) $ throwError $ PluginInternalError "Invalid rename of built-in syntax" -- Perform rename @@ -119,7 +119,7 @@ renameProvider state pluginId (RenameParams _prog (TextDocumentIdentifier uri) p -- | Limit renaming across modules. failWhenImportOrExport :: IdeState -> - NormalizedFilePath -> + NormalizedUri -> HashSet Location -> [Name] -> ExceptT PluginError (HandlerM config) () @@ -146,9 +146,9 @@ getSrcEdit :: ExceptT PluginError (HandlerM config) WorkspaceEdit getSrcEdit state verTxtDocId updatePs = do ccs <- lift pluginGetClientCapabilities - nfp <- getNormalizedFilePathE (verTxtDocId ^. L.uri) + let nuri = toNormalizedUri (verTxtDocId ^. L.uri) annAst <- runActionE "Rename.GetAnnotatedParsedSource" state - (useE GetAnnotatedParsedSource nfp) + (useE GetAnnotatedParsedSource nuri) let ps = annAst src = T.pack $ exactPrint ps res = T.pack $ exactPrint (updatePs ps) @@ -188,12 +188,12 @@ replaceRefs newName refs = everywhere $ refsAtName :: MonadIO m => IdeState -> - NormalizedFilePath -> + NormalizedUri -> Name -> ExceptT PluginError m [Location] -refsAtName state nfp name = do +refsAtName state nuri name = do ShakeExtras{withHieDb} <- liftIO $ runAction "Rename.HieDb" state getShakeExtras - ast <- handleGetHieAst state nfp + ast <- handleGetHieAst state nuri dbRefs <- case nameModule_maybe name of Nothing -> pure [] Just mod -> liftIO $ mapMaybe rowToLoc <$> withHieDb (\hieDb -> @@ -205,7 +205,7 @@ refsAtName state nfp name = do (nameOccName name) (Just $ moduleName mod) (Just $ moduleUnit mod) - [fromNormalizedFilePath nfp] + [T.unpack $ getUri $ fromNormalizedUri nuri] ) pure $ nameLocs name ast ++ dbRefs @@ -217,7 +217,7 @@ nameLocs name (HAR _ _ rm _ _) = --------------------------------------------------------------------------------------------------- -- Util -getNamesAtPos :: MonadIO m => IdeState -> NormalizedFilePath -> Position -> ExceptT PluginError m [Name] +getNamesAtPos :: MonadIO m => IdeState -> NormalizedUri -> Position -> ExceptT PluginError m [Name] getNamesAtPos state nfp pos = do HAR{hieAst} <- handleGetHieAst state nfp pure $ getNamesAtPoint' hieAst pos @@ -225,13 +225,13 @@ getNamesAtPos state nfp pos = do handleGetHieAst :: MonadIO m => IdeState -> - NormalizedFilePath -> + NormalizedUri -> ExceptT PluginError m HieAstResult -handleGetHieAst state nfp = +handleGetHieAst state nuri = -- We explicitly do not want to allow a stale version here - we only want to rename if -- the module compiles, otherwise we can't guarantee that we'll rename everything, -- which is bad (see https://github.com/haskell/haskell-language-server/issues/3799) - fmap removeGenerated $ runActionE "Rename.GetHieAst" state $ useE GetHieAst nfp + fmap removeGenerated $ runActionE "Rename.GetHieAst" state $ useE GetHieAst nuri {- Note [Generated references] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -274,8 +274,8 @@ unsafeSrcSpanToLoc srcSpan = Nothing -> error "Invalid conversion from UnhelpfulSpan to Location" Just location -> location -locToFilePos :: Monad m => Location -> ExceptT PluginError m (NormalizedFilePath, Position) -locToFilePos (Location uri (Range pos _)) = (,pos) <$> getNormalizedFilePathE uri +locToFilePos :: Location -> (NormalizedUri, Position) +locToFilePos (Location uri (Range pos _)) = (toNormalizedUri uri, pos) replaceModName :: Name -> Maybe ModuleName -> Module replaceModName name mbModName = diff --git a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Internal.hs b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Internal.hs index b8b07e667f..b680d464c8 100644 --- a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Internal.hs +++ b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Internal.hs @@ -32,8 +32,8 @@ import Development.IDE (Action, Recorder, Rules, WithPriority, cmapWithPrio, define, - fromNormalizedFilePath, - hieKind) + hieKind, + toNormalizedUri) import Development.IDE.Core.PluginUtils (runActionE, useE, useWithStaleE) import Development.IDE.Core.Rules (toIdeResult) @@ -45,7 +45,6 @@ import Development.IDE.GHC.Compat hiding (Warning) import Development.IDE.GHC.Compat.Util (mkFastString) import Ide.Logger (logWith) import Ide.Plugin.Error (PluginError (PluginInternalError), - getNormalizedFilePathE, handleMaybe, handleMaybeM) import Ide.Plugin.SemanticTokens.Mappings @@ -57,8 +56,10 @@ import Ide.Types import qualified Language.LSP.Protocol.Lens as L import Language.LSP.Protocol.Message (MessageResult, Method (Method_TextDocumentSemanticTokensFull, Method_TextDocumentSemanticTokensFullDelta)) -import Language.LSP.Protocol.Types (NormalizedFilePath, +import Language.LSP.Protocol.Types (NormalizedUri, SemanticTokens, + fromNormalizedUri, + getUri, type (|?) (InL, InR)) import Prelude hiding (span) import qualified StmContainers.Map as STM @@ -70,12 +71,12 @@ $mkSemanticConfigFunctions ---- the api ----------------------- -computeSemanticTokens :: Recorder (WithPriority SemanticLog) -> PluginId -> IdeState -> NormalizedFilePath -> ExceptT PluginError Action SemanticTokens -computeSemanticTokens recorder pid _ nfp = do +computeSemanticTokens :: Recorder (WithPriority SemanticLog) -> PluginId -> IdeState -> NormalizedUri -> ExceptT PluginError Action SemanticTokens +computeSemanticTokens recorder pid _ nuri = do config <- lift $ useSemanticConfigAction pid logWith recorder Debug (LogConfig config) semanticId <- lift getAndIncreaseSemanticTokensId - (RangeHsSemanticTokenTypes {rangeSemanticList}, mapping) <- useWithStaleE GetSemanticTokens nfp + (RangeHsSemanticTokenTypes {rangeSemanticList}, mapping) <- useWithStaleE GetSemanticTokens nuri withExceptT PluginInternalError $ liftEither $ rangeSemanticsSemanticTokens semanticId config mapping rangeSemanticList semanticTokensFull :: Recorder (WithPriority SemanticLog) -> PluginMethodHandler IdeState 'Method_TextDocumentSemanticTokensFull @@ -83,23 +84,23 @@ semanticTokensFull recorder state pid param = runActionE "SemanticTokens.semanti where computeSemanticTokensFull :: ExceptT PluginError Action (MessageResult Method_TextDocumentSemanticTokensFull) computeSemanticTokensFull = do - nfp <- getNormalizedFilePathE (param ^. L.textDocument . L.uri) - items <- computeSemanticTokens recorder pid state nfp - lift $ setSemanticTokens nfp items + let nuri = toNormalizedUri (param ^. L.textDocument . L.uri) + items <- computeSemanticTokens recorder pid state nuri + lift $ setSemanticTokens nuri items return $ InL items semanticTokensFullDelta :: Recorder (WithPriority SemanticLog) -> PluginMethodHandler IdeState 'Method_TextDocumentSemanticTokensFullDelta semanticTokensFullDelta recorder state pid param = do - nfp <- getNormalizedFilePathE (param ^. L.textDocument . L.uri) + let nuri = toNormalizedUri (param ^. L.textDocument . L.uri) let previousVersionFromParam = param ^. L.previousResultId - runActionE "SemanticTokens.semanticTokensFullDelta" state $ computeSemanticTokensFullDelta recorder previousVersionFromParam pid state nfp + runActionE "SemanticTokens.semanticTokensFullDelta" state $ computeSemanticTokensFullDelta recorder previousVersionFromParam pid state nuri where - computeSemanticTokensFullDelta :: Recorder (WithPriority SemanticLog) -> Text -> PluginId -> IdeState -> NormalizedFilePath -> ExceptT PluginError Action (MessageResult Method_TextDocumentSemanticTokensFullDelta) - computeSemanticTokensFullDelta recorder previousVersionFromParam pid state nfp = do - semanticTokens <- computeSemanticTokens recorder pid state nfp - previousSemanticTokensMaybe <- lift $ getPreviousSemanticTokens nfp - lift $ setSemanticTokens nfp semanticTokens + computeSemanticTokensFullDelta :: Recorder (WithPriority SemanticLog) -> Text -> PluginId -> IdeState -> NormalizedUri -> ExceptT PluginError Action (MessageResult Method_TextDocumentSemanticTokensFullDelta) + computeSemanticTokensFullDelta recorder previousVersionFromParam pid state nuri = do + semanticTokens <- computeSemanticTokens recorder pid state nuri + previousSemanticTokensMaybe <- lift $ getPreviousSemanticTokens nuri + lift $ setSemanticTokens nuri semanticTokens case previousSemanticTokensMaybe of Nothing -> return $ InL semanticTokens Just previousSemanticTokens -> @@ -125,7 +126,7 @@ getSemanticTokensRule recorder = define (cmapWithPrio LogShake recorder) $ \GetSemanticTokens nfp -> handleError recorder $ do (HAR {..}) <- withExceptT LogDependencyError $ useE GetHieAst nfp (DKMap {getTyThingMap}, _) <- withExceptT LogDependencyError $ useWithStaleE GetDocMap nfp - ast <- handleMaybe (LogNoAST $ show nfp) $ getAsts hieAst M.!? (HiePath . mkFastString . fromNormalizedFilePath) nfp + ast <- handleMaybe (LogNoAST $ show nfp) $ getAsts hieAst M.!? (HiePath . mkFastString . T.unpack . getUri . fromNormalizedUri) nfp virtualFile <- handleMaybeM LogNoVF $ getVirtualFile nfp let hsFinder = idSemantic getTyThingMap (hieKindFunMasksKind hieKind) refMap return $ computeRangeHsSemanticTokenTypeList hsFinder virtualFile ast @@ -156,8 +157,8 @@ getAndIncreaseSemanticTokensId = do i <- stateTVar semanticTokensId (\val -> (val, val+1)) return $ T.pack $ show i -getPreviousSemanticTokens :: NormalizedFilePath -> Action (Maybe SemanticTokens) +getPreviousSemanticTokens :: NormalizedUri -> Action (Maybe SemanticTokens) getPreviousSemanticTokens uri = getShakeExtras >>= liftIO . atomically . STM.lookup uri . semanticTokensCache -setSemanticTokens :: NormalizedFilePath -> SemanticTokens -> Action () +setSemanticTokens :: NormalizedUri -> SemanticTokens -> Action () setSemanticTokens uri tokens = getShakeExtras >>= liftIO . atomically . STM.insert tokens uri . semanticTokensCache diff --git a/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs b/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs index a1efb7f150..33d766d6dd 100644 --- a/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs +++ b/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs @@ -106,68 +106,71 @@ type instance RuleResult GetStanDiagnostics = () rules :: Recorder (WithPriority Log) -> PluginId -> Rules () rules recorder plId = do define (cmapWithPrio LogShake recorder) $ - \GetStanDiagnostics file -> do - config <- getPluginConfigAction plId - if plcGlobalOn config && plcDiagnosticsOn config then do - maybeHie <- getHieFile file - case maybeHie of - Nothing -> return ([], Nothing) - Just hie -> do - let isLoud = False -- in Stan: notJson = not isLoud - let stanArgs = - StanArgs - { stanArgsHiedir = "" -- :: !FilePath -- ^ Directory with HIE files - , stanArgsCabalFilePath = [] -- :: ![FilePath] -- ^ Path to @.cabal@ files. - , stanArgsOutputSettings = OutputSettings NonVerbose ShowSolution -- :: !OutputSettings -- ^ Settings for output terminal report - -- doesnt matter, because it is silenced by isLoud - , stanArgsReport = Nothing -- :: !(Maybe ReportArgs) -- ^ @HTML@ report settings - , stanArgsUseDefaultConfigFile = fiasco "" -- :: !(TaggedTrial Text Bool) -- ^ Use default @.stan.toml@ file - , stanArgsConfigFile = Nothing -- :: !(Maybe FilePath) -- ^ Path to a custom configurations file. - , stanArgsConfig = ConfigP - { configChecks = fiasco "'hls-stan-plugin' doesn't receive CLI options for: checks" - , configRemoved = fiasco "'hls-stan-plugin' doesn't receive CLI options for: remove" - , configIgnored = fiasco "'hls-stan-plugin' doesn't receive CLI options for: ignore" - } - -- if they are not fiascos, .stan.toml's aren't taken into account - ,stanArgsJsonOut = not isLoud -- :: !Bool -- ^ Output the machine-readable output in JSON format instead. - } - - (configTrial, useDefConfig, env) <- liftIO $ getStanConfig stanArgs isLoud - tomlsUsedByStan <- liftIO $ usedTomlFiles useDefConfig (stanArgsConfigFile stanArgs) - logWith recorder Debug (LogDebugStanConfigResult tomlsUsedByStan configTrial) - - -- If envVar is set to 'False', stan will ignore all local and global .stan.toml files - logWith recorder Debug (LogDebugStanEnvVars env) - - -- Note that Stan works in terms of relative paths, but the HIE come in as absolute. Without - -- making its path relative, the file name(s) won't line up with the associated Map keys. - relativeHsFilePath <- liftIO $ makeRelativeToCurrentDirectory $ fromNormalizedFilePath file - let hieRelative = hie{hie_hs_file=relativeHsFilePath} - - (checksMap, ignoredObservations) <- case configTrial of - FiascoL es -> do - logWith recorder Development.IDE.Warning (LogWarnConf es) - -- If we can't read the config file, default to using all inspections: - let allInspections = HM.singleton relativeHsFilePath inspectionsIds - pure (allInspections, []) - ResultL _warnings stanConfig -> do - -- HashMap of *relative* file paths to info about enabled checks for those file paths. - let checksMap = applyConfig [relativeHsFilePath] stanConfig - pure (checksMap, configIgnored stanConfig) - - -- A Map from *relative* file paths (just one, in this case) to language extension info: - cabalExtensionsMap <- liftIO $ createCabalExtensionsMap isLoud (stanArgsCabalFilePath stanArgs) [hieRelative] - let analysis = runAnalysis cabalExtensionsMap checksMap ignoredObservations [hieRelative] - return (analysisToDiagnostics file analysis, Just ()) - else return ([], Nothing) + \GetStanDiagnostics nuri -> do + case LSP.uriToNormalizedFilePath nuri of + Nothing -> pure ([ideErrorText nuri $ "Uri is no a file Uri: " <> getUri (fromNormalizedUri nuri)], Nothing) + Just nfp -> do + config <- getPluginConfigAction plId + if plcGlobalOn config && plcDiagnosticsOn config then do + maybeHie <- getHieFile nfp + case maybeHie of + Nothing -> return ([], Nothing) + Just hie -> do + let isLoud = False -- in Stan: notJson = not isLoud + let stanArgs = + StanArgs + { stanArgsHiedir = "" -- :: !FilePath -- ^ Directory with HIE files + , stanArgsCabalFilePath = [] -- :: ![FilePath] -- ^ Path to @.cabal@ files. + , stanArgsOutputSettings = OutputSettings NonVerbose ShowSolution -- :: !OutputSettings -- ^ Settings for output terminal report + -- doesnt matter, because it is silenced by isLoud + , stanArgsReport = Nothing -- :: !(Maybe ReportArgs) -- ^ @HTML@ report settings + , stanArgsUseDefaultConfigFile = fiasco "" -- :: !(TaggedTrial Text Bool) -- ^ Use default @.stan.toml@ file + , stanArgsConfigFile = Nothing -- :: !(Maybe FilePath) -- ^ Path to a custom configurations file. + , stanArgsConfig = ConfigP + { configChecks = fiasco "'hls-stan-plugin' doesn't receive CLI options for: checks" + , configRemoved = fiasco "'hls-stan-plugin' doesn't receive CLI options for: remove" + , configIgnored = fiasco "'hls-stan-plugin' doesn't receive CLI options for: ignore" + } + -- if they are not fiascos, .stan.toml's aren't taken into account + ,stanArgsJsonOut = not isLoud -- :: !Bool -- ^ Output the machine-readable output in JSON format instead. + } + + (configTrial, useDefConfig, env) <- liftIO $ getStanConfig stanArgs isLoud + tomlsUsedByStan <- liftIO $ usedTomlFiles useDefConfig (stanArgsConfigFile stanArgs) + logWith recorder Debug (LogDebugStanConfigResult tomlsUsedByStan configTrial) + + -- If envVar is set to 'False', stan will ignore all local and global .stan.toml files + logWith recorder Debug (LogDebugStanEnvVars env) + + -- Note that Stan works in terms of relative paths, but the HIE come in as absolute. Without + -- making its path relative, the file name(s) won't line up with the associated Map keys. + relativeHsFilePath <- liftIO $ makeRelativeToCurrentDirectory $ fromNormalizedFilePath nfp + let hieRelative = hie{hie_hs_file=relativeHsFilePath} + + (checksMap, ignoredObservations) <- case configTrial of + FiascoL es -> do + logWith recorder Development.IDE.Warning (LogWarnConf es) + -- If we can't read the config file, default to using all inspections: + let allInspections = HM.singleton relativeHsFilePath inspectionsIds + pure (allInspections, []) + ResultL _warnings stanConfig -> do + -- HashMap of *relative* file paths to info about enabled checks for those file paths. + let checksMap = applyConfig [relativeHsFilePath] stanConfig + pure (checksMap, configIgnored stanConfig) + + -- A Map from *relative* file paths (just one, in this case) to language extension info: + cabalExtensionsMap <- liftIO $ createCabalExtensionsMap isLoud (stanArgsCabalFilePath stanArgs) [hieRelative] + let analysis = runAnalysis cabalExtensionsMap checksMap ignoredObservations [hieRelative] + return (analysisToDiagnostics nuri analysis, Just ()) + else return ([], Nothing) action $ do files <- getFilesOfInterestUntracked void $ uses GetStanDiagnostics $ HM.keys files where - analysisToDiagnostics :: NormalizedFilePath -> Analysis -> [FileDiagnostic] + analysisToDiagnostics :: NormalizedUri -> Analysis -> [FileDiagnostic] analysisToDiagnostics file = mapMaybe (observationToDianostic file) . toList . analysisObservations - observationToDianostic :: NormalizedFilePath -> Observation -> Maybe FileDiagnostic + observationToDianostic :: NormalizedUri -> Observation -> Maybe FileDiagnostic observationToDianostic file Observation {observationSrcSpan, observationInspectionId} = do inspection <- HM.lookup observationInspectionId inspectionsMap diff --git a/plugins/hls-stylish-haskell-plugin/src/Ide/Plugin/StylishHaskell.hs b/plugins/hls-stylish-haskell-plugin/src/Ide/Plugin/StylishHaskell.hs index 767cc061df..5eab787d0d 100644 --- a/plugins/hls-stylish-haskell-plugin/src/Ide/Plugin/StylishHaskell.hs +++ b/plugins/hls-stylish-haskell-plugin/src/Ide/Plugin/StylishHaskell.hs @@ -25,7 +25,6 @@ import Ide.PluginUtils import Ide.Types hiding (Config) import Language.Haskell.Stylish import Language.LSP.Protocol.Types as LSP -import System.Directory import System.FilePath data Log @@ -47,9 +46,9 @@ descriptor recorder plId = (defaultPluginDescriptor plId desc) -- Formats the given source in either a given Range or the whole Document. -- If the provider fails an error is returned that can be displayed to the user. provider :: Recorder (WithPriority Log) -> FormattingHandler IdeState -provider recorder ide _token typ contents fp _opts = do - (msrModSummary -> ms_hspp_opts -> dyn) <- runActionE "stylish-haskell" ide $ useE GetModSummary fp - let file = fromNormalizedFilePath fp +provider recorder ide _token typ contents nuri _opts | Just nfp <- uriToNormalizedFilePath nuri = do + (msrModSummary -> ms_hspp_opts -> dyn) <- runActionE "stylish-haskell" ide $ useE GetModSummary nuri + let file = fromNormalizedFilePath nfp config <- liftIO $ loadConfigFrom file mergedConfig <- liftIO $ getMergedConfig dyn config let (range, selectedContents) = case typ of @@ -74,6 +73,8 @@ provider recorder ide _token typ contents fp _opts = do showExtension Cpp = "CPP" showExtension other = show other +provider _ _ _ _ _ nuri _ = throwError $ PluginInternalError $ "Stylish Haskell can only be used to file Uris, but " <> getUri (fromNormalizedUri nuri) <> " was not a file Uri" + -- | Recursively search in every directory of the given filepath for .stylish-haskell.yaml. -- If no such file has been found, return default config. From 14961f33d0710525f07138d74d2f278aedd340d8 Mon Sep 17 00:00:00 2001 From: mangoiv Date: Tue, 15 Jul 2025 22:36:26 +0200 Subject: [PATCH 4/5] [chore] some more fixes to URI handling and bug fix for dropping MVar --- ghcide/src/Development/IDE/Core/Compile.hs | 75 ++++++++++--------- .../src/Development/IDE/Core/Preprocessor.hs | 11 +-- ghcide/src/Development/IDE/Core/Rules.hs | 25 ++++++- hls-plugin-api/src/Ide/Plugin/Config.hs | 1 + .../src/Ide/Plugin/CodeRange/Rules.hs | 6 +- .../src/Ide/Plugin/Eval/Handlers.hs | 5 +- .../src/Ide/Plugin/ModuleName.hs | 13 ++-- .../hls-stan-plugin/src/Ide/Plugin/Stan.hs | 2 +- 8 files changed, 80 insertions(+), 58 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index eb38d34887..82744c0194 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -1125,43 +1125,44 @@ getModSummaryFromImports env uri _modTime mContents = do liftIO $ evaluate $ rnf textualImports - case uriToFilePath' uri of - Nothing -> do - let nuri = toNormalizedUri uri - throwError [ideErrorText nuri $ "Uri is not a file uri: " <> getUri uri] - Just file -> do - modLoc <- liftIO $ if mod == mAIN_NAME - -- specially in tests it's common to have lots of nameless modules - -- mkHomeModLocation will map them to the same hi/hie locations - then mkHomeModLocation dflags (pathToModuleName uri) file - else mkHomeModLocation dflags mod file - - let modl = mkHomeModule (hscHomeUnit ppEnv) mod - sourceType = if "-boot" `isSuffixOf` takeExtension file then HsBootFile else HsSrcFile - msrModSummary = - ModSummary - { ms_mod = modl - , ms_hie_date = Nothing - , ms_dyn_obj_date = Nothing - , ms_ghc_prim_import = ghc_prim_import - , ms_hs_hash = _src_hash - - , ms_hsc_src = sourceType - -- The contents are used by the GetModSummary rule - , ms_hspp_buf = Just contents - , ms_hspp_file = file - , ms_hspp_opts = dflags - , ms_iface_date = Nothing - , ms_location = withBootSuffix sourceType modLoc - , ms_obj_date = Nothing - , ms_parsed_mod = Nothing - , ms_srcimps = srcImports - , ms_textual_imps = textualImports - } - - msrFingerprint <- liftIO $ computeFingerprint file opts msrModSummary - msrHscEnv <- liftIO $ Loader.initializePlugins (hscSetFlags (ms_hspp_opts msrModSummary) ppEnv) - return ModSummaryResult{..} + -- NOTE: thisis pretty bad as it relies on the prepropcessors not actually reading from a file when it's not needed + when (isNothing (uriToFilePath' uri) && isNothing mContents) $ do + throwError [ideErrorText (toNormalizedUri uri) $ "Uri is not a file uri: " <> getUri uri] + + let file = T.unpack $ getUri uri + + modLoc <- liftIO $ if mod == mAIN_NAME + -- specially in tests it's common to have lots of nameless modules + -- mkHomeModLocation will map them to the same hi/hie locations + then mkHomeModLocation dflags (pathToModuleName uri) file + else mkHomeModLocation dflags mod file + + let modl = mkHomeModule (hscHomeUnit ppEnv) mod + sourceType = if "-boot" `isSuffixOf` takeExtension file then HsBootFile else HsSrcFile + msrModSummary = + ModSummary + { ms_mod = modl + , ms_hie_date = Nothing + , ms_dyn_obj_date = Nothing + , ms_ghc_prim_import = ghc_prim_import + , ms_hs_hash = _src_hash + + , ms_hsc_src = sourceType + -- The contents are used by the GetModSummary rule + , ms_hspp_buf = Just contents + , ms_hspp_file = file + , ms_hspp_opts = dflags + , ms_iface_date = Nothing + , ms_location = withBootSuffix sourceType modLoc + , ms_obj_date = Nothing + , ms_parsed_mod = Nothing + , ms_srcimps = srcImports + , ms_textual_imps = textualImports + } + + msrFingerprint <- liftIO $ computeFingerprint file opts msrModSummary + msrHscEnv <- liftIO $ Loader.initializePlugins (hscSetFlags (ms_hspp_opts msrModSummary) ppEnv) + return ModSummaryResult{..} where -- Compute a fingerprint from the contents of `ModSummary`, -- eliding the timestamps, the preprocessed source and other non relevant fields diff --git a/ghcide/src/Development/IDE/Core/Preprocessor.hs b/ghcide/src/Development/IDE/Core/Preprocessor.hs index 943e79fb1b..fe0e37885b 100644 --- a/ghcide/src/Development/IDE/Core/Preprocessor.hs +++ b/ghcide/src/Development/IDE/Core/Preprocessor.hs @@ -16,6 +16,7 @@ import Language.LSP.Protocol.Types (uriToFilePath) import Control.DeepSeq (NFData (rnf)) import Control.Exception (evaluate) import Control.Exception.Safe (catch, throw) +import Control.Monad (when) import Control.Monad.Except (throwError) import Control.Monad.IO.Class import Control.Monad.Trans.Except @@ -38,11 +39,11 @@ import System.IO.Extra -- | Given a file and some contents, apply any necessary preprocessors, -- e.g. unlit/cpp. Return the resulting buffer and the DynFlags it implies. preprocessor :: HscEnv -> Uri -> Maybe Util.StringBuffer -> ExceptT [FileDiagnostic] IO (Util.StringBuffer, [String], HscEnv, Util.Fingerprint) -preprocessor env uri mbContents = case uriToFilePath uri of - Nothing -> do - let nuri = toNormalizedUri uri - throwError [ideErrorText nuri $ "Uri is not a file uri: " <> getUri uri] - Just filename -> do +preprocessor env uri mbContents = do + -- NOTE: thisis pretty bad as it relies on the prepropcessors not actually reading from a file when it's not needed + when (isNothing (uriToFilePath uri) && isNothing mbContents) $ do + throwError [ideErrorText (toNormalizedUri uri) $ "Uri is not a file uri and contents are not available: " <> getUri uri] + let filename = T.unpack $ getUri uri -- Perform unlit (isOnDisk, contents) <- if isLiterate uri then do diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index e575dce397..357f919d24 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -173,6 +173,7 @@ import System.Info.Extra (isWindows) import qualified Data.IntMap as IM import GHC.Fingerprint +import System.Process.Extra (proc, readCreateProcess) data Log = LogShake Shake.Log @@ -710,11 +711,31 @@ loadGhcSession recorder ghcSessionDepsConfig = do return (fingerprint, res) defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GhcSession uri -> do + -- let mk k = case uriToNormalizedFilePath nuri of + -- -- FIXME: awful hack to get cradles to work + -- Nothing -> withSystemTempDirectory "tmp_cradle" $ \dir -> do + -- writeFile (dir "hie.yaml") "cradle:\n direct:\n arguments: []" + -- k dir + -- Just file -> k $ fromNormalizedFilePath file IdeGhcSession{loadSessionFun} <- useNoFile_ GhcSessionIO -- loading is always returning a absolute path now (val,deps) <- case uriToNormalizedFilePath uri of - Just file -> liftIO $ loadSessionFun $ fromNormalizedFilePath file - Nothing -> pure (([], Nothing), []) + Just fp -> liftIO $ loadSessionFun (fromNormalizedFilePath fp) + Nothing -> do + hscEnv :: HscEnv <- do + ShakeExtras{ideNc} <- getShakeExtras + + liftIO $ do + -- TODO: clean up + -- e.g. the hack to drop the line break but also other stuff + libdir <- init <$> readCreateProcess (proc "ghc" ["--print-libdir"]) "" + env <- runGhc {- get lib dir from somewhere -} (Just libdir) $ + getSessionDynFlags >>= setSessionDynFlags >> getSession + pure $ (hscSetFlags ((hsc_dflags env){useUnicode = True }) env) {hsc_NC = ideNc} + + hscEnvEq <- liftIO $ newHscEnvEq hscEnv + pure (([], Just hscEnvEq), []) + -- add the deps to the Shake graph diff --git a/hls-plugin-api/src/Ide/Plugin/Config.hs b/hls-plugin-api/src/Ide/Plugin/Config.hs index 4fee92c309..06decd6620 100644 --- a/hls-plugin-api/src/Ide/Plugin/Config.hs +++ b/hls-plugin-api/src/Ide/Plugin/Config.hs @@ -27,6 +27,7 @@ import Ide.Types -- | Given a DidChangeConfigurationNotification message, this function returns the parsed -- Config object if possible. getConfigFromNotification :: IdePlugins s -> Config -> A.Value -> Either T.Text Config +getConfigFromNotification _plugins defaultValue Null = pure defaultValue getConfigFromNotification plugins defaultValue p = case A.parse (parseConfig plugins defaultValue) p of A.Success c -> Right c diff --git a/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs b/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs index 34481747d3..4b4217bfef 100644 --- a/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs +++ b/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs @@ -167,12 +167,12 @@ type instance RuleResult GetCodeRange = CodeRange codeRangeRule :: Recorder (WithPriority Log) -> Rules () codeRangeRule recorder = - define (cmapWithPrio LogShake recorder) $ \GetCodeRange file -> handleError recorder $ do + define (cmapWithPrio LogShake recorder) $ \GetCodeRange nuri -> handleError recorder $ do -- We need both 'HieAST' (for basic AST) and api annotations (for comments and some keywords). -- See https://gitlab.haskell.org/ghc/ghc/-/wikis/api-annotations - HAR{hieAst, refMap} <- lift $ use_ GetHieAst file + HAR{hieAst, refMap} <- lift $ use_ GetHieAst nuri ast <- maybeToExceptT LogNoAST . MaybeT . pure $ - getAsts hieAst Map.!? (coerce . mkFastString . T.unpack . getUri . fromNormalizedUri) file + getAsts hieAst Map.!? (coerce . mkFastString . T.unpack . getUri . fromNormalizedUri) nuri let (codeRange, warnings) = runWriter (buildCodeRange ast refMap) traverse_ (logWith recorder Warning) warnings diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs index dbcc785bac..cd3a96fd02 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs @@ -152,7 +152,7 @@ mkRangeCommands recorder st plId textDocument = in perf "evalMkRangeCommands" $ do let TextDocumentIdentifier uri = textDocument - fp <- uriToFilePathE uri + let fp = T.unpack $ getUri uri let nuri = toNormalizedUri uri isLHS = isLiterate fp dbg $ LogCodeLensFp fp @@ -207,7 +207,6 @@ runEvalCmd recorder plId st mtoken EvalParams{..} = let tests = map (\(a,_,b) -> (a,b)) $ testsBySection sections let TextDocumentIdentifier{_uri} = module_ - fp <- uriToFilePathE _uri let nuri = toNormalizedUri _uri mdlText <- moduleText st _uri @@ -230,7 +229,7 @@ runEvalCmd recorder plId st mtoken EvalParams{..} = perf "edits" $ liftIO $ evalGhcEnv final_hscEnv $ do - runTests recorder evalCfg fp tests + runTests recorder evalCfg (T.unpack $ getUri _uri) tests let workspaceEditsMap = Map.singleton _uri (addFinalReturn mdlText edits) let workspaceEdits = WorkspaceEdit (Just workspaceEditsMap) Nothing Nothing 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 7f40298b9f..88309c35d2 100644 --- a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs +++ b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs @@ -107,13 +107,11 @@ data Action = Replace -- | Required action (that can be converted to either CodeLenses or CodeActions) action :: Recorder (WithPriority Log) -> IdeState -> Uri -> ExceptT PluginError (HandlerM c) [Action] action recorder state uri = do - fp <- uriToFilePathE uri let nuri = toNormalizedUri uri - contents <- liftIO $ runAction "ModuleName.getFileContents" state $ getFileContents nuri let emptyModule = maybe True (T.null . T.strip . Rope.toText) contents - correctNames <- mapExceptT liftIO $ pathModuleNames recorder state nuri fp + correctNames <- mapExceptT liftIO $ pathModuleNames recorder state nuri logWith recorder Debug (CorrectNames correctNames) let bestName = minimumBy (comparing T.length) <$> NE.nonEmpty correctNames logWith recorder Debug (BestName bestName) @@ -133,10 +131,10 @@ action recorder state uri = do -- | Possible module names, as derived by the position of the module in the -- source directories. There may be more than one possible name, if the source -- directories are nested inside each other. -pathModuleNames :: Recorder (WithPriority Log) -> IdeState -> NormalizedUri -> FilePath -> ExceptT PluginError IO [T.Text] -pathModuleNames recorder state nuri filePath - | firstLetter isLower $ takeFileName filePath = return ["Main"] - | otherwise = do +pathModuleNames :: Recorder (WithPriority Log) -> IdeState -> NormalizedUri -> ExceptT PluginError IO [T.Text] +pathModuleNames recorder state nuri + | Just filePath <- uriToFilePath $ fromNormalizedUri nuri + , firstLetter isUpper $ takeFileName filePath = do (session, _) <- runActionE "ModuleName.ghcSession" state $ useWithStaleE GhcSession nuri srcPaths <- liftIO $ evalGhcEnv (hscEnv session) $ importPaths <$> getSessionDynFlags logWith recorder Debug (SrcPaths srcPaths) @@ -155,6 +153,7 @@ pathModuleNames recorder state nuri filePath let suffixes = mapMaybe (`stripPrefix` mdlPath) paths pure (map moduleNameFrom suffixes) + | otherwise = pure [T.pack "Main"] where firstLetter :: (Char -> Bool) -> FilePath -> Bool firstLetter _ [] = False diff --git a/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs b/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs index 33d766d6dd..6e09bb4640 100644 --- a/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs +++ b/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs @@ -108,7 +108,7 @@ rules recorder plId = do define (cmapWithPrio LogShake recorder) $ \GetStanDiagnostics nuri -> do case LSP.uriToNormalizedFilePath nuri of - Nothing -> pure ([ideErrorText nuri $ "Uri is no a file Uri: " <> getUri (fromNormalizedUri nuri)], Nothing) + Nothing -> pure ([], Nothing) Just nfp -> do config <- getPluginConfigAction plId if plcGlobalOn config && plcDiagnosticsOn config then do From 1b5b772a881045fa8a3d8fa58e7be9e9e4c7291c Mon Sep 17 00:00:00 2001 From: mangoiv Date: Wed, 16 Jul 2025 14:47:43 +0200 Subject: [PATCH 5/5] [fix] fix another unnecessary short cut if an uri is not a file --- ghcide/src/Development/IDE/Plugin/Completions.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 4b5ce34fe1..96985efcbc 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -163,9 +163,9 @@ getCompletionsLSP ide plId ,_context=completionContext} = ExceptT $ do contentsMaybe <- liftIO $ runAction "Completion" ide $ getUriContents $ toNormalizedUri uri - fmap Right $ case (contentsMaybe, uriToFilePath' uri) of - (Just cnts, Just path) -> do - let nuri = filePathToUri' $ toNormalizedFilePath' path + fmap Right $ case contentsMaybe of + Just cnts -> do + let nuri = toNormalizedUri uri (ideOpts, compls, moduleExports, astres) <- liftIO $ runIdeAction "Completion" (shakeExtras ide) $ do opts <- liftIO $ getIdeOptionsIO $ shakeExtras ide localCompls <- useWithStaleFast LocalCompletions nuri @@ -209,7 +209,7 @@ getCompletionsLSP ide plId let allCompletions = getCompletions plugins ideOpts cci' parsedMod astres bindMap pfix clientCaps config moduleExports uri pure $ InL (orderedCompletions allCompletions) _ -> return (InL []) - _ -> return (InL []) + Nothing -> return (InL []) getCompletionsConfig :: PluginId -> Action CompletionsConfig getCompletionsConfig pId =