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

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

import           GHC.Parser.Annotation                 (AnnContext, AnnList,
                                                        AnnParen, AnnPragma)

import           Compat.HieTypes
import           Control.Lens                          ((^.))
import           Control.Monad
import           Control.Monad.Except
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Class
import           Control.Monad.Trans.Except
import           Data.Bifunctor                        (first)
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.Set                              as S
import qualified Data.Text                             as T
import           Development.IDE                       (Recorder, WithPriority,
                                                        usePropertyAction)
import           Development.IDE.Core.PluginUtils
import           Development.IDE.Core.PositionMapping
import           Development.IDE.Core.RuleTypes
import           Development.IDE.Core.Service
import           Development.IDE.Core.Shake
import           Development.IDE.GHC.Compat.Core
import           Development.IDE.GHC.Compat.ExactPrint
import           Development.IDE.GHC.Compat.Parser
import           Development.IDE.GHC.Compat.Units
import           Development.IDE.GHC.Error
import           Development.IDE.GHC.ExactPrint
import qualified Development.IDE.GHC.ExactPrint        as E
import           Development.IDE.Plugin.CodeAction
import           Development.IDE.Spans.AtPoint
import           Development.IDE.Types.Location
import           HieDb.Query
import           Ide.Plugin.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
import           Language.LSP.Server

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 = mkPluginHandler SMethod_TextDocumentRename renameProvider
    , pluginConfigDescriptor = defaultConfigDescriptor
        { configCustomConfig = mkCustomConfig properties }
    }

renameProvider :: PluginMethodHandler IdeState Method_TextDocumentRename
renameProvider :: PluginMethodHandler IdeState 'Method_TextDocumentRename
renameProvider IdeState
state PluginId
pluginId (RenameParams Maybe ProgressToken
_prog docId :: TextDocumentIdentifier
docId@(TextDocumentIdentifier Uri
uri) Position
pos  Text
newNameText) = do
        NormalizedFilePath
nfp <- Uri -> ExceptT PluginError (LspM Config) NormalizedFilePath
forall (m :: * -> *).
Monad m =>
Uri -> ExceptT PluginError m NormalizedFilePath
getNormalizedFilePathE Uri
uri
        [Name]
