{-# LANGUAGE CPP            #-}
{-# LANGUAGE DataKinds      #-}
{-# LANGUAGE GADTs          #-}
{-# LANGUAGE NamedFieldPuns #-}

module Ide.Plugin.Rename (descriptor) where

import           Control.Monad
import           Control.Monad.IO.Class               (MonadIO (liftIO))
import           Control.Monad.Trans.Class
import           Control.Monad.Trans.Except
import           Data.Containers.ListUtils
import           Data.Generics
import           Data.List.Extra                      hiding (nubOrd)
import qualified Data.Map                             as M
import           Data.Maybe
import qualified Data.Text                            as T
import           Development.IDE                      hiding (pluginHandlers)
import           Development.IDE.Core.PositionMapping
import           Development.IDE.Core.Shake
import           Development.IDE.GHC.Compat
import           Development.IDE.Spans.AtPoint
#if MIN_VERSION_ghc(9,0,1)
import           GHC.Types.Name
#else
import           Name
#endif
import           HieDb.Query
import           Ide.Plugin.Config
import           Ide.Plugin.Retrie                    hiding (descriptor)
import           Ide.PluginUtils
import           Ide.Types
import           Language.Haskell.GHC.ExactPrint
import           Language.LSP.Server
import           Language.LSP.Types

descriptor :: PluginId -> PluginDescriptor IdeState
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor PluginId
pluginId = (PluginId -> PluginDescriptor IdeState
forall ideState. PluginId -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
pluginId) {
    pluginHandlers :: PluginHandlers IdeState
pluginHandlers = SClientMethod 'TextDocumentRename
-> PluginMethodHandler IdeState 'TextDocumentRename
-> PluginHandlers IdeState
forall (m :: Method 'FromClient 'Request) ideState.
PluginMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SClientMethod 'TextDocumentRename
STextDocumentRename PluginMethodHandler IdeState 'TextDocumentRename
renameProvider
}

renameProvider :: PluginMethodHandler IdeState TextDocumentRename
renameProvider :: PluginMethodHandler IdeState 'TextDocumentRename
renameProvider IdeState
state PluginId
pluginId (RenameParams (TextDocumentIdentifier uri) pos _prog newNameText) =
    ExceptT String (LspT Config IO) WorkspaceEdit
-> LspT Config IO (Either ResponseError WorkspaceEdit)
forall (m :: * -> *) a.
Monad m =>
ExceptT String m a -> m (Either ResponseError a)
response (ExceptT String (LspT Config IO) WorkspaceEdit
 -> LspT Config IO (Either ResponseError WorkspaceEdit))
-> ExceptT String (LspT Config IO) WorkspaceEdit
-> LspT Config IO (Either ResponseError WorkspaceEdit)
forall a b. (a -> b) -> a -> b
$ do
        NormalizedFilePath
nfp <- Uri -> ExceptT String (LspT Config IO) NormalizedFilePath
forall (m :: * -> *).
Monad m =>
Uri -> ExceptT String m NormalizedFilePath
safeUriToNfp Uri
uri
        Name
oldName <- IdeState
-> NormalizedFilePath
-> Position
-> ExceptT String (LspT Config IO) Name
getNameAtPos IdeState
state NormalizedFilePath
nfp Position
pos
        [Location]
workspaceRefs <- IdeState
-> NormalizedFilePath
-> Name
-> ExceptT String (LspT Config IO) [Location]
refsAtName IdeState
state NormalizedFilePath
nfp Name
oldName
        let filesRefs :: [[Location]]
filesRefs = (Location -> Uri) -> [Location] -> [[Location]]
forall b a. Eq b => (a -> b) -> [a] -> [[a]]
groupOn Location -> Uri
locToUri [Location]
workspaceRefs
            getFileEdits :: [Location] -> ExceptT String (LspT Config IO) WorkspaceEdit
getFileEdits = ([Location]
 -> Uri -> ExceptT String (LspT Config IO) WorkspaceEdit)
-> ([Location] -> Uri)
-> [Location]
-> ExceptT String (LspT Config IO) WorkspaceEdit
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap (IdeState
-> (HsModule GhcPs -> HsModule GhcPs)
-> Uri
-> ExceptT String (LspT Config IO) WorkspaceEdit
forall config (m :: * -> *).
MonadLsp config m =>
IdeState
-> (HsModule GhcPs -> HsModule GhcPs)
-> Uri
-> ExceptT String m WorkspaceEdit
getSrcEdits IdeState
state ((HsModule GhcPs -> HsModule GhcPs)
 -> Uri -> ExceptT String (LspT Config IO) WorkspaceEdit)
-> ([Location] -> HsModule GhcPs -> HsModule GhcPs)
-> [Location]
-> Uri
-> ExceptT String (LspT Config IO) WorkspaceEdit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Location] -> HsModule GhcPs -> HsModule GhcPs
renameModRefs Text
newNameText) (Location -> Uri
locToUri (Location -> Uri) -> ([Location] -> Location) -> [Location] -> Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Location] -> Location
forall a. [a] -> a
head)

        [WorkspaceEdit]
fileEdits <- ([Location] -> ExceptT String (LspT Config IO) WorkspaceEdit)
-> [[Location]] -> ExceptT String (LspT Config IO) [WorkspaceEdit]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Location] -> ExceptT String (LspT Config IO) WorkspaceEdit
getFileEdits [[Location]]
filesRefs
        WorkspaceEdit -> ExceptT String (LspT Config IO) WorkspaceEdit
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WorkspaceEdit -> ExceptT String (LspT Config IO) WorkspaceEdit)
-> WorkspaceEdit -> ExceptT String (LspT Config IO) WorkspaceEdit
forall a b. (a -> b) -> a -> b
$ (WorkspaceEdit -> WorkspaceEdit -> WorkspaceEdit)
-> [WorkspaceEdit] -> WorkspaceEdit
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 WorkspaceEdit -> WorkspaceEdit -> WorkspaceEdit
forall a. Semigroup a => a -> a -> a
(<>) [WorkspaceEdit]
fileEdits

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

