{-# LANGUAGE CPP              #-}
{-# LANGUAGE OverloadedLabels #-}
{-# 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
(Int -> Log -> ShowS)
-> (Log -> String) -> ([Log] -> ShowS) -> Show Log
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Log -> ShowS
showsPrec :: Int -> Log -> ShowS
$cshow :: Log -> String
show :: Log -> String
$cshowList :: [Log] -> ShowS
showList :: [Log] -> ShowS
Show

instance Pretty Log where
  pretty :: forall ann. Log -> Doc ann
pretty = \case
    LogShake Log
msg -> Log -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Log -> 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 = (PluginId -> Text -> PluginDescriptor IdeState
forall ideState. PluginId -> Text -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId Text
desc)
  { pluginRules = produceCompletions recorder
  , pluginHandlers = mkPluginHandler SMethod_TextDocumentCompletion getCompletionsLSP
                     <> mkResolveHandler SMethod_CompletionItemResolve resolveCompletion
  , pluginConfigDescriptor = defaultConfigDescriptor {configCustomConfig = mkCustomConfig properties}
  , pluginPriority = ghcideCompletionsPluginPriority
  }
  where
    desc :: Text
desc = Text
"Provides Haskell completions"


produceCompletions :: Recorder (WithPriority Log) -> Rules ()
produceCompletions :: Recorder (WithPriority Log) -> Rules ()
produceCompletions Recorder (WithPriority Log)
recorder = do
    Recorder (WithPriority Log)
-> (LocalCompletions
    -> NormalizedFilePath -> Action (IdeResult CachedCompletions))
-> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) ((LocalCompletions
  -> NormalizedFilePath -> Action (IdeResult CachedCompletions))
 -> Rules ())
-> (LocalCompletions
    -> NormalizedFilePath -> Action (IdeResult CachedCompletions))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \LocalCompletions
LocalCompletions NormalizedFilePath
file -> do
        let uri :: Uri
uri = NormalizedUri -> Uri
fromNormalizedUri (NormalizedUri -> Uri) -> NormalizedUri -> Uri
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> NormalizedUri
normalizedFilePathToUri NormalizedFilePath
file
        Maybe (ParsedModule, PositionMapping)
mbPm <- 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)
mbPm of
            Just (ParsedModule
pm, PositionMapping
_) -> do
                let cdata :: CachedCompletions
cdata = Uri -> ParsedModule -> CachedCompletions
localCompletionsForParsedModule Uri
uri ParsedModule
pm
                IdeResult CachedCompletions -> Action (IdeResult CachedCompletions)
forall a. a -> Action a
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 a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Maybe CachedCompletions
forall a. Maybe a
Nothing)
    Recorder (WithPriority Log)
-> (NonLocalCompletions
    -> NormalizedFilePath -> Action (IdeResult CachedCompletions))
-> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) ((NonLocalCompletions
  -> NormalizedFilePath -> Action (IdeResult CachedCompletions))
 -> Rules ())
-> (NonLocalCompletions
    -> NormalizedFilePath -> Action (IdeResult CachedCompletions))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \NonLocalCompletions
NonLocalCompletions NormalizedFilePath
file -> do
        -- 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 <- ((ModSummaryResult, PositionMapping) -> ModSummaryResult)
-> Maybe (ModSummaryResult, PositionMapping)
-> Maybe ModSummaryResult
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ModSummaryResult, PositionMapping) -> ModSummaryResult
forall a b. (a, b) -> a
fst (Maybe (ModSummaryResult, PositionMapping)
 -> Maybe ModSummaryResult)
