{-# LANGUAGE CPP               #-}
{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE GADTs             #-}
{-# LANGUAGE OverloadedLabels  #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Ide.Plugin.Rename (descriptor, E.Log) where

import           Compat.HieTypes
import           Control.Lens                          ((^.))
import           Control.Monad
import           Control.Monad.Except                  (ExceptT, throwError)
import           Control.Monad.IO.Class                (MonadIO, liftIO)
import           Control.Monad.Trans.Class             (lift)
import           Data.Either                           (rights)
import           Data.Foldable                         (fold)
import           Data.Generics
import           Data.Hashable
import           Data.HashSet                          (HashSet)
import qualified Data.HashSet                          as HS
import           Data.List.NonEmpty                    (NonEmpty ((:|)),
                                                        groupWith)
import qualified Data.Map                              as M
import           Data.Maybe
import           Data.Mod.Word
import qualified Data.Set                              as S
import qualified Data.Text                             as T
import           Development.IDE                       (Recorder, WithPriority,
                                                        usePropertyAction)
import           Development.IDE.Core.PluginUtils
import           Development.IDE.Core.RuleTypes
import           Development.IDE.Core.Service
import           Development.IDE.Core.Shake
import           Development.IDE.GHC.Compat
import           Development.IDE.GHC.Compat.ExactPrint
import           Development.IDE.GHC.Error
import           Development.IDE.GHC.ExactPrint
import qualified Development.IDE.GHC.ExactPrint        as E
import           Development.IDE.Plugin.CodeAction
import           Development.IDE.Spans.AtPoint
import           Development.IDE.Types.Location
import           HieDb.Query
import           Ide.Plugin.Error
import           Ide.Plugin.Properties
import           Ide.PluginUtils
import           Ide.Types
import qualified Language.LSP.Protocol.Lens            as L
import           Language.LSP.Protocol.Message
import           Language.LSP.Protocol.Types

instance Hashable (Mod a) where hash :: Mod a -> Int
hash Mod a
n = Word -> Int
forall a. Hashable a => a -> Int
hash (Mod a -> Word
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 = Recorder (WithPriority Log)
-> PluginDescriptor IdeState -> PluginDescriptor IdeState
forall a.
Recorder (WithPriority Log)
-> PluginDescriptor a -> PluginDescriptor a
mkExactprintPluginDescriptor Recorder (WithPriority Log)
recorder (PluginDescriptor IdeState -> PluginDescriptor IdeState)
-> PluginDescriptor IdeState -> PluginDescriptor IdeState
forall a b. (a -> b) -> a -> b
$
    (PluginId -> Text -> PluginDescriptor IdeState
forall ideState. PluginId -> Text -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
pluginId Text
"Provides renaming of Haskell identifiers")
        { pluginHandlers = mconcat
              [ mkPluginHandler SMethod_TextDocumentRename renameProvider
              , mkPluginHandler SMethod_TextDocumentPrepareRename prepareRenameProvider
              ]
        , pluginConfigDescriptor = defaultConfigDescriptor
            { configCustomConfig = mkCustomConfig properties }
        }

prepareRenameProvider :: PluginMethodHandler IdeState Method_TextDocumentPrepareRename
prepareRenameProvider :: PluginMethodHandler IdeState 'Method_TextDocumentPrepareRename
prepareRenameProvider IdeState
state PluginId
_pluginId (PrepareRenameParams (TextDocumentIdentifier Uri
uri) Position
pos Maybe ProgressToken
_progressToken) = do
    NormalizedFilePath
nfp <- Uri -> ExceptT PluginError (HandlerM Config) NormalizedFilePath
forall (m :: * -> *).
Monad m =>
Uri -> ExceptT PluginError m NormalizedFilePath
getNormalizedFilePathE Uri
uri
    [Name]
namesUnderCursor <- IdeState
-> NormalizedFilePath
-> Position
-> ExceptT PluginError (HandlerM Config) [Name]
forall (m :: * -> *).
MonadIO m =>
IdeState
-> NormalizedFilePath -> Position -> ExceptT PluginError m [Name]
getNamesAtPos IdeState
state NormalizedFilePath
nfp Position
pos
    -- When this handler says that rename is invalid, VSCode shows "The element can't be renamed"
    -- and doesn't even allow you to create full rename request.
    -- This handler deliberately approximates "things that definitely can't be renamed"
    -- to mean "there is no Name at given position".
    --
    -- In particular it allows some cases through (e.g. cross-module renames),
    -- so that the full rename handler can give more informative error about them.
    let renameValid :: Bool
renameValid = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
namesUnderCursor
    (PrepareRenameResult |? Null)
-> ExceptT
     PluginError (HandlerM Config) (PrepareRenameResult |? Null)
forall a. a -> ExceptT PluginError (HandlerM Config) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((PrepareRenameResult |? Null)
 -> ExceptT
      PluginError (HandlerM Config) (PrepareRenameResult |? Null))
-> (PrepareRenameResult |? Null)
-> ExceptT
     PluginError (HandlerM Config) (PrepareRenameResult |? Null)
forall a b. (a -> b) -> a -> b
$ PrepareRenameResult -> PrepareRenameResult |? Null
forall a b. a -> a |? b
InL (PrepareRenameResult -> PrepareRenameResult |? Null)
-> PrepareRenameResult -> PrepareRenameResult |? Null
forall a b. (a -> b) -> a -> b
$ (Range
 |? (PrepareRenamePlaceholder |? PrepareRenameDefaultBehavior))
-> PrepareRenameResult
PrepareRenameResult ((Range
  |? (PrepareRenamePlaceholder |? PrepareRenameDefaultBehavior))
 -> PrepareRenameResult)
-> (Range
    |? (PrepareRenamePlaceholder |? PrepareRenameDefaultBehavior))
-> PrepareRenameResult
forall a b. (a -> b) -> a -> b
$ (PrepareRenamePlaceholder |? PrepareRenameDefaultBehavior)
-> Range
   |? (PrepareRenamePlaceholder |? PrepareRenameDefaultBehavior)
forall a b. b -> a |? b
InR ((PrepareRenamePlaceholder |? PrepareRenameDefaultBehavior)
 -> Range
    |? (PrepareRenamePlaceholder |? PrepareRenameDefaultBehavior))
-> (PrepareRenamePlaceholder |? PrepareRenameDefaultBehavior)
-> Range
   |? (PrepareRenamePlaceholder |? PrepareRenameDefaultBehavior)
forall a b. (a -> b) -> a -> b
$ PrepareRenameDefaultBehavior
-> PrepareRenamePlaceholder |? PrepareRenameDefaultBehavior
forall a b. b -> a |? b
InR (PrepareRenameDefaultBehavior
 -> PrepareRenamePlaceholder |? PrepareRenameDefaultBehavior)
-> PrepareRenameDefaultBehavior
-> PrepareRenamePlaceholder |? PrepareRenameDefaultBehavior
forall a b. (a -> b) -> a -> b
$ Bool -> PrepareRenameDefaultBehavior
PrepareRenameDefaultBehavior Bool
renameValid

renameProvider :: PluginMethodHandler IdeState Method_TextDocumentRename
renameProvider :: PluginMethodHandler IdeState 'Method_TextDocumentRename
renameProvider IdeState
state PluginId
pluginId (RenameParams Maybe ProgressToken
_prog (TextDocumentIdentifier Uri
uri) Position
pos Text
newNameText) = do
    NormalizedFilePath
nfp <- Uri -> ExceptT PluginError (HandlerM Config) NormalizedFilePath
forall (m :: * -> *).
Monad m =>
Uri -> ExceptT PluginError m NormalizedFilePath
getNormalizedFilePathE Uri
uri
    [Name]
directOldNames <- IdeState
-> NormalizedFilePath
-> Position
-> ExceptT PluginError (HandlerM Config) [Name]
forall (m :: * -> *).
MonadIO m =>
IdeState
-> NormalizedFilePath -> Position -> ExceptT PluginError m [Name]
getNamesAtPos IdeState
state NormalizedFilePath
nfp Position
pos
    [Location]
directRefs <- [[Location]] -> [Location]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Location]] -> [Location])
-> ExceptT PluginError (HandlerM Config) [[Location]]
-> ExceptT PluginError (HandlerM Config) [Location]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Name -> ExceptT PluginError (HandlerM Config) [Location])
-> [Name] -> ExceptT PluginError (HandlerM Config) [[Location]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (IdeState
-> NormalizedFilePath
-> Name
-> ExceptT PluginError (HandlerM Config) [Location]
forall (m :: * -> *).
MonadIO m =>
IdeState
-> NormalizedFilePath -> Name -> ExceptT PluginError 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 <- [[Name]] -> [Name]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Name]] -> [Name])
-> ([[Name]] -> [[Name]]) -> [[Name]] -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Name] -> Bool) -> [[Name]] -> [[Name]]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
1) (Int -> Bool) -> ([Name] -> Int) -> [Name] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([[Name]] -> [Name])
-> ExceptT PluginError (HandlerM Config) [[Name]]
-> ExceptT PluginError (HandlerM Config) [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        (Location -> ExceptT PluginError (HandlerM Config) [Name])
-> [Location] -> ExceptT PluginError (HandlerM Config) [[Name]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((NormalizedFilePath
 -> Position -> ExceptT PluginError (HandlerM Config) [Name])
-> (NormalizedFilePath, Position)
-> ExceptT PluginError (HandlerM Config) [Name]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (IdeState
-> NormalizedFilePath
-> Position
-> ExceptT PluginError (HandlerM Config) [Name]
forall (m :: * -> *).
MonadIO m =>
IdeState
-> NormalizedFilePath -> Position -> ExceptT PluginError m [Name]
getNamesAtPos IdeState
state) ((NormalizedFilePath, Position)
 -> ExceptT PluginError (HandlerM Config) [Name])
-> (Location
    -> ExceptT
         PluginError (HandlerM Config) (NormalizedFilePath, Position))
-> Location
-> ExceptT PluginError (HandlerM Config) [Name]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Location
-> ExceptT
     PluginError (HandlerM Config) (NormalizedFilePath, Position)
forall (m :: * -> *).
Monad m =>
Location -> ExceptT PluginError m (NormalizedFilePath, Position)
locToFilePos) [Location]
directRefs
    let oldNames :: [Name]
oldNames = (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter Name -> Bool
matchesDirect [Name]
indirectOldNames [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
directOldNames
           where
             matchesDirect :: Name -> Bool
matchesDirect Name
n = OccName -> FastString
occNameFS (Name -> OccName
nameOccName Name
n) FastString -> [FastString] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FastString]
directFS
             directFS :: [FastString]
directFS = (Name -> FastString) -> [Name] -> [FastString]
forall a b. (a -> b) -> [a] -> [b]
map (OccName -> FastString
occNameFS (OccName -> FastString) -> (Name -> OccName) -> Name -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> OccName
nameOccName) [Name]
directOldNames

    case [Name]
oldNames of
        -- There were no Names at given position (e.g. rename triggered within a comment or on a keyword)
        [] -> PluginError
-> ExceptT PluginError (HandlerM Config) (WorkspaceEdit |? Null)
forall a. PluginError -> ExceptT PluginError (HandlerM Config) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PluginError
 -> ExceptT PluginError (HandlerM Config) (WorkspaceEdit |? Null))
-> PluginError
-> ExceptT PluginError (HandlerM Config) (WorkspaceEdit |? Null)
forall a b. (a -> b) -> a -> b
$ Text -> PluginError
PluginInvalidParams Text
"No symbol to rename at given position"
        [Name]
_  -> do
            HashSet Location
refs <- [Location] -> HashSet Location
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList ([Location] -> HashSet Location)
-> ([[Location]] -> [Location]) -> [[Location]] -> HashSet Location
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Location]] -> [Location]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Location]] -> HashSet Location)
-> ExceptT PluginError (HandlerM Config) [[Location]]
-> ExceptT PluginError (HandlerM Config) (HashSet Location)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Name -> ExceptT PluginError (HandlerM Config) [Location])
-> [Name] -> ExceptT PluginError (HandlerM Config) [[Location]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (IdeState
-> NormalizedFilePath
-> Name
-> ExceptT PluginError (HandlerM Config) [Location]
forall (m :: * -> *).
MonadIO m =>
IdeState
-> NormalizedFilePath -> Name -> ExceptT PluginError m [Location]
refsAtName IdeState
state NormalizedFilePath
nfp) [Name]
oldNames

            -- Validate rename
            Bool
crossModuleEnabled <- IO Bool -> ExceptT PluginError (HandlerM Config) Bool
forall a. IO a -> ExceptT PluginError (HandlerM Config) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ExceptT PluginError (HandlerM Config) Bool)
-> IO Bool -> ExceptT PluginError (HandlerM Config) Bool
forall a b. (a -> b) -> a -> b
$ String -> IdeState -> Action Bool -> IO Bool
forall a. String -> IdeState -> Action a -> IO a
runAction String
"rename: config" IdeState
state (Action Bool -> IO Bool) -> Action Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ KeyNameProxy "crossModule"
-> PluginId
-> Properties '[ 'PropertyKey "crossModule" 'TBoolean]
-> Action
     (ToHsType
        (FindByKeyName
           "crossModule" '[ 'PropertyKey "crossModule" 'TBoolean]))
forall (s :: Symbol) (k :: PropertyKey) (t :: PropertyType)
       (r :: [PropertyKey]).
HasProperty s k t r =>
KeyNameProxy s -> PluginId -> Properties r -> Action (ToHsType t)
usePropertyAction KeyNameProxy "crossModule"
#crossModule PluginId
pluginId Properties '[ 'PropertyKey "crossModule" 'TBoolean]
properties
            Bool
-> ExceptT PluginError (HandlerM Config) ()
-> ExceptT PluginError (HandlerM Config) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
crossModuleEnabled (ExceptT PluginError (HandlerM Config) ()
 -> ExceptT PluginError (HandlerM Config) ())
-> ExceptT PluginError (HandlerM Config) ()
-> ExceptT PluginError (HandlerM Config) ()
forall a b. (a -> b) -> a -> b
$ IdeState
-> NormalizedFilePath
-> HashSet Location
-> [Name]
-> ExceptT PluginError (HandlerM Config) ()
forall config.
IdeState
-> NormalizedFilePath
-> HashSet Location
-> [Name]
-> ExceptT PluginError (HandlerM config) ()
failWhenImportOrExport IdeState
state NormalizedFilePath
nfp HashSet Location
refs [Name]
oldNames
            Bool
-> ExceptT PluginError (HandlerM Config) ()
-> ExceptT PluginError (HandlerM Config) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Name -> Bool) -> [Name] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Name -> Bool
isBuiltInSyntax [Name]
oldNames) (ExceptT PluginError (HandlerM Config) ()
 -> ExceptT PluginError (HandlerM Config) ())
