diff --git a/hls-rename-plugin.cabal b/hls-rename-plugin.cabal --- a/hls-rename-plugin.cabal +++ b/hls-rename-plugin.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: hls-rename-plugin -version: 2.0.0.1 +version: 2.1.0.0 synopsis: Rename plugin for Haskell Language Server description: Please see the README on GitHub at @@ -29,14 +29,16 @@ , extra , ghc , ghc-exactprint - , ghcide == 2.0.0.1 + , ghcide == 2.1.0.0 , hashable , hiedb , hie-compat - , hls-plugin-api == 2.0.0.1 + , hls-plugin-api == 2.1.0.0 , hls-refactor-plugin + , lens , lsp , lsp-types + , mtl , mod , syb , text @@ -58,4 +60,4 @@ , filepath , hls-plugin-api , hls-rename-plugin - , hls-test-utils == 2.0.0.1 + , hls-test-utils == 2.1.0.0 diff --git a/src/Ide/Plugin/Rename.hs b/src/Ide/Plugin/Rename.hs --- a/src/Ide/Plugin/Rename.hs +++ b/src/Ide/Plugin/Rename.hs @@ -6,9 +6,9 @@ {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -{-# LANGUAGE RecordWildCards #-} module Ide.Plugin.Rename (descriptor, E.Log) where @@ -17,23 +17,27 @@ AnnParen, AnnPragma) #endif +import Compat.HieTypes +import Control.Lens ((^.)) import Control.Monad +import Control.Monad.Except import Control.Monad.IO.Class import Control.Monad.Trans.Class import Control.Monad.Trans.Except -import Data.Generics import Data.Bifunctor (first) +import Data.Generics import Data.Hashable import Data.HashSet (HashSet) import qualified Data.HashSet as HS import Data.List.Extra hiding (length) import qualified Data.Map as M -import qualified Data.Set as S import Data.Maybe import Data.Mod.Word +import qualified Data.Set as S import qualified Data.Text as T import Development.IDE (Recorder, WithPriority, usePropertyAction) +import Development.IDE.Core.PluginUtils import Development.IDE.Core.PositionMapping import Development.IDE.Core.RuleTypes import Development.IDE.Core.Service @@ -49,26 +53,27 @@ import Development.IDE.Spans.AtPoint import Development.IDE.Types.Location import HieDb.Query +import Ide.Plugin.Error import Ide.Plugin.Properties import Ide.PluginUtils import Ide.Types +import qualified Language.LSP.Protocol.Lens as L +import Language.LSP.Protocol.Message +import Language.LSP.Protocol.Types import Language.LSP.Server -import Language.LSP.Types -import Compat.HieTypes instance Hashable (Mod a) where hash n = hash (unMod n) descriptor :: Recorder (WithPriority E.Log) -> PluginId -> PluginDescriptor IdeState descriptor recorder pluginId = mkExactprintPluginDescriptor recorder $ (defaultPluginDescriptor pluginId) - { pluginHandlers = mkPluginHandler STextDocumentRename renameProvider + { pluginHandlers = mkPluginHandler SMethod_TextDocumentRename renameProvider , pluginConfigDescriptor = defaultConfigDescriptor { configCustomConfig = mkCustomConfig properties } } -renameProvider :: PluginMethodHandler IdeState TextDocumentRename -renameProvider state pluginId (RenameParams (TextDocumentIdentifier uri) pos _prog newNameText) = - pluginResponse $ do - nfp <- handleUriToNfp uri +renameProvider :: PluginMethodHandler IdeState Method_TextDocumentRename +renameProvider state pluginId (RenameParams _prog docId@(TextDocumentIdentifier uri) pos newNameText) = do + nfp <- getNormalizedFilePathE uri directOldNames <- getNamesAtPos state nfp pos directRefs <- concat <$> mapM (refsAtName state nfp) directOldNames @@ -78,7 +83,7 @@ See the `IndirectPuns` test for an example. -} indirectOldNames <- concat . filter ((>1) . Prelude.length) <$> mapM (uncurry (getNamesAtPos state) . locToFilePos) directRefs - let oldNames = (filter matchesDirect indirectOldNames) ++ directOldNames + let oldNames = filter matchesDirect indirectOldNames ++ directOldNames matchesDirect n = occNameFS (nameOccName n) `elem` directFS where directFS = map (occNameFS. nameOccName) directOldNames @@ -87,14 +92,16 @@ -- Validate rename crossModuleEnabled <- liftIO $ runAction "rename: config" state $ usePropertyAction #crossModule pluginId properties unless crossModuleEnabled $ failWhenImportOrExport state nfp refs oldNames - when (any isBuiltInSyntax oldNames) $ throwE "Invalid rename of built-in syntax" + when (any isBuiltInSyntax oldNames) $ throwError $ PluginInternalError "Invalid rename of built-in syntax" -- Perform rename let newName = mkTcOcc $ T.unpack newNameText filesRefs = collectWith locToUri refs - getFileEdit = flip $ getSrcEdit state . replaceRefs newName - fileEdits <- mapM (uncurry getFileEdit) filesRefs - pure $ foldl' (<>) mempty fileEdits + getFileEdit (uri, locations) = do + verTxtDocId <- lift $ getVersionedTextDoc (TextDocumentIdentifier uri) + getSrcEdit state verTxtDocId (replaceRefs newName locations) + fileEdits <- mapM getFileEdit filesRefs + pure $ InL $ foldl' (<>) mempty fileEdits -- | Limit renaming across modules. failWhenImportOrExport :: @@ -103,19 +110,17 @@ NormalizedFilePath -> HashSet Location -> [Name] -> - ExceptT String m () + ExceptT PluginError m () failWhenImportOrExport state nfp refLocs names = do - pm <- handleMaybeM ("No parsed module for: " ++ show nfp) $ liftIO $ runAction - "Rename.GetParsedModule" - state - (use GetParsedModule nfp) + pm <- runActionE "Rename.GetParsedModule" state + (useE GetParsedModule nfp) let hsMod = unLoc $ pm_parsed_source pm case (unLoc <$> hsmodName hsMod, hsmodExports hsMod) of (mbModName, _) | not $ any (\n -> nameIsLocalOrFrom (replaceModName n mbModName) n) names - -> throwE "Renaming of an imported name is unsupported" + -> throwError $ PluginInternalError "Renaming of an imported name is unsupported" (_, Just (L _ exports)) | any ((`HS.member` refLocs) . unsafeSrcSpanToLoc . getLoc) exports - -> throwE "Renaming of an exported name is unsupported" - (Just _, Nothing) -> throwE "Explicit export list required for renaming" + -> throwError $ PluginInternalError "Renaming of an exported name is unsupported" + (Just _, Nothing) -> throwError $ PluginInternalError "Explicit export list required for renaming" _ -> pure () --------------------------------------------------------------------------------------------------- @@ -125,16 +130,14 @@ getSrcEdit :: (MonadLsp config m) => IdeState -> + VersionedTextDocumentIdentifier -> (ParsedSource -> ParsedSource) -> - Uri -> - ExceptT String m WorkspaceEdit -getSrcEdit state updatePs uri = do + ExceptT PluginError m WorkspaceEdit +getSrcEdit state verTxtDocId updatePs = do ccs <- lift getClientCapabilities - nfp <- handleUriToNfp uri - annAst <- handleMaybeM ("No parsed source for: " ++ show nfp) $ liftIO $ runAction - "Rename.GetAnnotatedParsedSource" - state - (use GetAnnotatedParsedSource nfp) + nfp <- getNormalizedFilePathE (verTxtDocId ^. L.uri) + annAst <- runActionE "Rename.GetAnnotatedParsedSource" state + (useE GetAnnotatedParsedSource nfp) let (ps, anns) = (astA annAst, annsA annAst) #if !MIN_VERSION_ghc(9,2,1) let src = T.pack $ exactPrint ps anns @@ -143,7 +146,7 @@ let src = T.pack $ exactPrint ps res = T.pack $ exactPrint (updatePs ps) #endif - pure $ diffText ccs (uri, src) res IncludeDeletions + pure $ diffText ccs (verTxtDocId, src) res IncludeDeletions -- | Replace names at every given `Location` (in a given `ParsedSource`) with a given new name. replaceRefs :: @@ -190,7 +193,7 @@ IdeState -> NormalizedFilePath -> Name -> - ExceptT String m [Location] + ExceptT PluginError m [Location] refsAtName state nfp name = do ShakeExtras{withHieDb} <- liftIO $ runAction "Rename.HieDb" state getShakeExtras ast <- handleGetHieAst state nfp @@ -215,7 +218,7 @@ --------------------------------------------------------------------------------------------------- -- Util -getNamesAtPos :: MonadIO m => IdeState -> NormalizedFilePath -> Position -> ExceptT String m [Name] +getNamesAtPos :: MonadIO m => IdeState -> NormalizedFilePath -> Position -> ExceptT PluginError m [Name] getNamesAtPos state nfp pos = do (HAR{hieAst}, pm) <- handleGetHieAst state nfp pure $ getNamesAtPoint hieAst pos pm @@ -224,10 +227,9 @@ MonadIO m => IdeState -> NormalizedFilePath -> - ExceptT String m (HieAstResult, PositionMapping) -handleGetHieAst state nfp = handleMaybeM - ("No AST for file: " ++ show nfp) - (liftIO $ fmap (fmap (first removeGenerated)) $ runAction "Rename.GetHieAst" state $ useWithStale GetHieAst nfp) + ExceptT PluginError m (HieAstResult, PositionMapping) +handleGetHieAst state nfp = + fmap (first removeGenerated) $ runActionE "Rename.GetHieAst" state $ useWithStaleE GetHieAst nfp -- | 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. @@ -242,11 +244,6 @@ #else hf #endif - -handleUriToNfp :: (Monad m) => Uri -> ExceptT String m NormalizedFilePath -handleUriToNfp uri = handleMaybe - ("No filepath for uri: " ++ show uri) - (toNormalizedFilePath <$> uriToFilePath uri) -- head is safe since groups are non-empty collectWith :: (Hashable a, Eq a, Eq b) => (a -> b) -> HashSet a -> [(b, HashSet a)]