{-# LANGUAGE CPP              #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE RankNTypes       #-}
{-# LANGUAGE TypeFamilies     #-}

module Development.IDE.Plugin.Completions
    ( descriptor
    , Log(..)
    , ghcideCompletionsPluginPriority
    ) where

import           Control.Concurrent.Async                 (concurrently)
import           Control.Concurrent.STM.Stats             (readTVarIO)
import           Control.Lens                             ((&), (.~), (?~))
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Except               (ExceptT (ExceptT),
                                                           withExceptT)
import qualified Data.HashMap.Strict                      as Map
import qualified Data.HashSet                             as Set
import           Data.Maybe
import qualified Data.Text                                as T
import           Development.IDE.Core.Compile
import           Development.IDE.Core.PluginUtils
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,
                                                           knownTargets)
import qualified Development.IDE.Core.Shake               as Shake
import           Development.IDE.GHC.Compat
import           Development.IDE.GHC.Util
import           Development.IDE.Graph
import           Development.IDE.Plugin.Completions.Logic
import           Development.IDE.Plugin.Completions.Types
import           Development.IDE.Spans.Common
import           Development.IDE.Spans.Documentation
import           Development.IDE.Types.Exports
import           Development.IDE.Types.HscEnvEq           (HscEnvEq (envPackageExports, envVisibleModuleNames),
                                                           hscEnv)
import qualified Development.IDE.Types.KnownTargets       as KT
import           Development.IDE.Types.Location
import           Ide.Logger                               (Pretty (pretty),
                                                           Recorder,
                                                           WithPriority,
                                                           cmapWithPrio)
import           Ide.Plugin.Error
import           Ide.Types
import qualified Language.LSP.Protocol.Lens               as L
import           Language.LSP.Protocol.Message
import           Language.LSP.Protocol.Types
import qualified Language.LSP.Server                      as LSP
import           Numeric.Natural
import           Prelude                                  hiding (mod)
import           Text.Fuzzy.Parallel                      (Scored (..))

import           Development.IDE.Core.Rules               (usePropertyAction)

import qualified Ide.Plugin.Config                        as Config

-- See Note [Guidelines For Using CPP In GHCIDE Import Statements]

import qualified GHC.LanguageExtensions                   as LangExt

data Log = LogShake Shake.Log deriving Int -> Log -> ShowS
[Log] -> ShowS
Log -> String
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 :: forall ann. Log -> Doc ann
pretty = \case
    LogShake Log
msg -> forall a ann. Pretty a => a -> Doc ann
pretty Log
msg

ghcideCompletionsPluginPriority :: Natural
ghcideCompletionsPluginPriority :: Natural
ghcideCompletionsPluginPriority = Natural
defaultPluginPriority

descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
descriptor :: Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
descriptor Recorder (WithPriority Log)
recorder PluginId
plId = (forall ideState. PluginId -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId)
  { $sel:pluginRules:PluginDescriptor :: Rules ()
pluginRules = Recorder (WithPriority Log) -> Rules ()
produceCompletions Recorder (WithPriority Log)
recorder
  , $sel:pluginHandlers:PluginDescriptor :: PluginHandlers IdeState
pluginHandlers = forall ideState (m :: Method 'ClientToServer 'Request).
PluginRequestMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SMethod 'Method_TextDocumentCompletion
SMethod_TextDocumentCompletion PluginMethodHandler IdeState 'Method_TextDocumentCompletion
getCompletionsLSP
                     forall a. Semigroup a => a -> a -> a
<> forall ideState a (m :: Method 'ClientToServer 'Request).
(FromJSON a, PluginRequestMethod m,
 HasData_ (MessageParams m) (Maybe Value)) =>
SClientMethod m
-> ResolveFunction ideState a m -> PluginHandlers ideState
mkResolveHandler SMethod 'Method_CompletionItemResolve
SMethod_CompletionItemResolve ResolveFunction
  IdeState CompletionResolveData 'Method_CompletionItemResolve
resolveCompletion
  , $sel:pluginConfigDescriptor:PluginDescriptor :: ConfigDescriptor
pluginConfigDescriptor = ConfigDescriptor
defaultConfigDescriptor {$sel:configCustomConfig:ConfigDescriptor :: CustomConfig
configCustomConfig = forall (r :: [PropertyKey]). Properties r -> CustomConfig
mkCustomConfig Properties
  '[ 'PropertyKey "autoExtendOn" 'TBoolean,
     'PropertyKey "snippetsOn" 'TBoolean]
properties}
  , $sel:pluginPriority:PluginDescriptor :: Natural
pluginPriority = Natural
ghcideCompletionsPluginPriority
  }