-> Action (Maybe (ModSummaryResult, PositionMapping))
-> Action (Maybe ModSummaryResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetModSummaryWithoutTimestamps
-> NormalizedFilePath
-> Action (Maybe (ModSummaryResult, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale GetModSummaryWithoutTimestamps
GetModSummaryWithoutTimestamps NormalizedFilePath
file
        Maybe HscEnvEq
mbSess <- ((HscEnvEq, PositionMapping) -> HscEnvEq)
-> Maybe (HscEnvEq, PositionMapping) -> Maybe HscEnvEq
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HscEnvEq, PositionMapping) -> HscEnvEq
forall a b. (a, b) -> a
fst (Maybe (HscEnvEq, PositionMapping) -> Maybe HscEnvEq)
-> Action (Maybe (HscEnvEq, PositionMapping))
-> Action (Maybe HscEnvEq)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GhcSessionDeps
-> NormalizedFilePath -> Action (Maybe (HscEnvEq, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale GhcSessionDeps
GhcSessionDeps NormalizedFilePath
file

        case (Maybe ModSummaryResult
ms, Maybe HscEnvEq
mbSess) of
            (Just ModSummaryResult{[LImportDecl GhcPs]
Fingerprint
ModSummary
HscEnv
msrModSummary :: ModSummary
msrImports :: [LImportDecl GhcPs]
msrFingerprint :: Fingerprint
msrHscEnv :: HscEnv
msrModSummary :: ModSummaryResult -> ModSummary
msrImports :: ModSummaryResult -> [LImportDecl GhcPs]
msrFingerprint :: ModSummaryResult -> Fingerprint
msrHscEnv :: ModSummaryResult -> HscEnv
..}, 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 TcRnMessage, Maybe GlobalRdrEnv)
global, (Messages TcRnMessage, Maybe GlobalRdrEnv)
inScope) <- IO
  ((Messages TcRnMessage, Maybe GlobalRdrEnv),
   (Messages TcRnMessage, Maybe GlobalRdrEnv))
-> Action
     ((Messages TcRnMessage, Maybe GlobalRdrEnv),
      (Messages TcRnMessage, Maybe GlobalRdrEnv))
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   ((Messages TcRnMessage, Maybe GlobalRdrEnv),
    (Messages TcRnMessage, Maybe GlobalRdrEnv))
 -> Action
      ((Messages TcRnMessage, Maybe GlobalRdrEnv),
       (Messages TcRnMessage, Maybe GlobalRdrEnv)))
-> IO
     ((Messages TcRnMessage, Maybe GlobalRdrEnv),
      (Messages TcRnMessage, Maybe GlobalRdrEnv))
-> Action
     ((Messages TcRnMessage, Maybe GlobalRdrEnv),
      (Messages TcRnMessage, Maybe GlobalRdrEnv))
forall a b. (a -> b) -> a -> b
$ HscEnv
-> [LImportDecl GhcPs]
-> IO (Messages TcRnMessage, Maybe GlobalRdrEnv)
tcRnImportDecls HscEnv
env (LImportDecl GhcPs -> LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
dropListFromImportDecl (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
 -> GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LImportDecl GhcPs]
[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
msrImports) IO (Messages TcRnMessage, Maybe GlobalRdrEnv)
-> IO (Messages TcRnMessage, Maybe GlobalRdrEnv)
-> IO
     ((Messages TcRnMessage, Maybe GlobalRdrEnv),
      (Messages TcRnMessage, Maybe GlobalRdrEnv))
forall a b. IO a -> IO b -> IO (a, b)
`concurrently` HscEnv
-> [LImportDecl GhcPs]
-> IO (Messages TcRnMessage, Maybe GlobalRdrEnv)
tcRnImportDecls HscEnv
env [LImportDecl GhcPs]
msrImports
              case ((Messages TcRnMessage, Maybe GlobalRdrEnv)
global, (Messages TcRnMessage, Maybe GlobalRdrEnv)
inScope) of
                  ((Messages TcRnMessage
_, Just GlobalRdrEnv
globalEnv), (Messages TcRnMessage
_, Just GlobalRdrEnv
inScopeEnv)) -> do
                      [ModuleName]
visibleMods <- IO [ModuleName] -> Action [ModuleName]
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ModuleName] -> Action [ModuleName])
-> IO [ModuleName] -> Action [ModuleName]
forall a b. (a -> b) -> a -> b
$ (Maybe [ModuleName] -> [ModuleName])
-> IO (Maybe [ModuleName]) -> IO [ModuleName]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([ModuleName] -> Maybe [ModuleName] -> [ModuleName]
forall a. a -> Maybe a -> a
fromMaybe []) (IO (Maybe [ModuleName]) -> IO [ModuleName])
-> IO (Maybe [ModuleName]) -> IO [ModuleName]
forall a b. (a -> b) -> a -> b
$ HscEnvEq -> IO (Maybe [ModuleName])
envVisibleModuleNames HscEnvEq
sess
                      let uri :: Uri
uri = NormalizedUri -> Uri
fromNormalizedUri (NormalizedUri -> Uri) -> NormalizedUri -> Uri
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
                      IdeResult CachedCompletions -> Action (IdeResult CachedCompletions)
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], CachedCompletions -> Maybe CachedCompletions
forall a. a -> Maybe a
Just CachedCompletions
cdata)
                  ((Messages TcRnMessage, Maybe GlobalRdrEnv)
_diag, (Messages TcRnMessage, Maybe GlobalRdrEnv)
_) ->
                      IdeResult CachedCompletions -> Action (IdeResult CachedCompletions)
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Maybe CachedCompletions
forall a. Maybe a
Nothing)
            (Maybe ModSummaryResult, Maybe HscEnvEq)
_ -> IdeResult CachedCompletions -> Action (IdeResult CachedCompletions)
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Maybe CachedCompletions
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 :: ImportDecl pass -> ImportDecl pass
f d :: ImportDecl pass
d@ImportDecl {Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclImportList :: Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclImportList :: forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclImportList} = case Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclImportList of
        Just (ImportListInterpretation
Exactly, XRec pass [LIE pass]
_) -> ImportDecl pass
d {ideclImportList=Nothing}
#else
    f d@ImportDecl {ideclHiding} = case ideclHiding of
        Just (False, _) -> d {ideclHiding=Nothing}
