{-# LANGUAGE CPP                 #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE OverloadedLabels    #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}

module Ide.Plugin.Rename (descriptor) 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.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.Text                             as T
import           Development.IDE                      (Recorder, WithPriority)
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.Spans.AtPoint
import           Development.IDE.Types.Location
import           Development.IDE.Plugin.CodeAction
import           HieDb.Query
import           Ide.Plugin.Properties
import           Ide.PluginUtils
import           Ide.Types
import           Language.LSP.Server
import           Language.LSP.Types

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 = [Name]
indirectOldNames forall a. [a] -> [a] -> [a]
++ [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 (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (s :: Symbol) (k :: PropertyKey) (t :: PropertyType)
       (r :: [PropertyKey]) (m :: * -> *).
(HasProperty s k t r, MonadLsp Config m) =>
KeyNameProxy s -> PluginId -> Properties r -> m (ToHsType t)
usePropertyLsp 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 occurences (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 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)

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