produceCompletions :: Recorder (WithPriority Log) -> Rules ()
produceCompletions :: Recorder (WithPriority Log) -> Rules ()
produceCompletions Recorder (WithPriority Log)
recorder = do
    forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define (forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) forall a b. (a -> b) -> a -> b
$ \LocalCompletions
LocalCompletions NormalizedFilePath
file -> do
        let uri :: Uri
uri = NormalizedUri -> Uri
fromNormalizedUri forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> NormalizedUri
normalizedFilePathToUri NormalizedFilePath
file
        Maybe (ParsedModule, PositionMapping)
mbPm <- forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale GetParsedModule
GetParsedModule NormalizedFilePath
file
        case Maybe (ParsedModule, PositionMapping)
mbPm of
            Just (ParsedModule
pm, PositionMapping
_) -> do
                let cdata :: CachedCompletions
cdata = Uri -> ParsedModule -> CachedCompletions
localCompletionsForParsedModule Uri
uri ParsedModule
pm
                forall (m :: * -> *) a. Monad m => a -> m a
return ([], forall a. a -> Maybe a
Just CachedCompletions
cdata)
            Maybe (ParsedModule, PositionMapping)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ([], forall a. Maybe a
Nothing)
    forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define (forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) forall a b. (a -> b) -> a -> b
$ \NonLocalCompletions
NonLocalCompletions NormalizedFilePath
file -> do
        -- For non local completions we avoid depending on the parsed module,
        -- synthesizing a fake module with an empty body from the buffer
        -- in the ModSummary, which preserves all the imports
        Maybe ModSummaryResult
ms <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale GetModSummaryWithoutTimestamps
GetModSummaryWithoutTimestamps NormalizedFilePath
file
        Maybe HscEnvEq
mbSess <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale GhcSessionDeps
GhcSessionDeps NormalizedFilePath
file

        case (Maybe ModSummaryResult
ms, Maybe HscEnvEq
mbSess) of
            (Just ModSummaryResult{[LImportDecl GhcPs]
Fingerprint
HscEnv
ModSummary
msrHscEnv :: ModSummaryResult -> HscEnv
msrFingerprint :: ModSummaryResult -> Fingerprint
msrImports :: ModSummaryResult -> [LImportDecl GhcPs]
msrModSummary :: ModSummaryResult -> ModSummary
msrHscEnv :: HscEnv
msrFingerprint :: Fingerprint
msrImports :: [LImportDecl GhcPs]
msrModSummary :: ModSummary
..}, Just HscEnvEq
sess) -> do
              let env :: HscEnv
env = HscEnvEq -> HscEnv
hscEnv HscEnvEq
sess
              -- We do this to be able to provide completions of items that are not restricted to the explicit list
              ((Messages DecoratedSDoc, Maybe GlobalRdrEnv)
global, (Messages DecoratedSDoc, Maybe GlobalRdrEnv)
inScope) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ HscEnv
-> [LImportDecl GhcPs]
-> IO (Messages DecoratedSDoc, Maybe GlobalRdrEnv)
tcRnImportDecls HscEnv
env (LImportDecl GhcPs -> LImportDecl GhcPs
dropListFromImportDecl forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LImportDecl GhcPs]
msrImports) forall a b. IO a -> IO b -> IO (a, b)
`concurrently` HscEnv
-> [LImportDecl GhcPs]
-> IO (Messages DecoratedSDoc, Maybe GlobalRdrEnv)
tcRnImportDecls HscEnv
env [LImportDecl GhcPs]
msrImports
              case ((Messages DecoratedSDoc, Maybe GlobalRdrEnv)
global, (Messages DecoratedSDoc, Maybe GlobalRdrEnv)
inScope) of
                  ((Messages DecoratedSDoc
_, Just GlobalRdrEnv
globalEnv), (Messages DecoratedSDoc
_, Just GlobalRdrEnv
inScopeEnv)) -> do
                      [ModuleName]
