diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 78bfb798af..52ee6072f1 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -137,7 +137,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 @@ -198,7 +198,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) @@ -475,13 +475,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 @@ -565,7 +565,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" @@ -586,8 +586,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 @@ -886,7 +886,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 @@ -1238,4 +1238,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 872e957364..cf8abf333a 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) @@ -406,10 +407,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 40ce1dda7b..499d81069d 100644 --- a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs +++ b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs @@ -81,6 +81,7 @@ import Language.LSP.Protocol.Types (ApplyWorkspaceEditParams TextDocumentIdentifier (TextDocumentIdentifier), TextEdit (TextEdit), WorkspaceEdit (WorkspaceEdit), + toNormalizedUri, type (|?) (..)) import Text.Regex.TDFA ((=~)) @@ -117,7 +118,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 @@ -130,7 +131,7 @@ codeLensProvider ideState pId CodeLensParams{_textDocument = TextDocumentIdentif [ CodeLens _range Nothing (Just $ toJSON TypeLensesResolve) | diag <- diags , let lspDiag@Diagnostic {_range} = fdLspDiagnostic diag - , fdFilePath diag == nfp + , fdUri diag == nuri , isGlobalDiagnostic lspDiag] -- The second option is to generate lenses from the GlobalBindingTypeSig -- rule. This is the only type that needs to have the range adjusted @@ -151,7 +152,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 = @@ -169,10 +170,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 a577cae32e..f335fd56d1 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 851625a8fc..0317007869 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 @@ -146,11 +146,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, @@ -164,7 +164,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. @@ -236,7 +236,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'. @@ -272,9 +272,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 d756795e78..25ed181043 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -1111,6 +1111,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..efe220f69c 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -1184,7 +1184,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-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 df776e6d15..8140084603 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 @@ -21,8 +21,7 @@ import Development.IDE.Core.Service (IdeState) import Development.IDE.GHC.Compat import Development.IDE.GHC.Util (printOutputable) import Generics.SYB (extQ, something) -import Ide.Plugin.Error (PluginError, - getNormalizedFilePathE) +import Ide.Plugin.Error (PluginError) import Ide.Types (PluginDescriptor (..), PluginId (PluginId), PluginMethodHandler, @@ -38,12 +37,12 @@ descriptor plId = (defaultPluginDescriptor plId "Provides a code action to chang codeActionHandler :: PluginId -> PluginMethodHandler IdeState 'Method_TextDocumentCodeAction codeActionHandler plId ideState _ CodeActionParams {_textDocument = TextDocumentIdentifier uri, _context = CodeActionContext diags _ _} = do - nfp <- getNormalizedFilePathE uri - decls <- getDecls plId ideState nfp + let nuri = toNormalizedUri uri + decls <- getDecls plId ideState nuri let actions = mapMaybe (generateAction plId uri decls) diags pure $ InL 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-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 1c40ea76b3..e515c18352 100644 --- a/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs +++ b/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs @@ -31,7 +31,7 @@ import Text.Regex.TDFA (Regex, caseSensitive, data Log = LogShake Shake.Log - | LogNotesFound NormalizedFilePath [(Text, Position)] + | LogNotesFound NormalizedUri [(Text, Position)] deriving Show data GetNotesInFile = MkGetNotesInFile @@ -42,7 +42,7 @@ type instance RuleResult GetNotesInFile = HM.HashMap Text Position data GetNotes = MkGetNotes deriving (Show, Generic, Eq, Ord) deriving anyclass (Hashable, NFData) -type instance RuleResult GetNotes = HashMap Text (NormalizedFilePath, Position) +type instance RuleResult GetNotes = HashMap Text (NormalizedUri, Position) instance Pretty Log where pretty = \case @@ -73,23 +73,21 @@ findNotesRules recorder = do pure $ Just $ HM.unions definedNotes jumpToNote :: PluginMethodHandler IdeState Method_TextDocumentDefinition -jumpToNote state _ param - | Just nfp <- uriToNormalizedFilePath uriOrig - = do +jumpToNote state _ param = do let Position l c = param ^. L.position contents <- err "Error getting file contents" - =<< liftIO (runAction "notes.getfileContents" state (getFileContents nfp)) + =<< liftIO (runAction "notes.getfileContents" state (getFileContents uriOrig)) line <- err "Line not found in file" (listToMaybe $ Rope.lines $ fst (Rope.splitAtLine 1 $ snd $ Rope.splitAtLine (fromIntegral l) contents)) let noteOpt = listToMaybe $ mapMaybe (atPos $ fromIntegral c) $ matchAllText noteRefRegex line 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) @@ -101,19 +99,20 @@ jumpToNote state _ param -- the title of the note as extracted by the regex. (_, (c', len)) -> if c' <= c && c <= c' + len then Just (fst (arr A.! 1)) else Nothing -jumpToNote _ _ _ = throwError $ PluginInternalError "conversion to normalized file path failed" -findNotesInFile :: NormalizedFilePath -> Recorder (WithPriority Log) -> Action (Maybe (HM.HashMap Text Position)) -findNotesInFile file recorder = do +findNotesInFile :: NormalizedUri -> Recorder (WithPriority Log) -> Action (Maybe (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 matches = (A.! 1) <$> matchAllText noteRegex content - m = toPositions matches content - logWith recorder Debug $ LogNotesFound file (HM.toList m) + 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 matches = (A.! 1) <$> foldMap (matchAllText noteRegex) mcontent + m = foldMap (toPositions matches) mcontent + logWith recorder Debug $ LogNotesFound nuri (HM.toList m) pure $ Just m 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 53ee5200c0..c369a4cc9e 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 @@ -54,8 +54,8 @@ type GhcideCodeAction = ExceptT PluginError (ReaderT CodeActionArgs IO) GhcideCo runGhcideCodeAction :: IdeState -> MessageParams Method_TextDocumentCodeAction -> GhcideCodeAction -> HandlerM Config GhcideCodeActionResult runGhcideCodeAction state (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext {_diagnostics = diags}) codeAction = do - let mbFile = toNormalizedFilePath' <$> uriToFilePath uri - runRule key = runAction ("GhcideCodeActions." <> show key) state $ runMaybeT $ MaybeT (pure mbFile) >>= MaybeT . use key + let nuri = toNormalizedUri uri + runRule key = runAction ("GhcideCodeActions." <> show key) state $ use key nuri caaGhcSession <- onceIO $ runRule GhcSession caaExportsMap <- onceIO $ diff --git a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs index 7cc1122982..41eefda622 100644 --- a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs +++ b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs @@ -66,8 +66,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" @@ -80,16 +80,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 @@ -99,11 +99,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 @@ -118,7 +118,7 @@ renameProvider state pluginId (RenameParams _prog (TextDocumentIdentifier uri) p -- | Limit renaming across modules. failWhenImportOrExport :: IdeState -> - NormalizedFilePath -> + NormalizedUri -> HashSet Location -> [Name] -> ExceptT PluginError (HandlerM config) () @@ -145,9 +145,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) @@ -187,12 +187,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 -> @@ -202,7 +202,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 @@ -214,7 +214,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 @@ -222,13 +222,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 -- | We don't want to rename in code generated by GHC as this gives false positives. -- So we restrict the HIE file to remove all the generated code. @@ -257,8 +257,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.