-> ExceptT PluginError (HandlerM Config) ()
-> ExceptT PluginError (HandlerM Config) ()
forall a b. (a -> b) -> a -> b
$ PluginError -> ExceptT PluginError (HandlerM Config) ()
forall a. PluginError -> ExceptT PluginError (HandlerM Config) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PluginError -> ExceptT PluginError (HandlerM Config) ())
-> PluginError -> ExceptT PluginError (HandlerM Config) ()
forall a b. (a -> b) -> a -> b
$ Text -> PluginError
PluginInternalError Text
"Invalid rename of built-in syntax"

            -- Perform rename
            let newName :: OccName
newName = String -> OccName
mkTcOcc (String -> OccName) -> String -> OccName
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
newNameText
                filesRefs :: [(Uri, HashSet Location)]
filesRefs = (Location -> Uri) -> HashSet Location -> [(Uri, HashSet Location)]
forall a b.
(Hashable a, Eq b) =>
(a -> b) -> HashSet a -> [(b, HashSet a)]
collectWith Location -> Uri
locToUri HashSet Location
refs
                getFileEdit :: (Uri, HashSet Location)
-> ExceptT PluginError (HandlerM Config) WorkspaceEdit
getFileEdit (Uri
uri, HashSet Location
locations) = do
                    VersionedTextDocumentIdentifier