directOldNames <- IdeState
-> NormalizedFilePath
-> Position
-> ExceptT PluginError (LspM 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 (LspM Config) [[Location]]
-> ExceptT PluginError (LspM Config) [Location]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Name -> ExceptT PluginError (LspM Config) [Location])
-> [Name] -> ExceptT PluginError (LspM 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 (LspM 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
Prelude.length) ([[Name]] -> [Name])
-> ExceptT PluginError (LspM Config) [[Name]]
-> ExceptT PluginError (LspM Config) [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            (Location -> ExceptT PluginError (LspM Config) [Name])
-> [Location] -> ExceptT PluginError (LspM 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 (LspM Config) [Name])
-> (NormalizedFilePath, Position)
-> ExceptT PluginError (LspM Config) [Name]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (IdeState
-> NormalizedFilePath
-> Position
-> ExceptT PluginError (LspM Config) [Name]
forall (m :: * -> *).
MonadIO m =>
IdeState
-> NormalizedFilePath -> Position -> ExceptT PluginError m [Name]
getNamesAtPos IdeState
state) ((NormalizedFilePath, Position)
 -> ExceptT PluginError (LspM Config) [Name])
-> (Location -> (NormalizedFilePath, Position))
-> Location
-> ExceptT PluginError (LspM Config) [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Location -> (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
            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
              where
                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
        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 (LspM Config) [[Location]]
-> ExceptT PluginError (LspM Config) (HashSet Location)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Name -> ExceptT PluginError (LspM Config) [Location])
-> [Name] -> ExceptT PluginError (LspM 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 (LspM 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 (LspM Config) Bool
forall a. IO a -> ExceptT PluginError (LspM Config) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ExceptT PluginError (LspM Config) Bool)
-> IO Bool -> ExceptT PluginError (LspM 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 (LspM Config) ()
-> ExceptT PluginError (LspM Config) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
crossModuleEnabled (ExceptT PluginError (LspM Config) ()
 -> ExceptT PluginError (LspM Config) ())
-> ExceptT PluginError (LspM Config) ()
-> ExceptT PluginError (LspM Config) ()
forall a b. (a -> b) -> a -> b
$ IdeState
-> NormalizedFilePath
-> HashSet Location
-> [Name]
-> ExceptT PluginError (LspM Config) ()
forall config (m :: * -> *).
MonadLsp config m =>
IdeState
-> NormalizedFilePath
-> HashSet Location
-> [Name]
-> ExceptT PluginError m ()
failWhenImportOrExport IdeState
state NormalizedFilePath
nfp HashSet Location
refs [Name]
oldNames
        Bool
-> ExceptT PluginError (LspM Config) ()
-> ExceptT PluginError (LspM 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 (LspM Config) ()
 -> ExceptT PluginError (LspM Config) ())
-> ExceptT PluginError (LspM Config) ()
-> ExceptT PluginError (LspM Config) ()
forall a b. (a -> b) -> a -> b
$ PluginError -> ExceptT PluginError (LspM Config) ()
forall a. PluginError -> ExceptT PluginError (LspM Config) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PluginError -> ExceptT PluginError (LspM Config) ())
-> PluginError -> ExceptT PluginError (LspM 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 a, Eq b) =>
(a -> b) -> HashSet a -> [(b, HashSet a)]
collectWith Location -> Uri
locToUri HashSet Location
refs
            getFileEdit :: (Uri, HashSet Location)
-> ExceptT PluginError (LspM Config) WorkspaceEdit
getFileEdit (Uri
uri, HashSet Location
locations) = do
              VersionedTextDocumentIdentifier
verTxtDocId <- LspM Config VersionedTextDocumentIdentifier
-> ExceptT
     PluginError (LspM 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 (LspM Config VersionedTextDocumentIdentifier
 -> ExceptT
      PluginError (LspM Config) VersionedTextDocumentIdentifier)
-> LspM Config VersionedTextDocumentIdentifier
-> ExceptT
     PluginError (LspM Config) VersionedTextDocumentIdentifier
forall a b. (a -> b) -> a -> b
$ TextDocumentIdentifier
-> LspM Config VersionedTextDocumentIdentifier
forall config (m :: * -> *).
MonadLsp config m =>
TextDocumentIdentifier -> m VersionedTextDocumentIdentifier
getVersionedTextDoc (Uri -> TextDocumentIdentifier
TextDocumentIdentifier Uri
uri)
              IdeState
-> VersionedTextDocumentIdentifier
-> (ParsedSource -> ParsedSource)
-> ExceptT PluginError (LspM Config) WorkspaceEdit
forall config (m :: * -> *).
MonadLsp config m =>
IdeState
-> VersionedTextDocumentIdentifier
-> (ParsedSource -> ParsedSource)
-> ExceptT PluginError m WorkspaceEdit
getSrcEdit IdeState
state VersionedTextDocumentIdentifier
verTxtDocId (OccName -> HashSet Location -> ParsedSource -> ParsedSource
replaceRefs OccName
newName HashSet Location
locations)
        [WorkspaceEdit]
fileEdits <- ((Uri, HashSet Location)
 -> ExceptT PluginError (LspM Config) WorkspaceEdit)
-> [(Uri, HashSet Location)]
-> ExceptT PluginError (LspM 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 (LspM Config) WorkspaceEdit
getFileEdit [(Uri, HashSet Location)]
filesRefs
        (WorkspaceEdit |? Null)
-> ExceptT PluginError (LspM Config) (WorkspaceEdit |? Null)
forall a. a -> ExceptT PluginError (LspM Config) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((WorkspaceEdit |? Null)
 -> ExceptT PluginError (LspM Config) (WorkspaceEdit |? Null))
-> (WorkspaceEdit |? Null)
-> ExceptT PluginError (LspM 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 -> WorkspaceEdit)
-> WorkspaceEdit -> [WorkspaceEdit] -> WorkspaceEdit
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' WorkspaceEdit -> WorkspaceEdit -> WorkspaceEdit
forall a. Semigroup a => a -> a -> a
(<>) WorkspaceEdit
forall a. Monoid a => a
mempty [WorkspaceEdit]
fileEdits

-- | Limit renaming across modules.
failWhenImportOrExport ::
    (MonadLsp config m) =>
    IdeState ->
    NormalizedFilePath ->
    HashSet Location ->
    [Name] ->
    ExceptT PluginError m ()
failWhenImportOrExport :: forall config (m :: * -> *).
MonadLsp config m =>
IdeState
-> NormalizedFilePath
-> HashSet Location
-> [Name]
-> ExceptT PluginError m ()
failWhenImportOrExport IdeState
state NormalizedFilePath
nfp HashSet Location
refLocs [Name]
names = do
    ParsedModule
pm <- String
-> IdeState
-> ExceptT PluginError Action ParsedModule
-> ExceptT PluginError m 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 m ()
forall a. PluginError -> ExceptT PluginError m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PluginError -> ExceptT PluginError m ())
-> PluginError -> ExceptT PluginError m ()
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 m ()
forall a. PluginError -> ExceptT PluginError m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PluginError -> ExceptT PluginError m ())
-> PluginError -> ExceptT PluginError m ()
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 m ()
forall a. PluginError -> ExceptT PluginError m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PluginError -> ExceptT PluginError m ())
-> PluginError -> ExceptT PluginError m ()
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 m ()
forall a. a -> ExceptT PluginError m 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 ::
    (MonadLsp config m) =>
    IdeState ->
    VersionedTextDocumentIdentifier ->
    (ParsedSource -> ParsedSource) ->
    ExceptT PluginError m WorkspaceEdit
getSrcEdit :: forall config (m :: * -> *).
MonadLsp config m =>
IdeState
-> VersionedTextDocumentIdentifier
-> (ParsedSource -> ParsedSource)
-> ExceptT PluginError m WorkspaceEdit
getSrcEdit IdeState
state VersionedTextDocumentIdentifier
verTxtDocId ParsedSource -> ParsedSource
updatePs = do
    ClientCapabilities
ccs <- m ClientCapabilities -> ExceptT PluginError m 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 m ClientCapabilities
forall config (m :: * -> *).
MonadLsp config m =>
m ClientCapabilities
getClientCapabilities
    NormalizedFilePath
nfp <- Uri -> ExceptT PluginError m 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)
    Annotated ParsedSource
annAst <- String
-> IdeState
-> ExceptT PluginError Action (Annotated ParsedSource)
-> ExceptT PluginError m (Annotated 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 (Annotated ParsedSource)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> ExceptT PluginError Action v
useE GetAnnotatedParsedSource
GetAnnotatedParsedSource NormalizedFilePath
nfp)
    let (ParsedSource
ps, ()
anns) = (Annotated ParsedSource -> ParsedSource
forall ast. Annotated ast -> ast
astA Annotated ParsedSource
annAst, Annotated ParsedSource -> ()
forall ast. Annotated ast -> ()
annsA Annotated ParsedSource
annAst)
    let 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 m WorkspaceEdit
forall a. a -> ExceptT PluginError m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WorkspaceEdit -> ExceptT PluginError m WorkspaceEdit)
-> WorkspaceEdit -> ExceptT PluginError m 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.
Typeable 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.
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 (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, PositionMapping)
ast <- IdeState
-> NormalizedFilePath
-> ExceptT PluginError m (HieAstResult, PositionMapping)
forall (m :: * -> *).
MonadIO m =>
IdeState
-> NormalizedFilePath
-> ExceptT PluginError m (HieAstResult, PositionMapping)
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, PositionMapping) -> [Location]
nameLocs Name
name (HieAstResult, PositionMapping)
ast [Location] -> [Location] -> [Location]
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) =
    ((RealSrcSpan, IdentifierDetails a) -> Maybe Location)
