{-# LANGUAGE CPP          #-}
{-# LANGUAGE TypeFamilies #-}
#include "ghc-api-version.h"

module Development.IDE.Plugin.Completions
    (
      plugin
    , getCompletionsLSP
    ) where

import Language.Haskell.LSP.Messages
import Language.Haskell.LSP.Types
import qualified Language.Haskell.LSP.Core as LSP
import qualified Language.Haskell.LSP.VFS as VFS
import Language.Haskell.LSP.Types.Capabilities
import Development.Shake.Classes
import Development.Shake
import GHC.Generics

import Development.IDE.Plugin
import Development.IDE.Core.Service
import Development.IDE.Core.PositionMapping
import Development.IDE.Plugin.Completions.Logic
import Development.IDE.Types.Location
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.Shake
import Development.IDE.GHC.Compat

import Development.IDE.GHC.Util
import Development.IDE.LSP.Server
import TcRnDriver (tcRnImportDecls)
import Data.Maybe

#if defined(GHC_LIB)
import Development.IDE.Import.DependencyInformation
#endif

plugin :: Plugin c
plugin :: Plugin c
plugin = Rules () -> PartialHandlers c -> Plugin c
forall c. Rules () -> PartialHandlers c -> Plugin c
Plugin Rules ()
produceCompletions PartialHandlers c
forall c. PartialHandlers c
setHandlersCompletion

produceCompletions :: Rules ()
produceCompletions :: Rules ()
produceCompletions = do
    (ProduceCompletions
 -> NormalizedFilePath -> Action (IdeResult CachedCompletions))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((ProduceCompletions
  -> NormalizedFilePath -> Action (IdeResult CachedCompletions))
 -> Rules ())
-> (ProduceCompletions
    -> NormalizedFilePath -> Action (IdeResult CachedCompletions))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \ProduceCompletions
ProduceCompletions NormalizedFilePath
file -> do
        Maybe (CachedCompletions, PositionMapping)
local <- LocalCompletions
-> NormalizedFilePath
-> Action (Maybe (CachedCompletions, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale LocalCompletions
LocalCompletions NormalizedFilePath
file
        Maybe (CachedCompletions, PositionMapping)
nonLocal <- NonLocalCompletions
-> NormalizedFilePath
-> Action (Maybe (CachedCompletions, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale NonLocalCompletions
NonLocalCompletions NormalizedFilePath
file
        let extract :: Maybe (b, b) -> Maybe b
extract = ((b, b) -> b) -> Maybe (b, b) -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, b) -> b
forall a b. (a, b) -> a
fst
        IdeResult CachedCompletions -> Action (IdeResult CachedCompletions)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Maybe (CachedCompletions, PositionMapping)
-> Maybe CachedCompletions
forall b b. Maybe (b, b) -> Maybe b
extract Maybe (CachedCompletions, PositionMapping)
local Maybe CachedCompletions
-> Maybe CachedCompletions -> Maybe CachedCompletions
forall a. Semigroup a => a -> a -> a
<> Maybe (CachedCompletions, PositionMapping)
-> Maybe CachedCompletions
forall b b. Maybe (b, b) -> Maybe b
extract Maybe (CachedCompletions, PositionMapping)
nonLocal)
    (LocalCompletions
 -> NormalizedFilePath -> Action (IdeResult CachedCompletions))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((LocalCompletions
  -> NormalizedFilePath -> Action (IdeResult CachedCompletions))
 -> Rules ())
-> (LocalCompletions
    -> NormalizedFilePath -> Action (IdeResult CachedCompletions))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \LocalCompletions
LocalCompletions NormalizedFilePath
file -> do
        Maybe (ParsedModule, PositionMapping)
pm <- GetParsedModule
-> NormalizedFilePath
-> Action (Maybe (ParsedModule, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale GetParsedModule
GetParsedModule NormalizedFilePath
file
        case Maybe (ParsedModule, PositionMapping)
pm of
            Just (ParsedModule
pm, PositionMapping
_) -> do
                let cdata :: CachedCompletions
cdata = ParsedModule -> CachedCompletions
localCompletionsForParsedModule ParsedModule
pm
                IdeResult CachedCompletions -> Action (IdeResult CachedCompletions)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], CachedCompletions -> Maybe CachedCompletions
forall a. a -> Maybe a
Just CachedCompletions
cdata)
            Maybe (ParsedModule, PositionMapping)
_ -> IdeResult CachedCompletions -> Action (IdeResult CachedCompletions)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Maybe CachedCompletions
forall a. Maybe a
Nothing)
    (NonLocalCompletions
 -> NormalizedFilePath -> Action (IdeResult CachedCompletions))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((NonLocalCompletions
  -> NormalizedFilePath -> Action (IdeResult CachedCompletions))
 -> Rules ())
-> (NonLocalCompletions
    -> NormalizedFilePath -> Action (IdeResult CachedCompletions))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \NonLocalCompletions
NonLocalCompletions NormalizedFilePath
file -> do
        -- For non local completions we avoid depending on the parsed module,
        -- synthetizing a fake module with an empty body from the buffer
        -- in the ModSummary, which preserves all the imports
        Maybe (ModSummary, [LImportDecl GhcPs])
ms <- (((ModSummary, [LImportDecl GhcPs]), PositionMapping)
 -> (ModSummary, [LImportDecl GhcPs]))
-> Maybe ((ModSummary, [LImportDecl GhcPs]), PositionMapping)
-> Maybe (ModSummary, [LImportDecl GhcPs])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ModSummary, [LImportDecl GhcPs]), PositionMapping)
-> (ModSummary, [LImportDecl GhcPs])
forall a b. (a, b) -> a
fst (Maybe ((ModSummary, [LImportDecl GhcPs]), PositionMapping)
 -> Maybe (ModSummary, [LImportDecl GhcPs]))
-> Action
     (Maybe ((ModSummary, [LImportDecl GhcPs]), PositionMapping))
-> Action (Maybe (ModSummary, [LImportDecl GhcPs]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetModSummaryWithoutTimestamps
-> NormalizedFilePath
-> Action
     (Maybe ((ModSummary, [LImportDecl GhcPs]), PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale GetModSummaryWithoutTimestamps
GetModSummaryWithoutTimestamps NormalizedFilePath
file
        Maybe HscEnvEq
sess <- ((HscEnvEq, PositionMapping) -> HscEnvEq)
-> Maybe (HscEnvEq, PositionMapping) -> Maybe HscEnvEq
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HscEnvEq, PositionMapping) -> HscEnvEq
forall a b. (a, b) -> a
fst (Maybe (HscEnvEq, PositionMapping) -> Maybe HscEnvEq)
-> Action (Maybe (HscEnvEq, PositionMapping))
-> Action (Maybe HscEnvEq)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GhcSessionDeps
-> NormalizedFilePath -> Action (Maybe (HscEnvEq, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale GhcSessionDeps
GhcSessionDeps NormalizedFilePath
file

-- When possible, rely on the haddocks embedded in our interface files
-- This creates problems on ghc-lib, see comment on 'getDocumentationTryGhc'
#if !defined(GHC_LIB)
        let parsedDeps :: [a]
parsedDeps = []
#else
        deps <- maybe (TransitiveDependencies [] [] []) fst <$> useWithStale GetDependencies file
        parsedDeps <- mapMaybe (fmap fst) <$> usesWithStale GetParsedModule (transitiveModuleDeps deps)
#endif

        case (Maybe (ModSummary, [LImportDecl GhcPs])
ms, Maybe HscEnvEq
sess) of
            (Just (ModSummary
ms,[LImportDecl GhcPs]
imps), Just HscEnvEq
sess) -> do
              let env :: HscEnv
env = HscEnvEq -> HscEnv
hscEnv HscEnvEq
sess
              (Messages, Maybe GlobalRdrEnv)
res <- IO (Messages, Maybe GlobalRdrEnv)
-> Action (Messages, Maybe GlobalRdrEnv)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Messages, Maybe GlobalRdrEnv)
 -> Action (Messages, Maybe GlobalRdrEnv))
-> IO (Messages, Maybe GlobalRdrEnv)
-> Action (Messages, Maybe GlobalRdrEnv)
forall a b. (a -> b) -> a -> b
$ HscEnv -> [LImportDecl GhcPs] -> IO (Messages, Maybe GlobalRdrEnv)
tcRnImportDecls HscEnv
env [LImportDecl GhcPs]
imps
              case (Messages, Maybe GlobalRdrEnv)
res of
                  (Messages
_, Just GlobalRdrEnv
rdrEnv) -> do
                      CachedCompletions
cdata <- IO CachedCompletions -> Action CachedCompletions
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CachedCompletions -> Action CachedCompletions)
-> IO CachedCompletions -> Action CachedCompletions
forall a b. (a -> b) -> a -> b
$ HscEnv
-> Module
-> GlobalRdrEnv
-> [LImportDecl GhcPs]
-> [ParsedModule]
-> IO CachedCompletions
cacheDataProducer HscEnv
env (ModSummary -> Module
ms_mod ModSummary
ms) GlobalRdrEnv
rdrEnv [LImportDecl GhcPs]
imps [ParsedModule]
forall a. [a]
parsedDeps
                      IdeResult CachedCompletions -> Action (IdeResult CachedCompletions)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], CachedCompletions -> Maybe CachedCompletions
forall a. a -> Maybe a
Just CachedCompletions
cdata)
                  (Messages
_diag, Maybe GlobalRdrEnv
_) ->
                      IdeResult CachedCompletions -> Action (IdeResult CachedCompletions)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Maybe CachedCompletions
forall a. Maybe a
Nothing)
            (Maybe (ModSummary, [LImportDecl GhcPs]), Maybe HscEnvEq)