verTxtDocId <- HandlerM Config VersionedTextDocumentIdentifier
-> ExceptT
     PluginError (HandlerM Config) VersionedTextDocumentIdentifier
forall (m :: * -> *) a. Monad m => m a -> ExceptT PluginError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (HandlerM Config VersionedTextDocumentIdentifier
 -> ExceptT
      PluginError (HandlerM Config) VersionedTextDocumentIdentifier)
-> HandlerM Config VersionedTextDocumentIdentifier
-> ExceptT
     PluginError (HandlerM Config) VersionedTextDocumentIdentifier
forall a b. (a -> b) -> a -> b
$ TextDocumentIdentifier
-> HandlerM Config VersionedTextDocumentIdentifier
forall config.
TextDocumentIdentifier
-> HandlerM config VersionedTextDocumentIdentifier
pluginGetVersionedTextDoc (Uri -> TextDocumentIdentifier
TextDocumentIdentifier Uri
uri)
                    IdeState
-> VersionedTextDocumentIdentifier
-> (ParsedSource -> ParsedSource)
-> ExceptT PluginError (HandlerM Config) WorkspaceEdit
forall config.
IdeState
-> VersionedTextDocumentIdentifier
-> (ParsedSource -> ParsedSource)
-> ExceptT PluginError (HandlerM config) WorkspaceEdit
getSrcEdit IdeState
state VersionedTextDocumentIdentifier
verTxtDocId (OccName -> HashSet Location -> ParsedSource -> ParsedSource
replaceRefs OccName
newName HashSet Location
locations)
            [WorkspaceEdit]