#endif
        -- if hiding or Nothing just return d
        Maybe (ImportListInterpretation, XRec pass [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 SrcSpanAnnA (ImportDecl GhcPs)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl 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
_detail :: Maybe Text
$sel:_detail:CompletionItem :: CompletionItem -> Maybe Text
_detail,Maybe (Text |? MarkupContent)
_documentation :: Maybe (Text |? MarkupContent)
$sel:_documentation:CompletionItem :: CompletionItem -> Maybe (Text |? MarkupContent)
_documentation,Maybe Value
_data_ :: Maybe Value
$sel:_data_:CompletionItem :: CompletionItem -> Maybe Value
_data_} Uri
uri (CompletionResolveData Uri
_ Bool
needType (NameDetails Module
mod OccName
occ)) =
  do
    NormalizedFilePath
file <- Uri -> ExceptT PluginError (LspT Config IO) NormalizedFilePath
forall (m :: * -> *).
Monad m =>
Uri -> ExceptT PluginError m NormalizedFilePath
getNormalizedFilePathE Uri
uri
    (HscEnvEq
sess,PositionMapping
_) <- (PluginError -> PluginError)
-> ExceptT PluginError (LspT Config IO) (HscEnvEq, PositionMapping)
-> ExceptT PluginError (LspT Config IO) (HscEnvEq, PositionMapping)
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT (PluginError -> PluginError -> PluginError
forall a b. a -> b -> a
const PluginError
PluginStaleResolve)
                  (ExceptT PluginError (LspT Config IO) (HscEnvEq, PositionMapping)
 -> ExceptT
      PluginError (LspT Config IO) (HscEnvEq, PositionMapping))
-> ExceptT PluginError (LspT Config IO) (HscEnvEq, PositionMapping)
-> ExceptT PluginError (LspT Config IO) (HscEnvEq, PositionMapping)
forall a b. (a -> b) -> a -> b
$ String
-> ShakeExtras
-> ExceptT PluginError IdeAction (HscEnvEq, PositionMapping)
-> ExceptT PluginError (LspT Config IO) (HscEnvEq, PositionMapping)
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)
                  (ExceptT PluginError IdeAction (HscEnvEq, PositionMapping)
 -> ExceptT
      PluginError (LspT Config IO) (HscEnvEq, PositionMapping))
-> ExceptT PluginError IdeAction (HscEnvEq, PositionMapping)
-> ExceptT PluginError (LspT Config IO) (HscEnvEq, PositionMapping)
forall a b. (a -> b) -> a -> b
$ GhcSessionDeps
-> NormalizedFilePath
-> ExceptT PluginError IdeAction (HscEnvEq, PositionMapping)
forall k v.
IdeRule k v =>
k
-> NormalizedFilePath
-> ExceptT PluginError IdeAction (v, PositionMapping)
useWithStaleFastE GhcSessionDeps
GhcSessionDeps NormalizedFilePath
file
    let nc :: NameCache
nc = ShakeExtras -> NameCache
ideNc (ShakeExtras -> NameCache) -> ShakeExtras -> NameCache
forall a b. (a -> b) -> a -> b
$ IdeState -> ShakeExtras
shakeExtras IdeState
ide
#if MIN_VERSION_ghc(9,3,0)
    Name
name <- IO Name -> ExceptT PluginError (LspT Config IO) Name
forall a. IO a -> ExceptT PluginError (LspT Config IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Name -> ExceptT PluginError (LspT Config IO) Name)
-> IO Name -> ExceptT PluginError (LspT Config IO) Name
forall a b. (a -> b) -> a -> b
$ NameCache -> Module -> OccName -> IO Name
lookupNameCache NameCache
nc Module
mod OccName
occ
#else
    name <- liftIO $ upNameCache nc (lookupNameCache mod occ)
#endif
    Maybe (DocAndTyThingMap, PositionMapping)
mdkm <- IO (Maybe (DocAndTyThingMap, PositionMapping))
-> ExceptT
     PluginError
     (LspT Config IO)
     (Maybe (DocAndTyThingMap, PositionMapping))
forall a. IO a -> ExceptT PluginError (LspT Config IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (DocAndTyThingMap, PositionMapping))
 -> ExceptT
      PluginError
      (LspT Config IO)
      (Maybe (DocAndTyThingMap, PositionMapping)))
-> IO (Maybe (DocAndTyThingMap, PositionMapping))
-> ExceptT
     PluginError
     (LspT Config IO)
     (Maybe (DocAndTyThingMap, PositionMapping))
forall a b. (a -> b) -> a -> b
$ String
-> ShakeExtras
-> IdeAction (Maybe (DocAndTyThingMap, PositionMapping))
-> IO (Maybe (DocAndTyThingMap, PositionMapping))
forall a. String -> ShakeExtras -> IdeAction a -> IO a
runIdeAction String
"CompletionResolve.GetDocMap" (IdeState -> ShakeExtras
shakeExtras IdeState
ide) (IdeAction (Maybe (DocAndTyThingMap, PositionMapping))
 -> IO (Maybe (DocAndTyThingMap, PositionMapping)))
-> IdeAction (Maybe (DocAndTyThingMap, PositionMapping))
-> IO (Maybe (DocAndTyThingMap, PositionMapping))
forall a b. (a -> b) -> a -> b
$ GetDocMap
-> NormalizedFilePath
-> IdeAction (Maybe (DocAndTyThingMap, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))
useWithStaleFast GetDocMap
GetDocMap NormalizedFilePath
file
    let (DocMap
dm,TyThingMap
km) = case Maybe (DocAndTyThingMap, PositionMapping)
mdkm of
          Just (DKMap DocMap
docMap TyThingMap
tyThingMap, PositionMapping
_) -> (DocMap
docMap,TyThingMap
tyThingMap)
          Maybe (DocAndTyThingMap, PositionMapping)
Nothing                           -> (DocMap
forall a. Monoid a => a
mempty, TyThingMap
forall a. Monoid a => a
mempty)
    [Text]
doc <- case DocMap -> Name -> Maybe SpanDoc
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv DocMap
dm Name
name of
      Just SpanDoc
doc -> [Text] -> ExceptT PluginError (LspT Config IO) [Text]
forall a. a -> ExceptT PluginError (LspT Config IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> ExceptT PluginError (LspT Config IO) [Text])
-> [Text] -> ExceptT PluginError (LspT Config IO) [Text]
forall a b. (a -> b) -> a -> b
$ SpanDoc -> [Text]
spanDocToMarkdown SpanDoc
doc
      Maybe SpanDoc