visibleMods <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a -> a
fromMaybe []) forall a b. (a -> b) -> a -> b
$ HscEnvEq -> IO (Maybe [ModuleName])
envVisibleModuleNames HscEnvEq
sess
                      let uri :: Uri
uri = NormalizedUri -> Uri
fromNormalizedUri forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> NormalizedUri
normalizedFilePathToUri NormalizedFilePath
file
                      let cdata :: CachedCompletions
cdata = Uri
-> [ModuleName]
-> Module
-> GlobalRdrEnv
-> GlobalRdrEnv
-> [LImportDecl GhcPs]
-> CachedCompletions
cacheDataProducer Uri
uri [ModuleName]
visibleMods (ModSummary -> Module
ms_mod ModSummary
msrModSummary) GlobalRdrEnv
globalEnv GlobalRdrEnv
inScopeEnv [LImportDecl GhcPs]
msrImports
                      forall (m :: * -> *) a. Monad m => a -> m a
return ([], forall a. a -> Maybe a
Just CachedCompletions
cdata)
                  ((Messages DecoratedSDoc, Maybe GlobalRdrEnv)
_diag, (Messages DecoratedSDoc, Maybe GlobalRdrEnv)
_) ->
                      forall (m :: * -> *) a. Monad m => a -> m a
return ([], forall a. Maybe a
Nothing)
            (Maybe ModSummaryResult, Maybe HscEnvEq)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ([], forall a. Maybe a
Nothing)

-- Drop any explicit imports in ImportDecl if not hidden
dropListFromImportDecl :: LImportDecl GhcPs -> LImportDecl GhcPs
dropListFromImportDecl :: LImportDecl GhcPs -> LImportDecl GhcPs
dropListFromImportDecl LImportDecl GhcPs
iDecl = let
#if MIN_VERSION_ghc(9,5,0)
    f d@ImportDecl {ideclImportList} = case ideclImportList of
        Just (Exactly, _) -> d {ideclImportList=Nothing}
#else
    f :: ImportDecl pass -> ImportDecl pass
f d :: ImportDecl pass
d@ImportDecl {Maybe (Bool, XRec pass [LIE pass])
ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, XRec pass [LIE pass])
ideclHiding :: Maybe (Bool, XRec pass [LIE pass])
ideclHiding} = case Maybe (Bool, XRec pass [LIE pass])
ideclHiding of
        Just (Bool
False, XRec pass [LIE pass]
_) -> ImportDecl pass
d {ideclHiding :: Maybe (Bool, XRec pass [LIE pass])
ideclHiding=forall a. Maybe a
Nothing}
#endif
        -- if hiding or Nothing just return d
        Maybe (Bool, XRec pass [LIE pass])
_               -> ImportDecl pass
d
    f ImportDecl pass
x = ImportDecl pass
x
    in forall {pass}. ImportDecl pass -> ImportDecl pass
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LImportDecl GhcPs
iDecl

resolveCompletion :: ResolveFunction IdeState CompletionResolveData Method_CompletionItemResolve
resolveCompletion :: ResolveFunction
  IdeState CompletionResolveData 'Method_CompletionItemResolve
resolveCompletion IdeState
ide PluginId
_pid comp :: MessageParams 'Method_CompletionItemResolve
comp@CompletionItem{Maybe Text
$sel:_detail:CompletionItem :: CompletionItem -> Maybe Text
_detail :: Maybe Text
_detail,Maybe (Text |? MarkupContent)
$sel:_documentation:CompletionItem :: CompletionItem -> Maybe (Text |? MarkupContent)
_documentation :: Maybe (Text |? MarkupContent)
_documentation,Maybe Value
$sel:_data_:CompletionItem :: CompletionItem -> Maybe Value
_data_ :: Maybe Value
_data_} Uri
uri (CompletionResolveData Uri
_ Bool
needType (NameDetails Module
mod OccName
occ)) =
  do
    NormalizedFilePath
file <- forall (m :: * -> *).
Monad m =>
Uri -> ExceptT PluginError m NormalizedFilePath
getNormalizedFilePathE Uri
uri
    (HscEnvEq
sess,PositionMapping
_) <- forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT (forall a b. a -> b -> a
const PluginError
PluginStaleResolve)
                  forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a.
MonadIO m =>
String -> ShakeExtras -> ExceptT e IdeAction a -> ExceptT e m a
runIdeActionE String
"CompletionResolve.GhcSessionDeps" (IdeState -> ShakeExtras
shakeExtras IdeState
ide)
                  forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k