fileEdits <- ((Uri, HashSet Location)
 -> ExceptT PluginError (HandlerM Config) WorkspaceEdit)
-> [(Uri, HashSet Location)]
-> ExceptT PluginError (HandlerM Config) [WorkspaceEdit]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Uri, HashSet Location)
-> ExceptT PluginError (HandlerM Config) WorkspaceEdit
getFileEdit [(Uri, HashSet Location)]
filesRefs
            (WorkspaceEdit |? Null)
-> ExceptT PluginError (HandlerM Config) (WorkspaceEdit |? Null)
forall a. a -> ExceptT PluginError (HandlerM Config) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((WorkspaceEdit |? Null)
 -> ExceptT PluginError (HandlerM Config) (WorkspaceEdit |? Null))
-> (WorkspaceEdit |? Null)
-> ExceptT PluginError (HandlerM Config) (WorkspaceEdit |? Null)
forall a b. (a -> b) -> a -> b
$ WorkspaceEdit -> WorkspaceEdit |? Null
forall a b. a -> a |? b
InL (WorkspaceEdit -> WorkspaceEdit |? Null)
-> WorkspaceEdit -> WorkspaceEdit |? Null
forall a b. (a -> b) -> a -> b
$ [WorkspaceEdit] -> WorkspaceEdit
forall a. Monoid a => [a] -> a
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [WorkspaceEdit]
fileEdits

-- | Limit renaming across modules.
failWhenImportOrExport ::
    IdeState ->
    NormalizedFilePath ->
    HashSet Location ->
    [Name] ->
    ExceptT PluginError (HandlerM config) ()
failWhenImportOrExport :: forall config.
IdeState
-> NormalizedFilePath
-> HashSet Location
-> [Name]
-> ExceptT PluginError (HandlerM config) ()
failWhenImportOrExport IdeState
state NormalizedFilePath
nfp HashSet Location
refLocs [Name]
names = do
    ParsedModule
pm <- String
-> IdeState
-> ExceptT PluginError Action ParsedModule
-> ExceptT PluginError (HandlerM config) ParsedModule
forall (m :: * -> *) e a.
MonadIO m =>
String -> IdeState -> ExceptT e Action a -> ExceptT e m a
runActionE String
"Rename.GetParsedModule" IdeState
state
         (GetParsedModule
-> NormalizedFilePath -> ExceptT PluginError Action ParsedModule
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> ExceptT PluginError Action v
useE GetParsedModule
GetParsedModule NormalizedFilePath
nfp)
    let hsMod :: HsModule GhcPs
hsMod = ParsedSource -> HsModule GhcPs
forall l e. GenLocated l e -> e
unLoc (ParsedSource -> HsModule GhcPs) -> ParsedSource -> HsModule GhcPs
forall a b. (a -> b) -> a -> b
$ ParsedModule -> ParsedSource
pm_parsed_source ParsedModule
pm
    case (GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnA ModuleName -> ModuleName)
