{-# 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.Monad.IO.Class
import           Control.Lens                            ((&), (.~))
import qualified Data.HashMap.Strict                      as Map
import qualified Data.HashSet                             as Set
import           Data.Aeson
import           Data.Maybe
import qualified Data.Text                                as T
import           Development.IDE.Core.PositionMapping
import           Development.IDE.Core.Compile
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.Util
import           Development.IDE.Graph
import           Development.IDE.Spans.Common
import           Development.IDE.Spans.Documentation
import           Development.IDE.Plugin.Completions.Logic
import           Development.IDE.Plugin.Completions.Types
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           Development.IDE.Types.Logger             (Pretty (pretty),
                                                           Recorder,
                                                           WithPriority,
                                                           cmapWithPrio)
import           Ide.Types
import qualified Language.LSP.Server                      as LSP
import           Language.LSP.Types
import qualified Language.LSP.Types.Lens         as J
import qualified Language.LSP.VFS                         as VFS
import           Numeric.Natural
import           Text.Fuzzy.Parallel                      (Scored (..))

import           Development.IDE.Core.Rules               (usePropertyAction)
import qualified GHC.LanguageExtensions                   as LangExt
import qualified Ide.Plugin.Config                        as Config

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
log -> forall a ann. Pretty a => a -> Doc ann
pretty Log
log

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)
  { pluginRules :: Rules ()
pluginRules = Recorder (WithPriority Log) -> Rules ()
produceCompletions Recorder (WithPriority Log)
recorder
  , pluginHandlers :: PluginHandlers IdeState
pluginHandlers = forall (m :: Method 'FromClient 'Request) ideState.
PluginRequestMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SMethod 'TextDocumentCompletion
STextDocumentCompletion IdeState
-> PluginId
-> CompletionParams
-> LspM
     Config
     (Either ResponseError (ResponseResult 'TextDocumentCompletion))
getCompletionsLSP
                  forall a. Semigroup a => a -> a -> a
<> forall (m :: Method 'FromClient 'Request) ideState.
PluginRequestMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SMethod 'CompletionItemResolve
SCompletionItemResolve IdeState
-> PluginId
-> CompletionItem
-> LspM Config (Either ResponseError CompletionItem)
resolveCompletion
  , pluginConfigDescriptor :: ConfigDescriptor
pluginConfigDescriptor = ConfigDescriptor
defaultConfigDescriptor {configCustomConfig :: CustomConfig
configCustomConfig = forall (r :: [PropertyKey]). Properties r -> CustomConfig
mkCustomConfig Properties
  '[ 'PropertyKey "autoExtendOn" 'TBoolean,
     'PropertyKey "snippetsOn" 'TBoolean]
properties}
  , pluginPriority :: 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)
pm <- 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
                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
sess <- 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
sess) 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 :: IdeState -> PluginId -> CompletionItem -> LSP.LspM Config (Either ResponseError CompletionItem)
resolveCompletion :: IdeState
-> PluginId
-> CompletionItem
-> LspM Config (Either ResponseError CompletionItem)
resolveCompletion IdeState
ide PluginId
_ comp :: CompletionItem
comp@CompletionItem{Maybe Text
$sel:_detail:CompletionItem :: CompletionItem -> Maybe Text
_detail :: Maybe Text
_detail,Maybe CompletionDoc
$sel:_documentation:CompletionItem :: CompletionItem -> Maybe CompletionDoc
_documentation :: Maybe CompletionDoc
_documentation,Maybe Value
$sel:_xdata:CompletionItem :: CompletionItem -> Maybe Value
_xdata :: Maybe Value
_xdata}
  | Just Value
resolveData <- Maybe Value
_xdata
  , Success (CompletionResolveData Uri
uri Bool
needType (NameDetails Module
mod OccName
occ)) <- forall a. FromJSON a => Value -> Result a
fromJSON Value
resolveData
  , Just NormalizedFilePath
file <- NormalizedUri -> Maybe NormalizedFilePath
uriToNormalizedFilePath forall a b. (a -> b) -> a -> b
$ Uri -> NormalizedUri
toNormalizedUri Uri
uri
  = 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 resolve" (IdeState -> ShakeExtras
shakeExtras IdeState
ide) forall a b. (a -> b) -> a -> b
$ do
    Maybe (HscEnvEq, PositionMapping)
msess <- forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))
useWithStaleFast GhcSessionDeps
GhcSessionDeps NormalizedFilePath
file
    case Maybe (HscEnvEq, PositionMapping)
msess of
      Maybe (HscEnvEq, PositionMapping)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right CompletionItem
comp) -- File doesn't compile, return original completion item
      Just (HscEnvEq
sess,PositionMapping
_) -> do
        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 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
dm KindMap
km, PositionMapping
_) -> (DocMap
dm,KindMap
km)
              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 :: CompletionDoc
doc1 = case Maybe CompletionDoc
_documentation of
              Just (CompletionDocMarkup (MarkupContent MarkupKind
MkMarkdown Text
old)) ->
                MarkupContent -> CompletionDoc
CompletionDocMarkup forall a b. (a -> b) -> a -> b
$ MarkupKind -> Text -> MarkupContent
MarkupContent MarkupKind
MkMarkdown forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
sectionSeparator (Text
oldforall a. a -> [a] -> [a]
:[Text]
doc)
              Maybe CompletionDoc
_ -> MarkupContent -> CompletionDoc
CompletionDocMarkup forall a b. (a -> b) -> a -> b
$ MarkupKind -> Text -> MarkupContent
MarkupContent MarkupKind
MkMarkdown 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 (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ CompletionItem
comp forall a b. a -> (a -> b) -> b
& forall s a. HasDetail s a => Lens' s a
J.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
J.documentation forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> Maybe a
Just CompletionDoc
doc1
                           )
  where
    stripForall :: Type -> Type
stripForall Type
ty = case Type -> ([TyCoVar], Type)
splitForAllTyCoVars Type
ty of
      ([TyCoVar]
_,Type
res) -> Type
res
resolveCompletion IdeState
_ PluginId
_ CompletionItem
comp = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right CompletionItem
comp)

-- | Generate code actions.
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 <- 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
#if MIN_VERSION_ghc(9,2,0)
            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
#else
            let uses_overloaded_record_dot _ = False
#endif
            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 forall a b. (a -> b) -> a -> b
$ forall a. [a] -> List a
List [])
              (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 (forall a. [a] -> List a
List forall a b. (a -> b) -> a -> b
$ [Scored CompletionItem] -> [CompletionItem]
orderedCompletions [Scored CompletionItem]
allCompletions)
              (PosPrefixInfo, Maybe CompletionContext)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> a |? b
InL forall a b. (a -> b) -> a -> b
$ forall a. [a] -> List a
List [])
          Maybe
  (CachedCompletions, Maybe (ParsedModule, PositionMapping),
   (Bindings, PositionMapping))
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> a |? b
InL forall a b. (a -> b) -> a -> b
$ forall a. [a] -> List a
List [])
      (Maybe VirtualFile, Maybe String)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> a |? b
InL forall a b. (a -> b) -> a -> b
$ forall a. [a] -> List a
List [])

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