-> NormalizedFilePath
-> ExceptT PluginError IdeAction (v, PositionMapping)
useWithStaleFastE GhcSessionDeps
GhcSessionDeps NormalizedFilePath
file
    let nc :: IORef NameCache
nc = ShakeExtras -> IORef NameCache
ideNc forall a b. (a -> b) -> a -> b
$ IdeState -> ShakeExtras
shakeExtras IdeState
ide
#if MIN_VERSION_ghc(9,3,0)
    name <- liftIO $ lookupNameCache nc mod occ
#else
    Name
name <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall c. IORef NameCache -> (NameCache -> (NameCache, c)) -> IO c
upNameCache IORef NameCache
nc (Module -> OccName -> NameCache -> (NameCache, Name)
lookupNameCache Module
mod OccName
occ)
#endif
    Maybe (DocAndKindMap, PositionMapping)
mdkm <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. String -> ShakeExtras -> IdeAction a -> IO a
runIdeAction String
"CompletionResolve.GetDocMap" (IdeState -> ShakeExtras
shakeExtras IdeState
ide) forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))
useWithStaleFast GetDocMap
GetDocMap NormalizedFilePath
file
    let (DocMap
dm,KindMap
km) = case Maybe (DocAndKindMap, PositionMapping)
mdkm of
          Just (DKMap DocMap
docMap KindMap
kindMap, PositionMapping
_) -> (DocMap
docMap,KindMap
kindMap)
          Maybe (DocAndKindMap, PositionMapping)
Nothing                        -> (forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty)
    [Text]
doc <- case forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv DocMap
dm Name
name of
      Just SpanDoc
doc -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ SpanDoc -> [Text]
spanDocToMarkdown SpanDoc
doc
      Maybe SpanDoc
Nothing -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ SpanDoc -> [Text]
spanDocToMarkdown forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HscEnv -> Name -> IO SpanDoc
getDocumentationTryGhc (HscEnvEq -> HscEnv
hscEnv HscEnvEq
sess) Name
name
    Maybe Type
typ <- case forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv KindMap
km Name
name of
      Maybe TyThing
_ | Bool -> Bool
not Bool
needType -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
      Just TyThing
ty -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (TyThing -> Maybe Type
safeTyThingType TyThing
ty)
      Maybe TyThing
Nothing -> do
        (TyThing -> Maybe Type
safeTyThingType forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (HscEnv -> Name -> IO (Maybe TyThing)
lookupName (HscEnvEq -> HscEnv
hscEnv HscEnvEq
sess) Name
name)
    let det1 :: Maybe Text
det1 = case Maybe Type
typ of
          Just Type
ty -> forall a. a -> Maybe a
Just (Text
":: " forall a. Semigroup a => a -> a -> a
<> forall a. Outputable a => a -> Text
printOutputable (Type -> Type
stripForall Type
ty) forall a. Semigroup a => a -> a -> a
<> Text
"\n")
          Maybe Type
Nothing -> forall a. Maybe a
Nothing
        doc1 :: Text |? MarkupContent
doc1 = case Maybe (Text |? MarkupContent)
_documentation of
          Just (InR (MarkupContent MarkupKind
MarkupKind_Markdown Text
old)) ->
            forall a b. b -> a |? b
InR forall a b. (a -> b) -> a -> b
$ MarkupKind -> Text -> MarkupContent
MarkupContent MarkupKind
MarkupKind_Markdown forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
sectionSeparator (Text
oldforall a. a -> [a] -> [a]
:[Text]
doc)
          Maybe (Text |? MarkupContent)
_ -> forall a b. b -> a |? b
InR forall a b. (a -> b) -> a -> b
$ MarkupKind -> Text -> MarkupContent
MarkupContent MarkupKind
MarkupKind_Markdown forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
sectionSeparator [Text]
doc
    forall (f :: * -> *) a. Applicative f => a -> f a
pure  (MessageParams 'Method_CompletionItemResolve
comp forall a b. a -> (a -> b) -> b
& forall s a. HasDetail s a => Lens' s a
L.detail forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Maybe Text
det1 forall a. Semigroup a => a -> a -> a
<> Maybe Text
_detail)
                forall a b. a -> (a -> b) -> b
& forall s a. HasDocumentation s a => Lens' s a
L.documentation forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text |? MarkupContent
doc1)
  where
    stripForall :: Type -> Type