Nothing -> IO [Text] -> ExceptT PluginError (LspT Config IO) [Text]
forall a. IO a -> ExceptT PluginError (LspT Config IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Text] -> ExceptT PluginError (LspT Config IO) [Text])
-> IO [Text] -> ExceptT PluginError (LspT Config IO) [Text]
forall a b. (a -> b) -> a -> b
$ SpanDoc -> [Text]
spanDocToMarkdown (SpanDoc -> [Text]) -> IO SpanDoc -> IO [Text]
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 TyThingMap -> Name -> Maybe TyThing
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv TyThingMap
km Name
name of
      Maybe TyThing
_ | Bool -> Bool
not Bool
needType -> Maybe Type -> ExceptT PluginError (LspT Config IO) (Maybe Type)
forall a. a -> ExceptT PluginError (LspT Config IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Type
forall a. Maybe a
Nothing
      Just TyThing
ty -> Maybe Type -> ExceptT PluginError (LspT Config IO) (Maybe Type)
forall a. a -> ExceptT PluginError (LspT Config IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TyThing -> Maybe Type
safeTyThingType TyThing
ty)
      Maybe TyThing
Nothing -> do
        (TyThing -> Maybe Type
safeTyThingType =<<) (Maybe TyThing -> Maybe Type)
-> ExceptT PluginError (LspT Config IO) (Maybe TyThing)
-> ExceptT PluginError (LspT Config IO) (Maybe Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe TyThing)
-> ExceptT PluginError (LspT Config IO) (Maybe TyThing)
forall a. IO a -> ExceptT PluginError (LspT Config IO) a
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 -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text
":: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Type -> Text
forall a. Outputable a => a -> Text
printOutputable (Type -> Type
stripForall Type
ty) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n")
          Maybe Type
Nothing -> Maybe Text
forall a. Maybe a
Nothing
        doc1 :: Text |? MarkupContent
doc1 = case Maybe (Text |? MarkupContent)
_documentation of
          Just (InR (MarkupContent MarkupKind
MarkupKind_Markdown Text
old)) ->
            MarkupContent -> Text |? MarkupContent
forall a b. b -> a |? b
InR (MarkupContent -> Text |? MarkupContent)
-> MarkupContent -> Text |? MarkupContent
forall a b. (a -> b) -> a -> b
$ MarkupKind -> Text -> MarkupContent
MarkupContent MarkupKind
MarkupKind_Markdown (Text -> MarkupContent) -> Text -> MarkupContent
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
sectionSeparator (Text
oldText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
doc)
          Maybe (Text |? MarkupContent)
_ -> MarkupContent -> Text |? MarkupContent
forall a b. b -> a |? b
InR (MarkupContent -> Text |? MarkupContent)
-> MarkupContent -> Text |? MarkupContent
forall a b. (a -> b) -> a -> b
$ MarkupKind -> Text -> MarkupContent
MarkupContent MarkupKind
MarkupKind_Markdown (Text -> MarkupContent) -> Text -> MarkupContent
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
sectionSeparator [Text]
doc
    CompletionItem
-> ExceptT PluginError (LspT Config IO) CompletionItem
forall a. a -> ExceptT PluginError (LspT Config IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure  (CompletionItem
MessageParams 'Method_CompletionItemResolve
comp CompletionItem
-> (CompletionItem -> CompletionItem) -> CompletionItem
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text))
-> CompletionItem -> Identity CompletionItem
forall s a. HasDetail s a => Lens' s a
Lens' CompletionItem (Maybe Text)
L.detail ((Maybe Text -> Identity (Maybe Text))
 -> CompletionItem -> Identity CompletionItem)
-> Maybe Text -> CompletionItem -> CompletionItem
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Maybe Text
det1 Maybe Text -> Maybe Text -> Maybe Text
forall a. Semigroup a => a -> a -> a
<> Maybe Text
_detail)
                CompletionItem
-> (CompletionItem -> CompletionItem) -> CompletionItem
forall a b. a -> (a -> b) -> b
& (Maybe (Text |? MarkupContent)
 -> Identity (Maybe (Text |? MarkupContent)))
-> CompletionItem -> Identity CompletionItem
forall s a. HasDocumentation s a => Lens' s a
Lens' CompletionItem (Maybe (Text |? MarkupContent))
L.documentation ((Maybe (Text |? MarkupContent)
  -> Identity (Maybe (Text |? MarkupContent)))
 -> CompletionItem -> Identity CompletionItem)