_ -> IdeResult CachedCompletions -> Action (IdeResult CachedCompletions)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Maybe CachedCompletions
forall a. Maybe a
Nothing)

-- | Produce completions info for a file
type instance RuleResult ProduceCompletions = CachedCompletions
type instance RuleResult LocalCompletions = CachedCompletions
type instance RuleResult NonLocalCompletions = CachedCompletions

data ProduceCompletions = ProduceCompletions
    deriving (ProduceCompletions -> ProduceCompletions -> Bool
(ProduceCompletions -> ProduceCompletions -> Bool)
-> (ProduceCompletions -> ProduceCompletions -> Bool)
-> Eq ProduceCompletions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProduceCompletions -> ProduceCompletions -> Bool
$c/= :: ProduceCompletions -> ProduceCompletions -> Bool
== :: ProduceCompletions -> ProduceCompletions -> Bool
$c== :: ProduceCompletions -> ProduceCompletions -> Bool
Eq, Int -> ProduceCompletions -> ShowS
[ProduceCompletions] -> ShowS
ProduceCompletions -> String
(Int -> ProduceCompletions -> ShowS)
-> (ProduceCompletions -> String)
-> ([ProduceCompletions] -> ShowS)
-> Show ProduceCompletions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProduceCompletions] -> ShowS
$cshowList :: [ProduceCompletions] -> ShowS
show :: ProduceCompletions -> String
$cshow :: ProduceCompletions -> String
showsPrec :: Int -> ProduceCompletions -> ShowS
$cshowsPrec :: Int -> ProduceCompletions -> ShowS
Show, Typeable, (forall x. ProduceCompletions -> Rep ProduceCompletions x)
-> (forall x. Rep ProduceCompletions x -> ProduceCompletions)
-> Generic ProduceCompletions
forall x. Rep ProduceCompletions x -> ProduceCompletions
forall x. ProduceCompletions -> Rep ProduceCompletions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProduceCompletions x -> ProduceCompletions
$cfrom :: forall x. ProduceCompletions -> Rep ProduceCompletions x
Generic)
instance Hashable ProduceCompletions
instance NFData   ProduceCompletions
instance Binary   ProduceCompletions

