{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
module Development.IDE.Plugin.Completions
( descriptor
, Log(..)
) where
import Control.Concurrent.Async (concurrently)
import Control.Concurrent.STM.Stats (readTVarIO)
import Control.Monad.Extra
import Control.Monad.IO.Class
import Control.Monad.Trans.Maybe
import Data.Aeson
import qualified Data.HashMap.Strict as Map
import qualified Data.HashSet as Set
import Data.List (find)
import Data.Maybe
import qualified Data.Text as T
import Development.IDE.Core.PositionMapping
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.Service hiding (Log,
LogShake)
import Development.IDE.Core.Shake hiding (Log)
import qualified Development.IDE.Core.Shake as Shake
import Development.IDE.GHC.Compat
import Development.IDE.GHC.Error (rangeToSrcSpan)
import Development.IDE.GHC.ExactPrint (GetAnnotatedParsedSource (GetAnnotatedParsedSource))
import Development.IDE.GHC.Util (printOutputable)
import Development.IDE.Graph
import Development.IDE.Plugin.CodeAction (newImport,
newImportToEdit)
import Development.IDE.Plugin.CodeAction.ExactPrint
import Development.IDE.Plugin.Completions.Logic
import Development.IDE.Plugin.Completions.Types
import Development.IDE.Types.Exports
import Development.IDE.Types.HscEnvEq (HscEnvEq (envPackageExports),
hscEnv)
import qualified Development.IDE.Types.KnownTargets as KT
import Development.IDE.Types.Location
import Development.IDE.Types.Logger (Pretty (pretty),
Recorder,
WithPriority,
cmapWithPrio)
import GHC.Exts (fromList, toList)
import Ide.Plugin.Config (Config)
import Ide.Types
import qualified Language.LSP.Server as LSP
import Language.LSP.Types
import qualified Language.LSP.VFS as VFS
import Text.Fuzzy.Parallel (Scored (..))
data Log = LogShake Shake.Log deriving Int -> Log -> ShowS
[Log] -> ShowS
Log -> String
(Int -> Log -> ShowS)
-> (Log -> String) -> ([Log] -> ShowS) -> Show Log
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Log] -> ShowS
$cshowList :: [Log] -> ShowS
show :: Log -> String
$cshow :: Log -> String
showsPrec :: Int -> Log -> ShowS
$cshowsPrec :: Int -> Log -> ShowS
Show
instance Pretty Log where
pretty :: Log -> Doc ann
pretty = \case
LogShake Log
log -> Log -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Log
log
descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
descriptor :: Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
descriptor Recorder (WithPriority Log)
recorder PluginId
plId = (PluginId -> PluginDescriptor IdeState
forall ideState. PluginId -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId)
{ pluginRules :: Rules ()
pluginRules = Recorder (WithPriority Log) -> Rules ()
produceCompletions Recorder (WithPriority Log)
recorder
, pluginHandlers :: PluginHandlers IdeState
pluginHandlers = SClientMethod 'TextDocumentCompletion
-> PluginMethodHandler IdeState 'TextDocumentCompletion
-> PluginHandlers IdeState
forall (m :: Method 'FromClient 'Request) ideState.
PluginMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SClientMethod 'TextDocumentCompletion
STextDocumentCompletion PluginMethodHandler IdeState 'TextDocumentCompletion
IdeState
-> PluginId
-> CompletionParams
-> LspM
Config
(Either ResponseError (ResponseResult 'TextDocumentCompletion))
getCompletionsLSP
, pluginCommands :: [PluginCommand IdeState]
pluginCommands = [PluginCommand IdeState
extendImportCommand]
, pluginConfigDescriptor :: ConfigDescriptor
pluginConfigDescriptor = ConfigDescriptor
defaultConfigDescriptor {configCustomConfig :: CustomConfig
configCustomConfig = Properties
'[ 'PropertyKey "autoExtendOn" 'TBoolean,
'PropertyKey "snippetsOn" 'TBoolean]
-> CustomConfig
forall (r :: [PropertyKey]). Properties r -> CustomConfig
mkCustomConfig Properties
'[ 'PropertyKey "autoExtendOn" 'TBoolean,
'PropertyKey "snippetsOn" 'TBoolean]
properties}
}
produceCompletions :: Recorder (WithPriority Log) -> Rules ()
produceCompletions :: Recorder (WithPriority Log) -> Rules ()
produceCompletions Recorder (WithPriority Log)
recorder = do
Recorder (WithPriority Log)
-> (LocalCompletions
-> NormalizedFilePath -> Action (IdeResult CachedCompletions))
-> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) ((LocalCompletions
-> NormalizedFilePath -> Action (IdeResult CachedCompletions))
-> Rules ())
-> (LocalCompletions
-> NormalizedFilePath -> Action (IdeResult CachedCompletions))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \LocalCompletions
LocalCompletions NormalizedFilePath
file -> do
let uri :: Uri
uri = NormalizedUri -> Uri
fromNormalizedUri (NormalizedUri -> Uri) -> NormalizedUri -> Uri
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> NormalizedUri
normalizedFilePathToUri NormalizedFilePath
file
Maybe (ParsedModule, PositionMapping)
pm <- GetParsedModule
-> NormalizedFilePath
-> Action (Maybe (ParsedModule, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale GetParsedModule
GetParsedModule NormalizedFilePath
file
case Maybe (ParsedModule, PositionMapping)
pm of
Just (ParsedModule
pm, PositionMapping
_) -> do
let cdata :: CachedCompletions
cdata = Uri -> ParsedModule -> CachedCompletions
localCompletionsForParsedModule Uri
uri ParsedModule
pm
IdeResult CachedCompletions -> Action (IdeResult CachedCompletions)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], CachedCompletions -> Maybe CachedCompletions
forall a. a -> Maybe a
Just CachedCompletions
cdata)
Maybe (ParsedModule, PositionMapping)
_ -> IdeResult CachedCompletions -> Action (IdeResult CachedCompletions)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Maybe CachedCompletions
forall a. Maybe a
Nothing)
Recorder (WithPriority Log)
-> (NonLocalCompletions
-> NormalizedFilePath -> Action (IdeResult CachedCompletions))
-> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) ((NonLocalCompletions
-> NormalizedFilePath -> Action (IdeResult CachedCompletions))
-> Rules ())
-> (NonLocalCompletions
-> NormalizedFilePath -> Action (IdeResult CachedCompletions))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \NonLocalCompletions
NonLocalCompletions NormalizedFilePath
file -> do
Maybe ModSummaryResult
ms <- ((ModSummaryResult, PositionMapping) -> ModSummaryResult)
-> Maybe (ModSummaryResult, PositionMapping)
-> Maybe ModSummaryResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ModSummaryResult, PositionMapping) -> ModSummaryResult
forall a b. (a, b) -> a
fst (Maybe (ModSummaryResult, PositionMapping)
-> Maybe ModSummaryResult)
-> Action (Maybe (ModSummaryResult, PositionMapping))
-> Action (Maybe ModSummaryResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetModSummaryWithoutTimestamps
-> NormalizedFilePath
-> Action (Maybe (ModSummaryResult, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale GetModSummaryWithoutTimestamps
GetModSummaryWithoutTimestamps NormalizedFilePath
file
Maybe HscEnvEq
sess <- ((HscEnvEq, PositionMapping) -> HscEnvEq)
-> Maybe (HscEnvEq, PositionMapping) -> Maybe HscEnvEq
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HscEnvEq, PositionMapping) -> HscEnvEq
forall a b. (a, b) -> a
fst (Maybe (HscEnvEq, PositionMapping) -> Maybe HscEnvEq)
-> Action (Maybe (HscEnvEq, PositionMapping))
-> Action (Maybe HscEnvEq)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GhcSessionDeps
-> NormalizedFilePath -> Action (Maybe (HscEnvEq, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale GhcSessionDeps
GhcSessionDeps NormalizedFilePath
file
case (Maybe ModSummaryResult
ms, Maybe HscEnvEq
sess) of
(Just ModSummaryResult{[LImportDecl GhcPs]
Fingerprint
ModSummary
msrFingerprint :: ModSummaryResult -> Fingerprint
msrImports :: ModSummaryResult -> [LImportDecl GhcPs]
msrModSummary :: ModSummaryResult -> ModSummary
msrFingerprint :: Fingerprint
msrImports :: [LImportDecl GhcPs]
msrModSummary :: ModSummary
..}, Just HscEnvEq
sess) -> do
let env :: HscEnv
env = HscEnvEq -> HscEnv
hscEnv HscEnvEq
sess
((Messages, Maybe GlobalRdrEnv)
global, (Messages, Maybe GlobalRdrEnv)
inScope) <- IO ((Messages, Maybe GlobalRdrEnv), (Messages, Maybe GlobalRdrEnv))
-> Action
((Messages, Maybe GlobalRdrEnv), (Messages, Maybe GlobalRdrEnv))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
((Messages, Maybe GlobalRdrEnv), (Messages, Maybe GlobalRdrEnv))
-> Action
((Messages, Maybe GlobalRdrEnv), (Messages, Maybe GlobalRdrEnv)))
-> IO
((Messages, Maybe GlobalRdrEnv), (Messages, Maybe GlobalRdrEnv))
-> Action
((Messages, Maybe GlobalRdrEnv), (Messages, Maybe GlobalRdrEnv))
forall a b. (a -> b) -> a -> b
$ HscEnv -> [LImportDecl GhcPs] -> IO (Messages, Maybe GlobalRdrEnv)
tcRnImportDecls HscEnv
env (LImportDecl GhcPs -> LImportDecl GhcPs
dropListFromImportDecl (LImportDecl GhcPs -> LImportDecl GhcPs)
-> [LImportDecl GhcPs] -> [LImportDecl GhcPs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LImportDecl GhcPs]
msrImports) IO (Messages, Maybe GlobalRdrEnv)
-> IO (Messages, Maybe GlobalRdrEnv)
-> IO
((Messages, Maybe GlobalRdrEnv), (Messages, Maybe GlobalRdrEnv))
forall a b. IO a -> IO b -> IO (a, b)
`concurrently` HscEnv -> [LImportDecl GhcPs] -> IO (Messages, Maybe GlobalRdrEnv)
tcRnImportDecls HscEnv
env [LImportDecl GhcPs]
msrImports
case ((Messages, Maybe GlobalRdrEnv)
global, (Messages, Maybe GlobalRdrEnv)
inScope) of
((Messages
_, Just GlobalRdrEnv
globalEnv), (Messages
_, Just GlobalRdrEnv
inScopeEnv)) -> do
let uri :: Uri
uri = NormalizedUri -> Uri
fromNormalizedUri (NormalizedUri -> Uri) -> NormalizedUri -> Uri
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> NormalizedUri
normalizedFilePathToUri NormalizedFilePath
file
CachedCompletions
cdata <- IO CachedCompletions -> Action CachedCompletions
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CachedCompletions -> Action CachedCompletions)
-> IO CachedCompletions -> Action CachedCompletions
forall a b. (a -> b) -> a -> b
$ Uri
-> HscEnvEq
-> Module
-> GlobalRdrEnv
-> GlobalRdrEnv
-> [LImportDecl GhcPs]
-> IO CachedCompletions
cacheDataProducer Uri
uri HscEnvEq
sess (ModSummary -> Module
ms_mod ModSummary
msrModSummary) GlobalRdrEnv
globalEnv GlobalRdrEnv
inScopeEnv [LImportDecl GhcPs]
msrImports
IdeResult CachedCompletions -> Action (IdeResult CachedCompletions)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], CachedCompletions -> Maybe CachedCompletions
forall a. a -> Maybe a
Just CachedCompletions
cdata)
((Messages, Maybe GlobalRdrEnv)
_diag, (Messages, Maybe GlobalRdrEnv)
_) ->
IdeResult CachedCompletions -> Action (IdeResult CachedCompletions)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Maybe CachedCompletions
forall a. Maybe a
Nothing)
(Maybe ModSummaryResult, Maybe HscEnvEq)
_ -> IdeResult CachedCompletions -> Action (IdeResult CachedCompletions)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Maybe CachedCompletions
forall a. Maybe a
Nothing)
dropListFromImportDecl :: LImportDecl GhcPs -> LImportDecl GhcPs
dropListFromImportDecl :: LImportDecl GhcPs -> LImportDecl GhcPs
dropListFromImportDecl LImportDecl GhcPs
iDecl = let
f :: ImportDecl pass -> ImportDecl pass
f d :: ImportDecl pass
d@ImportDecl {Maybe (Bool, Located [LIE pass])
ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding :: Maybe (Bool, Located [LIE pass])
ideclHiding} = case Maybe (Bool, Located [LIE pass])
ideclHiding of
Just (Bool
False, Located [LIE pass]
_) -> ImportDecl pass
d {ideclHiding :: Maybe (Bool, Located [LIE pass])
ideclHiding=Maybe (Bool, Located [LIE pass])
forall a. Maybe a
Nothing}
Maybe (Bool, Located [LIE pass])
_ -> ImportDecl pass
d
f ImportDecl pass
x = ImportDecl pass
x
in ImportDecl GhcPs -> ImportDecl GhcPs
forall pass. ImportDecl pass -> ImportDecl pass
f (ImportDecl GhcPs -> ImportDecl GhcPs)
-> LImportDecl GhcPs -> LImportDecl GhcPs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LImportDecl GhcPs
iDecl
getCompletionsLSP
:: IdeState
-> PluginId
-> CompletionParams
-> LSP.LspM Config (Either ResponseError (ResponseResult TextDocumentCompletion))
getCompletionsLSP :: IdeState
-> PluginId
-> CompletionParams
-> LspM
Config
(Either ResponseError (ResponseResult 'TextDocumentCompletion))
getCompletionsLSP IdeState
ide PluginId
plId
CompletionParams{$sel:_textDocument:CompletionParams :: CompletionParams -> TextDocumentIdentifier
_textDocument=TextDocumentIdentifier Uri
uri
,$sel:_position:CompletionParams :: CompletionParams -> Position
_position=Position
position
,$sel:_context:CompletionParams :: CompletionParams -> Maybe CompletionContext
_context=Maybe CompletionContext
completionContext} = do
Maybe VirtualFile
contents <- NormalizedUri -> LspT Config IO (Maybe VirtualFile)
forall config (m :: * -> *).
MonadLsp config m =>
NormalizedUri -> m (Maybe VirtualFile)
LSP.getVirtualFile (NormalizedUri -> LspT Config IO (Maybe VirtualFile))
-> NormalizedUri -> LspT Config IO (Maybe VirtualFile)
forall a b. (a -> b) -> a -> b
$ Uri -> NormalizedUri
toNormalizedUri Uri
uri
((List CompletionItem |? CompletionList)
-> Either ResponseError (List CompletionItem |? CompletionList))
-> LspT Config IO (List CompletionItem |? CompletionList)
-> LspT
Config
IO
(Either ResponseError (List CompletionItem |? CompletionList))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (List CompletionItem |? CompletionList)
-> Either ResponseError (List CompletionItem |? CompletionList)
forall a b. b -> Either a b
Right (LspT Config IO (List CompletionItem |? CompletionList)
-> LspT
Config
IO
(Either ResponseError (List CompletionItem |? CompletionList)))
-> LspT Config IO (List CompletionItem |? CompletionList)
-> LspT
Config
IO
(Either ResponseError (List CompletionItem |? CompletionList))
forall a b. (a -> b) -> a -> b
$ case (Maybe VirtualFile
contents, Uri -> Maybe String
uriToFilePath' Uri
uri) of
(Just VirtualFile
cnts, Just String
path) -> do
let npath :: NormalizedFilePath
npath = String -> NormalizedFilePath
toNormalizedFilePath' String
path
(IdeOptions
ideOpts, Maybe
(CachedCompletions, Maybe (ParsedModule, PositionMapping),
(Bindings, PositionMapping))
compls, HashMap ModuleNameText (HashSet IdentInfo)
moduleExports) <- IO
(IdeOptions,
Maybe
(CachedCompletions, Maybe (ParsedModule, PositionMapping),
(Bindings, PositionMapping)),
HashMap ModuleNameText (HashSet IdentInfo))
-> LspT
Config
IO
(IdeOptions,
Maybe
(CachedCompletions, Maybe (ParsedModule, PositionMapping),
(Bindings, PositionMapping)),
HashMap ModuleNameText (HashSet IdentInfo))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
(IdeOptions,
Maybe
(CachedCompletions, Maybe (ParsedModule, PositionMapping),
(Bindings, PositionMapping)),
HashMap ModuleNameText (HashSet IdentInfo))
-> LspT
Config
IO
(IdeOptions,
Maybe
(CachedCompletions, Maybe (ParsedModule, PositionMapping),
(Bindings, PositionMapping)),
HashMap ModuleNameText (HashSet IdentInfo)))
-> IO
(IdeOptions,
Maybe
(CachedCompletions, Maybe (ParsedModule, PositionMapping),
(Bindings, PositionMapping)),
HashMap ModuleNameText (HashSet IdentInfo))
-> LspT
Config
IO
(IdeOptions,
Maybe
(CachedCompletions, Maybe (ParsedModule, PositionMapping),
(Bindings, PositionMapping)),
HashMap ModuleNameText (HashSet IdentInfo))
forall a b. (a -> b) -> a -> b
$ String
-> ShakeExtras
-> IdeAction
(IdeOptions,
Maybe
(CachedCompletions, Maybe (ParsedModule, PositionMapping),
(Bindings, PositionMapping)),
HashMap ModuleNameText (HashSet IdentInfo))
-> IO
(IdeOptions,
Maybe
(CachedCompletions, Maybe (ParsedModule, PositionMapping),
(Bindings, PositionMapping)),
HashMap ModuleNameText (HashSet IdentInfo))
forall a. String -> ShakeExtras -> IdeAction a -> IO a
runIdeAction String
"Completion" (IdeState -> ShakeExtras
shakeExtras IdeState
ide) (IdeAction
(IdeOptions,
Maybe
(CachedCompletions, Maybe (ParsedModule, PositionMapping),
(Bindings, PositionMapping)),
HashMap ModuleNameText (HashSet IdentInfo))
-> IO
(IdeOptions,
Maybe
(CachedCompletions, Maybe (ParsedModule, PositionMapping),
(Bindings, PositionMapping)),
HashMap ModuleNameText (HashSet IdentInfo)))
-> IdeAction
(IdeOptions,
Maybe
(CachedCompletions, Maybe (ParsedModule, PositionMapping),
(Bindings, PositionMapping)),
HashMap ModuleNameText (HashSet IdentInfo))
-> IO
(IdeOptions,
Maybe
(CachedCompletions, Maybe (ParsedModule, PositionMapping),
(Bindings, PositionMapping)),
HashMap ModuleNameText (HashSet IdentInfo))
forall a b. (a -> b) -> a -> b
$ do
IdeOptions
opts <- IO IdeOptions -> IdeAction IdeOptions
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IdeOptions -> IdeAction IdeOptions)
-> IO IdeOptions -> IdeAction IdeOptions
forall a b. (a -> b) -> a -> b
$ ShakeExtras -> IO IdeOptions
getIdeOptionsIO (ShakeExtras -> IO IdeOptions) -> ShakeExtras -> IO IdeOptions
forall a b. (a -> b) -> a -> b
$ IdeState -> ShakeExtras
shakeExtras IdeState
ide
Maybe (CachedCompletions, PositionMapping)
localCompls <- LocalCompletions
-> NormalizedFilePath
-> IdeAction (Maybe (CachedCompletions, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))
useWithStaleFast LocalCompletions
LocalCompletions NormalizedFilePath
npath
Maybe (CachedCompletions, PositionMapping)
nonLocalCompls <- NonLocalCompletions
-> NormalizedFilePath
-> IdeAction (Maybe (CachedCompletions, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))
useWithStaleFast NonLocalCompletions
NonLocalCompletions NormalizedFilePath
npath
Maybe (ParsedModule, PositionMapping)
pm <- GetParsedModule
-> NormalizedFilePath
-> IdeAction (Maybe (ParsedModule, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))
useWithStaleFast GetParsedModule
GetParsedModule NormalizedFilePath
npath
(Bindings, PositionMapping)
binds <- (Bindings, PositionMapping)
-> Maybe (Bindings, PositionMapping) -> (Bindings, PositionMapping)
forall a. a -> Maybe a -> a
fromMaybe (Bindings
forall a. Monoid a => a
mempty, PositionMapping
zeroMapping) (Maybe (Bindings, PositionMapping) -> (Bindings, PositionMapping))
-> IdeAction (Maybe (Bindings, PositionMapping))
-> IdeAction (Bindings, PositionMapping)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetBindings
-> NormalizedFilePath
-> IdeAction (Maybe (Bindings, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))
useWithStaleFast GetBindings
GetBindings NormalizedFilePath
npath
Maybe (HashMap Target (HashSet NormalizedFilePath))
knownTargets <- IO (Maybe (HashMap Target (HashSet NormalizedFilePath)))
-> IdeAction (Maybe (HashMap Target (HashSet NormalizedFilePath)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (HashMap Target (HashSet NormalizedFilePath)))
-> IdeAction (Maybe (HashMap Target (HashSet NormalizedFilePath))))
-> IO (Maybe (HashMap Target (HashSet NormalizedFilePath)))
-> IdeAction (Maybe (HashMap Target (HashSet NormalizedFilePath)))
forall a b. (a -> b) -> a -> b
$ String
-> IdeState
-> Action (Maybe (HashMap Target (HashSet NormalizedFilePath)))
-> IO (Maybe (HashMap Target (HashSet NormalizedFilePath)))
forall a. String -> IdeState -> Action a -> IO a
runAction String
"Completion" IdeState
ide (Action (Maybe (HashMap Target (HashSet NormalizedFilePath)))
-> IO (Maybe (HashMap Target (HashSet NormalizedFilePath))))
-> Action (Maybe (HashMap Target (HashSet NormalizedFilePath)))
-> IO (Maybe (HashMap Target (HashSet NormalizedFilePath)))
forall a b. (a -> b) -> a -> b
$ GetKnownTargets
-> Action (Maybe (HashMap Target (HashSet NormalizedFilePath)))
forall k v. IdeRule k v => k -> Action (Maybe v)
useNoFile GetKnownTargets
GetKnownTargets
let localModules :: [Target]
localModules = [Target]
-> (HashMap Target (HashSet NormalizedFilePath) -> [Target])
-> Maybe (HashMap Target (HashSet NormalizedFilePath))
-> [Target]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] HashMap Target (HashSet NormalizedFilePath) -> [Target]
forall k v. HashMap k v -> [k]
Map.keys Maybe (HashMap Target (HashSet NormalizedFilePath))
knownTargets
let lModules :: CachedCompletions
lModules = CachedCompletions
forall a. Monoid a => a
mempty{importableModules :: [ModuleNameText]
importableModules = (Target -> ModuleNameText) -> [Target] -> [ModuleNameText]
forall a b. (a -> b) -> [a] -> [b]
map Target -> ModuleNameText
toModueNameText [Target]
localModules}
Maybe (IO ExportsMap)
packageExportsMapIO <- ((HscEnvEq, PositionMapping) -> IO ExportsMap)
-> Maybe (HscEnvEq, PositionMapping) -> Maybe (IO ExportsMap)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(HscEnvEq -> IO ExportsMap
envPackageExports (HscEnvEq -> IO ExportsMap)
-> ((HscEnvEq, PositionMapping) -> HscEnvEq)
-> (HscEnvEq, PositionMapping)
-> IO ExportsMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HscEnvEq, PositionMapping) -> HscEnvEq
forall a b. (a, b) -> a
fst) (Maybe (HscEnvEq, PositionMapping) -> Maybe (IO ExportsMap))
-> IdeAction (Maybe (HscEnvEq, PositionMapping))
-> IdeAction (Maybe (IO ExportsMap))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GhcSession
-> NormalizedFilePath
-> IdeAction (Maybe (HscEnvEq, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))
useWithStaleFast GhcSession
GhcSession NormalizedFilePath
npath
Maybe ExportsMap
packageExportsMap <- (IO ExportsMap -> IdeAction ExportsMap)
-> Maybe (IO ExportsMap) -> IdeAction (Maybe ExportsMap)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IO ExportsMap -> IdeAction ExportsMap
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO Maybe (IO ExportsMap)
packageExportsMapIO
ExportsMap
projectExportsMap <- IO ExportsMap -> IdeAction ExportsMap
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ExportsMap -> IdeAction ExportsMap)
-> IO ExportsMap -> IdeAction ExportsMap
forall a b. (a -> b) -> a -> b
$ TVar ExportsMap -> IO ExportsMap
forall a. TVar a -> IO a
readTVarIO (ShakeExtras -> TVar ExportsMap
exportsMap (ShakeExtras -> TVar ExportsMap) -> ShakeExtras -> TVar ExportsMap
forall a b. (a -> b) -> a -> b
$ IdeState -> ShakeExtras
shakeExtras IdeState
ide)
let exportsMap :: ExportsMap
exportsMap = ExportsMap -> Maybe ExportsMap -> ExportsMap
forall a. a -> Maybe a -> a
fromMaybe ExportsMap
forall a. Monoid a => a
mempty Maybe ExportsMap
packageExportsMap ExportsMap -> ExportsMap -> ExportsMap
forall a. Semigroup a => a -> a -> a
<> ExportsMap
projectExportsMap
let moduleExports :: HashMap ModuleNameText (HashSet IdentInfo)
moduleExports = ExportsMap -> HashMap ModuleNameText (HashSet IdentInfo)
getModuleExportsMap ExportsMap
exportsMap
exportsCompItems :: [Maybe ModuleNameText -> CompItem]
exportsCompItems = (HashSet IdentInfo -> [Maybe ModuleNameText -> CompItem])
-> [HashSet IdentInfo] -> [Maybe ModuleNameText -> CompItem]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((IdentInfo -> Maybe ModuleNameText -> CompItem)
-> [IdentInfo] -> [Maybe ModuleNameText -> CompItem]
forall a b. (a -> b) -> [a] -> [b]
map (Uri -> IdentInfo -> Maybe ModuleNameText -> CompItem
fromIdentInfo Uri
uri) ([IdentInfo] -> [Maybe ModuleNameText -> CompItem])
-> (HashSet IdentInfo -> [IdentInfo])
-> HashSet IdentInfo
-> [Maybe ModuleNameText -> CompItem]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet IdentInfo -> [IdentInfo]
forall a. HashSet a -> [a]
Set.toList) ([HashSet IdentInfo] -> [Maybe ModuleNameText -> CompItem])
-> (ExportsMap -> [HashSet IdentInfo])
-> ExportsMap
-> [Maybe ModuleNameText -> CompItem]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap ModuleNameText (HashSet IdentInfo) -> [HashSet IdentInfo]
forall k v. HashMap k v -> [v]
Map.elems (HashMap ModuleNameText (HashSet IdentInfo) -> [HashSet IdentInfo])
-> (ExportsMap -> HashMap ModuleNameText (HashSet IdentInfo))
-> ExportsMap
-> [HashSet IdentInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExportsMap -> HashMap ModuleNameText (HashSet IdentInfo)
getExportsMap (ExportsMap -> [Maybe ModuleNameText -> CompItem])
-> ExportsMap -> [Maybe ModuleNameText -> CompItem]
forall a b. (a -> b) -> a -> b
$ ExportsMap
exportsMap
exportsCompls :: CachedCompletions
exportsCompls = CachedCompletions
forall a. Monoid a => a
mempty{anyQualCompls :: [Maybe ModuleNameText -> CompItem]
anyQualCompls = [Maybe ModuleNameText -> CompItem]
exportsCompItems}
let compls :: Maybe CachedCompletions
compls = ((CachedCompletions, PositionMapping) -> CachedCompletions
forall a b. (a, b) -> a
fst ((CachedCompletions, PositionMapping) -> CachedCompletions)
-> Maybe (CachedCompletions, PositionMapping)
-> Maybe CachedCompletions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (CachedCompletions, PositionMapping)
localCompls) Maybe CachedCompletions
-> Maybe CachedCompletions -> Maybe CachedCompletions
forall a. Semigroup a => a -> a -> a
<> ((CachedCompletions, PositionMapping) -> CachedCompletions
forall a b. (a, b) -> a
fst ((CachedCompletions, PositionMapping) -> CachedCompletions)
-> Maybe (CachedCompletions, PositionMapping)
-> Maybe CachedCompletions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (CachedCompletions, PositionMapping)
nonLocalCompls) Maybe CachedCompletions
-> Maybe CachedCompletions -> Maybe CachedCompletions
forall a. Semigroup a => a -> a -> a
<> CachedCompletions -> Maybe CachedCompletions
forall a. a -> Maybe a
Just CachedCompletions
exportsCompls Maybe CachedCompletions
-> Maybe CachedCompletions -> Maybe CachedCompletions
forall a. Semigroup a => a -> a -> a
<> CachedCompletions -> Maybe CachedCompletions
forall a. a -> Maybe a
Just CachedCompletions
lModules
(IdeOptions,
Maybe
(CachedCompletions, Maybe (ParsedModule, PositionMapping),
(Bindings, PositionMapping)),
HashMap ModuleNameText (HashSet IdentInfo))
-> IdeAction
(IdeOptions,
Maybe
(CachedCompletions, Maybe (ParsedModule, PositionMapping),
(Bindings, PositionMapping)),
HashMap ModuleNameText (HashSet IdentInfo))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IdeOptions
opts, (CachedCompletions
-> (CachedCompletions, Maybe (ParsedModule, PositionMapping),
(Bindings, PositionMapping)))
-> Maybe CachedCompletions
-> Maybe
(CachedCompletions, Maybe (ParsedModule, PositionMapping),
(Bindings, PositionMapping))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,Maybe (ParsedModule, PositionMapping)
pm,(Bindings, PositionMapping)
binds) Maybe CachedCompletions
compls, HashMap ModuleNameText (HashSet IdentInfo)
moduleExports)
case Maybe
(CachedCompletions, Maybe (ParsedModule, PositionMapping),
(Bindings, PositionMapping))
compls of
Just (CachedCompletions
cci', Maybe (ParsedModule, PositionMapping)
parsedMod, (Bindings, PositionMapping)
bindMap) -> do
Maybe PosPrefixInfo
pfix <- Position -> VirtualFile -> LspT Config IO (Maybe PosPrefixInfo)
forall (m :: * -> *).
Monad m =>
Position -> VirtualFile -> m (Maybe PosPrefixInfo)
VFS.getCompletionPrefix Position
position VirtualFile
cnts
case (Maybe PosPrefixInfo
pfix, Maybe CompletionContext
completionContext) of
(Just (VFS.PosPrefixInfo ModuleNameText
_ ModuleNameText
"" ModuleNameText
_ Position
_), Just CompletionContext { $sel:_triggerCharacter:CompletionContext :: CompletionContext -> Maybe ModuleNameText
_triggerCharacter = Just ModuleNameText
"."})
-> (List CompletionItem |? CompletionList)
-> LspT Config IO (List CompletionItem |? CompletionList)
forall (m :: * -> *) a. Monad m => a -> m a
return (List CompletionItem -> List CompletionItem |? CompletionList
forall a b. a -> a |? b
InL (List CompletionItem -> List CompletionItem |? CompletionList)
-> List CompletionItem -> List CompletionItem |? CompletionList
forall a b. (a -> b) -> a -> b
$ [CompletionItem] -> List CompletionItem
forall a. [a] -> List a
List [])
(Just PosPrefixInfo
pfix', Maybe CompletionContext
_) -> do
let clientCaps :: ClientCapabilities
clientCaps = ShakeExtras -> ClientCapabilities
clientCapabilities (ShakeExtras -> ClientCapabilities)
-> ShakeExtras -> ClientCapabilities
forall a b. (a -> b) -> a -> b
$ IdeState -> ShakeExtras
shakeExtras IdeState
ide
CompletionsConfig
config <- PluginId -> LspT Config IO CompletionsConfig
forall (m :: * -> *).
MonadLsp Config m =>
PluginId -> m CompletionsConfig
getCompletionsConfig PluginId
plId
[Scored CompletionItem]
allCompletions <- IO [Scored CompletionItem]
-> LspT Config IO [Scored CompletionItem]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Scored CompletionItem]
-> LspT Config IO [Scored CompletionItem])
-> IO [Scored CompletionItem]
-> LspT Config IO [Scored CompletionItem]
forall a b. (a -> b) -> a -> b
$ PluginId
-> IdeOptions
-> CachedCompletions
-> Maybe (ParsedModule, PositionMapping)
-> (Bindings, PositionMapping)
-> PosPrefixInfo
-> ClientCapabilities
-> CompletionsConfig
-> HashMap ModuleNameText (HashSet IdentInfo)
-> IO [Scored CompletionItem]
getCompletions PluginId
plId IdeOptions
ideOpts CachedCompletions
cci' Maybe (ParsedModule, PositionMapping)
parsedMod (Bindings, PositionMapping)
bindMap PosPrefixInfo
pfix' ClientCapabilities
clientCaps CompletionsConfig
config HashMap ModuleNameText (HashSet IdentInfo)
moduleExports
(List CompletionItem |? CompletionList)
-> LspT Config IO (List CompletionItem |? CompletionList)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((List CompletionItem |? CompletionList)
-> LspT Config IO (List CompletionItem |? CompletionList))
-> (List CompletionItem |? CompletionList)
-> LspT Config IO (List CompletionItem |? CompletionList)
forall a b. (a -> b) -> a -> b
$ List CompletionItem -> List CompletionItem |? CompletionList
forall a b. a -> a |? b
InL ([CompletionItem] -> List CompletionItem
forall a. [a] -> List a
List ([CompletionItem] -> List CompletionItem)
-> [CompletionItem] -> List CompletionItem
forall a b. (a -> b) -> a -> b
$ [Scored CompletionItem] -> [CompletionItem]
orderedCompletions [Scored CompletionItem]
allCompletions)
(Maybe PosPrefixInfo, Maybe CompletionContext)
_ -> (List CompletionItem |? CompletionList)
-> LspT Config IO (List CompletionItem |? CompletionList)
forall (m :: * -> *) a. Monad m => a -> m a
return (List CompletionItem -> List CompletionItem |? CompletionList
forall a b. a -> a |? b
InL (List CompletionItem -> List CompletionItem |? CompletionList)
-> List CompletionItem -> List CompletionItem |? CompletionList
forall a b. (a -> b) -> a -> b
$ [CompletionItem] -> List CompletionItem
forall a. [a] -> List a
List [])
Maybe
(CachedCompletions, Maybe (ParsedModule, PositionMapping),
(Bindings, PositionMapping))
_ -> (List CompletionItem |? CompletionList)
-> LspT Config IO (List CompletionItem |? CompletionList)
forall (m :: * -> *) a. Monad m => a -> m a
return (List CompletionItem -> List CompletionItem |? CompletionList
forall a b. a -> a |? b
InL (List CompletionItem -> List CompletionItem |? CompletionList)
-> List CompletionItem -> List CompletionItem |? CompletionList
forall a b. (a -> b) -> a -> b
$ [CompletionItem] -> List CompletionItem
forall a. [a] -> List a
List [])
(Maybe VirtualFile, Maybe String)
_ -> (List CompletionItem |? CompletionList)
-> LspT Config IO (List CompletionItem |? CompletionList)
forall (m :: * -> *) a. Monad m => a -> m a
return (List CompletionItem -> List CompletionItem |? CompletionList
forall a b. a -> a |? b
InL (List CompletionItem -> List CompletionItem |? CompletionList)
-> List CompletionItem -> List CompletionItem |? CompletionList
forall a b. (a -> b) -> a -> b
$ [CompletionItem] -> List CompletionItem
forall a. [a] -> List a
List [])
orderedCompletions :: [Scored CompletionItem] -> [CompletionItem]
orderedCompletions :: [Scored CompletionItem] -> [CompletionItem]
orderedCompletions [] = []
orderedCompletions [Scored CompletionItem]
xx = (Int -> Scored CompletionItem -> CompletionItem)
-> [Int] -> [Scored CompletionItem] -> [CompletionItem]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Scored CompletionItem -> CompletionItem
addOrder [Int
0..] [Scored CompletionItem]
xx
where
lxx :: Int
lxx = Int -> Int
digits (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ [Scored CompletionItem] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [Scored CompletionItem]
xx
digits :: Int -> Int
digits = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length (String -> Int) -> (Int -> String) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show
addOrder :: Int -> Scored CompletionItem -> CompletionItem
addOrder :: Int -> Scored CompletionItem -> CompletionItem
addOrder Int
n Scored{original :: forall a. Scored a -> a
original = it :: CompletionItem
it@CompletionItem{ModuleNameText
$sel:_label:CompletionItem :: CompletionItem -> ModuleNameText
_label :: ModuleNameText
_label,Maybe ModuleNameText
$sel:_sortText:CompletionItem :: CompletionItem -> Maybe ModuleNameText
_sortText :: Maybe ModuleNameText
_sortText}} =
CompletionItem
it{$sel:_sortText:CompletionItem :: Maybe ModuleNameText
_sortText = ModuleNameText -> Maybe ModuleNameText
forall a. a -> Maybe a
Just (ModuleNameText -> Maybe ModuleNameText)
-> ModuleNameText -> Maybe ModuleNameText
forall a b. (a -> b) -> a -> b
$
String -> ModuleNameText
T.pack(Int -> Int -> String
forall a. Show a => Int -> a -> String
pad Int
lxx Int
n)
}
pad :: Int -> a -> String
pad Int
n a
x = let sx :: String
sx = a -> String
forall a. Show a => a -> String
show a
x in Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length String
sx) Char
'0' String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
sx
toModueNameText :: KT.Target -> T.Text
toModueNameText :: Target -> ModuleNameText
toModueNameText Target
target = case Target
target of
KT.TargetModule ModuleName
m -> String -> ModuleNameText
T.pack (String -> ModuleNameText) -> String -> ModuleNameText
forall a b. (a -> b) -> a -> b
$ ModuleName -> String
moduleNameString ModuleName
m
Target
_ -> ModuleNameText
T.empty
extendImportCommand :: PluginCommand IdeState
extendImportCommand :: PluginCommand IdeState
extendImportCommand =
CommandId
-> ModuleNameText
-> CommandFunction IdeState ExtendImport
-> PluginCommand IdeState
forall ideState a.
FromJSON a =>
CommandId
-> ModuleNameText
-> CommandFunction ideState a
-> PluginCommand ideState
PluginCommand (ModuleNameText -> CommandId
CommandId ModuleNameText
extendImportCommandId) ModuleNameText
"additional edits for a completion" CommandFunction IdeState ExtendImport
extendImportHandler
extendImportHandler :: CommandFunction IdeState ExtendImport
extendImportHandler :: CommandFunction IdeState ExtendImport
extendImportHandler IdeState
ideState edit :: ExtendImport
edit@ExtendImport {Maybe ModuleNameText
ModuleNameText
Uri
importQual :: ExtendImport -> Maybe ModuleNameText
importName :: ExtendImport -> ModuleNameText
thingParent :: ExtendImport -> Maybe ModuleNameText
newThing :: ExtendImport -> ModuleNameText
doc :: ExtendImport -> Uri
importQual :: Maybe ModuleNameText
importName :: ModuleNameText
thingParent :: Maybe ModuleNameText
newThing :: ModuleNameText
doc :: Uri
..} = do
Maybe (NormalizedFilePath, WorkspaceEdit)
res <- IO (Maybe (NormalizedFilePath, WorkspaceEdit))
-> LspT Config IO (Maybe (NormalizedFilePath, WorkspaceEdit))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (NormalizedFilePath, WorkspaceEdit))
-> LspT Config IO (Maybe (NormalizedFilePath, WorkspaceEdit)))
-> IO (Maybe (NormalizedFilePath, WorkspaceEdit))
-> LspT Config IO (Maybe (NormalizedFilePath, WorkspaceEdit))
forall a b. (a -> b) -> a -> b
$ MaybeT IO (NormalizedFilePath, WorkspaceEdit)
-> IO (Maybe (NormalizedFilePath, WorkspaceEdit))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO (NormalizedFilePath, WorkspaceEdit)
-> IO (Maybe (NormalizedFilePath, WorkspaceEdit)))
-> MaybeT IO (NormalizedFilePath, WorkspaceEdit)
-> IO (Maybe (NormalizedFilePath, WorkspaceEdit))
forall a b. (a -> b) -> a -> b
$ IdeState
-> ExtendImport -> MaybeT IO (NormalizedFilePath, WorkspaceEdit)
extendImportHandler' IdeState
ideState ExtendImport
edit
Maybe (NormalizedFilePath, WorkspaceEdit)
-> ((NormalizedFilePath, WorkspaceEdit) -> LspT Config IO ())
-> LspT Config IO ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (NormalizedFilePath, WorkspaceEdit)
res (((NormalizedFilePath, WorkspaceEdit) -> LspT Config IO ())
-> LspT Config IO ())
-> ((NormalizedFilePath, WorkspaceEdit) -> LspT Config IO ())
-> LspT Config IO ()
forall a b. (a -> b) -> a -> b
$ \(NormalizedFilePath
nfp, wedit :: WorkspaceEdit
wedit@WorkspaceEdit {Maybe WorkspaceEditMap
$sel:_changes:WorkspaceEdit :: WorkspaceEdit -> Maybe WorkspaceEditMap
_changes :: Maybe WorkspaceEditMap
_changes}) -> do
let (Uri
_, List ([TextEdit] -> TextEdit
forall a. [a] -> a
head -> TextEdit {Range
$sel:_range:TextEdit :: TextEdit -> Range
_range :: Range
_range})) = Maybe (Uri, List TextEdit) -> (Uri, List TextEdit)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Uri, List TextEdit) -> (Uri, List TextEdit))
-> Maybe (Uri, List TextEdit) -> (Uri, List TextEdit)
forall a b. (a -> b) -> a -> b
$ Maybe WorkspaceEditMap
_changes Maybe WorkspaceEditMap
-> (WorkspaceEditMap -> Maybe (Uri, List TextEdit))
-> Maybe (Uri, List TextEdit)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(Uri, List TextEdit)] -> Maybe (Uri, List TextEdit)
forall a. [a] -> Maybe a
listToMaybe ([(Uri, List TextEdit)] -> Maybe (Uri, List TextEdit))
-> (WorkspaceEditMap -> [(Uri, List TextEdit)])
-> WorkspaceEditMap
-> Maybe (Uri, List TextEdit)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceEditMap -> [(Uri, List TextEdit)]
forall l. IsList l => l -> [Item l]
toList
srcSpan :: SrcSpan
srcSpan = NormalizedFilePath -> Range -> SrcSpan
rangeToSrcSpan NormalizedFilePath
nfp Range
_range
SServerMethod 'WindowShowMessage
-> MessageParams 'WindowShowMessage -> LspT Config IO ()
forall (m :: Method 'FromServer 'Notification) (f :: * -> *)
config.
MonadLsp config f =>
SServerMethod m -> MessageParams m -> f ()
LSP.sendNotification SServerMethod 'WindowShowMessage
SWindowShowMessage (MessageParams 'WindowShowMessage -> LspT Config IO ())
-> MessageParams 'WindowShowMessage -> LspT Config IO ()
forall a b. (a -> b) -> a -> b
$
MessageType -> ModuleNameText -> ShowMessageParams
ShowMessageParams MessageType
MtInfo (ModuleNameText -> ShowMessageParams)
-> ModuleNameText -> ShowMessageParams
forall a b. (a -> b) -> a -> b
$
ModuleNameText
"Import "
ModuleNameText -> ModuleNameText -> ModuleNameText
forall a. Semigroup a => a -> a -> a
<> ModuleNameText
-> (ModuleNameText -> ModuleNameText)
-> Maybe ModuleNameText
-> ModuleNameText
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ModuleNameText
"‘" ModuleNameText -> ModuleNameText -> ModuleNameText
forall a. Semigroup a => a -> a -> a
<> ModuleNameText
newThing) (\ModuleNameText
x -> ModuleNameText
"‘" ModuleNameText -> ModuleNameText -> ModuleNameText
forall a. Semigroup a => a -> a -> a
<> ModuleNameText
x ModuleNameText -> ModuleNameText -> ModuleNameText
forall a. Semigroup a => a -> a -> a
<> ModuleNameText
" (" ModuleNameText -> ModuleNameText -> ModuleNameText
forall a. Semigroup a => a -> a -> a
<> ModuleNameText
newThing ModuleNameText -> ModuleNameText -> ModuleNameText
forall a. Semigroup a => a -> a -> a
<> ModuleNameText
")") Maybe ModuleNameText
thingParent
ModuleNameText -> ModuleNameText -> ModuleNameText
forall a. Semigroup a => a -> a -> a
<> ModuleNameText
"’ from "
ModuleNameText -> ModuleNameText -> ModuleNameText
forall a. Semigroup a => a -> a -> a
<> ModuleNameText
importName
ModuleNameText -> ModuleNameText -> ModuleNameText
forall a. Semigroup a => a -> a -> a
<> ModuleNameText
" (at "
ModuleNameText -> ModuleNameText -> ModuleNameText
forall a. Semigroup a => a -> a -> a
<> SrcSpan -> ModuleNameText
forall a. Outputable a => a -> ModuleNameText
printOutputable SrcSpan
srcSpan
ModuleNameText -> ModuleNameText -> ModuleNameText
forall a. Semigroup a => a -> a -> a
<> ModuleNameText
")"
LspT Config IO (LspId 'WorkspaceApplyEdit) -> LspT Config IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (LspT Config IO (LspId 'WorkspaceApplyEdit) -> LspT Config IO ())
-> LspT Config IO (LspId 'WorkspaceApplyEdit) -> LspT Config IO ()
forall a b. (a -> b) -> a -> b
$ SServerMethod 'WorkspaceApplyEdit
-> MessageParams 'WorkspaceApplyEdit
-> (Either ResponseError (ResponseResult 'WorkspaceApplyEdit)
-> LspT Config IO ())
-> LspT Config IO (LspId 'WorkspaceApplyEdit)
forall (m :: Method 'FromServer 'Request) (f :: * -> *) config.
MonadLsp config f =>
SServerMethod m
-> MessageParams m
-> (Either ResponseError (ResponseResult m) -> f ())
-> f (LspId m)
LSP.sendRequest SServerMethod 'WorkspaceApplyEdit
SWorkspaceApplyEdit (Maybe ModuleNameText -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams Maybe ModuleNameText
forall a. Maybe a
Nothing WorkspaceEdit
wedit) (\Either ResponseError (ResponseResult 'WorkspaceApplyEdit)
_ -> () -> LspT Config IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
Either ResponseError Value
-> LspM Config (Either ResponseError Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ResponseError Value
-> LspM Config (Either ResponseError Value))
-> Either ResponseError Value
-> LspM Config (Either ResponseError Value)
forall a b. (a -> b) -> a -> b
$ Value -> Either ResponseError Value
forall a b. b -> Either a b
Right Value
Null
extendImportHandler' :: IdeState -> ExtendImport -> MaybeT IO (NormalizedFilePath, WorkspaceEdit)
extendImportHandler' :: IdeState
-> ExtendImport -> MaybeT IO (NormalizedFilePath, WorkspaceEdit)
extendImportHandler' IdeState
ideState ExtendImport {Maybe ModuleNameText
ModuleNameText
Uri
importQual :: Maybe ModuleNameText
importName :: ModuleNameText
thingParent :: Maybe ModuleNameText
newThing :: ModuleNameText
doc :: Uri
importQual :: ExtendImport -> Maybe ModuleNameText
importName :: ExtendImport -> ModuleNameText
thingParent :: ExtendImport -> Maybe ModuleNameText
newThing :: ExtendImport -> ModuleNameText
doc :: ExtendImport -> Uri
..}
| Just String
fp <- Uri -> Maybe String
uriToFilePath Uri
doc,
NormalizedFilePath
nfp <- String -> NormalizedFilePath
toNormalizedFilePath' String
fp =
do
(ModSummaryResult {[LImportDecl GhcPs]
Fingerprint
ModSummary
msrFingerprint :: Fingerprint
msrImports :: [LImportDecl GhcPs]
msrModSummary :: ModSummary
msrFingerprint :: ModSummaryResult -> Fingerprint
msrImports :: ModSummaryResult -> [LImportDecl GhcPs]
msrModSummary :: ModSummaryResult -> ModSummary
..}, Annotated ParsedSource
ps, Maybe ModuleNameText
contents) <- IO
(Maybe
(ModSummaryResult, Annotated ParsedSource, Maybe ModuleNameText))
-> MaybeT
IO (ModSummaryResult, Annotated ParsedSource, Maybe ModuleNameText)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO
(Maybe
(ModSummaryResult, Annotated ParsedSource, Maybe ModuleNameText))
-> MaybeT
IO
(ModSummaryResult, Annotated ParsedSource, Maybe ModuleNameText))
-> IO
(Maybe
(ModSummaryResult, Annotated ParsedSource, Maybe ModuleNameText))
-> MaybeT
IO (ModSummaryResult, Annotated ParsedSource, Maybe ModuleNameText)
forall a b. (a -> b) -> a -> b
$ IO
(Maybe
(ModSummaryResult, Annotated ParsedSource, Maybe ModuleNameText))
-> IO
(Maybe
(ModSummaryResult, Annotated ParsedSource, Maybe ModuleNameText))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
(Maybe
(ModSummaryResult, Annotated ParsedSource, Maybe ModuleNameText))
-> IO
(Maybe
(ModSummaryResult, Annotated ParsedSource, Maybe ModuleNameText)))
-> IO
(Maybe
(ModSummaryResult, Annotated ParsedSource, Maybe ModuleNameText))
-> IO
(Maybe
(ModSummaryResult, Annotated ParsedSource, Maybe ModuleNameText))
forall a b. (a -> b) -> a -> b
$
String
-> IdeState
-> Action
(Maybe
(ModSummaryResult, Annotated ParsedSource, Maybe ModuleNameText))
-> IO
(Maybe
(ModSummaryResult, Annotated ParsedSource, Maybe ModuleNameText))
forall a. String -> IdeState -> Action a -> IO a
runAction String
"extend import" IdeState
ideState (Action
(Maybe
(ModSummaryResult, Annotated ParsedSource, Maybe ModuleNameText))
-> IO
(Maybe
(ModSummaryResult, Annotated ParsedSource, Maybe ModuleNameText)))
-> Action
(Maybe
(ModSummaryResult, Annotated ParsedSource, Maybe ModuleNameText))
-> IO
(Maybe
(ModSummaryResult, Annotated ParsedSource, Maybe ModuleNameText))
forall a b. (a -> b) -> a -> b
$
MaybeT
Action
(ModSummaryResult, Annotated ParsedSource, Maybe ModuleNameText)
-> Action
(Maybe
(ModSummaryResult, Annotated ParsedSource, Maybe ModuleNameText))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT
Action
(ModSummaryResult, Annotated ParsedSource, Maybe ModuleNameText)
-> Action
(Maybe
(ModSummaryResult, Annotated ParsedSource, Maybe ModuleNameText)))
-> MaybeT
Action
(ModSummaryResult, Annotated ParsedSource, Maybe ModuleNameText)
-> Action
(Maybe
(ModSummaryResult, Annotated ParsedSource, Maybe ModuleNameText))
forall a b. (a -> b) -> a -> b
$ do
ModSummaryResult
msr <- Action (Maybe ModSummaryResult) -> MaybeT Action ModSummaryResult
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Action (Maybe ModSummaryResult) -> MaybeT Action ModSummaryResult)
-> Action (Maybe ModSummaryResult)
-> MaybeT Action ModSummaryResult
forall a b. (a -> b) -> a -> b
$ GetModSummaryWithoutTimestamps
-> NormalizedFilePath -> Action (Maybe ModSummaryResult)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetModSummaryWithoutTimestamps
GetModSummaryWithoutTimestamps NormalizedFilePath
nfp
Annotated ParsedSource
ps <- Action (Maybe (Annotated ParsedSource))
-> MaybeT Action (Annotated ParsedSource)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Action (Maybe (Annotated ParsedSource))
-> MaybeT Action (Annotated ParsedSource))
-> Action (Maybe (Annotated ParsedSource))
-> MaybeT Action (Annotated ParsedSource)
forall a b. (a -> b) -> a -> b
$ GetAnnotatedParsedSource
-> NormalizedFilePath -> Action (Maybe (Annotated ParsedSource))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetAnnotatedParsedSource
GetAnnotatedParsedSource NormalizedFilePath
nfp
(FileVersion
_, Maybe ModuleNameText
contents) <- Action (Maybe (FileVersion, Maybe ModuleNameText))
-> MaybeT Action (FileVersion, Maybe ModuleNameText)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Action (Maybe (FileVersion, Maybe ModuleNameText))
-> MaybeT Action (FileVersion, Maybe ModuleNameText))
-> Action (Maybe (FileVersion, Maybe ModuleNameText))
-> MaybeT Action (FileVersion, Maybe ModuleNameText)
forall a b. (a -> b) -> a -> b
$ GetFileContents
-> NormalizedFilePath
-> Action (Maybe (FileVersion, Maybe ModuleNameText))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetFileContents
GetFileContents NormalizedFilePath
nfp
(ModSummaryResult, Annotated ParsedSource, Maybe ModuleNameText)
-> MaybeT
Action
(ModSummaryResult, Annotated ParsedSource, Maybe ModuleNameText)
forall (m :: * -> *) a. Monad m => a -> m a
return (ModSummaryResult
msr, Annotated ParsedSource
ps, Maybe ModuleNameText
contents)
let df :: DynFlags
df = ModSummary -> DynFlags
ms_hspp_opts ModSummary
msrModSummary
wantedModule :: ModuleName
wantedModule = String -> ModuleName
mkModuleName (ModuleNameText -> String
T.unpack ModuleNameText
importName)
wantedQual :: Maybe ModuleName
wantedQual = String -> ModuleName
mkModuleName (String -> ModuleName)
-> (ModuleNameText -> String) -> ModuleNameText -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleNameText -> String
T.unpack (ModuleNameText -> ModuleName)
-> Maybe ModuleNameText -> Maybe ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ModuleNameText
importQual
existingImport :: Maybe (LImportDecl GhcPs)
existingImport = (LImportDecl GhcPs -> Bool)
-> [LImportDecl GhcPs] -> Maybe (LImportDecl GhcPs)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (ModuleName -> Maybe ModuleName -> LImportDecl GhcPs -> Bool
forall l.
ModuleName
-> Maybe ModuleName -> GenLocated l (ImportDecl GhcPs) -> Bool
isWantedModule ModuleName
wantedModule Maybe ModuleName
wantedQual) [LImportDecl GhcPs]
msrImports
case Maybe (LImportDecl GhcPs)
existingImport of
Just LImportDecl GhcPs
imp -> do
(WorkspaceEdit -> (NormalizedFilePath, WorkspaceEdit))
-> MaybeT IO WorkspaceEdit
-> MaybeT IO (NormalizedFilePath, WorkspaceEdit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NormalizedFilePath
nfp,) (MaybeT IO WorkspaceEdit
-> MaybeT IO (NormalizedFilePath, WorkspaceEdit))
-> MaybeT IO WorkspaceEdit
-> MaybeT IO (NormalizedFilePath, WorkspaceEdit)
forall a b. (a -> b) -> a -> b
$ Either String WorkspaceEdit -> MaybeT IO WorkspaceEdit
forall (m :: * -> *) e a. Monad m => Either e a -> MaybeT m a
liftEither (Either String WorkspaceEdit -> MaybeT IO WorkspaceEdit)
-> Either String WorkspaceEdit -> MaybeT IO WorkspaceEdit
forall a b. (a -> b) -> a -> b
$
DynFlags -> Uri -> Anns -> Rewrite -> Either String WorkspaceEdit
rewriteToWEdit DynFlags
df Uri
doc
#if !MIN_VERSION_ghc(9,2,0)
(Annotated ParsedSource -> Anns
forall ast. Annotated ast -> Anns
annsA Annotated ParsedSource
ps)
#endif
(Rewrite -> Either String WorkspaceEdit)
-> Rewrite -> Either String WorkspaceEdit
forall a b. (a -> b) -> a -> b
$
Maybe String -> String -> LImportDecl GhcPs -> Rewrite
extendImport (ModuleNameText -> String
T.unpack (ModuleNameText -> String) -> Maybe ModuleNameText -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ModuleNameText
thingParent) (ModuleNameText -> String
T.unpack ModuleNameText
newThing) (LImportDecl GhcPs -> LImportDecl GhcPs
forall ast. ExactPrint ast => ast -> ast
makeDeltaAst LImportDecl GhcPs
imp)
Maybe (LImportDecl GhcPs)
Nothing -> do
let n :: NewImport
n = ModuleNameText
-> Maybe ModuleNameText
-> Maybe ModuleNameText
-> Bool
-> NewImport
newImport ModuleNameText
importName Maybe ModuleNameText
sym Maybe ModuleNameText
importQual Bool
False
sym :: Maybe ModuleNameText
sym = if Maybe ModuleNameText -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ModuleNameText
importQual then ModuleNameText -> Maybe ModuleNameText
forall a. a -> Maybe a
Just ModuleNameText
it else Maybe ModuleNameText
forall a. Maybe a
Nothing
it :: ModuleNameText
it = case Maybe ModuleNameText
thingParent of
Maybe ModuleNameText
Nothing -> ModuleNameText
newThing
Just ModuleNameText
p -> ModuleNameText
p ModuleNameText -> ModuleNameText -> ModuleNameText
forall a. Semigroup a => a -> a -> a
<> ModuleNameText
"(" ModuleNameText -> ModuleNameText -> ModuleNameText
forall a. Semigroup a => a -> a -> a
<> ModuleNameText
newThing ModuleNameText -> ModuleNameText -> ModuleNameText
forall a. Semigroup a => a -> a -> a
<> ModuleNameText
")"
TextEdit
t <- Maybe TextEdit -> MaybeT IO TextEdit
forall (m :: * -> *) a. Monad m => Maybe a -> MaybeT m a
liftMaybe (Maybe TextEdit -> MaybeT IO TextEdit)
-> Maybe TextEdit -> MaybeT IO TextEdit
forall a b. (a -> b) -> a -> b
$ (ModuleNameText, TextEdit) -> TextEdit
forall a b. (a, b) -> b
snd ((ModuleNameText, TextEdit) -> TextEdit)
-> Maybe (ModuleNameText, TextEdit) -> Maybe TextEdit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NewImport
-> ParsedSource
-> ModuleNameText
-> Maybe (ModuleNameText, TextEdit)
newImportToEdit
NewImport
n
(Annotated ParsedSource -> ParsedSource
forall ast. Annotated ast -> ast
astA Annotated ParsedSource
ps)
(ModuleNameText -> Maybe ModuleNameText -> ModuleNameText
forall a. a -> Maybe a -> a
fromMaybe ModuleNameText
"" Maybe ModuleNameText
contents)
(NormalizedFilePath, WorkspaceEdit)
-> MaybeT IO (NormalizedFilePath, WorkspaceEdit)
forall (m :: * -> *) a. Monad m => a -> m a
return (NormalizedFilePath
nfp, WorkspaceEdit :: Maybe WorkspaceEditMap
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit {$sel:_changes:WorkspaceEdit :: Maybe WorkspaceEditMap
_changes=WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a. a -> Maybe a
Just ([Item WorkspaceEditMap] -> WorkspaceEditMap
forall l. IsList l => [Item l] -> l
fromList [(Uri
doc,[TextEdit] -> List TextEdit
forall a. [a] -> List a
List [TextEdit
t])]), $sel:_documentChanges:WorkspaceEdit :: Maybe (List DocumentChange)
_documentChanges=Maybe (List DocumentChange)
forall a. Maybe a
Nothing, $sel:_changeAnnotations:WorkspaceEdit :: Maybe ChangeAnnotationMap
_changeAnnotations=Maybe ChangeAnnotationMap
forall a. Maybe a
Nothing})
| Bool
otherwise =
MaybeT IO (NormalizedFilePath, WorkspaceEdit)
forall (m :: * -> *) a. MonadPlus m => m a
mzero
isWantedModule :: ModuleName -> Maybe ModuleName -> GenLocated l (ImportDecl GhcPs) -> Bool
isWantedModule :: ModuleName
-> Maybe ModuleName -> GenLocated l (ImportDecl GhcPs) -> Bool
isWantedModule ModuleName
wantedModule Maybe ModuleName
Nothing (L l
_ it :: ImportDecl GhcPs
it@ImportDecl{Located ModuleName
ideclName :: forall pass. ImportDecl pass -> Located ModuleName
ideclName :: Located ModuleName
ideclName, ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding = Just (Bool
False, Located [LIE GhcPs]
_)}) =
Bool -> Bool
not (ImportDecl GhcPs -> Bool
forall a. ImportDecl a -> Bool
isQualifiedImport ImportDecl GhcPs
it) Bool -> Bool -> Bool
&& Located ModuleName -> SrcSpanLess (Located ModuleName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located ModuleName
ideclName ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName
wantedModule
isWantedModule ModuleName
wantedModule (Just ModuleName
qual) (L l
_ ImportDecl{Maybe (Located ModuleName)
ideclAs :: forall pass. ImportDecl pass -> Maybe (Located ModuleName)
ideclAs :: Maybe (Located ModuleName)
ideclAs, Located ModuleName
ideclName :: Located ModuleName
ideclName :: forall pass. ImportDecl pass -> Located ModuleName
ideclName, ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding = Just (Bool
False, Located [LIE GhcPs]
_)}) =
Located ModuleName -> SrcSpanLess (Located ModuleName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located ModuleName
ideclName ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName
wantedModule Bool -> Bool -> Bool
&& (ModuleName
wantedModule ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName
qual Bool -> Bool -> Bool
|| (Located ModuleName -> ModuleName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located ModuleName -> ModuleName)
-> (Located ModuleName -> Located ModuleName)
-> Located ModuleName
-> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located ModuleName -> Located ModuleName
forall a. Located a -> Located a
reLoc (Located ModuleName -> ModuleName)
-> Maybe (Located ModuleName) -> Maybe ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Located ModuleName)
ideclAs) Maybe ModuleName -> Maybe ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just ModuleName
qual)
isWantedModule ModuleName
_ Maybe ModuleName
_ GenLocated l (ImportDecl GhcPs)
_ = Bool
False
liftMaybe :: Monad m => Maybe a -> MaybeT m a
liftMaybe :: Maybe a -> MaybeT m a
liftMaybe Maybe a
a = m (Maybe a) -> MaybeT m a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe a) -> MaybeT m a) -> m (Maybe a) -> MaybeT m a
forall a b. (a -> b) -> a -> b
$ Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
a
liftEither :: Monad m => Either e a -> MaybeT m a
liftEither :: Either e a -> MaybeT m a
liftEither (Left e
_) = MaybeT m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
liftEither (Right a
x) = a -> MaybeT m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x