-> (Text |? MarkupContent) -> CompletionItem -> CompletionItem
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} = LspM
  Config
  (Either PluginError (MessageResult 'Method_TextDocumentCompletion))
-> ExceptT
     PluginError
     (LspT Config IO)
     (MessageResult 'Method_TextDocumentCompletion)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (LspM
   Config
   (Either PluginError (MessageResult 'Method_TextDocumentCompletion))
 -> ExceptT
      PluginError
      (LspT Config IO)
      (MessageResult 'Method_TextDocumentCompletion))
-> LspM
     Config
     (Either PluginError (MessageResult 'Method_TextDocumentCompletion))
-> ExceptT
     PluginError
     (LspT Config IO)
     (MessageResult 'Method_TextDocumentCompletion)
forall a b. (a -> b) -> a -> b
$ do
    Maybe VirtualFile
contents <- NormalizedUri -> LspT Config IO (Maybe VirtualFile)
forall config (m :: * -> *).
MonadLsp config m =>
NormalizedUri -> m (Maybe VirtualFile)
LSP.getVirtualFile (NormalizedUri -> LspT Config IO (Maybe VirtualFile))
-> NormalizedUri -> LspT Config IO (Maybe VirtualFile)
forall a b. (a -> b) -> a -> b
$ Uri -> NormalizedUri
toNormalizedUri Uri
uri
    (([CompletionItem] |? (CompletionList |? Null))
 -> Either
      PluginError ([CompletionItem] |? (CompletionList |? Null)))
-> LspT Config IO ([CompletionItem] |? (CompletionList |? Null))
-> LspT
     Config
     IO
     (Either PluginError ([CompletionItem] |? (CompletionList |? Null)))
forall a b. (a -> b) -> LspT Config IO a -> LspT Config IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([CompletionItem] |? (CompletionList |? Null))
-> Either
     PluginError ([CompletionItem] |? (CompletionList |? Null))
forall a b. b -> Either a b
Right (LspT Config IO ([CompletionItem] |? (CompletionList |? Null))
 -> LspT
      Config
      IO
      (Either
         PluginError ([CompletionItem] |? (CompletionList |? Null))))
-> LspT Config IO ([CompletionItem] |? (CompletionList |? Null))
-> LspT
     Config
     IO
     (Either PluginError ([CompletionItem] |? (CompletionList |? Null)))
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) <- IO
  (IdeOptions,
   Maybe
     (CachedCompletions, Maybe (ParsedModule, PositionMapping),
      (Bindings, PositionMapping)),
   ModuleNameEnv (HashSet IdentInfo),
   Maybe (HieAstResult, PositionMapping))
-> LspT
     Config
     IO
     (IdeOptions,
      Maybe
        (CachedCompletions, Maybe (ParsedModule, PositionMapping),
         (Bindings, PositionMapping)),
      ModuleNameEnv (HashSet IdentInfo),
      Maybe (HieAstResult, PositionMapping))
forall a. IO a -> LspT Config IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   (IdeOptions,
    Maybe
      (CachedCompletions, Maybe (ParsedModule, PositionMapping),
       (Bindings, PositionMapping)),
    ModuleNameEnv (HashSet IdentInfo),
    Maybe (HieAstResult, PositionMapping))
 -> LspT
      Config
      IO
      (IdeOptions,
       Maybe
         (CachedCompletions, Maybe (ParsedModule, PositionMapping),
          (Bindings, PositionMapping)),
       ModuleNameEnv (HashSet IdentInfo),
       Maybe (HieAstResult, PositionMapping)))
-> IO
     (IdeOptions,
      Maybe
        (CachedCompletions, Maybe (ParsedModule, PositionMapping),
         (Bindings, PositionMapping)),
      ModuleNameEnv (HashSet IdentInfo),
      Maybe (HieAstResult, PositionMapping))
-> LspT
     Config
     IO
     (IdeOptions,
      Maybe
        (CachedCompletions, Maybe (ParsedModule, PositionMapping),
         (Bindings, PositionMapping)),
      ModuleNameEnv (HashSet IdentInfo),
      Maybe (HieAstResult, PositionMapping))
forall a b. (a -> b) -> a -> b
$ String
-> ShakeExtras
-> IdeAction
     (IdeOptions,
      Maybe
        (CachedCompletions, Maybe (ParsedModule, PositionMapping),
         (Bindings, PositionMapping)),
      ModuleNameEnv (HashSet IdentInfo),
      Maybe (HieAstResult, PositionMapping))
-> IO
     (IdeOptions,
      Maybe
        (CachedCompletions, Maybe (ParsedModule, PositionMapping),
         (Bindings, PositionMapping)),
      ModuleNameEnv (HashSet IdentInfo),
      Maybe (HieAstResult, 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)),
    ModuleNameEnv (HashSet IdentInfo),
    Maybe (HieAstResult, PositionMapping))
 -> IO
      (IdeOptions,
       Maybe
         (CachedCompletions, Maybe (ParsedModule, PositionMapping),
          (Bindings, PositionMapping)),
       ModuleNameEnv (HashSet IdentInfo),
       Maybe (HieAstResult, PositionMapping)))
-> IdeAction
     (IdeOptions,
      Maybe
        (CachedCompletions, Maybe (ParsedModule, PositionMapping),
         (Bindings, PositionMapping)),
      ModuleNameEnv (HashSet IdentInfo),
      Maybe (HieAstResult, PositionMapping))
-> IO
     (IdeOptions,
      Maybe
        (CachedCompletions, Maybe (ParsedModule, PositionMapping),
         (Bindings, PositionMapping)),
      ModuleNameEnv (HashSet IdentInfo),
      Maybe (HieAstResult, PositionMapping))
forall a b. (a -> b) -> a -> b
$ do
            IdeOptions
opts <- IO IdeOptions -> IdeAction IdeOptions
forall a. IO a -> IdeAction a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IdeOptions -> IdeAction IdeOptions)
-> IO IdeOptions -> IdeAction IdeOptions
forall a b. (a -> b) -> a -> b
$ ShakeExtras -> IO IdeOptions
getIdeOptionsIO (ShakeExtras -> IO IdeOptions) -> ShakeExtras -> IO IdeOptions
forall a b. (a -> b) -> a -> b
$ IdeState -> ShakeExtras
shakeExtras IdeState
ide
            Maybe (CachedCompletions, PositionMapping)
localCompls <- LocalCompletions
-> NormalizedFilePath
-> IdeAction (Maybe (CachedCompletions, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))
useWithStaleFast LocalCompletions
LocalCompletions NormalizedFilePath
npath
            Maybe (CachedCompletions, PositionMapping)
nonLocalCompls <- NonLocalCompletions
-> NormalizedFilePath
-> IdeAction (Maybe (CachedCompletions, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))
useWithStaleFast NonLocalCompletions
NonLocalCompletions NormalizedFilePath
npath
            Maybe (ParsedModule, PositionMapping)
pm <- GetParsedModule
-> NormalizedFilePath
-> IdeAction (Maybe (ParsedModule, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))
useWithStaleFast GetParsedModule
GetParsedModule NormalizedFilePath
npath
            (Bindings, PositionMapping)
binds <- (Bindings, PositionMapping)
-> Maybe (Bindings, PositionMapping) -> (Bindings, PositionMapping)
forall a. a -> Maybe a -> a
fromMaybe (Bindings
forall a. Monoid a => a
mempty, PositionMapping
zeroMapping) (Maybe (Bindings, PositionMapping) -> (Bindings, PositionMapping))
-> IdeAction (Maybe (Bindings, PositionMapping))
-> IdeAction (Bindings, PositionMapping)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetBindings
-> NormalizedFilePath
-> IdeAction (Maybe (Bindings, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))
useWithStaleFast GetBindings
GetBindings NormalizedFilePath
npath
            Maybe (HashMap Target (HashSet NormalizedFilePath))
knownTargets <- IO (Maybe (HashMap Target (HashSet NormalizedFilePath)))
-> IdeAction (Maybe (HashMap Target (HashSet NormalizedFilePath)))
forall a. IO a -> IdeAction a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (HashMap Target (HashSet NormalizedFilePath)))
 -> IdeAction (Maybe (HashMap Target (HashSet NormalizedFilePath))))
-> IO (Maybe (HashMap Target (HashSet NormalizedFilePath)))
-> IdeAction (Maybe (HashMap Target (HashSet NormalizedFilePath)))
forall a b. (a -> b) -> a -> b
$ String
-> IdeState
-> Action (Maybe (HashMap Target (HashSet NormalizedFilePath)))
-> IO (Maybe (HashMap Target (HashSet NormalizedFilePath)))
forall a. String -> IdeState -> Action a -> IO a
runAction  String
"Completion" IdeState
ide (Action (Maybe (HashMap Target (HashSet NormalizedFilePath)))
 -> IO (Maybe (HashMap Target (HashSet NormalizedFilePath))))
-> Action (Maybe (HashMap Target (HashSet NormalizedFilePath)))
-> IO (Maybe (HashMap Target (HashSet NormalizedFilePath)))
forall a b. (a -> b) -> a -> b
$ GetKnownTargets
-> Action (Maybe (HashMap Target (HashSet NormalizedFilePath)))
forall k v. IdeRule k v => k -> Action (Maybe v)
useNoFile GetKnownTargets
GetKnownTargets
            let localModules :: [Target]
localModules = [Target]
-> (HashMap Target (HashSet NormalizedFilePath) -> [Target])
-> Maybe (HashMap Target (HashSet NormalizedFilePath))
-> [Target]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] HashMap Target (HashSet NormalizedFilePath) -> [Target]
forall k v. HashMap k v -> [k]
Map.keys Maybe (HashMap Target (HashSet NormalizedFilePath))
knownTargets
            let lModules :: CachedCompletions
lModules = CachedCompletions
forall a. Monoid a => a
mempty{importableModules = map toModueNameText localModules}
            -- set up the exports map including both package and project-level identifiers
            Maybe (IO ExportsMap)
packageExportsMapIO <- ((HscEnvEq, PositionMapping) -> IO ExportsMap)
-> Maybe (HscEnvEq, PositionMapping) -> Maybe (IO ExportsMap)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(HscEnvEq -> IO ExportsMap
envPackageExports (HscEnvEq -> IO ExportsMap)
-> ((HscEnvEq, PositionMapping) -> HscEnvEq)
-> (HscEnvEq, PositionMapping)
-> IO ExportsMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HscEnvEq, PositionMapping) -> HscEnvEq
forall a b. (a, b) -> a
fst) (Maybe (HscEnvEq, PositionMapping) -> Maybe (IO ExportsMap))
-> IdeAction (Maybe (HscEnvEq, PositionMapping))
-> IdeAction (Maybe (IO ExportsMap))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GhcSession
-> NormalizedFilePath
-> IdeAction (Maybe (HscEnvEq, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))
useWithStaleFast GhcSession
GhcSession NormalizedFilePath
npath
            Maybe ExportsMap