-- | Compute a `WorkspaceEdit` by applying a given function to the `ParsedModule` for a given `Uri`.
getSrcEdits ::
    (MonadLsp config m) =>
    IdeState ->
#if MIN_VERSION_ghc(9,0,1)
    (HsModule -> HsModule) ->
#else
    (HsModule GhcPs -> HsModule GhcPs) ->
#endif
    Uri ->
    ExceptT String m WorkspaceEdit
getSrcEdits :: IdeState
-> (HsModule GhcPs -> HsModule GhcPs)
-> Uri
-> ExceptT String m WorkspaceEdit
getSrcEdits IdeState
state HsModule GhcPs -> HsModule GhcPs
updateMod Uri
uri = do
    ClientCapabilities
ccs <- m ClientCapabilities -> ExceptT String m ClientCapabilities
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ClientCapabilities
forall config (m :: * -> *).
MonadLsp config m =>
m ClientCapabilities
getClientCapabilities
    NormalizedFilePath
nfp <- Uri -> ExceptT String m NormalizedFilePath
forall (m :: * -> *).
Monad m =>
Uri -> ExceptT String m NormalizedFilePath
safeUriToNfp Uri
uri
    ParsedModule{pm_parsed_source :: ParsedModule -> ParsedSource
pm_parsed_source = ParsedSource
ps, pm_annotations :: ParsedModule -> ApiAnns
pm_annotations = ApiAnns
apiAnns} <-
        String -> m (Maybe ParsedModule) -> ExceptT String m ParsedModule
forall (m :: * -> *) e b.
Monad m =>
e -> m (Maybe b) -> ExceptT e m b
handleMaybeM String
"Error: could not get parsed source" (m (Maybe ParsedModule) -> ExceptT String m ParsedModule)
-> m (Maybe ParsedModule) -> ExceptT String m ParsedModule
forall a b. (a -> b) -> a -> b
$ IO (Maybe ParsedModule) -> m (Maybe ParsedModule)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ParsedModule) -> m (Maybe ParsedModule))
-> IO (Maybe ParsedModule) -> m (Maybe ParsedModule)
forall a b. (a -> b) -> a -> b
$ String
-> IdeState
-> Action (Maybe ParsedModule)
-> IO (Maybe ParsedModule)
forall a. String -> IdeState -> Action a -> IO a
runAction
            String
"Rename.GetParsedModuleWithComments"
            IdeState
state
            (GetParsedModuleWithComments
-> NormalizedFilePath -> Action (Maybe ParsedModule)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetParsedModuleWithComments
GetParsedModuleWithComments NormalizedFilePath
nfp)

    let anns :: Anns
anns = ParsedSource -> ApiAnns -> Anns
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> ApiAnns -> Anns
relativiseApiAnns ParsedSource
ps ApiAnns
apiAnns
        src :: Text
src = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ParsedSource -> Anns -> String
forall ast. Annotate ast => Located ast -> Anns -> String
exactPrint ParsedSource
ps Anns
anns
        res :: Text
res = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ParsedSource -> Anns -> String
forall ast. Annotate ast => Located ast -> Anns -> String
exactPrint (HsModule GhcPs -> HsModule GhcPs
updateMod (HsModule GhcPs -> HsModule GhcPs) -> ParsedSource -> ParsedSource
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsedSource
ps) Anns
anns

    WorkspaceEdit -> ExceptT String m WorkspaceEdit
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WorkspaceEdit -> ExceptT String m WorkspaceEdit)
-> WorkspaceEdit -> ExceptT String m WorkspaceEdit
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 a name at every given `Location` (in a given `HsModule`) with a given new name.
renameModRefs ::
    T.Text ->
    [Location] ->
#if MIN_VERSION_ghc(9,0,1)
    HsModule
    -> HsModule
#else
    HsModule GhcPs
    -> HsModule GhcPs
#endif
renameModRefs :: Text -> [Location] -> HsModule GhcPs -> HsModule GhcPs
renameModRefs Text
newNameText [Location]
refs = (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere ((forall a. Data a => a -> a) -> forall a. Data a => a -> a)
-> (forall a. Data a => a -> a) -> forall a. Data a => a -> a
forall a b. (a -> b) -> a -> b
$ (Located RdrName -> Located RdrName) -> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT Located RdrName -> Located RdrName
replace
    where
        replace :: Located RdrName -> Located RdrName
        replace :: Located RdrName -> Located RdrName
replace (L SrcSpan
srcSpan RdrName
oldRdrName)
            | SrcSpan -> Bool
isRef SrcSpan
srcSpan = SrcSpan -> RdrName -> Located RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpan
srcSpan (RdrName -> Located RdrName) -> RdrName -> Located RdrName
forall a b. (a -> b) -> a -> b
$ RdrName -> RdrName
newRdrName RdrName
oldRdrName
        replace Located RdrName
lOldRdrName = Located RdrName
lOldRdrName

        newRdrName :: RdrName -> RdrName
        newRdrName :: RdrName -> RdrName
newRdrName RdrName
oldRdrName = case RdrName
oldRdrName of
            Qual ModuleName
modName OccName
_ -> ModuleName -> OccName -> RdrName
Qual ModuleName
modName OccName
newOccName
            RdrName
_              -> OccName -> RdrName
Unqual OccName
newOccName

        newOccName :: OccName
newOccName = String -> OccName
mkTcOcc (String -> OccName) -> String -> OccName
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
newNameText

        isRef :: SrcSpan -> Bool
        isRef :: SrcSpan -> Bool
isRef = (Location -> [Location] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Location]
refs) (Location -> Bool) -> (SrcSpan -> Location) -> SrcSpan -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Location -> Location
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Location -> Location)
-> (SrcSpan -> Maybe Location) -> SrcSpan -> Location
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> Maybe Location
srcSpanToLocation

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

-- | Note: We only find exact name occurences (i.e. type reference "depth" is 0).
refsAtName :: IdeState -> NormalizedFilePath -> Name -> ExceptT [Char] (LspT Config IO) [Location]
refsAtName :: IdeState
-> NormalizedFilePath
-> Name
-> ExceptT String (LspT Config IO) [Location]
refsAtName IdeState
state NormalizedFilePath
nfp Name
name = do
    ShakeExtras{HieDb
$sel:hiedb:ShakeExtras :: ShakeExtras -> HieDb
hiedb :: HieDb
hiedb} <- IO ShakeExtras -> ExceptT String (LspT Config IO) ShakeExtras
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ShakeExtras -> ExceptT String (LspT Config IO) ShakeExtras)
-> IO ShakeExtras -> ExceptT String (LspT Config IO) ShakeExtras
forall a b. (a -> b) -> a -> b
$ String -> IdeState -> Action ShakeExtras -> IO ShakeExtras
forall a. String -> IdeState -> Action a -> IO a
runAction String
"Rename.HieDb" IdeState
state Action ShakeExtras
getShakeExtras
    (HieAstResult, PositionMapping)
ast <- IdeState
-> NormalizedFilePath
-> ExceptT String (LspT Config IO) (HieAstResult, PositionMapping)
forall (m :: * -> *).
MonadIO m =>
IdeState
-> NormalizedFilePath
-> ExceptT String m (HieAstResult, PositionMapping)
safeGetHieAst IdeState
state NormalizedFilePath
nfp
    [Location]