data LocalCompletions = LocalCompletions
    deriving (LocalCompletions -> LocalCompletions -> Bool
(LocalCompletions -> LocalCompletions -> Bool)
-> (LocalCompletions -> LocalCompletions -> Bool)
-> Eq LocalCompletions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LocalCompletions -> LocalCompletions -> Bool
$c/= :: LocalCompletions -> LocalCompletions -> Bool
== :: LocalCompletions -> LocalCompletions -> Bool
$c== :: LocalCompletions -> LocalCompletions -> Bool
Eq, Int -> LocalCompletions -> ShowS
[LocalCompletions] -> ShowS
LocalCompletions -> String
(Int -> LocalCompletions -> ShowS)
-> (LocalCompletions -> String)
-> ([LocalCompletions] -> ShowS)
-> Show LocalCompletions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LocalCompletions] -> ShowS
$cshowList :: [LocalCompletions] -> ShowS
show :: LocalCompletions -> String
$cshow :: LocalCompletions -> String
showsPrec :: Int -> LocalCompletions -> ShowS
$cshowsPrec :: Int -> LocalCompletions -> ShowS
Show, Typeable, (forall x. LocalCompletions -> Rep LocalCompletions x)
-> (forall x. Rep LocalCompletions x -> LocalCompletions)
-> Generic LocalCompletions
forall x. Rep LocalCompletions x -> LocalCompletions
forall x. LocalCompletions -> Rep LocalCompletions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LocalCompletions x -> LocalCompletions
$cfrom :: forall x. LocalCompletions -> Rep LocalCompletions x
Generic)
instance Hashable LocalCompletions
instance NFData   LocalCompletions
instance Binary   LocalCompletions