stripForall Type
ty = case Type -> ([TyCoVar], Type)
splitForAllTyCoVars Type
ty of
      ([TyCoVar]
_,Type
res) -> Type
res

-- | Generate code actions.
getCompletionsLSP :: PluginMethodHandler IdeState Method_TextDocumentCompletion
getCompletionsLSP :: PluginMethodHandler IdeState 'Method_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} = forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ do
    Maybe VirtualFile
contents <- forall config (m :: * -> *).
MonadLsp config m =>
NormalizedUri -> m (Maybe VirtualFile)
LSP.getVirtualFile forall a b. (a -> b) -> a -> b
$ Uri -> NormalizedUri
toNormalizedUri Uri
uri
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right 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, ModuleNameEnv (HashSet IdentInfo)
moduleExports, Maybe (HieAstResult, PositionMapping)
astres) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. String -> ShakeExtras -> IdeAction a -> IO a
runIdeAction String
"Completion" (IdeState -> ShakeExtras
shakeExtras IdeState
ide) forall a b. (a -> b) -> a -> b
$ do
            IdeOptions
opts <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ShakeExtras -> IO IdeOptions
getIdeOptionsIO forall a b. (a -> b) -> a -> b
$ IdeState -> ShakeExtras
shakeExtras IdeState
ide
            Maybe (CachedCompletions, PositionMapping)
localCompls <- forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))
useWithStaleFast LocalCompletions
LocalCompletions NormalizedFilePath
npath
            Maybe (CachedCompletions, PositionMapping)
nonLocalCompls <- forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))
useWithStaleFast NonLocalCompletions
NonLocalCompletions NormalizedFilePath
npath
            Maybe (ParsedModule, PositionMapping)
pm <- forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))
useWithStaleFast GetParsedModule
GetParsedModule NormalizedFilePath
npath
            (Bindings, PositionMapping)
binds <- forall a. a -> Maybe a -> a
fromMaybe (forall a. Monoid a => a
mempty, PositionMapping
zeroMapping) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))
useWithStaleFast GetBindings
GetBindings NormalizedFilePath
npath
            Maybe (HashMap Target (HashSet NormalizedFilePath))
knownTargets <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. String -> IdeState -> Action a -> IO a
runAction  String
"Completion" IdeState
ide forall a b. (a -> b) -> a -> b
$ forall k v. IdeRule k v => k -> Action (Maybe v)
useNoFile GetKnownTargets
GetKnownTargets
            let localModules :: [Target]
localModules = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall k v. HashMap k v -> [k]
Map.keys Maybe (HashMap Target (HashSet NormalizedFilePath))
knownTargets
            let lModules :: CachedCompletions
lModules = forall a. Monoid a => a
mempty{importableModules :: [Text]
importableModules = forall a b. (a -> b) -> [a] -> [b]
map Target -> Text
toModueNameText [Target]
localModules}
            -- set up the exports map including both package and project-level identifiers
            Maybe (IO ExportsMap)
packageExportsMapIO <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(HscEnvEq -> IO ExportsMap
envPackageExports forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))
useWithStaleFast GhcSession
GhcSession NormalizedFilePath
npath
            Maybe ExportsMap
packageExportsMap <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO Maybe (IO ExportsMap)
packageExportsMapIO
            ExportsMap
projectExportsMap <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> IO a
readTVarIO (ShakeExtras -> TVar ExportsMap
exportsMap forall a b. (a -> b) -> a -> b
$ IdeState -> ShakeExtras
shakeExtras IdeState
ide)
            let exportsMap :: ExportsMap
exportsMap = forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty Maybe ExportsMap
packageExportsMap forall a. Semigroup a => a -> a -> a
<> ExportsMap
projectExportsMap

            let moduleExports :: ModuleNameEnv (HashSet IdentInfo)
moduleExports = ExportsMap -> ModuleNameEnv (HashSet IdentInfo)
getModuleExportsMap ExportsMap
exportsMap
                exportsCompItems :: [Maybe Text -> CompItem]