astRefs <- String
-> Maybe [Location] -> ExceptT String (LspT Config IO) [Location]
forall (m :: * -> *) e b. Monad m => e -> Maybe b -> ExceptT e m b
handleMaybe String
"Error: Could not get name AST references" (Maybe [Location] -> ExceptT String (LspT Config IO) [Location])
-> Maybe [Location] -> ExceptT String (LspT Config IO) [Location]
forall a b. (a -> b) -> a -> b
$ Name -> (HieAstResult, PositionMapping) -> Maybe [Location]
getNameAstLocations Name
name (HieAstResult, PositionMapping)
ast
    [Location]
dbRefs <- case Name -> Maybe Module
nameModule_maybe Name
name of
        Maybe Module
Nothing -> [Location] -> ExceptT String (LspT Config IO) [Location]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        Just Module
mod -> IO [Location] -> ExceptT String (LspT Config IO) [Location]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Location] -> ExceptT String (LspT Config IO) [Location])
-> IO [Location] -> ExceptT String (LspT Config IO) [Location]
forall a b. (a -> b) -> a -> b
$ (Res RefRow -> Maybe Location) -> [Res RefRow] -> [Location]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Res RefRow -> Maybe Location
rowToLoc ([Res RefRow] -> [Location]) -> IO [Res RefRow] -> IO [Location]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            HieDb
-> Bool
-> OccName
-> Maybe ModuleName
-> Maybe Unit
-> [String]
-> IO [Res RefRow]
findReferences
                HieDb
hiedb
                Bool
True
                (Name -> OccName
nameOccName Name
name)
                (ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just (ModuleName -> Maybe ModuleName) -> ModuleName -> Maybe ModuleName
forall a b. (a -> b) -> a -> b
$ Module -> ModuleName
moduleName Module
mod)
                (Unit -> Maybe Unit
forall a. a -> Maybe a
Just (Unit -> Maybe Unit) -> Unit -> Maybe Unit
forall a b. (a -> b) -> a -> b
$ Module -> Unit
moduleUnitId Module
mod)
                [NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
nfp]
    [Location] -> ExceptT String (LspT Config IO) [Location]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Location] -> ExceptT String (LspT Config IO) [Location])
-> [Location] -> ExceptT String (LspT Config IO) [Location]
forall a b. (a -> b) -> a -> b
$ [Location] -> [Location]
forall a. Ord a => [a] -> [a]
nubOrd ([Location] -> [Location]) -> [Location] -> [Location]
forall a b. (a -> b) -> a -> b
$ [Location]
astRefs [Location] -> [Location] -> [Location]
forall a. [a] -> [a] -> [a]
++ [Location]
dbRefs

getNameAstLocations :: Name -> (HieAstResult, PositionMapping) -> Maybe [Location]
getNameAstLocations :: Name -> (HieAstResult, PositionMapping) -> Maybe [Location]
getNameAstLocations Name
name (HAR Module
_ HieASTs a
_ RefMap a
rm Map Name [RealSrcSpan]
_ HieKind a
_, PositionMapping
mapping) =
    ((RealSrcSpan, IdentifierDetails a) -> Maybe Location)
-> [(RealSrcSpan, IdentifierDetails a)] -> [Location]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (PositionMapping -> Location -> Maybe Location
toCurrentLocation PositionMapping
mapping (Location -> Maybe Location)
-> ((RealSrcSpan, IdentifierDetails a) -> Location)
-> (RealSrcSpan, IdentifierDetails a)
-> Maybe Location
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealSrcSpan -> Location
realSrcSpanToLocation (RealSrcSpan -> Location)
-> ((RealSrcSpan, IdentifierDetails a) -> RealSrcSpan)
-> (RealSrcSpan, IdentifierDetails a)
-> Location
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RealSrcSpan, IdentifierDetails a) -> RealSrcSpan
forall a b. (a, b) -> a
fst) ([(RealSrcSpan, IdentifierDetails a)] -> [Location])
-> Maybe [(RealSrcSpan, IdentifierDetails a)] -> Maybe [Location]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either ModuleName Name
-> RefMap a -> Maybe [(RealSrcSpan, IdentifierDetails a)]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Name -> Either ModuleName Name
forall a b. b -> Either a b
Right Name
name) RefMap a
rm

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

getNameAtPos :: IdeState -> NormalizedFilePath -> Position -> ExceptT String (LspT Config IO) Name
getNameAtPos :: IdeState
-> NormalizedFilePath
-> Position
-> ExceptT String (LspT Config IO) Name
getNameAtPos IdeState
state NormalizedFilePath
nfp Position
pos = do
    (HAR{HieASTs a
hieAst :: ()
hieAst :: HieASTs a
hieAst}, PositionMapping
mapping) <- IdeState
-> NormalizedFilePath
-> ExceptT String (LspT Config IO) (HieAstResult, PositionMapping)
forall (m :: * -> *).
MonadIO m =>
IdeState
-> NormalizedFilePath
-> ExceptT String m (HieAstResult, PositionMapping)
safeGetHieAst IdeState
state NormalizedFilePath
nfp
    String -> Maybe Name -> ExceptT String (LspT Config IO) Name