data NonLocalCompletions = NonLocalCompletions
    deriving (NonLocalCompletions -> NonLocalCompletions -> Bool
(NonLocalCompletions -> NonLocalCompletions -> Bool)
-> (NonLocalCompletions -> NonLocalCompletions -> Bool)
-> Eq NonLocalCompletions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NonLocalCompletions -> NonLocalCompletions -> Bool
$c/= :: NonLocalCompletions -> NonLocalCompletions -> Bool
== :: NonLocalCompletions -> NonLocalCompletions -> Bool
$c== :: NonLocalCompletions -> NonLocalCompletions -> Bool
Eq, Int -> NonLocalCompletions -> ShowS
[NonLocalCompletions] -> ShowS
NonLocalCompletions -> String
(Int -> NonLocalCompletions -> ShowS)
-> (NonLocalCompletions -> String)
-> ([NonLocalCompletions] -> ShowS)
-> Show NonLocalCompletions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NonLocalCompletions] -> ShowS
$cshowList :: [NonLocalCompletions] -> ShowS
show :: NonLocalCompletions -> String
$cshow :: NonLocalCompletions -> String
showsPrec :: Int -> NonLocalCompletions -> ShowS
$cshowsPrec :: Int -> NonLocalCompletions -> ShowS
Show, Typeable, (forall x. NonLocalCompletions -> Rep NonLocalCompletions x)
-> (forall x. Rep NonLocalCompletions x -> NonLocalCompletions)
-> Generic NonLocalCompletions
forall x. Rep NonLocalCompletions x -> NonLocalCompletions
forall x. NonLocalCompletions -> Rep NonLocalCompletions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NonLocalCompletions x -> NonLocalCompletions
$cfrom :: forall x. NonLocalCompletions -> Rep NonLocalCompletions x
Generic)
instance Hashable NonLocalCompletions
instance NFData   NonLocalCompletions
instance Binary   NonLocalCompletions

-- | Generate code actions.
getCompletionsLSP
    :: LSP.LspFuncs cofd
    -> IdeState
    -> CompletionParams
    -> IO (Either ResponseError CompletionResponseResult)
getCompletionsLSP :: LspFuncs cofd
-> IdeState
-> CompletionParams
-> IO (Either ResponseError CompletionResponseResult)
getCompletionsLSP LspFuncs cofd
lsp IdeState
ide
  CompletionParams{$sel:_textDocument:CompletionParams :: CompletionParams -> TextDocumentIdentifier
_textDocument=TextDocumentIdentifier Uri
uri
                  ,$sel:_position:CompletionParams :: CompletionParams -> Position
_position=Position
position
                  ,$sel:_context:CompletionParams :: CompletionParams -> Maybe CompletionContext
_context=Maybe CompletionContext
completionContext} = do
    Maybe VirtualFile
contents <- LspFuncs cofd -> NormalizedUri -> IO (Maybe VirtualFile)
forall c. LspFuncs c -> NormalizedUri -> IO (Maybe VirtualFile)
LSP.getVirtualFileFunc LspFuncs cofd
lsp (NormalizedUri -> IO (Maybe VirtualFile))
-> NormalizedUri -> IO (Maybe VirtualFile)
forall a b. (a -> b) -> a -> b
$ Uri -> NormalizedUri
toNormalizedUri Uri
uri
    (CompletionResponseResult
 -> Either ResponseError CompletionResponseResult)