-> [(RealSrcSpan, IdentifierDetails a)] -> [Location]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (PositionMapping -> Location -> Maybe Location
toCurrentLocation PositionMapping
pm (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)
             (Maybe [(RealSrcSpan, IdentifierDetails a)]
-> [(RealSrcSpan, IdentifierDetails a)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Maybe [(RealSrcSpan, IdentifierDetails a)]
 -> [(RealSrcSpan, IdentifierDetails a)])
-> Maybe [(RealSrcSpan, IdentifierDetails a)]
-> [(RealSrcSpan, IdentifierDetails a)]
forall a b. (a -> b) -> a -> 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

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}, PositionMapping
pm) <- IdeState
-> NormalizedFilePath
-> ExceptT PluginError m (HieAstResult, PositionMapping)
forall (m :: * -> *).
MonadIO m =>
IdeState
-> NormalizedFilePath
-> ExceptT PluginError m (HieAstResult, PositionMapping)
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 -> PositionMapping -> [Name]
forall a. HieASTs a -> Position -> PositionMapping -> [Name]
getNamesAtPoint HieASTs a
hieAst Position
pos PositionMapping
pm

handleGetHieAst ::
    MonadIO m =>
    IdeState ->
    NormalizedFilePath ->
    ExceptT PluginError m (HieAstResult, PositionMapping)