packageExportsMap <- (IO ExportsMap -> IdeAction ExportsMap)
-> Maybe (IO ExportsMap) -> IdeAction (Maybe ExportsMap)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM IO ExportsMap -> IdeAction ExportsMap
forall a. IO a -> IdeAction a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO Maybe (IO ExportsMap)
packageExportsMapIO
            ExportsMap
projectExportsMap <- IO ExportsMap -> IdeAction ExportsMap
forall a. IO a -> IdeAction a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ExportsMap -> IdeAction ExportsMap)
-> IO ExportsMap -> IdeAction ExportsMap
forall a b. (a -> b) -> a -> b
$ TVar ExportsMap -> IO ExportsMap
forall a. TVar a -> IO a
readTVarIO (ShakeExtras -> TVar ExportsMap
exportsMap (ShakeExtras -> TVar ExportsMap) -> ShakeExtras -> TVar ExportsMap
forall a b. (a -> b) -> a -> b
$ IdeState -> ShakeExtras
shakeExtras IdeState
ide)
            let exportsMap :: ExportsMap
exportsMap = ExportsMap -> Maybe ExportsMap -> ExportsMap
forall a. a -> Maybe a -> a
fromMaybe ExportsMap
forall a. Monoid a => a
mempty Maybe ExportsMap
packageExportsMap ExportsMap -> ExportsMap -> ExportsMap
forall a. Semigroup a => a -> a -> a
<> ExportsMap
projectExportsMap

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

            -- get HieAst if OverloadedRecordDot is enabled
            let uses_overloaded_record_dot :: ModSummaryResult -> Bool