exportsCompItems = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a b. (a -> b) -> [a] -> [b]
map (Uri -> IdentInfo -> Maybe Text -> CompItem
fromIdentInfo Uri
uri) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HashSet a -> [a]
Set.toList) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. OccEnv a -> [a]
nonDetOccEnvElts forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExportsMap -> OccEnv (HashSet IdentInfo)
getExportsMap forall a b. (a -> b) -> a -> b
$ ExportsMap
exportsMap
                exportsCompls :: CachedCompletions
exportsCompls = forall a. Monoid a => a
mempty{anyQualCompls :: [Maybe Text -> CompItem]
anyQualCompls = [Maybe Text -> CompItem]
exportsCompItems}
            let compls :: Maybe CachedCompletions
compls = (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (CachedCompletions, PositionMapping)
localCompls) forall a. Semigroup a => a -> a -> a
<> (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (CachedCompletions, PositionMapping)
nonLocalCompls) forall a. Semigroup a => a -> a -> a
<> forall a. a -> Maybe a
Just CachedCompletions
exportsCompls forall a. Semigroup a => a -> a -> a
<> forall a. a -> Maybe a
Just CachedCompletions
lModules

            -- get HieAst if OverloadedRecordDot is enabled
            let uses_overloaded_record_dot :: ModSummaryResult -> Bool
uses_overloaded_record_dot (ModSummary -> DynFlags
ms_hspp_opts forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModSummaryResult -> ModSummary
msrModSummary -> DynFlags
dflags) = Extension -> DynFlags -> Bool
xopt Extension
LangExt.OverloadedRecordDot DynFlags
dflags
            Maybe ModSummaryResult
ms <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))
useWithStaleFast GetModSummaryWithoutTimestamps
GetModSummaryWithoutTimestamps NormalizedFilePath
npath
            Maybe (HieAstResult, PositionMapping)
astres <- case Maybe ModSummaryResult
ms of
              Just ModSummaryResult
ms' | ModSummaryResult -> Bool
uses_overloaded_record_dot ModSummaryResult
ms'
                ->  forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))
useWithStaleFast GetHieAst
GetHieAst NormalizedFilePath
npath
              Maybe ModSummaryResult
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

            forall (f :: * -> *) a. Applicative f => a -> f a
pure (IdeOptions
opts, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,Maybe (ParsedModule, PositionMapping)
pm,(Bindings, PositionMapping)
binds) Maybe CachedCompletions
compls, ModuleNameEnv (HashSet IdentInfo)
moduleExports, Maybe (HieAstResult, PositionMapping)
astres)
        case Maybe
  (CachedCompletions, Maybe (ParsedModule, PositionMapping),
   (Bindings, PositionMapping))
compls of
          Just (CachedCompletions
cci', Maybe (ParsedModule, PositionMapping)
parsedMod, (Bindings, PositionMapping)
bindMap) -> do
            let pfix :: PosPrefixInfo
pfix = Position -> VirtualFile -> PosPrefixInfo
getCompletionPrefix Position
position VirtualFile
cnts
            case (PosPrefixInfo
pfix, Maybe CompletionContext
completionContext) of
              (PosPrefixInfo Text
_ Text
"" Text
_ Position
_, Just CompletionContext { $sel:_triggerCharacter:CompletionContext :: CompletionContext -> Maybe Text
_triggerCharacter = Just Text
"."})
                -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> a |? b
InL [])
              (PosPrefixInfo
_, Maybe CompletionContext
_) -> do
                let clientCaps :: ClientCapabilities
clientCaps = ShakeExtras -> ClientCapabilities
clientCapabilities forall a b. (a -> b) -> a -> b
$ IdeState -> ShakeExtras
shakeExtras IdeState
ide
                    plugins :: IdePlugins IdeState
plugins = ShakeExtras -> IdePlugins IdeState
idePlugins forall a b. (a -> b) -> a -> b
$ IdeState -> ShakeExtras
shakeExtras IdeState
ide
                CompletionsConfig
config <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. String -> IdeState -> Action a -> IO a
runAction String
"" IdeState
ide forall a b. (a -> b) -> a -> b
$ PluginId -> Action CompletionsConfig
getCompletionsConfig PluginId
plId

                [Scored CompletionItem]