-> IO CompletionResponseResult
-> IO (Either ResponseError CompletionResponseResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompletionResponseResult
-> Either ResponseError CompletionResponseResult
forall a b. b -> Either a b
Right (IO CompletionResponseResult
 -> IO (Either ResponseError CompletionResponseResult))
-> IO CompletionResponseResult
-> IO (Either ResponseError CompletionResponseResult)
forall a b. (a -> b) -> a -> b
$ case (Maybe VirtualFile
contents, Uri -> Maybe String
uriToFilePath' Uri
uri) of
      (Just VirtualFile
cnts, Just String
path) -> do
        let npath :: NormalizedFilePath
npath = String -> NormalizedFilePath
toNormalizedFilePath' String
path
        (IdeOptions
ideOpts, Maybe
  ((CachedCompletions, PositionMapping),
   Maybe (ParsedModule, PositionMapping), (Bindings, PositionMapping))
compls) <- String
-> ShakeExtras
-> IdeAction
     (IdeOptions,
      Maybe
        ((CachedCompletions, PositionMapping),
         Maybe (ParsedModule, PositionMapping),
         (Bindings, PositionMapping)))
-> IO
     (IdeOptions,
      Maybe
        ((CachedCompletions, PositionMapping),
         Maybe (ParsedModule, PositionMapping),
         (Bindings, PositionMapping)))
forall a. String -> ShakeExtras -> IdeAction a -> IO a
runIdeAction String
"Completion" (IdeState -> ShakeExtras
shakeExtras IdeState
ide) (IdeAction
   (IdeOptions,
    Maybe
      ((CachedCompletions, PositionMapping),
       Maybe (ParsedModule, PositionMapping),
       (Bindings, PositionMapping)))
 -> IO
      (IdeOptions,
       Maybe
         ((CachedCompletions, PositionMapping),
          Maybe (ParsedModule, PositionMapping),
          (Bindings, PositionMapping))))
-> IdeAction
     (IdeOptions,
      Maybe
        ((CachedCompletions, PositionMapping),
         Maybe (ParsedModule, PositionMapping),
         (Bindings, PositionMapping)))
-> IO
     (IdeOptions,
      Maybe
        ((CachedCompletions, PositionMapping),
         Maybe (ParsedModule, PositionMapping),
         (Bindings, PositionMapping)))
forall a b. (a -> b) -> a -> b
$ do
            IdeOptions
opts <- IO IdeOptions -> IdeAction IdeOptions
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IdeOptions -> IdeAction IdeOptions)
-> IO IdeOptions -> IdeAction IdeOptions
forall a b. (a -> b) -> a -> b
$ ShakeExtras -> IO IdeOptions
getIdeOptionsIO (ShakeExtras -> IO IdeOptions) -> ShakeExtras -> IO IdeOptions
forall a b. (a -> b) -> a -> b
$ IdeState -> ShakeExtras
shakeExtras IdeState
ide
            Maybe (CachedCompletions, PositionMapping)
compls <- ProduceCompletions
-> NormalizedFilePath
-> IdeAction (Maybe (CachedCompletions, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))
useWithStaleFast ProduceCompletions
ProduceCompletions NormalizedFilePath
npath
            Maybe (ParsedModule, PositionMapping)
pm <- GetParsedModule
-> NormalizedFilePath
-> IdeAction (Maybe (ParsedModule, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))
useWithStaleFast GetParsedModule
GetParsedModule NormalizedFilePath
npath
            (Bindings, PositionMapping)
binds <- (Bindings, PositionMapping)
-> Maybe (Bindings, PositionMapping) -> (Bindings, PositionMapping)
forall a. a -> Maybe a -> a
fromMaybe (Bindings
forall a. Monoid a => a
mempty, PositionMapping
zeroMapping) (Maybe (Bindings, PositionMapping) -> (Bindings, PositionMapping))
-> IdeAction (Maybe (Bindings, PositionMapping))
-> IdeAction (Bindings, PositionMapping)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetBindings
-> NormalizedFilePath
-> IdeAction (Maybe (Bindings, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))
useWithStaleFast GetBindings
GetBindings NormalizedFilePath
npath
            (IdeOptions,
 Maybe
   ((CachedCompletions, PositionMapping),
    Maybe (ParsedModule, PositionMapping),
    (Bindings, PositionMapping)))
