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: 1.0.0.0 +version: 1.0.0.1 synopsis: Rename plugin for Haskell Language Server description: Please see the README on GitHub at @@ -25,10 +25,9 @@ , extra , ghc , ghc-exactprint - , ghcide >=1.4 && <1.5 + , ghcide ^>=1.6 , hiedb - , hls-plugin-api ^>=1.2 - , hls-retrie-plugin >=1.0.1.1 + , hls-plugin-api ^>=1.3 , lsp , lsp-types , syb @@ -47,4 +46,4 @@ , base , filepath , hls-rename-plugin - , hls-test-utils >=1.0 && <1.2 + , hls-test-utils ^>=1.2 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 @@ -1,7 +1,10 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} module Ide.Plugin.Rename (descriptor) where @@ -11,7 +14,7 @@ import Control.Monad.Trans.Except import Data.Containers.ListUtils import Data.Generics -import Data.List.Extra hiding (nubOrd) +import Data.List.Extra hiding (nubOrd, replace) import qualified Data.Map as M import Data.Maybe import qualified Data.Text as T @@ -20,14 +23,18 @@ import Development.IDE.Core.Shake import Development.IDE.GHC.Compat import Development.IDE.Spans.AtPoint +#if MIN_VERSION_ghc(9,2,1) +import GHC.Parser.Annotation (AnnContext, AnnList, + AnnParen, AnnPragma) +#endif #if MIN_VERSION_ghc(9,0,1) import GHC.Types.Name #else import Name #endif +import Development.IDE.GHC.ExactPrint (GetAnnotatedParsedSource (GetAnnotatedParsedSource)) import HieDb.Query import Ide.Plugin.Config -import Ide.Plugin.Retrie hiding (descriptor) import Ide.PluginUtils import Ide.Types import Language.Haskell.GHC.ExactPrint @@ -47,9 +54,8 @@ workspaceRefs <- refsAtName state nfp oldName let filesRefs = groupOn locToUri workspaceRefs getFileEdits = ap (getSrcEdits state . renameModRefs newNameText) (locToUri . head) - fileEdits <- mapM getFileEdits filesRefs - pure $ foldl1 (<>) fileEdits + pure $ foldl' (<>) mempty fileEdits ------------------------------------------------------------------------------- -- Source renaming @@ -68,15 +74,19 @@ getSrcEdits state updateMod uri = do ccs <- lift getClientCapabilities nfp <- safeUriToNfp uri - ParsedModule{pm_parsed_source = ps, pm_annotations = apiAnns} <- + annotatedAst <- handleMaybeM "Error: could not get parsed source" $ liftIO $ runAction "Rename.GetParsedModuleWithComments" state - (use GetParsedModuleWithComments nfp) - - let anns = relativiseApiAnns ps apiAnns - src = T.pack $ exactPrint ps anns + (use GetAnnotatedParsedSource nfp) + let (ps, anns) = (astA annotatedAst, annsA annotatedAst) +#if !MIN_VERSION_ghc(9,2,1) + let src = T.pack $ exactPrint ps anns res = T.pack $ exactPrint (updateMod <$> ps) anns +#else + let src = T.pack $ exactPrint ps + res = T.pack $ exactPrint (updateMod <$> ps) +#endif pure $ diffText ccs (uri, src) res IncludeDeletions @@ -91,42 +101,60 @@ HsModule GhcPs -> HsModule GhcPs #endif +#if MIN_VERSION_ghc(9,2,1) +renameModRefs newNameText refs = everywhere $ + -- there has to be a better way... + mkT (replace @AnnListItem) `extT` + -- replace @AnnList `extT` -- not needed + -- replace @AnnParen `extT` -- not needed + -- replace @AnnPragma `extT` -- not needed + -- replace @AnnContext `extT` -- not needed + -- replace @NoEpAnns `extT` -- not needed + replace @NameAnn + where + replace :: forall an. Typeable an => LocatedAn an RdrName -> LocatedAn an RdrName + replace (L srcSpan oldRdrName) + | isRef (locA srcSpan) = L srcSpan $ newRdrName oldRdrName + replace lOldRdrName = lOldRdrName +#else renameModRefs newNameText refs = everywhere $ mkT replace where replace :: Located RdrName -> Located RdrName replace (L srcSpan oldRdrName) | isRef srcSpan = L srcSpan $ newRdrName oldRdrName replace lOldRdrName = lOldRdrName +#endif + isRef :: SrcSpan -> Bool + isRef = (`elem` refs) . fromJust . srcSpanToLocation + newRdrName :: RdrName -> RdrName newRdrName oldRdrName = case oldRdrName of Qual modName _ -> Qual modName newOccName _ -> Unqual newOccName newOccName = mkTcOcc $ T.unpack newNameText - - isRef :: SrcSpan -> Bool - isRef = (`elem` refs) . fromJust . srcSpanToLocation - ------------------------------------------------------------------------------- -- Reference finding -- | Note: We only find exact name occurences (i.e. type reference "depth" is 0). refsAtName :: IdeState -> NormalizedFilePath -> Name -> ExceptT [Char] (LspT Config IO) [Location] refsAtName state nfp name = do - ShakeExtras{hiedb} <- liftIO $ runAction "Rename.HieDb" state getShakeExtras + ShakeExtras{withHieDb} <- liftIO $ runAction "Rename.HieDb" state getShakeExtras ast <- safeGetHieAst state nfp astRefs <- handleMaybe "Error: Could not get name AST references" $ getNameAstLocations name ast dbRefs <- case nameModule_maybe name of Nothing -> pure [] Just mod -> liftIO $ mapMaybe rowToLoc <$> - findReferences - hiedb - True - (nameOccName name) - (Just $ moduleName mod) - (Just $ moduleUnitId mod) - [fromNormalizedFilePath nfp] + withHieDb (\hieDb -> + findReferences + hieDb + True + (nameOccName name) + (Just $ moduleName mod) + (Just $ moduleUnit mod) + [fromNormalizedFilePath nfp] + ) pure $ nubOrd $ astRefs ++ dbRefs getNameAstLocations :: Name -> (HieAstResult, PositionMapping) -> Maybe [Location]