-> Maybe (GenLocated SrcSpanAnnA ModuleName) -> Maybe ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsModule GhcPs -> Maybe (XRec GhcPs ModuleName)
forall p. HsModule p -> Maybe (XRec p ModuleName)
hsmodName HsModule GhcPs
hsMod, HsModule GhcPs -> Maybe (XRec GhcPs [LIE GhcPs])
forall p. HsModule p -> Maybe (XRec p [LIE p])
hsmodExports HsModule GhcPs
hsMod) of
        (Maybe ModuleName
mbModName, Maybe (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
_) | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Name -> Bool) -> [Name] -> Bool
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
            -> PluginError -> ExceptT PluginError (HandlerM config) ()
forall a. PluginError -> ExceptT PluginError (HandlerM config) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PluginError -> ExceptT PluginError (HandlerM config) ())
-> PluginError -> ExceptT PluginError (HandlerM config) ()
forall a b. (a -> b) -> a -> b
$ Text -> PluginError
PluginInternalError Text
"Renaming of an imported name is unsupported"
        (Maybe ModuleName
_, Just (L SrcSpanAnnL
_ [GenLocated SrcSpanAnnA (IE GhcPs)]
exports)) | (GenLocated SrcSpanAnnA (IE GhcPs) -> Bool)
-> [GenLocated SrcSpanAnnA (IE GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Location -> HashSet Location -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HS.member` HashSet Location
refLocs) (Location -> Bool)
-> (GenLocated SrcSpanAnnA (IE GhcPs) -> Location)
-> GenLocated SrcSpanAnnA (IE GhcPs)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> Location
unsafeSrcSpanToLoc (SrcSpan -> Location)
-> (GenLocated SrcSpanAnnA (IE GhcPs) -> SrcSpan)
-> GenLocated SrcSpanAnnA (IE GhcPs)
-> Location
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (IE GhcPs) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc) [GenLocated SrcSpanAnnA (IE GhcPs)]
exports
            -> PluginError -> ExceptT PluginError (HandlerM config) ()
forall a. PluginError -> ExceptT PluginError (HandlerM config) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PluginError -> ExceptT PluginError (HandlerM config) ())
-> PluginError -> ExceptT PluginError (HandlerM config) ()
forall a b. (a -> b) -> a -> b
$ Text -> PluginError
PluginInternalError Text
"Renaming of an exported name is unsupported"
        (Just ModuleName
_, Maybe (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
Nothing) -> PluginError -> ExceptT PluginError (HandlerM config) ()
forall a. PluginError -> ExceptT PluginError (HandlerM config) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PluginError -> ExceptT PluginError (HandlerM config) ())
-> PluginError -> ExceptT PluginError (HandlerM config) ()
forall a b. (a -> b) -> a -> b
$ Text -> PluginError
PluginInternalError Text
"Explicit export list required for renaming"
        (Maybe ModuleName,
 Maybe (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]))
_ -> () -> ExceptT PluginError (HandlerM config) ()
forall a. a -> ExceptT PluginError (HandlerM config) a
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 ::
    IdeState ->
    VersionedTextDocumentIdentifier ->
    (ParsedSource -> ParsedSource) ->
    ExceptT PluginError (HandlerM config) WorkspaceEdit
getSrcEdit :: forall config.
IdeState
-> VersionedTextDocumentIdentifier
-> (ParsedSource -> ParsedSource)
-> ExceptT PluginError (HandlerM config) WorkspaceEdit
getSrcEdit IdeState
state VersionedTextDocumentIdentifier
verTxtDocId ParsedSource -> ParsedSource
updatePs = do
    ClientCapabilities
ccs <- HandlerM config ClientCapabilities
-> ExceptT PluginError (HandlerM config) ClientCapabilities
forall (m :: * -> *) a. Monad m => m a -> ExceptT PluginError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift HandlerM config ClientCapabilities
forall config. HandlerM config ClientCapabilities
pluginGetClientCapabilities
    NormalizedFilePath
nfp <- Uri -> ExceptT PluginError (HandlerM config) NormalizedFilePath
forall (m :: * -> *).
Monad m =>
Uri -> ExceptT PluginError m NormalizedFilePath
getNormalizedFilePathE (VersionedTextDocumentIdentifier
verTxtDocId VersionedTextDocumentIdentifier
-> Getting Uri VersionedTextDocumentIdentifier Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri VersionedTextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
Lens' VersionedTextDocumentIdentifier Uri
L.uri)
    ParsedSource
annAst <- String
-> IdeState
-> ExceptT PluginError Action ParsedSource
-> ExceptT PluginError (HandlerM config) ParsedSource
forall (m :: * -> *) e a.
MonadIO m =>
String -> IdeState -> ExceptT e Action a -> ExceptT e m a
runActionE String
"Rename.GetAnnotatedParsedSource" IdeState
state
        (GetAnnotatedParsedSource
-> NormalizedFilePath -> ExceptT PluginError Action ParsedSource
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> ExceptT PluginError Action v
useE GetAnnotatedParsedSource
GetAnnotatedParsedSource NormalizedFilePath
nfp)
    let ps :: ParsedSource
ps = ParsedSource
annAst
        src :: Text
src = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ParsedSource -> String
forall ast. ExactPrint ast => ast -> String
exactPrint ParsedSource
ps
        res :: Text
res = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ParsedSource -> String
forall ast. ExactPrint ast => ast -> String
exactPrint (ParsedSource -> ParsedSource
updatePs ParsedSource
ps)
    WorkspaceEdit
-> ExceptT PluginError (HandlerM config) WorkspaceEdit
forall a. a -> ExceptT PluginError (HandlerM config) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WorkspaceEdit
 -> ExceptT PluginError (HandlerM config) WorkspaceEdit)
-> WorkspaceEdit
-> ExceptT PluginError (HandlerM config) WorkspaceEdit
forall a b. (a -> b) -> a -> b
$ ClientCapabilities
-> (VersionedTextDocumentIdentifier, Text)
-> Text
-> WithDeletions
-> WorkspaceEdit
diffText ClientCapabilities
ccs (VersionedTextDocumentIdentifier
verTxtDocId, 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
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. 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
$
    -- there has to be a better way...
    (LocatedAn AnnListItem RdrName -> LocatedAn AnnListItem RdrName)
-> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT (forall an. LocatedAn an RdrName -> LocatedAn an RdrName
replaceLoc @AnnListItem) (a -> a)
-> (LocatedAn NameAnn RdrName -> LocatedAn NameAnn RdrName)
-> a
-> a
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. LocatedAn an RdrName -> LocatedAn an RdrName
replaceLoc @NameAnn
    where
        replaceLoc :: forall an. LocatedAn an RdrName -> LocatedAn an RdrName
        replaceLoc :: forall an. LocatedAn an RdrName -> LocatedAn an RdrName
replaceLoc (L SrcAnn an
srcSpan RdrName
oldRdrName)
            | SrcSpan -> Bool
isRef (SrcAnn an -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcAnn an
srcSpan) = SrcAnn an -> RdrName -> GenLocated (SrcAnn an) RdrName
forall l e. l -> e -> GenLocated l e
L SrcAnn an
srcSpan (RdrName -> GenLocated (SrcAnn an) RdrName)
-> RdrName -> GenLocated (SrcAnn an) RdrName
forall a b. (a -> b) -> a -> b
$ RdrName -> RdrName
replace RdrName
oldRdrName
        replaceLoc GenLocated (SrcAnn an) RdrName
lOldRdrName = GenLocated (SrcAnn an) RdrName
lOldRdrName
        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 = (Location -> HashSet Location -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HS.member` HashSet Location
refs) (Location -> Bool) -> (SrcSpan -> Location) -> SrcSpan -> Bool
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 PluginError m [Location]
refsAtName :: forall (m :: * -> *).
MonadIO m =>
IdeState
-> NormalizedFilePath -> Name -> ExceptT PluginError m [Location]
refsAtName IdeState
state NormalizedFilePath
nfp Name
name = do
    ShakeExtras{WithHieDb
withHieDb :: WithHieDb
$sel:withHieDb:ShakeExtras :: ShakeExtras -> WithHieDb
withHieDb} <- IO ShakeExtras -> ExceptT PluginError m ShakeExtras
forall a. IO a -> ExceptT PluginError m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ShakeExtras -> ExceptT PluginError m ShakeExtras)
-> IO ShakeExtras -> ExceptT PluginError m 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
ast <- IdeState
-> NormalizedFilePath -> ExceptT PluginError m HieAstResult
forall (m :: * -> *).
MonadIO m =>
IdeState
-> NormalizedFilePath -> ExceptT PluginError m HieAstResult
handleGetHieAst IdeState
state NormalizedFilePath
nfp
    [Location]
