{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeFamilies #-}
#include "ghc-api-version.h"
module Development.IDE.Plugin.Completions
( descriptor
, LocalCompletions(..)
, NonLocalCompletions(..)
) where
import Language.Haskell.LSP.Types
import qualified Language.Haskell.LSP.Core as LSP
import qualified Language.Haskell.LSP.VFS as VFS
import Control.Monad
import Control.Monad.Trans.Maybe
import Data.Aeson
import Data.List (find)
import Data.Maybe
import qualified Data.Text as T
import Development.Shake.Classes
import Development.Shake
import GHC.Generics
import Development.IDE.Core.Service
import Development.IDE.Core.PositionMapping
import Development.IDE.Plugin.Completions.Logic
import Development.IDE.Types.Location
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.Shake
import Development.IDE.GHC.Compat
import Development.IDE.GHC.ExactPrint (Annotated (annsA), GetAnnotatedParsedSource (GetAnnotatedParsedSource))
import Development.IDE.Types.HscEnvEq (hscEnv)
import Development.IDE.Plugin.CodeAction.ExactPrint
import Development.IDE.Plugin.Completions.Types
import Ide.Plugin.Config (Config (completionSnippetsOn))
import Ide.PluginUtils (getClientConfig)
import Ide.Types
import TcRnDriver (tcRnImportDecls)
import Control.Concurrent.Async (concurrently)
#if defined(GHC_LIB)
import Development.IDE.Import.DependencyInformation
#endif
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor PluginId
plId = (PluginId -> PluginDescriptor IdeState
forall ideState. PluginId -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId)
{ pluginRules :: Rules ()
pluginRules = Rules ()
produceCompletions,
pluginCompletionProvider :: Maybe (CompletionProvider IdeState)
pluginCompletionProvider = CompletionProvider IdeState -> Maybe (CompletionProvider IdeState)
forall a. a -> Maybe a
Just (PluginId -> CompletionProvider IdeState
getCompletionsLSP PluginId
plId),
pluginCommands :: [PluginCommand IdeState]
pluginCommands = [PluginCommand IdeState
extendImportCommand]
}
produceCompletions :: Rules ()
produceCompletions :: Rules ()
produceCompletions = do
(LocalCompletions
-> NormalizedFilePath -> Action (IdeResult CachedCompletions))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((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)
(NonLocalCompletions
-> NormalizedFilePath -> Action (IdeResult CachedCompletions))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((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 (ModSummary, [GenLocated SrcSpan (ImportDecl GhcPs)])
ms <- (((ModSummary, [GenLocated SrcSpan (ImportDecl GhcPs)]),
PositionMapping)
-> (ModSummary, [GenLocated SrcSpan (ImportDecl GhcPs)]))
-> Maybe
((ModSummary, [GenLocated SrcSpan (ImportDecl GhcPs)]),
PositionMapping)
-> Maybe (ModSummary, [GenLocated SrcSpan (ImportDecl GhcPs)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ModSummary, [GenLocated SrcSpan (ImportDecl GhcPs)]),
PositionMapping)
-> (ModSummary, [GenLocated SrcSpan (ImportDecl GhcPs)])
forall a b. (a, b) -> a
fst (Maybe
((ModSummary, [GenLocated SrcSpan (ImportDecl GhcPs)]),
PositionMapping)
-> Maybe (ModSummary, [GenLocated SrcSpan (ImportDecl GhcPs)]))
-> Action
(Maybe
((ModSummary, [GenLocated SrcSpan (ImportDecl GhcPs)]),
PositionMapping))
-> Action
(Maybe (ModSummary, [GenLocated SrcSpan (ImportDecl GhcPs)]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetModSummaryWithoutTimestamps
-> NormalizedFilePath
-> Action
(Maybe
((ModSummary, [GenLocated SrcSpan (ImportDecl GhcPs)]),
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
#if !defined(GHC_LIB)
let parsedDeps :: [a]
parsedDeps = []
#else
deps <- maybe (TransitiveDependencies [] [] []) fst <$> useWithStale GetDependencies file
parsedDeps <- mapMaybe (fmap fst) <$> usesWithStale GetParsedModule (transitiveModuleDeps deps)
#endif
case (Maybe (ModSummary, [GenLocated SrcSpan (ImportDecl GhcPs)])
ms, Maybe HscEnvEq
sess) of
(Just (ModSummary
ms,[GenLocated SrcSpan (ImportDecl GhcPs)]
imps), 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
-> [GenLocated SrcSpan (ImportDecl GhcPs)]
-> IO (Messages, Maybe GlobalRdrEnv)
tcRnImportDecls HscEnv
env (GenLocated SrcSpan (ImportDecl GhcPs)
-> GenLocated SrcSpan (ImportDecl GhcPs)
dropListFromImportDecl (GenLocated SrcSpan (ImportDecl GhcPs)
-> GenLocated SrcSpan (ImportDecl GhcPs))
-> [GenLocated SrcSpan (ImportDecl GhcPs)]
-> [GenLocated SrcSpan (ImportDecl GhcPs)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GenLocated SrcSpan (ImportDecl GhcPs)]
imps) 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
-> [GenLocated SrcSpan (ImportDecl GhcPs)]
-> IO (Messages, Maybe GlobalRdrEnv)
tcRnImportDecls HscEnv
env [GenLocated SrcSpan (ImportDecl GhcPs)]
imps
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
-> HscEnv
-> Module
-> GlobalRdrEnv
-> GlobalRdrEnv
-> [GenLocated SrcSpan (ImportDecl GhcPs)]
-> [ParsedModule]
-> IO CachedCompletions
cacheDataProducer Uri
uri HscEnv
env (ModSummary -> Module
ms_mod ModSummary
ms) GlobalRdrEnv
globalEnv GlobalRdrEnv
inScopeEnv [GenLocated SrcSpan (ImportDecl GhcPs)]
imps [ParsedModule]
forall a. [a]
parsedDeps
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 (ModSummary, [GenLocated SrcSpan (ImportDecl GhcPs)]),
Maybe HscEnvEq)
_ -> IdeResult CachedCompletions -> Action (IdeResult CachedCompletions)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Maybe CachedCompletions
forall a. Maybe a
Nothing)
dropListFromImportDecl :: GenLocated SrcSpan (ImportDecl GhcPs) -> GenLocated SrcSpan (ImportDecl GhcPs)
dropListFromImportDecl :: GenLocated SrcSpan (ImportDecl GhcPs)
-> GenLocated SrcSpan (ImportDecl GhcPs)
dropListFromImportDecl GenLocated SrcSpan (ImportDecl 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)
-> GenLocated SrcSpan (ImportDecl GhcPs)
-> GenLocated SrcSpan (ImportDecl GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenLocated SrcSpan (ImportDecl GhcPs)
iDecl
type instance RuleResult LocalCompletions = CachedCompletions
type instance RuleResult NonLocalCompletions = CachedCompletions
data LocalCompletions = LocalCompletions
deriving (LocalCompletions -> LocalCompletions -> Bool
(LocalCompletions -> LocalCompletions -> Bool)
-> (LocalCompletions -> LocalCompletions -> Bool)
-> Eq LocalCompletions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LocalCompletions -> LocalCompletions -> Bool
$c/= :: LocalCompletions -> LocalCompletions -> Bool
== :: LocalCompletions -> LocalCompletions -> Bool
$c== :: LocalCompletions -> LocalCompletions -> Bool
Eq, Int -> LocalCompletions -> ShowS
[LocalCompletions] -> ShowS
LocalCompletions -> String
(Int -> LocalCompletions -> ShowS)
-> (LocalCompletions -> String)
-> ([LocalCompletions] -> ShowS)
-> Show LocalCompletions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LocalCompletions] -> ShowS
$cshowList :: [LocalCompletions] -> ShowS
show :: LocalCompletions -> String
$cshow :: LocalCompletions -> String
showsPrec :: Int -> LocalCompletions -> ShowS
$cshowsPrec :: Int -> LocalCompletions -> ShowS
Show, Typeable, (forall x. LocalCompletions -> Rep LocalCompletions x)
-> (forall x. Rep LocalCompletions x -> LocalCompletions)
-> Generic LocalCompletions
forall x. Rep LocalCompletions x -> LocalCompletions
forall x. LocalCompletions -> Rep LocalCompletions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LocalCompletions x -> LocalCompletions
$cfrom :: forall x. LocalCompletions -> Rep LocalCompletions x
Generic)
instance Hashable LocalCompletions
instance NFData LocalCompletions
instance Binary LocalCompletions
data NonLocalCompletions = NonLocalCompletions
deriving (NonLocalCompletions -> NonLocalCompletions -> Bool
(NonLocalCompletions -> NonLocalCompletions -> Bool)
-> (NonLocalCompletions -> NonLocalCompletions -> Bool)
-> Eq NonLocalCompletions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NonLocalCompletions -> NonLocalCompletions -> Bool
$c/= :: NonLocalCompletions -> NonLocalCompletions -> Bool
== :: NonLocalCompletions -> NonLocalCompletions -> Bool
$c== :: NonLocalCompletions -> NonLocalCompletions -> Bool
Eq, Int -> NonLocalCompletions -> ShowS
[NonLocalCompletions] -> ShowS
NonLocalCompletions -> String
(Int -> NonLocalCompletions -> ShowS)
-> (NonLocalCompletions -> String)
-> ([NonLocalCompletions] -> ShowS)
-> Show NonLocalCompletions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NonLocalCompletions] -> ShowS
$cshowList :: [NonLocalCompletions] -> ShowS
show :: NonLocalCompletions -> String
$cshow :: NonLocalCompletions -> String
showsPrec :: Int -> NonLocalCompletions -> ShowS
$cshowsPrec :: Int -> NonLocalCompletions -> ShowS
Show, Typeable, (forall x. NonLocalCompletions -> Rep NonLocalCompletions x)
-> (forall x. Rep NonLocalCompletions x -> NonLocalCompletions)
-> Generic NonLocalCompletions
forall x. Rep NonLocalCompletions x -> NonLocalCompletions
forall x. NonLocalCompletions -> Rep NonLocalCompletions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NonLocalCompletions x -> NonLocalCompletions
$cfrom :: forall x. NonLocalCompletions -> Rep NonLocalCompletions x
Generic)
instance Hashable NonLocalCompletions
instance NFData NonLocalCompletions
instance Binary NonLocalCompletions
getCompletionsLSP
:: PluginId
-> LSP.LspFuncs Config
-> IdeState
-> CompletionParams
-> IO (Either ResponseError CompletionResponseResult)
getCompletionsLSP :: PluginId -> CompletionProvider IdeState
getCompletionsLSP PluginId
plId LspFuncs Config
lsp IdeState
ide
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 <- LspFuncs Config -> NormalizedUri -> IO (Maybe VirtualFile)
forall c. LspFuncs c -> NormalizedUri -> IO (Maybe VirtualFile)
LSP.getVirtualFileFunc LspFuncs Config
lsp (NormalizedUri -> IO (Maybe VirtualFile))
-> NormalizedUri -> IO (Maybe VirtualFile)
forall a b. (a -> b) -> a -> b
$ Uri -> NormalizedUri
toNormalizedUri Uri
uri
(CompletionResponseResult
-> Either ResponseError CompletionResponseResult)
-> IO CompletionResponseResult
-> IO (Either ResponseError CompletionResponseResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompletionResponseResult
-> Either ResponseError CompletionResponseResult
forall a b. b -> Either a b
Right (IO CompletionResponseResult
-> IO (Either ResponseError CompletionResponseResult))
-> IO CompletionResponseResult
-> IO (Either ResponseError CompletionResponseResult)
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) <- String
-> ShakeExtras
-> IdeAction
(IdeOptions,
Maybe
(CachedCompletions, Maybe (ParsedModule, PositionMapping),
(Bindings, PositionMapping)))
-> IO
(IdeOptions,
Maybe
(CachedCompletions, Maybe (ParsedModule, PositionMapping),
(Bindings, PositionMapping)))
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)))
-> IO
(IdeOptions,
Maybe
(CachedCompletions, Maybe (ParsedModule, PositionMapping),
(Bindings, PositionMapping))))
-> IdeAction
(IdeOptions,
Maybe
(CachedCompletions, Maybe (ParsedModule, PositionMapping),
(Bindings, PositionMapping)))
-> IO
(IdeOptions,
Maybe
(CachedCompletions, Maybe (ParsedModule, PositionMapping),
(Bindings, PositionMapping)))
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
(IdeOptions,
Maybe
(CachedCompletions, Maybe (ParsedModule, PositionMapping),
(Bindings, PositionMapping)))
-> IdeAction
(IdeOptions,
Maybe
(CachedCompletions, Maybe (ParsedModule, PositionMapping),
(Bindings, PositionMapping)))
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) (((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)))
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 -> 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 Text
_ Text
"" Text
_ Position
_), Just CompletionContext { $sel:_triggerCharacter:CompletionContext :: CompletionContext -> Maybe Text
_triggerCharacter = Just Text
"."})
-> CompletionResponseResult -> IO CompletionResponseResult
forall (m :: * -> *) a. Monad m => a -> m a
return (List CompletionItem -> CompletionResponseResult
Completions (List CompletionItem -> CompletionResponseResult)
-> List CompletionItem -> CompletionResponseResult
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
Config
config <- LspFuncs Config -> IO Config
getClientConfig LspFuncs Config
lsp
let snippets :: WithSnippets
snippets = Bool -> WithSnippets
WithSnippets (Bool -> WithSnippets)
-> (Config -> Bool) -> Config -> WithSnippets
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Bool
completionSnippetsOn (Config -> WithSnippets) -> Config -> WithSnippets
forall a b. (a -> b) -> a -> b
$ Config
config
[CompletionItem]
allCompletions <- PluginId
-> IdeOptions
-> CachedCompletions
-> Maybe (ParsedModule, PositionMapping)
-> (Bindings, PositionMapping)
-> PosPrefixInfo
-> ClientCapabilities
-> WithSnippets
-> IO [CompletionItem]
getCompletions PluginId
plId IdeOptions
ideOpts CachedCompletions
cci' Maybe (ParsedModule, PositionMapping)
parsedMod (Bindings, PositionMapping)
bindMap PosPrefixInfo
pfix' ClientCapabilities
clientCaps WithSnippets
snippets
CompletionResponseResult -> IO CompletionResponseResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CompletionResponseResult -> IO CompletionResponseResult)
-> CompletionResponseResult -> IO CompletionResponseResult
forall a b. (a -> b) -> a -> b
$ List CompletionItem -> CompletionResponseResult
Completions ([CompletionItem] -> List CompletionItem
forall a. [a] -> List a
List [CompletionItem]
allCompletions)
(Maybe PosPrefixInfo, Maybe CompletionContext)
_ -> CompletionResponseResult -> IO CompletionResponseResult
forall (m :: * -> *) a. Monad m => a -> m a
return (List CompletionItem -> CompletionResponseResult
Completions (List CompletionItem -> CompletionResponseResult)
-> List CompletionItem -> CompletionResponseResult
forall a b. (a -> b) -> a -> b
$ [CompletionItem] -> List CompletionItem
forall a. [a] -> List a
List [])
Maybe
(CachedCompletions, Maybe (ParsedModule, PositionMapping),
(Bindings, PositionMapping))
_ -> CompletionResponseResult -> IO CompletionResponseResult
forall (m :: * -> *) a. Monad m => a -> m a
return (List CompletionItem -> CompletionResponseResult
Completions (List CompletionItem -> CompletionResponseResult)
-> List CompletionItem -> CompletionResponseResult
forall a b. (a -> b) -> a -> b
$ [CompletionItem] -> List CompletionItem
forall a. [a] -> List a
List [])
(Maybe VirtualFile, Maybe String)
_ -> CompletionResponseResult -> IO CompletionResponseResult
forall (m :: * -> *) a. Monad m => a -> m a
return (List CompletionItem -> CompletionResponseResult
Completions (List CompletionItem -> CompletionResponseResult)
-> List CompletionItem -> CompletionResponseResult
forall a b. (a -> b) -> a -> b
$ [CompletionItem] -> List CompletionItem
forall a. [a] -> List a
List [])
extendImportCommand :: PluginCommand IdeState
extendImportCommand :: PluginCommand IdeState
extendImportCommand =
CommandId
-> Text
-> CommandFunction IdeState ExtendImport
-> PluginCommand IdeState
forall ideState a.
FromJSON a =>
CommandId
-> Text -> CommandFunction ideState a -> PluginCommand ideState
PluginCommand (Text -> CommandId
CommandId Text
extendImportCommandId) Text
"additional edits for a completion" CommandFunction IdeState ExtendImport
extendImportHandler
extendImportHandler :: CommandFunction IdeState ExtendImport
extendImportHandler :: CommandFunction IdeState ExtendImport
extendImportHandler LspFuncs Config
_lsp IdeState
ideState ExtendImport
edit = do
Maybe (ServerMethod, ApplyWorkspaceEditParams)
res <- MaybeT IO (ServerMethod, ApplyWorkspaceEditParams)
-> IO (Maybe (ServerMethod, ApplyWorkspaceEditParams))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO (ServerMethod, ApplyWorkspaceEditParams)
-> IO (Maybe (ServerMethod, ApplyWorkspaceEditParams)))
-> MaybeT IO (ServerMethod, ApplyWorkspaceEditParams)
-> IO (Maybe (ServerMethod, ApplyWorkspaceEditParams))
forall a b. (a -> b) -> a -> b
$ IdeState
-> ExtendImport
-> MaybeT IO (ServerMethod, ApplyWorkspaceEditParams)
extendImportHandler' IdeState
ideState ExtendImport
edit
(Either ResponseError Value,
Maybe (ServerMethod, ApplyWorkspaceEditParams))
-> IO
(Either ResponseError Value,
Maybe (ServerMethod, ApplyWorkspaceEditParams))
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Either ResponseError Value
forall a b. b -> Either a b
Right Value
Null, Maybe (ServerMethod, ApplyWorkspaceEditParams)
res)
extendImportHandler' :: IdeState -> ExtendImport -> MaybeT IO (ServerMethod, ApplyWorkspaceEditParams)
extendImportHandler' :: IdeState
-> ExtendImport
-> MaybeT IO (ServerMethod, ApplyWorkspaceEditParams)
extendImportHandler' IdeState
ideState ExtendImport {Maybe Text
Text
Uri
importQual :: ExtendImport -> Maybe Text
importName :: ExtendImport -> Text
thingParent :: ExtendImport -> Maybe Text
newThing :: ExtendImport -> Text
doc :: ExtendImport -> Uri
importQual :: Maybe Text
importName :: Text
thingParent :: Maybe Text
newThing :: Text
doc :: Uri
..}
| Just String
fp <- Uri -> Maybe String
uriToFilePath Uri
doc,
NormalizedFilePath
nfp <- String -> NormalizedFilePath
toNormalizedFilePath' String
fp =
do
(ModSummary
ms, Annotated ParsedSource
ps, [GenLocated SrcSpan (ImportDecl GhcPs)]
imps) <- IO
(Maybe
(ModSummary, Annotated ParsedSource,
[GenLocated SrcSpan (ImportDecl GhcPs)]))
-> MaybeT
IO
(ModSummary, Annotated ParsedSource,
[GenLocated SrcSpan (ImportDecl GhcPs)])
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO
(Maybe
(ModSummary, Annotated ParsedSource,
[GenLocated SrcSpan (ImportDecl GhcPs)]))
-> MaybeT
IO
(ModSummary, Annotated ParsedSource,
[GenLocated SrcSpan (ImportDecl GhcPs)]))
-> IO
(Maybe
(ModSummary, Annotated ParsedSource,
[GenLocated SrcSpan (ImportDecl GhcPs)]))
-> MaybeT
IO
(ModSummary, Annotated ParsedSource,
[GenLocated SrcSpan (ImportDecl GhcPs)])
forall a b. (a -> b) -> a -> b
$
String
-> IdeState
-> Action
(Maybe
(ModSummary, Annotated ParsedSource,
[GenLocated SrcSpan (ImportDecl GhcPs)]))
-> IO
(Maybe
(ModSummary, Annotated ParsedSource,
[GenLocated SrcSpan (ImportDecl GhcPs)]))
forall a. String -> IdeState -> Action a -> IO a
runAction String
"extend import" IdeState
ideState (Action
(Maybe
(ModSummary, Annotated ParsedSource,
[GenLocated SrcSpan (ImportDecl GhcPs)]))
-> IO
(Maybe
(ModSummary, Annotated ParsedSource,
[GenLocated SrcSpan (ImportDecl GhcPs)])))
-> Action
(Maybe
(ModSummary, Annotated ParsedSource,
[GenLocated SrcSpan (ImportDecl GhcPs)]))
-> IO
(Maybe
(ModSummary, Annotated ParsedSource,
[GenLocated SrcSpan (ImportDecl GhcPs)]))
forall a b. (a -> b) -> a -> b
$
MaybeT
Action
(ModSummary, Annotated ParsedSource,
[GenLocated SrcSpan (ImportDecl GhcPs)])
-> Action
(Maybe
(ModSummary, Annotated ParsedSource,
[GenLocated SrcSpan (ImportDecl GhcPs)]))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT
Action
(ModSummary, Annotated ParsedSource,
[GenLocated SrcSpan (ImportDecl GhcPs)])
-> Action
(Maybe
(ModSummary, Annotated ParsedSource,
[GenLocated SrcSpan (ImportDecl GhcPs)])))
-> MaybeT
Action
(ModSummary, Annotated ParsedSource,
[GenLocated SrcSpan (ImportDecl GhcPs)])
-> Action
(Maybe
(ModSummary, Annotated ParsedSource,
[GenLocated SrcSpan (ImportDecl GhcPs)]))
forall a b. (a -> b) -> a -> b
$ do
(ModSummary
ms, [GenLocated SrcSpan (ImportDecl GhcPs)]
imps) <- Action
(Maybe (ModSummary, [GenLocated SrcSpan (ImportDecl GhcPs)]))
-> MaybeT
Action (ModSummary, [GenLocated SrcSpan (ImportDecl GhcPs)])
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Action
(Maybe (ModSummary, [GenLocated SrcSpan (ImportDecl GhcPs)]))
-> MaybeT
Action (ModSummary, [GenLocated SrcSpan (ImportDecl GhcPs)]))
-> Action
(Maybe (ModSummary, [GenLocated SrcSpan (ImportDecl GhcPs)]))
-> MaybeT
Action (ModSummary, [GenLocated SrcSpan (ImportDecl GhcPs)])
forall a b. (a -> b) -> a -> b
$ GetModSummaryWithoutTimestamps
-> NormalizedFilePath
-> Action
(Maybe (ModSummary, [GenLocated SrcSpan (ImportDecl GhcPs)]))
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
(ModSummary, Annotated ParsedSource,
[GenLocated SrcSpan (ImportDecl GhcPs)])
-> MaybeT
Action
(ModSummary, Annotated ParsedSource,
[GenLocated SrcSpan (ImportDecl GhcPs)])
forall (m :: * -> *) a. Monad m => a -> m a
return (ModSummary
ms, Annotated ParsedSource
ps, [GenLocated SrcSpan (ImportDecl GhcPs)]
imps)
let df :: DynFlags
df = ModSummary -> DynFlags
ms_hspp_opts ModSummary
ms
wantedModule :: ModuleName
wantedModule = String -> ModuleName
mkModuleName (Text -> String
T.unpack Text
importName)
wantedQual :: Maybe ModuleName
wantedQual = String -> ModuleName
mkModuleName (String -> ModuleName) -> (Text -> String) -> Text -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> ModuleName) -> Maybe Text -> Maybe ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
importQual
GenLocated SrcSpan (ImportDecl GhcPs)
imp <- Maybe (GenLocated SrcSpan (ImportDecl GhcPs))
-> MaybeT IO (GenLocated SrcSpan (ImportDecl GhcPs))
forall (m :: * -> *) a. Monad m => Maybe a -> MaybeT m a
liftMaybe (Maybe (GenLocated SrcSpan (ImportDecl GhcPs))
-> MaybeT IO (GenLocated SrcSpan (ImportDecl GhcPs)))
-> Maybe (GenLocated SrcSpan (ImportDecl GhcPs))
-> MaybeT IO (GenLocated SrcSpan (ImportDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpan (ImportDecl GhcPs) -> Bool)
-> [GenLocated SrcSpan (ImportDecl GhcPs)]
-> Maybe (GenLocated SrcSpan (ImportDecl GhcPs))
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (ModuleName
-> Maybe ModuleName
-> GenLocated SrcSpan (ImportDecl GhcPs)
-> Bool
forall l pass.
ModuleName
-> Maybe ModuleName -> GenLocated l (ImportDecl pass) -> Bool
isWantedModule ModuleName
wantedModule Maybe ModuleName
wantedQual) [GenLocated SrcSpan (ImportDecl GhcPs)]
imps
WorkspaceEdit
wedit <-
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 (Annotated ParsedSource -> Anns
forall ast. Annotated ast -> Anns
annsA Annotated ParsedSource
ps) (Rewrite -> Either String WorkspaceEdit)
-> Rewrite -> Either String WorkspaceEdit
forall a b. (a -> b) -> a -> b
$
Maybe String
-> String -> GenLocated SrcSpan (ImportDecl GhcPs) -> Rewrite
extendImport (Text -> String
T.unpack (Text -> String) -> Maybe Text -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
thingParent) (Text -> String
T.unpack Text
newThing) GenLocated SrcSpan (ImportDecl GhcPs)
imp
(ServerMethod, ApplyWorkspaceEditParams)
-> MaybeT IO (ServerMethod, ApplyWorkspaceEditParams)
forall (m :: * -> *) a. Monad m => a -> m a
return (ServerMethod
WorkspaceApplyEdit, WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams WorkspaceEdit
wedit)
| Bool
otherwise =
MaybeT IO (ServerMethod, ApplyWorkspaceEditParams)
forall (m :: * -> *) a. MonadPlus m => m a
mzero
isWantedModule :: ModuleName -> Maybe ModuleName -> GenLocated l (ImportDecl pass) -> Bool
isWantedModule :: ModuleName
-> Maybe ModuleName -> GenLocated l (ImportDecl pass) -> Bool
isWantedModule ModuleName
wantedModule Maybe ModuleName
Nothing (L l
_ it :: ImportDecl pass
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 pass]
_)}) =
Bool -> Bool
not (ImportDecl pass -> Bool
forall a. ImportDecl a -> Bool
isQualifiedImport ImportDecl pass
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 pass]
_)}) =
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)
-> 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 pass)
_ = 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