{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Ide.Plugin.Rename (descriptor, E.Log) where
#if MIN_VERSION_ghc(9,2,1)
import GHC.Parser.Annotation (AnnContext, AnnList,
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.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 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
import Development.IDE.Core.Shake
import Development.IDE.GHC.Compat.Core
import Development.IDE.GHC.Compat.ExactPrint
import Development.IDE.GHC.Compat.Parser
import Development.IDE.GHC.Compat.Units
import Development.IDE.GHC.Error
import Development.IDE.GHC.ExactPrint
import qualified Development.IDE.GHC.ExactPrint as E
import Development.IDE.Plugin.CodeAction
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
instance Hashable (Mod a) where hash :: Mod a -> Int
hash Mod a
n = forall a. Hashable a => a -> Int
hash (forall (m :: Nat). Mod m -> Word
unMod Mod a
n)
descriptor :: Recorder (WithPriority E.Log) -> PluginId -> PluginDescriptor IdeState
descriptor :: Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
descriptor Recorder (WithPriority Log)
recorder PluginId
pluginId = forall a.
Recorder (WithPriority Log)
-> PluginDescriptor a -> PluginDescriptor a
mkExactprintPluginDescriptor Recorder (WithPriority Log)
recorder forall a b. (a -> b) -> a -> b
$ (forall ideState. PluginId -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
pluginId)
{ pluginHandlers :: PluginHandlers IdeState
pluginHandlers = forall ideState (m :: Method 'ClientToServer 'Request).
PluginRequestMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SMethod 'Method_TextDocumentRename
SMethod_TextDocumentRename PluginMethodHandler IdeState 'Method_TextDocumentRename
renameProvider
, pluginConfigDescriptor :: ConfigDescriptor
pluginConfigDescriptor = ConfigDescriptor
defaultConfigDescriptor
{ configCustomConfig :: CustomConfig
configCustomConfig = forall (r :: [PropertyKey]). Properties r -> CustomConfig
mkCustomConfig Properties '[ 'PropertyKey "crossModule" 'TBoolean]
properties }
}
renameProvider :: PluginMethodHandler IdeState Method_TextDocumentRename
renameProvider :: PluginMethodHandler IdeState 'Method_TextDocumentRename
renameProvider IdeState
state PluginId
pluginId (RenameParams Maybe ProgressToken
_prog docId :: TextDocumentIdentifier
docId@(TextDocumentIdentifier Uri
uri) Position
pos Text
newNameText) = do
NormalizedFilePath
nfp <- forall (m :: * -> *).
Monad m =>
Uri -> ExceptT PluginError m NormalizedFilePath
getNormalizedFilePathE Uri
uri
[Name]
directOldNames <- forall (m :: * -> *).
MonadIO m =>
IdeState
-> NormalizedFilePath -> Position -> ExceptT PluginError m [Name]
getNamesAtPos IdeState
state NormalizedFilePath
nfp Position
pos
[Location]
directRefs <- forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
MonadIO m =>
IdeState
-> NormalizedFilePath -> Name -> ExceptT PluginError m [Location]
refsAtName IdeState
state NormalizedFilePath
nfp) [Name]
directOldNames
[Name]
indirectOldNames <- forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> a -> Bool
>Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall (m :: * -> *).
MonadIO m =>
IdeState
-> NormalizedFilePath -> Position -> ExceptT PluginError m [Name]
getNamesAtPos IdeState
state) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Location -> (NormalizedFilePath, Position)
locToFilePos) [Location]
directRefs
let oldNames :: [Name]
oldNames = forall a. (a -> Bool) -> [a] -> [a]
filter Name -> Bool
matchesDirect [Name]
indirectOldNames forall a. [a] -> [a] -> [a]
++ [Name]
directOldNames
matchesDirect :: Name -> Bool
matchesDirect Name
n = OccName -> FastString
occNameFS (Name -> OccName
nameOccName Name
n) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FastString]
directFS
where
directFS :: [FastString]
directFS = forall a b. (a -> b) -> [a] -> [b]
map (OccName -> FastString
occNameFSforall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> OccName
nameOccName) [Name]
directOldNames
HashSet Location
refs <- forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
MonadIO m =>
IdeState
-> NormalizedFilePath -> Name -> ExceptT PluginError m [Location]
refsAtName IdeState
state NormalizedFilePath
nfp) [Name]
oldNames
Bool
crossModuleEnabled <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. String -> IdeState -> Action a -> IO a
runAction String
"rename: config" IdeState
state forall a b. (a -> b) -> a -> b
$ forall (s :: Symbol) (k :: PropertyKey) (t :: PropertyType)
(r :: [PropertyKey]).
HasProperty s k t r =>
KeyNameProxy s -> PluginId -> Properties r -> Action (ToHsType t)
usePropertyAction forall a. IsLabel "crossModule" a => a
#crossModule PluginId
pluginId Properties '[ 'PropertyKey "crossModule" 'TBoolean]
properties
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
crossModuleEnabled forall a b. (a -> b) -> a -> b
$ forall config (m :: * -> *).
MonadLsp config m =>
IdeState
-> NormalizedFilePath
-> HashSet Location
-> [Name]
-> ExceptT PluginError m ()
failWhenImportOrExport IdeState
state NormalizedFilePath
nfp HashSet Location
refs [Name]
oldNames
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Name -> Bool
isBuiltInSyntax [Name]
oldNames) forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> PluginError
PluginInternalError Text
"Invalid rename of built-in syntax"
let newName :: OccName
newName = String -> OccName
mkTcOcc forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
newNameText
filesRefs :: [(Uri, HashSet Location)]
filesRefs = forall a b.
(Hashable a, Eq a, Eq b) =>
(a -> b) -> HashSet a -> [(b, HashSet a)]
collectWith Location -> Uri
locToUri HashSet Location
refs
getFileEdit :: (Uri, HashSet Location)
-> ExceptT PluginError (LspM Config) WorkspaceEdit
getFileEdit (Uri
uri, HashSet Location
locations) = do
VersionedTextDocumentIdentifier
verTxtDocId <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall config (m :: * -> *).
MonadLsp config m =>
TextDocumentIdentifier -> m VersionedTextDocumentIdentifier
getVersionedTextDoc (Uri -> TextDocumentIdentifier
TextDocumentIdentifier Uri
uri)
forall config (m :: * -> *).
MonadLsp config m =>
IdeState
-> VersionedTextDocumentIdentifier
-> (ParsedSource -> ParsedSource)
-> ExceptT PluginError m WorkspaceEdit
getSrcEdit IdeState
state VersionedTextDocumentIdentifier
verTxtDocId (OccName -> HashSet Location -> ParsedSource -> ParsedSource
replaceRefs OccName
newName HashSet Location
locations)
[WorkspaceEdit]
fileEdits <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Uri, HashSet Location)
-> ExceptT PluginError (LspM Config) WorkspaceEdit
getFileEdit [(Uri, HashSet Location)]
filesRefs
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> a |? b
InL forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Semigroup a => a -> a -> a
(<>) forall a. Monoid a => a
mempty [WorkspaceEdit]
fileEdits
failWhenImportOrExport ::
(MonadLsp config m) =>
IdeState ->
NormalizedFilePath ->
HashSet Location ->
[Name] ->
ExceptT PluginError m ()
failWhenImportOrExport :: forall config (m :: * -> *).
MonadLsp config m =>
IdeState
-> NormalizedFilePath
-> HashSet Location
-> [Name]
-> ExceptT PluginError m ()
failWhenImportOrExport IdeState
state NormalizedFilePath
nfp HashSet Location
refLocs [Name]
names = do
ParsedModule
pm <- forall (m :: * -> *) e a.
MonadIO m =>
String -> IdeState -> ExceptT e Action a -> ExceptT e m a
runActionE String
"Rename.GetParsedModule" IdeState
state
(forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> ExceptT PluginError Action v
useE GetParsedModule
GetParsedModule NormalizedFilePath
nfp)
let hsMod :: HsModule
hsMod = forall l e. GenLocated l e -> e
unLoc forall a b. (a -> b) -> a -> b
$ ParsedModule -> ParsedSource
pm_parsed_source ParsedModule
pm
case (forall l e. GenLocated l e -> e
unLoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsModule -> Maybe (LocatedA ModuleName)
hsmodName HsModule
hsMod, HsModule -> Maybe (LocatedL [LIE GhcPs])
hsmodExports HsModule
hsMod) of
(Maybe ModuleName
mbModName, Maybe (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
_) | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Name
n -> Module -> Name -> Bool
nameIsLocalOrFrom (Name -> Maybe ModuleName -> Module
replaceModName Name
n Maybe ModuleName
mbModName) Name
n) [Name]
names
-> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> PluginError
PluginInternalError Text
"Renaming of an imported name is unsupported"
(Maybe ModuleName
_, Just (L SrcSpanAnnL
_ [GenLocated SrcSpanAnnA (IE GhcPs)]
exports)) | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HS.member` HashSet Location
refLocs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> Location
unsafeSrcSpanToLoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasSrcSpan a => a -> SrcSpan
getLoc) [GenLocated SrcSpanAnnA (IE GhcPs)]
exports
-> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> PluginError
PluginInternalError Text
"Renaming of an exported name is unsupported"
(Just ModuleName
_, Maybe (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
Nothing) -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> PluginError
PluginInternalError Text
"Explicit export list required for renaming"
(Maybe ModuleName,
Maybe (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]))
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
getSrcEdit ::
(MonadLsp config m) =>
IdeState ->
VersionedTextDocumentIdentifier ->
(ParsedSource -> ParsedSource) ->
ExceptT PluginError m WorkspaceEdit
getSrcEdit :: forall config (m :: * -> *).
MonadLsp config m =>
IdeState
-> VersionedTextDocumentIdentifier
-> (ParsedSource -> ParsedSource)
-> ExceptT PluginError m WorkspaceEdit
getSrcEdit IdeState
state VersionedTextDocumentIdentifier
verTxtDocId ParsedSource -> ParsedSource
updatePs = do
ClientCapabilities
ccs <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall config (m :: * -> *).
MonadLsp config m =>
m ClientCapabilities
getClientCapabilities
NormalizedFilePath
nfp <- forall (m :: * -> *).
Monad m =>
Uri -> ExceptT PluginError m NormalizedFilePath
getNormalizedFilePathE (VersionedTextDocumentIdentifier
verTxtDocId forall s a. s -> Getting a s a -> a
^. forall s a. HasUri s a => Lens' s a
L.uri)
Annotated ParsedSource
annAst <- forall (m :: * -> *) e a.
MonadIO m =>
String -> IdeState -> ExceptT e Action a -> ExceptT e m a
runActionE String
"Rename.GetAnnotatedParsedSource" IdeState
state
(forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> ExceptT PluginError Action v
useE GetAnnotatedParsedSource
GetAnnotatedParsedSource NormalizedFilePath
nfp)
let (ParsedSource
ps, ()
anns) = (forall ast. Annotated ast -> ast
astA Annotated ParsedSource
annAst, forall ast. Annotated ast -> ()
annsA Annotated ParsedSource
annAst)
#if !MIN_VERSION_ghc(9,2,1)
let src = T.pack $ exactPrint ps anns
res = T.pack $ exactPrint (updatePs ps) anns
#else
let src :: Text
src = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall ast. ExactPrint ast => ast -> String
exactPrint ParsedSource
ps
res :: Text
res = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall ast. ExactPrint ast => ast -> String
exactPrint (ParsedSource -> ParsedSource
updatePs ParsedSource
ps)
#endif
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ClientCapabilities
-> (VersionedTextDocumentIdentifier, Text)
-> Text
-> WithDeletions
-> WorkspaceEdit
diffText ClientCapabilities
ccs (VersionedTextDocumentIdentifier
verTxtDocId, Text
src) Text
res WithDeletions
IncludeDeletions
replaceRefs ::
OccName ->
HashSet Location ->
ParsedSource ->
ParsedSource
#if MIN_VERSION_ghc(9,2,1)
replaceRefs :: OccName -> HashSet Location -> ParsedSource -> ParsedSource
replaceRefs OccName
newName HashSet Location
refs = (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere forall a b. (a -> b) -> a -> b
$
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT (forall an.
Typeable an =>
LocatedAn an RdrName -> LocatedAn an RdrName
replaceLoc @AnnListItem) forall a b.
(Typeable a, Typeable b) =>
(a -> a) -> (b -> b) -> a -> a
`extT`
forall an.
Typeable an =>
LocatedAn an RdrName -> LocatedAn an RdrName
replaceLoc @NameAnn
where
replaceLoc :: forall an. Typeable an => LocatedAn an RdrName -> LocatedAn an RdrName
replaceLoc :: forall an.
Typeable an =>
LocatedAn an RdrName -> LocatedAn an RdrName
replaceLoc (L SrcAnn an
srcSpan RdrName
oldRdrName)
| SrcSpan -> Bool
isRef (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcAnn an
srcSpan) = forall l e. l -> e -> GenLocated l e
L SrcAnn an
srcSpan forall a b. (a -> b) -> a -> b
$ RdrName -> RdrName
replace RdrName
oldRdrName
replaceLoc GenLocated (SrcAnn an) RdrName
lOldRdrName = GenLocated (SrcAnn an) RdrName
lOldRdrName
#else
replaceRefs newName refs = everywhere $ mkT replaceLoc
where
replaceLoc :: Located RdrName -> Located RdrName
replaceLoc (L srcSpan oldRdrName)
| isRef srcSpan = L srcSpan $ replace oldRdrName
replaceLoc lOldRdrName = lOldRdrName
#endif
replace :: RdrName -> RdrName
replace :: RdrName -> RdrName
replace (Qual ModuleName
modName OccName
_) = ModuleName -> OccName -> RdrName
Qual ModuleName
modName OccName
newName
replace RdrName
_ = OccName -> RdrName
Unqual OccName
newName
isRef :: SrcSpan -> Bool
isRef :: SrcSpan -> Bool
isRef = (forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HS.member` HashSet Location
refs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> Location
unsafeSrcSpanToLoc
refsAtName ::
MonadIO m =>
IdeState ->
NormalizedFilePath ->
Name ->
ExceptT PluginError m [Location]
refsAtName :: forall (m :: * -> *).
MonadIO m =>
IdeState
-> NormalizedFilePath -> Name -> ExceptT PluginError m [Location]
refsAtName IdeState
state NormalizedFilePath
nfp Name
name = do
ShakeExtras{WithHieDb
$sel:withHieDb:ShakeExtras :: ShakeExtras -> WithHieDb
withHieDb :: WithHieDb
withHieDb} <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. String -> IdeState -> Action a -> IO a
runAction String
"Rename.HieDb" IdeState
state Action ShakeExtras
getShakeExtras
(HieAstResult, PositionMapping)
ast <- forall (m :: * -> *).
MonadIO m =>
IdeState
-> NormalizedFilePath
-> ExceptT PluginError m (HieAstResult, PositionMapping)
handleGetHieAst IdeState
state NormalizedFilePath
nfp
[Location]
dbRefs <- case Name -> Maybe Module
nameModule_maybe Name
name of
Maybe Module
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
Just Module
mod -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Res RefRow -> Maybe Location
rowToLoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithHieDb
withHieDb (\HieDb
hieDb ->
HieDb
-> Bool
-> OccName
-> Maybe ModuleName
-> Maybe Unit
-> [String]
-> IO [Res RefRow]
findReferences
HieDb
hieDb
Bool
True
(Name -> OccName
nameOccName Name
name)
(forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall unit. GenModule unit -> ModuleName
moduleName Module
mod)
(forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Module -> Unit
moduleUnit Module
mod)
[NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
nfp]
)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Name -> (HieAstResult, PositionMapping) -> [Location]
nameLocs Name
name (HieAstResult, PositionMapping)
ast forall a. [a] -> [a] -> [a]
++ [Location]
dbRefs
nameLocs :: Name -> (HieAstResult, PositionMapping) -> [Location]
nameLocs :: Name -> (HieAstResult, PositionMapping) -> [Location]
nameLocs Name
name (HAR Module
_ HieASTs a
_ RefMap a
rm Map Name [RealSrcSpan]
_ HieKind a
_, PositionMapping
pm) =
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (PositionMapping -> Location -> Maybe Location
toCurrentLocation PositionMapping
pm forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealSrcSpan -> Location
realSrcSpanToLocation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
(forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (forall a b. b -> Either a b
Right Name
name) RefMap a
rm)
getNamesAtPos :: MonadIO m => IdeState -> NormalizedFilePath -> Position -> ExceptT PluginError m [Name]
getNamesAtPos :: forall (m :: * -> *).
MonadIO m =>
IdeState
-> NormalizedFilePath -> Position -> ExceptT PluginError m [Name]
getNamesAtPos IdeState
state NormalizedFilePath
nfp Position
pos = do
(HAR{HieASTs a
hieAst :: ()
hieAst :: HieASTs a
hieAst}, PositionMapping
pm) <- forall (m :: * -> *).
MonadIO m =>
IdeState
-> NormalizedFilePath
-> ExceptT PluginError m (HieAstResult, PositionMapping)
handleGetHieAst IdeState
state NormalizedFilePath
nfp
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. HieASTs a -> Position -> PositionMapping -> [Name]
getNamesAtPoint HieASTs a
hieAst Position
pos PositionMapping
pm
handleGetHieAst ::
MonadIO m =>
IdeState ->
NormalizedFilePath ->
ExceptT PluginError m (HieAstResult, PositionMapping)
handleGetHieAst :: forall (m :: * -> *).
MonadIO m =>
IdeState
-> NormalizedFilePath
-> ExceptT PluginError m (HieAstResult, PositionMapping)
handleGetHieAst IdeState
state NormalizedFilePath
nfp =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first HieAstResult -> HieAstResult
removeGenerated) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a.
MonadIO m =>
String -> IdeState -> ExceptT e Action a -> ExceptT e m a
runActionE String
"Rename.GetHieAst" IdeState
state forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k
-> NormalizedFilePath
-> ExceptT PluginError Action (v, PositionMapping)
useWithStaleE GetHieAst
GetHieAst NormalizedFilePath
nfp
removeGenerated :: HieAstResult -> HieAstResult
removeGenerated :: HieAstResult -> HieAstResult
removeGenerated HAR{RefMap a
Map Name [RealSrcSpan]
HieASTs a
Module
HieKind a
hieModule :: HieAstResult -> Module
refMap :: ()
typeRefs :: HieAstResult -> Map Name [RealSrcSpan]
hieKind :: ()
hieKind :: HieKind a
typeRefs :: Map Name [RealSrcSpan]
refMap :: RefMap a
hieAst :: HieASTs a
hieModule :: Module
hieAst :: ()
..} = HAR{hieAst :: HieASTs a
hieAst = forall a. HieASTs a -> HieASTs a
go HieASTs a
hieAst,RefMap a
Map Name [RealSrcSpan]
Module
HieKind a
hieModule :: Module
refMap :: RefMap a
typeRefs :: Map Name [RealSrcSpan]
hieKind :: HieKind a
hieKind :: HieKind a
typeRefs :: Map Name [RealSrcSpan]
refMap :: RefMap a
hieModule :: Module
..}
where
go :: HieASTs a -> HieASTs a
go :: forall a. HieASTs a -> HieASTs a
go HieASTs a
hf =
#if MIN_VERSION_ghc(9,2,1)
forall a. Map HiePath (HieAST a) -> HieASTs a
HieASTs (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. HieAST a -> HieAST a
goAst (forall a. HieASTs a -> Map HiePath (HieAST a)
getAsts HieASTs a
hf))
goAst :: HieAST a -> HieAST a
goAst (Node SourcedNodeInfo a
nsi RealSrcSpan
sp [HieAST a]
xs) = forall a.
SourcedNodeInfo a -> RealSrcSpan -> [HieAST a] -> HieAST a
Node (forall a. Map NodeOrigin (NodeInfo a) -> SourcedNodeInfo a
SourcedNodeInfo forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => Map k a -> Set k -> Map k a
M.restrictKeys (forall a. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
getSourcedNodeInfo SourcedNodeInfo a
nsi) (forall a. a -> Set a
S.singleton NodeOrigin
SourceInfo)) RealSrcSpan
sp (forall a b. (a -> b) -> [a] -> [b]
map HieAST a -> HieAST a
goAst [HieAST a]
xs)
#else
hf
#endif
collectWith :: (Hashable a, Eq a, Eq b) => (a -> b) -> HashSet a -> [(b, HashSet a)]
collectWith :: forall a b.
(Hashable a, Eq a, Eq b) =>
(a -> b) -> HashSet a -> [(b, HashSet a)]
collectWith a -> b
f = forall a b. (a -> b) -> [a] -> [b]
map (\[a]
a -> (a -> b
f forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [a]
a, forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList [a]
a)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Eq k => (a -> k) -> [a] -> [[a]]
groupOn a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HashSet a -> [a]
HS.toList
locToUri :: Location -> Uri
locToUri :: Location -> Uri
locToUri (Location Uri
uri Range
_) = Uri
uri
nfpToUri :: NormalizedFilePath -> Uri
nfpToUri :: NormalizedFilePath -> Uri
nfpToUri = String -> Uri
filePathToUri forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizedFilePath -> String
fromNormalizedFilePath
showName :: Name -> String
showName :: Name -> String
showName = OccName -> String
occNameString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NamedThing a => a -> OccName
getOccName
unsafeSrcSpanToLoc :: SrcSpan -> Location
unsafeSrcSpanToLoc :: SrcSpan -> Location
unsafeSrcSpanToLoc SrcSpan
srcSpan =
case SrcSpan -> Maybe Location
srcSpanToLocation SrcSpan
srcSpan of
Maybe Location
Nothing -> forall a. HasCallStack => String -> a
error String
"Invalid conversion from UnhelpfulSpan to Location"
Just Location
location -> Location
location
locToFilePos :: Location -> (NormalizedFilePath, Position)
locToFilePos :: Location -> (NormalizedFilePath, Position)
locToFilePos (Location Uri
uri (Range Position
pos Position
_)) = (NormalizedFilePath
nfp, Position
pos)
where
Just NormalizedFilePath
nfp = (NormalizedUri -> Maybe NormalizedFilePath
uriToNormalizedFilePath forall b c a. (b -> c) -> (a -> b) -> a -> c
. Uri -> NormalizedUri
toNormalizedUri) Uri
uri
replaceModName :: Name -> Maybe ModuleName -> Module
replaceModName :: Name -> Maybe ModuleName -> Module
replaceModName Name
name Maybe ModuleName
mbModName =
forall u. u -> ModuleName -> GenModule u
mkModule (Module -> Unit
moduleUnit forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => Name -> Module
nameModule Name
name) (forall a. a -> Maybe a -> a
fromMaybe (String -> ModuleName
mkModuleName String
"Main") Maybe ModuleName
mbModName)
properties :: Properties '[ 'PropertyKey "crossModule" 'TBoolean]
properties :: Properties '[ 'PropertyKey "crossModule" 'TBoolean]
properties = Properties '[]
emptyProperties
forall a b. a -> (a -> b) -> b
& forall (s :: Symbol) (r :: [PropertyKey]).
(KnownSymbol s, NotElem s r) =>
KeyNameProxy s
-> Text
-> Bool
-> Properties r
-> Properties ('PropertyKey s 'TBoolean : r)
defineBooleanProperty forall a. IsLabel "crossModule" a => a
#crossModule
Text
"Enable experimental cross-module renaming" Bool
False