dbRefs <- case Name -> Maybe Module
nameModule_maybe Name
name of
        Maybe Module
Nothing -> [Location] -> ExceptT PluginError m [Location]
forall a. a -> ExceptT PluginError m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        Just Module
mod -> IO [Location] -> ExceptT PluginError m [Location]
forall a. IO a -> ExceptT PluginError m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Location] -> ExceptT PluginError m [Location])
-> IO [Location] -> ExceptT PluginError m [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 -> IO [Res RefRow]) -> IO [Res RefRow]
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)
                (ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just (ModuleName -> Maybe ModuleName) -> ModuleName -> Maybe ModuleName
forall a b. (a -> b) -> a -> b
$ Module -> ModuleName
forall unit. GenModule unit -> 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
forall unit. GenModule unit -> unit
moduleUnit Module
mod)
                [NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
nfp]
            )
    [Location] -> ExceptT PluginError m [Location]
forall a. a -> ExceptT PluginError m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Location] -> ExceptT PluginError m [Location])
-> [Location] -> ExceptT PluginError m [Location]
forall a b. (a -> b) -> a -> b
$ Name -> HieAstResult -> [Location]
nameLocs Name
name HieAstResult
ast [Location] -> [Location] -> [Location]
forall a. [a] -> [a] -> [a]
++ [Location]
dbRefs

nameLocs :: Name -> HieAstResult -> [Location]
nameLocs :: Name -> HieAstResult -> [Location]
nameLocs Name
name (HAR Module
_ HieASTs a
_ RefMap a
rm Map Name [RealSrcSpan]
_ HieKind a
_) =
    ([(RealSrcSpan, IdentifierDetails a)] -> [Location])