handleGetHieAst :: forall (m :: * -> *).
MonadIO m =>
IdeState
-> NormalizedFilePath
-> ExceptT PluginError m (HieAstResult, PositionMapping)
handleGetHieAst IdeState
state NormalizedFilePath
nfp =
    ((HieAstResult, PositionMapping)
 -> (HieAstResult, PositionMapping))
-> ExceptT PluginError m (HieAstResult, PositionMapping)
-> ExceptT PluginError m (HieAstResult, PositionMapping)
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)
-> (HieAstResult, PositionMapping)
-> (HieAstResult, PositionMapping)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first HieAstResult -> HieAstResult
removeGenerated) (ExceptT PluginError m (HieAstResult, PositionMapping)
 -> ExceptT PluginError m (HieAstResult, PositionMapping))
-> ExceptT PluginError m (HieAstResult, PositionMapping)
-> ExceptT PluginError m (HieAstResult, PositionMapping)
forall a b. (a -> b) -> a -> b
$ String
-> IdeState
-> ExceptT PluginError Action (HieAstResult, PositionMapping)
-> ExceptT PluginError m (HieAstResult, PositionMapping)
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, PositionMapping)
 -> ExceptT PluginError m (HieAstResult, PositionMapping))
-> ExceptT PluginError Action (HieAstResult, PositionMapping)
-> ExceptT PluginError m (HieAstResult, PositionMapping)
forall a b. (a -> b) -> a -> b
$ GetHieAst
-> NormalizedFilePath
-> ExceptT PluginError Action (HieAstResult, PositionMapping)
forall k v.
IdeRule k v =>
k
-> NormalizedFilePath
-> ExceptT PluginError Action (v, PositionMapping)
useWithStaleE 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)

-- 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 = ([a] -> (b, HashSet a)) -> [[a]] -> [(b, HashSet a)]
forall a b. (a -> b) -> [a] -> [b]
map (\[a]
a -> (a -> b
f (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ [a] -> a
forall a. HasCallStack => [a] -> a
head [a]
a, [a] -> HashSet a
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList [a]
a)) ([[a]] -> [(b, HashSet a)])
-> (HashSet a -> [[a]]) -> HashSet a -> [(b, HashSet a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> [a] -> [[a]]
forall k a. Eq k => (a -> k) -> [a] -> [[a]]
groupOn a -> b
f ([a] -> [[a]]) -> (HashSet a -> [a]) -> HashSet a -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet a -> [a]
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 (String -> Uri)
-> (NormalizedFilePath -> String) -> NormalizedFilePath -> Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizedFilePath -> String
fromNormalizedFilePath

showName :: Name -> String
showName :: Name -> String
showName = OccName -> String
occNameString (OccName -> String) -> (Name -> OccName) -> Name -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> OccName
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       -> String -> Location
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 (NormalizedUri -> Maybe NormalizedFilePath)
-> (Uri -> NormalizedUri) -> Uri -> Maybe NormalizedFilePath
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 =
    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