-> IdeAction
     (IdeOptions,
      Maybe
        ((CachedCompletions, PositionMapping),
         Maybe (ParsedModule, PositionMapping),
         (Bindings, PositionMapping)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IdeOptions
opts, ((CachedCompletions, PositionMapping)
 -> ((CachedCompletions, PositionMapping),
     Maybe (ParsedModule, PositionMapping),
     (Bindings, PositionMapping)))
-> Maybe (CachedCompletions, PositionMapping)
-> Maybe
     ((CachedCompletions, PositionMapping),
      Maybe (ParsedModule, PositionMapping), (Bindings, PositionMapping))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,Maybe (ParsedModule, PositionMapping)
pm,(Bindings, PositionMapping)
binds) Maybe (CachedCompletions, PositionMapping)
compls )
        case Maybe
  ((CachedCompletions, PositionMapping),
   Maybe (ParsedModule, PositionMapping), (Bindings, PositionMapping))
compls of
          Just ((CachedCompletions
cci', PositionMapping
_), Maybe (ParsedModule, PositionMapping)
parsedMod, (Bindings, PositionMapping)
bindMap) -> do
            Maybe PosPrefixInfo
pfix <- Position -> VirtualFile -> IO (Maybe PosPrefixInfo)
forall (m :: * -> *).
Monad m =>
Position -> VirtualFile -> m (Maybe PosPrefixInfo)
VFS.getCompletionPrefix Position
position VirtualFile
cnts
            case (Maybe PosPrefixInfo
pfix, Maybe CompletionContext
completionContext) of
              (Just (VFS.PosPrefixInfo Text
_ Text
"" Text
_ Position
_), Just CompletionContext { $sel:_triggerCharacter:CompletionContext :: CompletionContext -> Maybe Text
_triggerCharacter = Just Text
"."})
                -> CompletionResponseResult -> IO CompletionResponseResult
forall (m :: * -> *) a. Monad m => a -> m a
return (List CompletionItem -> CompletionResponseResult
Completions (List CompletionItem -> CompletionResponseResult)
-> List CompletionItem -> CompletionResponseResult
forall a b. (a -> b) -> a -> b
$ [CompletionItem] -> List CompletionItem
forall a. [a] -> List a
List [])
              (Just PosPrefixInfo
pfix', Maybe CompletionContext
_) -> do
                  -- TODO pass the real capabilities here (or remove the logic for snippets)
                let fakeClientCapabilities :: ClientCapabilities
fakeClientCapabilities = Maybe WorkspaceClientCapabilities
-> Maybe TextDocumentClientCapabilities
-> Maybe WindowClientCapabilities
-> Maybe Object
-> ClientCapabilities
ClientCapabilities Maybe WorkspaceClientCapabilities
forall a. Maybe a
Nothing Maybe TextDocumentClientCapabilities
forall a. Maybe a
Nothing Maybe WindowClientCapabilities
forall a. Maybe a
Nothing Maybe Object
forall a. Maybe a
Nothing
                List CompletionItem -> CompletionResponseResult
Completions (List CompletionItem -> CompletionResponseResult)
-> ([CompletionItem] -> List CompletionItem)
-> [CompletionItem]
-> CompletionResponseResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CompletionItem] -> List CompletionItem
forall a. [a] -> List a
List ([CompletionItem] -> CompletionResponseResult)
-> IO [CompletionItem] -> IO CompletionResponseResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IdeOptions
-> CachedCompletions
-> Maybe (ParsedModule, PositionMapping)
-> (Bindings, PositionMapping)
-> PosPrefixInfo
-> ClientCapabilities
-> WithSnippets
-> IO [CompletionItem]
getCompletions IdeOptions
ideOpts CachedCompletions
cci' Maybe (ParsedModule, PositionMapping)
parsedMod (Bindings, PositionMapping)
bindMap PosPrefixInfo
pfix' ClientCapabilities
fakeClientCapabilities (Bool -> WithSnippets
WithSnippets Bool
True)
              (Maybe PosPrefixInfo, Maybe CompletionContext)