-> Maybe [(RealSrcSpan, IdentifierDetails a)] -> [Location]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (((RealSrcSpan, IdentifierDetails a) -> Location)
-> [(RealSrcSpan, IdentifierDetails a)] -> [Location]
forall a b. (a -> b) -> [a] -> [b]
map (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))
              (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

getNamesAtPos :: MonadIO m => IdeState -> NormalizedFilePath -> Position -> ExceptT PluginError m [Name]
getNamesAtPos :: forall (m :: * -> *).
MonadIO m =>
IdeState
-> NormalizedFilePath -> Position -> ExceptT PluginError m [Name]
getNamesAtPos IdeState
state NormalizedFilePath
nfp Position
pos = do
    HAR{HieASTs a
hieAst :: HieASTs a
hieAst :: ()
hieAst} <- IdeState
-> NormalizedFilePath -> ExceptT PluginError m HieAstResult
forall (m :: * -> *).
MonadIO m =>
IdeState
-> NormalizedFilePath -> ExceptT PluginError m HieAstResult
handleGetHieAst IdeState
state NormalizedFilePath
nfp
    [Name] -> ExceptT PluginError m [Name]
forall a. a -> ExceptT PluginError m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Name] -> ExceptT PluginError m [Name])
-> [Name] -> ExceptT PluginError m [Name]
forall a b. (a -> b) -> a -> b
$ HieASTs a -> Position -> [Name]
forall a. HieASTs a -> Position -> [Name]
getNamesAtPoint' HieASTs a
hieAst Position
pos

handleGetHieAst ::
    MonadIO m =>
    IdeState ->
    NormalizedFilePath ->
    ExceptT PluginError m HieAstResult
handleGetHieAst :: forall (m :: * -> *).
MonadIO m =>
IdeState
-> NormalizedFilePath -> ExceptT PluginError m HieAstResult
handleGetHieAst IdeState
state NormalizedFilePath
nfp =
    -- We explicitly do not want to allow a stale version here - we only want to rename if
    -- the module compiles, otherwise we can't guarantee that we'll rename everything,
    -- which is bad (see https://github.com/haskell/haskell-language-server/issues/3799)
    (HieAstResult -> HieAstResult)
-> ExceptT PluginError m HieAstResult
-> ExceptT PluginError m HieAstResult
forall a b.
(a -> b) -> ExceptT PluginError m a -> ExceptT PluginError m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HieAstResult -> HieAstResult
removeGenerated (ExceptT PluginError m HieAstResult
 -> ExceptT PluginError m HieAstResult)
-> ExceptT PluginError m HieAstResult
-> ExceptT PluginError m HieAstResult
forall a b. (a -> b) -> a -> b
$ String
-> IdeState
-> ExceptT PluginError Action HieAstResult
-> ExceptT PluginError m HieAstResult
forall (m :: * -> *) e a.
MonadIO m =>
String -> IdeState -> ExceptT e Action a -> ExceptT e m a
runActionE String
"Rename.GetHieAst" IdeState
state (ExceptT PluginError Action HieAstResult
 -> ExceptT PluginError m HieAstResult)
-> ExceptT PluginError Action HieAstResult
-> ExceptT PluginError m HieAstResult
forall a b. (a -> b) -> a -> b
$ GetHieAst
-> NormalizedFilePath -> ExceptT PluginError Action HieAstResult
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> ExceptT PluginError Action v
useE 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]
Module
HieASTs a
HieKind a
hieAst :: ()
hieModule :: Module
hieAst :: HieASTs a
refMap :: RefMap a
typeRefs :: Map Name [RealSrcSpan]
hieKind :: HieKind a
hieModule :: HieAstResult -> Module
refMap :: ()
typeRefs :: HieAstResult -> Map Name [RealSrcSpan]
hieKind :: ()
..} = HAR{hieAst :: HieASTs a
hieAst = HieASTs a -> HieASTs a
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
hieModule :: Module
refMap :: RefMap a
typeRefs :: Map Name [RealSrcSpan]
hieKind :: HieKind a
..}
  where
    go :: HieASTs a -> HieASTs a
    go :: forall a. HieASTs a -> HieASTs a
go HieASTs a
hf =
      Map HiePath (HieAST a) -> HieASTs a
