{-# 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

        {- 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. -}
        [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

        -- Validate rename
        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"

        -- Perform rename
        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

-- | Limit renaming across modules.
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 ()

---------------------------------------------------------------------------------------------------
-- Source renaming

-- | Apply a function to a `ParsedSource` for a given `Uri` to compute a `WorkspaceEdit`.
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

-- | Replace names at every given `Location` (in a given `ParsedSource`) with a given new name.
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
$
    -- there has to be a better way...
    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`
    -- replaceLoc @AnnList `extT` -- not needed
    -- replaceLoc @AnnParen `extT`   -- not needed
    -- replaceLoc @AnnPragma `extT` -- not needed
    -- replaceLoc @AnnContext `extT` -- not needed
    -- replaceLoc @NoEpAnns `extT` -- not needed
    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

---------------------------------------------------------------------------------------------------
-- Reference finding

-- | Note: We only find exact name occurrences (i.e. type reference "depth" is 0).
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)

---------------------------------------------------------------------------------------------------
-- Util

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)

-- | 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.
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)

-- head is safe since groups are non-empty
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)

---------------------------------------------------------------------------------------------------
-- Config

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