_ -> CompletionResponseResult -> IO CompletionResponseResult
forall (m :: * -> *) a. Monad m => a -> m a
return (List CompletionItem -> CompletionResponseResult
Completions (List CompletionItem -> CompletionResponseResult)
-> List CompletionItem -> CompletionResponseResult
forall a b. (a -> b) -> a -> b
$ [CompletionItem] -> List CompletionItem
forall a. [a] -> List a
List [])
          Maybe
  ((CachedCompletions, PositionMapping),
   Maybe (ParsedModule, PositionMapping), (Bindings, PositionMapping))
_ -> CompletionResponseResult -> IO CompletionResponseResult
forall (m :: * -> *) a. Monad m => a -> m a
return (List CompletionItem -> CompletionResponseResult
Completions (List CompletionItem -> CompletionResponseResult)
-> List CompletionItem -> CompletionResponseResult
forall a b. (a -> b) -> a -> b
$ [CompletionItem] -> List CompletionItem
forall a. [a] -> List a
List [])
      (Maybe VirtualFile, Maybe String)
_ -> CompletionResponseResult -> IO CompletionResponseResult
forall (m :: * -> *) a. Monad m => a -> m a
return (List CompletionItem -> CompletionResponseResult
Completions (List CompletionItem -> CompletionResponseResult)
-> List CompletionItem -> CompletionResponseResult
forall a b. (a -> b) -> a -> b
$ [CompletionItem] -> List CompletionItem
forall a. [a] -> List a
List [])

setHandlersCompletion :: PartialHandlers c
setHandlersCompletion :: PartialHandlers c
setHandlersCompletion = (WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
forall c.
(WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
PartialHandlers ((WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c)
-> (WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
forall a b. (a -> b) -> a -> b
$ \WithMessage{(LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
forall m req.
(Show m, Show req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs c -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
forall m req resp.
(Show m, Show req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs c
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs c
    -> IdeState
    -> req
    -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
$sel:withInitialize:WithMessage :: forall c.
WithMessage c
-> (LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
$sel:withResponseAndRequest:WithMessage :: forall c.
WithMessage c
-> forall m rm req resp newReqParams newReqBody.
   (Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
   (ResponseMessage resp -> FromServerMessage)
   -> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
   -> (LspFuncs c
       -> IdeState
       -> req
       -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
   -> Maybe (Handler (RequestMessage m req resp))
$sel:withNotification:WithMessage :: forall c.
WithMessage c
-> forall m req.
   (Show m, Show req) =>
   Maybe (Handler (NotificationMessage m req))
   -> (LspFuncs c -> IdeState -> req -> IO ())
   -> Maybe (Handler (NotificationMessage m req))
$sel:withResponse:WithMessage :: forall c.
WithMessage c
-> forall m req resp.
   (Show m, Show req) =>
   (ResponseMessage resp -> FromServerMessage)
   -> (LspFuncs c
       -> IdeState -> req -> IO (Either ResponseError resp))
   -> Maybe (Handler (RequestMessage m req resp))
withInitialize :: (LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
withResponseAndRequest :: forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs c
    -> IdeState
    -> req
    -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
withNotification :: forall m req.
(Show m, Show req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs c -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
withResponse :: forall m req resp.
(Show m, Show req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs c
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
..} Handlers
x -> Handlers -> IO Handlers
forall (m :: * -> *) a. Monad m => a -> m a
return Handlers
x{
    completionHandler :: Maybe (Handler CompletionRequest)
LSP.completionHandler = (ResponseMessage CompletionResponseResult -> FromServerMessage)
-> (LspFuncs c
    -> IdeState
    -> CompletionParams
    -> IO (Either ResponseError CompletionResponseResult))
-> Maybe (Handler CompletionRequest)
forall m req resp.
(Show m, Show req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs c
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
withResponse ResponseMessage CompletionResponseResult -> FromServerMessage
RspCompletion LspFuncs c
-> IdeState
-> CompletionParams
-> IO (Either ResponseError CompletionResponseResult)
forall cofd.
LspFuncs cofd
-> IdeState
-> CompletionParams
-> IO (Either ResponseError CompletionResponseResult)
getCompletionsLSP
    }