forall a. Map HiePath (HieAST a) -> HieASTs a
HieASTs ((HieAST a -> HieAST a)
-> Map HiePath (HieAST a) -> Map HiePath (HieAST a)
forall a b. (a -> b) -> Map HiePath a -> Map HiePath b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HieAST a -> HieAST a
forall {a}. HieAST a -> HieAST a
goAst (HieASTs a -> Map HiePath (HieAST a)
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) = SourcedNodeInfo a -> RealSrcSpan -> [HieAST a] -> HieAST a
forall a.
SourcedNodeInfo a -> RealSrcSpan -> [HieAST a] -> HieAST a
Node (Map NodeOrigin (NodeInfo a) -> SourcedNodeInfo a
forall a. Map NodeOrigin (NodeInfo a) -> SourcedNodeInfo a
SourcedNodeInfo (Map NodeOrigin (NodeInfo a) -> SourcedNodeInfo a)
-> Map NodeOrigin (NodeInfo a) -> SourcedNodeInfo a
forall a b. (a -> b) -> a -> b
$ Map NodeOrigin (NodeInfo a)
-> Set NodeOrigin -> Map NodeOrigin (NodeInfo a)
forall k a. Ord k => Map k a -> Set k -> Map k a
M.restrictKeys (SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
forall a. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
getSourcedNodeInfo SourcedNodeInfo a
nsi) (NodeOrigin -> Set NodeOrigin
forall a. a -> Set a
S.singleton NodeOrigin
SourceInfo)) RealSrcSpan
sp ((HieAST a -> HieAST a) -> [HieAST a] -> [HieAST a]
forall a b. (a -> b) -> [a] -> [b]
map HieAST a -> HieAST a
goAst [HieAST a]
xs)

collectWith :: (Hashable a, Eq b) => (a -> b) -> HashSet a -> [(b, HashSet a)]
collectWith :: forall a b.
(Hashable a, Eq b) =>
(a -> b) -> HashSet a -> [(b, HashSet a)]
collectWith a -> b
f = (NonEmpty a -> (b, HashSet a)) -> [NonEmpty a] -> [(b, HashSet a)]
forall a b. (a -> b) -> [a] -> [b]
map (\(a
a :| [a]
as) -> (a -> b
f a
a, [a] -> HashSet a
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
as))) ([NonEmpty a] -> [(b, HashSet a)])
-> (HashSet a -> [NonEmpty a]) -> HashSet a -> [(b, HashSet a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> [a] -> [NonEmpty a]
forall (f :: * -> *) b a.
(Foldable f, Eq b) =>
(a -> b) -> f a -> [NonEmpty a]
groupWith a -> b
f ([a] -> [NonEmpty a])
-> (HashSet a -> [a]) -> HashSet a -> [NonEmpty a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet a -> [a]
forall a. HashSet a -> [a]
HS.toList

-- | A variant 'getNamesAtPoint' that does not expect a 'PositionMapping'
getNamesAtPoint' :: HieASTs a -> Position -> [Name]
getNamesAtPoint' :: forall a. HieASTs a -> Position -> [Name]
getNamesAtPoint' HieASTs a
hf Position
pos =
  [[Name]] -> [Name]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Name]] -> [Name]) -> [[Name]] -> [Name]
forall a b. (a -> b) -> a -> b
$ HieASTs a -> Position -> (HieAST a -> [Name]) -> [[Name]]
forall t a. HieASTs t -> Position -> (HieAST t -> a) -> [a]
pointCommand HieASTs a
hf Position
pos ([Either ModuleName Name] -> [Name]
forall a b. [Either a b] -> [b]
rights ([Either ModuleName Name] -> [Name])
-> (HieAST a -> [Either ModuleName Name]) -> HieAST a -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (Either ModuleName Name) (IdentifierDetails a)
-> [Either ModuleName Name]
forall k a. Map k a -> [k]
M.keys (Map (Either ModuleName Name) (IdentifierDetails a)
 -> [Either ModuleName Name])
-> (HieAST a -> Map (Either ModuleName Name) (IdentifierDetails a))
-> HieAST a
-> [Either ModuleName Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST a -> Map (Either ModuleName Name) (IdentifierDetails a)
forall a.
HieAST a -> Map (Either ModuleName Name) (IdentifierDetails a)
getNodeIds)

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

unsafeSrcSpanToLoc :: SrcSpan -> Location
unsafeSrcSpanToLoc :: SrcSpan -> Location
unsafeSrcSpanToLoc SrcSpan
srcSpan =
    case SrcSpan -> Maybe Location
srcSpanToLocation SrcSpan
srcSpan of
        Maybe Location
Nothing       -> String -> Location
forall a. HasCallStack => String -> a
error String
"Invalid conversion from UnhelpfulSpan to Location"
        Just Location
location -> Location
location

locToFilePos :: Monad m => Location -> ExceptT PluginError m (NormalizedFilePath, Position)
locToFilePos :: forall (m :: * -> *).
Monad m =>
Location -> ExceptT PluginError m (NormalizedFilePath, Position)
locToFilePos (Location Uri
uri (Range Position
pos Position
_)) = (,Position
pos) (NormalizedFilePath -> (NormalizedFilePath, Position))
-> ExceptT PluginError m NormalizedFilePath
-> ExceptT PluginError m (NormalizedFilePath, Position)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Uri -> ExceptT PluginError m NormalizedFilePath
forall (m :: * -> *).
Monad m =>
Uri -> ExceptT PluginError m NormalizedFilePath
getNormalizedFilePathE Uri
uri

replaceModName :: Name -> Maybe ModuleName -> Module
replaceModName :: Name -> Maybe ModuleName -> Module
replaceModName Name
name Maybe ModuleName
mbModName =
    Unit -> ModuleName -> Module
forall u. u -> ModuleName -> GenModule u
mkModule (Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit (Module -> Unit) -> Module -> Unit
forall a b. (a -> b) -> a -> b
$ (() :: Constraint) => Name -> Module
Name -> Module
nameModule Name
name) (ModuleName -> Maybe ModuleName -> ModuleName
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
  Properties '[]
-> (Properties '[]
    -> Properties '[ 'PropertyKey "crossModule" 'TBoolean])
-> Properties '[ 'PropertyKey "crossModule" 'TBoolean]
forall a b. a -> (a -> b) -> b
& KeyNameProxy "crossModule"
-> Text
-> Bool
-> Properties '[]
-> Properties '[ 'PropertyKey "crossModule" 'TBoolean]
forall (s :: Symbol) (r :: [PropertyKey]).
(KnownSymbol s, NotElem s r) =>
KeyNameProxy s
-> Text
-> Bool
-> Properties r
-> Properties ('PropertyKey s 'TBoolean : r)
defineBooleanProperty KeyNameProxy "crossModule"
#crossModule
    Text
"Enable experimental cross-module renaming" Bool
False