forall (m :: * -> *) e b. Monad m => e -> Maybe b -> ExceptT e m b
handleMaybe String
"Error: could not find name at position" (Maybe Name -> ExceptT String (LspT Config IO) Name)
-> Maybe Name -> ExceptT String (LspT Config IO) Name
forall a b. (a -> b) -> a -> b
$ [Name] -> Maybe Name
forall a. [a] -> Maybe a
listToMaybe ([Name] -> Maybe Name) -> [Name] -> Maybe Name
forall a b. (a -> b) -> a -> b
$
        HieASTs a -> Position -> PositionMapping -> [Name]
forall a. HieASTs a -> Position -> PositionMapping -> [Name]
getAstNamesAtPoint HieASTs a
hieAst Position
pos PositionMapping
mapping

nfpToUri :: NormalizedFilePath -> Uri
nfpToUri :: NormalizedFilePath -> Uri
nfpToUri = String -> Uri
filePathToUri (String -> Uri)
-> (NormalizedFilePath -> String) -> NormalizedFilePath -> Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizedFilePath -> String
fromNormalizedFilePath

safeUriToNfp :: (Monad m) => Uri -> ExceptT String m NormalizedFilePath
safeUriToNfp :: Uri -> ExceptT String m NormalizedFilePath
safeUriToNfp = String
-> Maybe NormalizedFilePath -> ExceptT String m NormalizedFilePath
forall (m :: * -> *) e b. Monad m => e -> Maybe b -> ExceptT e m b
handleMaybe String
"Error: Could not get uri" (Maybe NormalizedFilePath -> ExceptT String m NormalizedFilePath)
-> (Uri -> Maybe NormalizedFilePath)
-> Uri
-> ExceptT String m NormalizedFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> NormalizedFilePath)
-> Maybe String -> Maybe NormalizedFilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> NormalizedFilePath
toNormalizedFilePath (Maybe String -> Maybe NormalizedFilePath)
-> (Uri -> Maybe String) -> Uri -> Maybe NormalizedFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Uri -> Maybe String
uriToFilePath

safeGetHieAst ::
    MonadIO m =>
    IdeState ->
    NormalizedFilePath ->
    ExceptT String m (HieAstResult, PositionMapping)
safeGetHieAst :: IdeState
-> NormalizedFilePath
-> ExceptT String m (HieAstResult, PositionMapping)
safeGetHieAst IdeState
state = String
-> m (Maybe (HieAstResult, PositionMapping))
-> ExceptT String m (HieAstResult, PositionMapping)
forall (m :: * -> *) e b.
Monad m =>
e -> m (Maybe b) -> ExceptT e m b
handleMaybeM String
"Error: Could not get AST" (m (Maybe (HieAstResult, PositionMapping))
 -> ExceptT String m (HieAstResult, PositionMapping))
-> (NormalizedFilePath
    -> m (Maybe (HieAstResult, PositionMapping)))
-> NormalizedFilePath
-> ExceptT String m (HieAstResult, PositionMapping)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Maybe (HieAstResult, PositionMapping))
-> m (Maybe (HieAstResult, PositionMapping))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (HieAstResult, PositionMapping))
 -> m (Maybe (HieAstResult, PositionMapping)))
-> (NormalizedFilePath
    -> IO (Maybe (HieAstResult, PositionMapping)))
-> NormalizedFilePath
-> m (Maybe (HieAstResult, PositionMapping))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    String
-> IdeState
-> Action (Maybe (HieAstResult, PositionMapping))
-> IO (Maybe (HieAstResult, PositionMapping))
forall a. String -> IdeState -> Action a -> IO a
runAction String
"Rename.GetHieAst" IdeState
state (Action (Maybe (HieAstResult, PositionMapping))
 -> IO (Maybe (HieAstResult, PositionMapping)))
-> (NormalizedFilePath
    -> Action (Maybe (HieAstResult, PositionMapping)))
-> NormalizedFilePath
-> IO (Maybe (HieAstResult, PositionMapping))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetHieAst
-> NormalizedFilePath
-> Action (Maybe (HieAstResult, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale GetHieAst
GetHieAst

locToUri :: Location -> Uri
locToUri :: Location -> Uri
locToUri (Location Uri
uri Range
_) = Uri
uri