uses_overloaded_record_dot (ModSummary -> DynFlags
ms_hspp_opts (ModSummary -> DynFlags)
-> (ModSummaryResult -> ModSummary) -> ModSummaryResult -> DynFlags
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 <- ((ModSummaryResult, PositionMapping) -> ModSummaryResult)
-> Maybe (ModSummaryResult, PositionMapping)
-> Maybe ModSummaryResult
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ModSummaryResult, PositionMapping) -> ModSummaryResult
forall a b. (a, b) -> a
fst (Maybe (ModSummaryResult, PositionMapping)
 -> Maybe ModSummaryResult)
-> IdeAction (Maybe (ModSummaryResult, PositionMapping))
-> IdeAction (Maybe ModSummaryResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetModSummaryWithoutTimestamps
-> NormalizedFilePath
-> IdeAction (Maybe (ModSummaryResult, PositionMapping))
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'
                ->  GetHieAst
-> NormalizedFilePath
-> IdeAction (Maybe (HieAstResult, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))
useWithStaleFast GetHieAst
GetHieAst NormalizedFilePath
npath
              Maybe ModSummaryResult
_ -> Maybe (HieAstResult, PositionMapping)
-> IdeAction (Maybe (HieAstResult, PositionMapping))
forall a. a -> IdeAction a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (HieAstResult, PositionMapping)
forall a. Maybe a
Nothing

            (IdeOptions,
 Maybe
   (CachedCompletions, Maybe (ParsedModule, PositionMapping),
    (Bindings, PositionMapping)),
 ModuleNameEnv (HashSet IdentInfo),
 Maybe (HieAstResult, PositionMapping))
-> IdeAction
     (IdeOptions,
      Maybe
        (CachedCompletions, Maybe (ParsedModule, PositionMapping),
         (Bindings, PositionMapping)),
      ModuleNameEnv (HashSet IdentInfo),
      Maybe (HieAstResult, PositionMapping))
forall a. a -> IdeAction a
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 a b. (a -> b) -> Maybe a -> Maybe b
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
"."})
                -> ([CompletionItem] |? (CompletionList |? Null))
-> LspT Config IO ([CompletionItem] |? (CompletionList |? Null))
forall a. a -> LspT Config IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([CompletionItem] -> [CompletionItem] |? (CompletionList |? Null)
forall a b. a -> a |? b
InL [])
              (PosPrefixInfo
_, 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
                    plugins :: IdePlugins IdeState
plugins = ShakeExtras -> IdePlugins IdeState
idePlugins (ShakeExtras -> IdePlugins IdeState)
-> ShakeExtras -> IdePlugins IdeState
forall a b. (a -> b) -> a -> b
$ IdeState -> ShakeExtras
shakeExtras IdeState
ide
                CompletionsConfig
config <- IO CompletionsConfig -> LspT Config IO CompletionsConfig
forall a. IO a -> LspT Config IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CompletionsConfig -> LspT Config IO CompletionsConfig)
-> IO CompletionsConfig -> LspT Config IO CompletionsConfig
forall a b. (a -> b) -> a -> b
$ String
-> IdeState -> Action CompletionsConfig -> IO CompletionsConfig
forall a. String -> IdeState -> Action a -> IO a
runAction String
"" IdeState
ide (Action CompletionsConfig -> IO CompletionsConfig)
-> Action CompletionsConfig -> IO CompletionsConfig
forall a b. (a -> b) -> a -> b
$ PluginId -> Action CompletionsConfig
getCompletionsConfig PluginId
plId

                let allCompletions :: [Scored CompletionItem]
allCompletions = IdePlugins IdeState
-> IdeOptions
-> CachedCompletions
-> Maybe (ParsedModule, PositionMapping)
-> Maybe (HieAstResult, PositionMapping)
-> (Bindings, PositionMapping)
-> PosPrefixInfo
-> ClientCapabilities
-> CompletionsConfig
-> ModuleNameEnv (HashSet IdentInfo)
-> Uri
-> [Scored CompletionItem]
forall a.
IdePlugins a
-> IdeOptions
-> CachedCompletions
-> Maybe (ParsedModule, PositionMapping)
-> Maybe (HieAstResult, PositionMapping)
-> (Bindings, PositionMapping)
-> PosPrefixInfo
-> ClientCapabilities
-> CompletionsConfig
-> ModuleNameEnv (HashSet IdentInfo)
-> Uri
-> [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
                ([CompletionItem] |? (CompletionList |? Null))
-> LspT Config IO ([CompletionItem] |? (CompletionList |? Null))
forall a. a -> LspT Config IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([CompletionItem] |? (CompletionList |? Null))
 -> LspT Config IO ([CompletionItem] |? (CompletionList |? Null)))