allCompletions <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a.
IdePlugins a
-> IdeOptions
-> CachedCompletions
-> Maybe (ParsedModule, PositionMapping)
-> Maybe (HieAstResult, PositionMapping)
-> (Bindings, PositionMapping)
-> PosPrefixInfo
-> ClientCapabilities
-> CompletionsConfig
-> ModuleNameEnv (HashSet IdentInfo)
-> Uri
-> IO [Scored CompletionItem]
getCompletions IdePlugins IdeState
plugins IdeOptions
ideOpts CachedCompletions
cci' Maybe (ParsedModule, PositionMapping)
parsedMod Maybe (HieAstResult, PositionMapping)
astres (Bindings, PositionMapping)
bindMap PosPrefixInfo
pfix ClientCapabilities
clientCaps CompletionsConfig
config ModuleNameEnv (HashSet IdentInfo)
moduleExports Uri
uri
                forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> a |? b
InL ([Scored CompletionItem] -> [CompletionItem]
orderedCompletions [Scored CompletionItem]
allCompletions)
          Maybe
  (CachedCompletions, Maybe (ParsedModule, PositionMapping),
   (Bindings, PositionMapping))
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> a |? b
InL [])
      (Maybe VirtualFile, Maybe String)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> a |? b
InL [])

getCompletionsConfig :: PluginId -> Action CompletionsConfig
getCompletionsConfig :: PluginId -> Action CompletionsConfig
getCompletionsConfig PluginId
pId =
  Bool -> Bool -> Int -> CompletionsConfig
CompletionsConfig
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (s :: Symbol) (k :: PropertyKey) (t :: PropertyType)
       (r :: [PropertyKey]).
HasProperty s k t r =>
KeyNameProxy s -> PluginId -> Properties r -> Action (ToHsType t)
usePropertyAction forall a. IsLabel "snippetsOn" a => a
#snippetsOn PluginId
pId Properties
  '[ 'PropertyKey "autoExtendOn" 'TBoolean,
     'PropertyKey "snippetsOn" 'TBoolean]
properties
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (s :: Symbol) (k :: PropertyKey) (t :: PropertyType)
       (r :: [PropertyKey]).
HasProperty s k t r =>
KeyNameProxy s -> PluginId -> Properties r -> Action (ToHsType t)
usePropertyAction forall a. IsLabel "autoExtendOn" a => a
#autoExtendOn PluginId
pId Properties
  '[ 'PropertyKey "autoExtendOn" 'TBoolean,
     'PropertyKey "snippetsOn" 'TBoolean]
properties
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Config -> Int
Config.maxCompletions forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Action Config
getClientConfigAction)

{- COMPLETION SORTING
   We return an ordered set of completions (local -> nonlocal -> global).
   Ordering is important because local/nonlocal are import aware, whereas
   global are not and will always insert import statements, potentially redundant.

   Moreover, the order prioritizes qualifiers, for instance, given:

   import qualified MyModule
   foo = MyModule.<complete>

   The identifiers defined in MyModule will be listed first, followed by other
   identifiers in importable modules.

   According to the LSP specification, if no sortText is provided, the label is used
   to sort alphabetically. Alphabetical ordering is almost never what we want,
   so we force the LSP client to respect our ordering by using a numbered sequence.
-}

orderedCompletions :: [Scored CompletionItem] -> [CompletionItem]
orderedCompletions :: [Scored CompletionItem] -> [CompletionItem]
orderedCompletions [] = []
orderedCompletions [Scored CompletionItem]
xx = 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 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [Scored CompletionItem]
xx
    digits :: Int -> Int
digits = forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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{Text
$sel:_label:CompletionItem :: CompletionItem -> Text
_label :: Text
_label,Maybe Text
$sel:_sortText:CompletionItem :: CompletionItem -> Maybe Text
_sortText :: Maybe Text
_sortText}} =
        CompletionItem
it{$sel:_sortText:CompletionItem :: Maybe Text
_sortText = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
                String -> Text
T.pack(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 = forall a. Show a => a -> String
show a
x in forall a. Int -> a -> [a]
replicate (Int
n forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length String
sx) Char
'0' forall a. Semigroup a => a -> a -> a
<> String
sx

----------------------------------------------------------------------------------------------------

toModueNameText :: KT.Target -> T.Text
toModueNameText :: Target -> Text
toModueNameText Target
target = case Target
target of
  KT.TargetModule ModuleName
m -> String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ ModuleName -> String
moduleNameString ModuleName
m
  Target
_                 -> Text
T.empty