{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE RecordWildCards #-}
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 Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Monad.Trans.Except
import Data.Generics
import Data.Bifunctor (first)
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.Text as T
import Development.IDE (Recorder, WithPriority,
usePropertyAction)
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.Properties
import Ide.PluginUtils
import Ide.Types
import Language.LSP.Server
import Language.LSP.Types
import Compat.HieTypes
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 (m :: Method 'FromClient 'Request) ideState.
PluginRequestMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SMethod 'TextDocumentRename
STextDocumentRename PluginMethodHandler IdeState '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 TextDocumentRename
renameProvider :: PluginMethodHandler IdeState 'TextDocumentRename
renameProvider IdeState
state PluginId
pluginId (RenameParams (TextDocumentIdentifier Uri
uri) Position
pos Maybe ProgressToken
_prog Text
newNameText) =
forall (m :: * -> *) a.
Monad m =>
ExceptT String m a -> m (Either ResponseError a)
pluginResponse forall a b. (a -> b) -> a -> b
$ do
NormalizedFilePath
nfp <- forall (m :: * -> *).
Monad m =>
Uri -> ExceptT String m NormalizedFilePath
handleUriToNfp Uri
uri
[Name]
directOldNames <- forall (m :: * -> *).
MonadIO m =>
IdeState
-> NormalizedFilePath -> Position -> ExceptT String 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 String 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 String 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 String 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 String 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 (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE String
"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 String (LspT Config IO) WorkspaceEdit
getFileEdit = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
$ forall config (m :: * -> *).
MonadLsp config m =>
IdeState
-> (ParsedSource -> ParsedSource)
-> Uri
-> ExceptT String m WorkspaceEdit
getSrcEdit IdeState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> HashSet Location -> ParsedSource -> ParsedSource
replaceRefs OccName
newName
[WorkspaceEdit]
fileEdits <- 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 Uri
-> HashSet Location
-> ExceptT String (LspT Config IO) WorkspaceEdit
getFileEdit) [(Uri, HashSet Location)]
filesRefs
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 String m ()
failWhenImportOrExport :: forall config (m :: * -> *).
MonadLsp config m =>
IdeState
-> NormalizedFilePath
-> HashSet Location
-> [Name]
-> ExceptT String m ()
failWhenImportOrExport IdeState
state NormalizedFilePath
nfp HashSet Location
refLocs [Name]
names = do
ParsedModule
pm <- forall (m :: * -> *) e b.
Monad m =>
e -> m (Maybe b) -> ExceptT e m b
handleMaybeM (String
"No parsed module for: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show NormalizedFilePath
nfp) forall a b. (a -> b) -> a -> b
$ 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.GetParsedModule"
IdeState
state
(forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use 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 (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE String
"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 (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE String
"Renaming of an exported name is unsupported"
(Just ModuleName
_, Maybe (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
Nothing) -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE String
"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 ->
(ParsedSource -> ParsedSource) ->
Uri ->
ExceptT String m WorkspaceEdit
getSrcEdit :: forall config (m :: * -> *).
MonadLsp config m =>
IdeState
-> (ParsedSource -> ParsedSource)
-> Uri
-> ExceptT String m WorkspaceEdit
getSrcEdit IdeState
state ParsedSource -> ParsedSource
updatePs Uri
uri = 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 String m NormalizedFilePath
handleUriToNfp Uri
uri
Annotated ParsedSource
annAst <- forall (m :: * -> *) e b.
Monad m =>
e -> m (Maybe b) -> ExceptT e m b
handleMaybeM (String
"No parsed source for: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show NormalizedFilePath
nfp) forall a b. (a -> b) -> a -> b
$ 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.GetAnnotatedParsedSource"
IdeState
state
(forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use 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
-> (Uri, Text) -> Text -> WithDeletions -> WorkspaceEdit
diffText ClientCapabilities
ccs (Uri
uri, 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 String m [Location]
refsAtName :: forall (m :: * -> *).
MonadIO m =>
IdeState
-> NormalizedFilePath -> Name -> ExceptT String 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 String 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 String m [Name]
getNamesAtPos :: forall (m :: * -> *).
MonadIO m =>
IdeState
-> NormalizedFilePath -> Position -> ExceptT String 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 String 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 String m (HieAstResult, PositionMapping)
handleGetHieAst :: forall (m :: * -> *).
MonadIO m =>
IdeState
-> NormalizedFilePath
-> ExceptT String m (HieAstResult, PositionMapping)
handleGetHieAst IdeState
state NormalizedFilePath
nfp = forall (m :: * -> *) e b.
Monad m =>
e -> m (Maybe b) -> ExceptT e m b
handleMaybeM
(String
"No AST for file: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show NormalizedFilePath
nfp)
(forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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 a. String -> IdeState -> Action a -> IO a
runAction String
"Rename.GetHieAst" IdeState
state forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale 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
handleUriToNfp :: (Monad m) => Uri -> ExceptT String m NormalizedFilePath
handleUriToNfp :: forall (m :: * -> *).
Monad m =>
Uri -> ExceptT String m NormalizedFilePath
handleUriToNfp Uri
uri = forall (m :: * -> *) e b. Monad m => e -> Maybe b -> ExceptT e m b
handleMaybe
(String
"No filepath for uri: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Uri
uri)
(String -> NormalizedFilePath
toNormalizedFilePath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Uri -> Maybe String
uriToFilePath Uri
uri)
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