-> ([CompletionItem] |? (CompletionList |? Null))
-> LspT Config IO ([CompletionItem] |? (CompletionList |? Null))
forall a b. (a -> b) -> a -> b
$ [CompletionItem] -> [CompletionItem] |? (CompletionList |? Null)
forall a b. a -> a |? b
InL ([Scored CompletionItem] -> [CompletionItem]
orderedCompletions [Scored CompletionItem]
allCompletions)
          Maybe
  (CachedCompletions, Maybe (ParsedModule, PositionMapping),
   (Bindings, PositionMapping))
_ -> ([CompletionItem] |? (CompletionList |? Null))
-> LspT Config IO ([CompletionItem] |? (CompletionList |? Null))
forall a. a -> LspT Config IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([CompletionItem] -> [CompletionItem] |? (CompletionList |? Null)
forall a b. a -> a |? b
InL [])
      (Maybe VirtualFile, Maybe String)
_ -> ([CompletionItem] |? (CompletionList |? Null))
-> LspT Config IO ([CompletionItem] |? (CompletionList |? Null))
forall a. a -> LspT Config IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([CompletionItem] -> [CompletionItem] |? (CompletionList |? Null)
forall a b. a -> a |? b
InL [])

getCompletionsConfig :: PluginId -> Action CompletionsConfig
getCompletionsConfig :: PluginId -> Action CompletionsConfig
getCompletionsConfig PluginId
pId =
  Bool -> Bool -> Int -> CompletionsConfig
CompletionsConfig
    (Bool -> Bool -> Int -> CompletionsConfig)
-> Action Bool -> Action (Bool -> Int -> CompletionsConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyNameProxy "snippetsOn"
-> PluginId
-> Properties
     '[ 'PropertyKey "autoExtendOn" 'TBoolean,
        'PropertyKey "snippetsOn" 'TBoolean]
-> Action
     (ToHsType
        (FindByKeyName
           "snippetsOn"
           '[ 'PropertyKey "autoExtendOn" 'TBoolean,
              'PropertyKey "snippetsOn" 'TBoolean]))
forall (s :: Symbol) (k :: PropertyKey) (t :: PropertyType)
       (r :: [PropertyKey]).
HasProperty s k t r =>
KeyNameProxy s -> PluginId -> Properties r -> Action (ToHsType t)
usePropertyAction KeyNameProxy "snippetsOn"
#snippetsOn PluginId
pId Properties
  '[ 'PropertyKey "autoExtendOn" 'TBoolean,
     'PropertyKey "snippetsOn" 'TBoolean]
properties
    Action (Bool -> Int -> CompletionsConfig)
-> Action Bool -> Action (Int -> CompletionsConfig)
forall a b. Action (a -> b) -> Action a -> Action b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> KeyNameProxy "autoExtendOn"
-> PluginId
-> Properties
     '[ 'PropertyKey "autoExtendOn" 'TBoolean,
        'PropertyKey "snippetsOn" 'TBoolean]
-> Action
     (ToHsType
        (FindByKeyName
           "autoExtendOn"
           '[ 'PropertyKey "autoExtendOn" 'TBoolean,
              'PropertyKey "snippetsOn" 'TBoolean]))
forall (s :: Symbol) (k :: PropertyKey) (t :: PropertyType)
       (r :: [PropertyKey]).
HasProperty s k t r =>
KeyNameProxy s -> PluginId -> Properties r -> Action (ToHsType t)
usePropertyAction KeyNameProxy "autoExtendOn"
#autoExtendOn PluginId
pId Properties
  '[ 'PropertyKey "autoExtendOn" 'TBoolean,
     'PropertyKey "snippetsOn" 'TBoolean]
properties
    Action (Int -> CompletionsConfig)
-> Action Int -> Action CompletionsConfig
forall a b. Action (a -> b) -> Action a -> Action b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Config -> Int
Config.maxCompletions (Config -> Int) -> Action Config -> Action Int
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 = (Int -> Scored CompletionItem -> CompletionItem)
-> [Int] -> [Scored CompletionItem] -> [CompletionItem]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Scored CompletionItem -> CompletionItem
addOrder [Int
0..] [Scored CompletionItem]
xx
    where
    lxx :: Int
lxx = Int -> Int
digits (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ [Scored CompletionItem] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [Scored CompletionItem]
xx
    digits :: Int -> Int
digits = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length (String -> Int) -> (Int -> String) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show

    addOrder :: Int -> Scored CompletionItem -> CompletionItem
    addOrder :: Int -> Scored CompletionItem -> CompletionItem
addOrder Int
n Scored{original :: forall a. Scored a -> a
original = it :: CompletionItem
it@CompletionItem{Text
_label :: Text
$sel:_label:CompletionItem :: CompletionItem -> Text
_label,Maybe Text
_sortText :: Maybe Text
$sel:_sortText:CompletionItem :: CompletionItem -> Maybe Text
_sortText}} =
        CompletionItem
it{_sortText = Just $
                T.pack(pad lxx n)
                }

    pad :: Int -> a -> String
pad Int
n a
x = let sx :: String
sx = a -> String
forall a. Show a => a -> String
show a
x in Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length String
sx) Char
'0' String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
sx

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

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