{-# LANGUAGE CPP #-}
#include "ghc-api-version.h"
-- Mostly taken from "haskell-ide-engine"
module Development.IDE.Plugin.Completions.Logic (
  CachedCompletions
, cacheDataProducer
, localCompletionsForParsedModule
, WithSnippets(..)
, getCompletions
) where

import Control.Applicative
import Data.Char (isUpper)
import Data.Generics
import Data.List.Extra as List hiding (stripPrefix)
import qualified Data.Map  as Map
import Data.Maybe (fromMaybe, mapMaybe)
import qualified Data.Text as T
import qualified Text.Fuzzy as Fuzzy

import HscTypes
import Name
import RdrName
import Type
import Packages
#if MIN_GHC_API_VERSION(8,10,0)
import Predicate (isDictTy)
import GHC.Platform
import Pair
import Coercion
#endif

import Language.Haskell.LSP.Types
import Language.Haskell.LSP.Types.Capabilities
import qualified Language.Haskell.LSP.VFS as VFS
import Development.IDE.Core.Compile
import Development.IDE.Core.PositionMapping
import Development.IDE.Plugin.Completions.Types
import Development.IDE.Spans.Documentation
import Development.IDE.Spans.LocalBindings
import Development.IDE.GHC.Compat as GHC
import Development.IDE.GHC.Error
import Development.IDE.Types.Options
import Development.IDE.Spans.Common
import Development.IDE.GHC.Util
import Outputable (Outputable)
import qualified Data.Set as Set

-- From haskell-ide-engine/hie-plugin-api/Haskell/Ide/Engine/Context.hs

-- | A context of a declaration in the program
-- e.g. is the declaration a type declaration or a value declaration
-- Used for determining which code completions to show
-- TODO: expand this with more contexts like classes or instances for
-- smarter code completion
data Context = TypeContext
             | ValueContext
             | ModuleContext String -- ^ module context with module name
             | ImportContext String -- ^ import context with module name
             | ImportListContext String -- ^ import list context with module name
             | ImportHidingContext String -- ^ import hiding context with module name
             | ExportContext -- ^ List of exported identifiers from the current module
  deriving (Int -> Context -> ShowS
[Context] -> ShowS
Context -> String
(Int -> Context -> ShowS)
-> (Context -> String) -> ([Context] -> ShowS) -> Show Context
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Context] -> ShowS
$cshowList :: [Context] -> ShowS
show :: Context -> String
$cshow :: Context -> String
showsPrec :: Int -> Context -> ShowS
$cshowsPrec :: Int -> Context -> ShowS
Show, Context -> Context -> Bool
(Context -> Context -> Bool)
-> (Context -> Context -> Bool) -> Eq Context
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Context -> Context -> Bool
$c/= :: Context -> Context -> Bool
== :: Context -> Context -> Bool
$c== :: Context -> Context -> Bool
Eq)

-- | Generates a map of where the context is a type and where the context is a value
-- i.e. where are the value decls and the type decls
getCContext :: Position -> ParsedModule -> Maybe Context
getCContext :: Position -> ParsedModule -> Maybe Context
getCContext Position
pos ParsedModule
pm
  | Just (L SrcSpan
r ModuleName
modName) <- Maybe (Located ModuleName)
moduleHeader
  , Position
pos Position -> SrcSpan -> Bool
`isInsideSrcSpan` SrcSpan
r
  = Context -> Maybe Context
forall a. a -> Maybe a
Just (String -> Context
ModuleContext (ModuleName -> String
moduleNameString ModuleName
modName))

  | Just (L SrcSpan
r [LIE GhcPs]
_) <- Maybe (Located [LIE GhcPs])
exportList
  , Position
pos Position -> SrcSpan -> Bool
`isInsideSrcSpan` SrcSpan
r
  = Context -> Maybe Context
forall a. a -> Maybe a
Just Context
ExportContext

  | Just Context
ctx <- GenericQ (Maybe Context) -> [LHsDecl GhcPs] -> Maybe Context
forall u. GenericQ (Maybe u) -> GenericQ (Maybe u)
something (Maybe Context
forall a. Maybe a
Nothing Maybe Context
-> (LHsDecl GhcPs -> Maybe Context) -> a -> Maybe Context
forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
`mkQ` LHsDecl GhcPs -> Maybe Context
go (a -> Maybe Context)
-> (LHsType GhcPs -> Maybe Context) -> a -> Maybe Context
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` LHsType GhcPs -> Maybe Context
goInline) [LHsDecl GhcPs]
decl
  = Context -> Maybe Context
forall a. a -> Maybe a
Just Context
ctx

  | Just Context
ctx <- GenericQ (Maybe Context) -> [LImportDecl GhcPs] -> Maybe Context
forall u. GenericQ (Maybe u) -> GenericQ (Maybe u)
something (Maybe Context
forall a. Maybe a
Nothing Maybe Context
-> (LImportDecl GhcPs -> Maybe Context) -> a -> Maybe Context
forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
`mkQ` LImportDecl GhcPs -> Maybe Context
importGo) [LImportDecl GhcPs]
imports
  = Context -> Maybe Context
forall a. a -> Maybe a
Just Context
ctx

  | Bool
otherwise
  = Maybe Context
forall a. Maybe a
Nothing

  where decl :: [LHsDecl GhcPs]
decl = HsModule GhcPs -> [LHsDecl GhcPs]
forall pass. HsModule pass -> [LHsDecl pass]
hsmodDecls (HsModule GhcPs -> [LHsDecl GhcPs])
-> HsModule GhcPs -> [LHsDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ ParsedSource -> SrcSpanLess ParsedSource
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (ParsedSource -> SrcSpanLess ParsedSource)
-> ParsedSource -> SrcSpanLess ParsedSource
forall a b. (a -> b) -> a -> b
$ ParsedModule -> ParsedSource
pm_parsed_source ParsedModule
pm
        moduleHeader :: Maybe (Located ModuleName)
moduleHeader = HsModule GhcPs -> Maybe (Located ModuleName)
forall pass. HsModule pass -> Maybe (Located ModuleName)
hsmodName (HsModule GhcPs -> Maybe (Located ModuleName))
-> HsModule GhcPs -> Maybe (Located ModuleName)
forall a b. (a -> b) -> a -> b
$ ParsedSource -> SrcSpanLess ParsedSource
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (ParsedSource -> SrcSpanLess ParsedSource)
-> ParsedSource -> SrcSpanLess ParsedSource
forall a b. (a -> b) -> a -> b
$ ParsedModule -> ParsedSource
pm_parsed_source ParsedModule
pm
        exportList :: Maybe (Located [LIE GhcPs])
exportList = HsModule GhcPs -> Maybe (Located [LIE GhcPs])
forall pass. HsModule pass -> Maybe (Located [LIE pass])
hsmodExports (HsModule GhcPs -> Maybe (Located [LIE GhcPs]))
-> HsModule GhcPs -> Maybe (Located [LIE GhcPs])
forall a b. (a -> b) -> a -> b
$ ParsedSource -> SrcSpanLess ParsedSource
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (ParsedSource -> SrcSpanLess ParsedSource)
-> ParsedSource -> SrcSpanLess ParsedSource
forall a b. (a -> b) -> a -> b
$ ParsedModule -> ParsedSource
pm_parsed_source ParsedModule
pm
        imports :: [LImportDecl GhcPs]
imports = HsModule GhcPs -> [LImportDecl GhcPs]
forall pass. HsModule pass -> [LImportDecl pass]
hsmodImports (HsModule GhcPs -> [LImportDecl GhcPs])
-> HsModule GhcPs -> [LImportDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ ParsedSource -> SrcSpanLess ParsedSource
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (ParsedSource -> SrcSpanLess ParsedSource)
-> ParsedSource -> SrcSpanLess ParsedSource
forall a b. (a -> b) -> a -> b
$ ParsedModule -> ParsedSource
pm_parsed_source ParsedModule
pm

        go :: LHsDecl GhcPs -> Maybe Context
        go :: LHsDecl GhcPs -> Maybe Context
go (L SrcSpan
r SigD {})
          | Position
pos Position -> SrcSpan -> Bool
`isInsideSrcSpan` SrcSpan
r = Context -> Maybe Context
forall a. a -> Maybe a
Just Context
TypeContext
          | Bool
otherwise = Maybe Context
forall a. Maybe a
Nothing
        go (L SrcSpan
r GHC.ValD {})
          | Position
pos Position -> SrcSpan -> Bool
`isInsideSrcSpan` SrcSpan
r = Context -> Maybe Context
forall a. a -> Maybe a
Just Context
ValueContext
          | Bool
otherwise = Maybe Context
forall a. Maybe a
Nothing
        go LHsDecl GhcPs
_ = Maybe Context
forall a. Maybe a
Nothing

        goInline :: GHC.LHsType GhcPs -> Maybe Context
        goInline :: LHsType GhcPs -> Maybe Context
goInline (GHC.L SrcSpan
r HsType GhcPs
_)
          | Position
pos Position -> SrcSpan -> Bool
`isInsideSrcSpan` SrcSpan
r = Context -> Maybe Context
forall a. a -> Maybe a
Just Context
TypeContext
        goInline LHsType GhcPs
_ = Maybe Context
forall a. Maybe a
Nothing

        importGo :: GHC.LImportDecl GhcPs -> Maybe Context
        importGo :: LImportDecl GhcPs -> Maybe Context
importGo (L SrcSpan
r ImportDecl GhcPs
impDecl)
          | Position
pos Position -> SrcSpan -> Bool
`isInsideSrcSpan` SrcSpan
r
          = String -> Maybe (Bool, Located [LIE GhcPs]) -> Maybe Context
importInline String
importModuleName (ImportDecl GhcPs -> Maybe (Bool, Located [LIE GhcPs])
forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding ImportDecl GhcPs
impDecl)
          Maybe Context -> Maybe Context -> Maybe Context
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Context -> Maybe Context
forall a. a -> Maybe a
Just (String -> Context
ImportContext String
importModuleName)

          | Bool
otherwise = Maybe Context
forall a. Maybe a
Nothing
          where importModuleName :: String
importModuleName = ModuleName -> String
moduleNameString (ModuleName -> String) -> ModuleName -> String
forall a b. (a -> b) -> a -> b
$ Located ModuleName -> SrcSpanLess (Located ModuleName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located ModuleName -> SrcSpanLess (Located ModuleName))
-> Located ModuleName -> SrcSpanLess (Located ModuleName)
forall a b. (a -> b) -> a -> b
$ ImportDecl GhcPs -> Located ModuleName
forall pass. ImportDecl pass -> Located ModuleName
ideclName ImportDecl GhcPs
impDecl

        importInline :: String -> Maybe (Bool,  GHC.Located [LIE GhcPs]) -> Maybe Context
        importInline :: String -> Maybe (Bool, Located [LIE GhcPs]) -> Maybe Context
importInline String
modName (Just (Bool
True, L SrcSpan
r [LIE GhcPs]
_))
          | Position
pos Position -> SrcSpan -> Bool
`isInsideSrcSpan` SrcSpan
r = Context -> Maybe Context
forall a. a -> Maybe a
Just (Context -> Maybe Context) -> Context -> Maybe Context
forall a b. (a -> b) -> a -> b
$ String -> Context
ImportHidingContext String
modName
          | Bool
otherwise = Maybe Context
forall a. Maybe a
Nothing
        importInline String
modName (Just (Bool
False, L SrcSpan
r [LIE GhcPs]
_))
          | Position
pos Position -> SrcSpan -> Bool
`isInsideSrcSpan` SrcSpan
r = Context -> Maybe Context
forall a. a -> Maybe a
Just (Context -> Maybe Context) -> Context -> Maybe Context
forall a b. (a -> b) -> a -> b
$ String -> Context
ImportListContext String
modName
          | Bool
otherwise = Maybe Context
forall a. Maybe a
Nothing
        importInline String
_ Maybe (Bool, Located [LIE GhcPs])
_ = Maybe Context
forall a. Maybe a
Nothing

occNameToComKind :: Maybe T.Text -> OccName -> CompletionItemKind
occNameToComKind :: Maybe Text -> OccName -> CompletionItemKind
occNameToComKind Maybe Text
ty OccName
oc
  | OccName -> Bool
isVarOcc  OccName
oc = case OccName -> String
occNameString OccName
oc of
                     Char
i:String
_ | Char -> Bool
isUpper Char
i -> CompletionItemKind
CiConstructor
                     String
_               -> CompletionItemKind
CiFunction
  | OccName -> Bool
isTcOcc   OccName
oc = case Maybe Text
ty of
                     Just Text
t
                       | Text
"Constraint" Text -> Text -> Bool
`T.isSuffixOf` Text
t
                       -> CompletionItemKind
CiClass
                     Maybe Text
_ -> CompletionItemKind
CiStruct
  | OccName -> Bool
isDataOcc OccName
oc = CompletionItemKind
CiConstructor
  | Bool
otherwise    = CompletionItemKind
CiVariable


showModName :: ModuleName -> T.Text
showModName :: ModuleName -> Text
showModName = String -> Text
T.pack (String -> Text) -> (ModuleName -> String) -> ModuleName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> String
moduleNameString

mkCompl :: IdeOptions -> CompItem -> CompletionItem
mkCompl :: IdeOptions -> CompItem -> CompletionItem
mkCompl IdeOptions{Bool
Int
String
[String]
[Text]
Maybe String
Action IdeGhcSession
IdePkgLocationOptions
IdeTesting
IdeDefer
IdeReportProgress
CheckParents
CheckProject
OptHaddockParse
ParsedSource -> IdePreprocessedSource
DynFlags -> DynFlags
optCustomDynFlags :: IdeOptions -> DynFlags -> DynFlags
optHaddockParse :: IdeOptions -> OptHaddockParse
optCheckParents :: IdeOptions -> CheckParents
optCheckProject :: IdeOptions -> CheckProject
optDefer :: IdeOptions -> IdeDefer
optKeywords :: IdeOptions -> [Text]
optNewColonConvention :: IdeOptions -> Bool
optLanguageSyntax :: IdeOptions -> String
optReportProgress :: IdeOptions -> IdeReportProgress
optTesting :: IdeOptions -> IdeTesting
optShakeProfiling :: IdeOptions -> Maybe String
optShakeFiles :: IdeOptions -> Maybe String
optThreads :: IdeOptions -> Int
optExtensions :: IdeOptions -> [String]
optPkgLocationOpts :: IdeOptions -> IdePkgLocationOptions
optGhcSession :: IdeOptions -> Action IdeGhcSession
optPreprocessor :: IdeOptions -> ParsedSource -> IdePreprocessedSource
optCustomDynFlags :: DynFlags -> DynFlags
optHaddockParse :: OptHaddockParse
optCheckParents :: CheckParents
optCheckProject :: CheckProject
optDefer :: IdeDefer
optKeywords :: [Text]
optNewColonConvention :: Bool
optLanguageSyntax :: String
optReportProgress :: IdeReportProgress
optTesting :: IdeTesting
optShakeProfiling :: Maybe String
optShakeFiles :: Maybe String
optThreads :: Int
optExtensions :: [String]
optPkgLocationOpts :: IdePkgLocationOptions
optGhcSession :: Action IdeGhcSession
optPreprocessor :: ParsedSource -> IdePreprocessedSource
..} CI{CompletionItemKind
compKind :: CompItem -> CompletionItemKind
compKind :: CompletionItemKind
compKind,Text
insertText :: CompItem -> Text
insertText :: Text
insertText, Either SrcSpan Text
importedFrom :: CompItem -> Either SrcSpan Text
importedFrom :: Either SrcSpan Text
importedFrom,Maybe Text
typeText :: CompItem -> Maybe Text
typeText :: Maybe Text
typeText,Text
label :: CompItem -> Text
label :: Text
label,SpanDoc
docs :: CompItem -> SpanDoc
docs :: SpanDoc
docs} =
  Text
-> Maybe CompletionItemKind
-> List CompletionItemTag
-> Maybe Text
-> Maybe CompletionDoc
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe InsertTextFormat
-> Maybe TextEdit
-> Maybe (List TextEdit)
-> Maybe (List Text)
-> Maybe Command
-> Maybe Value
-> CompletionItem
CompletionItem Text
label Maybe CompletionItemKind
kind ([CompletionItemTag] -> List CompletionItemTag
forall a. [a] -> List a
List []) ((Text
colon Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
typeText)
    (CompletionDoc -> Maybe CompletionDoc
forall a. a -> Maybe a
Just (CompletionDoc -> Maybe CompletionDoc)
-> CompletionDoc -> Maybe CompletionDoc
forall a b. (a -> b) -> a -> b
$ MarkupContent -> CompletionDoc
CompletionDocMarkup (MarkupContent -> CompletionDoc) -> MarkupContent -> CompletionDoc
forall a b. (a -> b) -> a -> b
$ MarkupKind -> Text -> MarkupContent
MarkupContent MarkupKind
MkMarkdown (Text -> MarkupContent) -> Text -> MarkupContent
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
sectionSeparator [Text]
docs')
    Maybe Bool
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
insertText) (InsertTextFormat -> Maybe InsertTextFormat
forall a. a -> Maybe a
Just InsertTextFormat
Snippet)
    Maybe TextEdit
forall a. Maybe a
Nothing Maybe (List TextEdit)
forall a. Maybe a
Nothing Maybe (List Text)
forall a. Maybe a
Nothing Maybe Command
forall a. Maybe a
Nothing Maybe Value
forall a. Maybe a
Nothing
  where kind :: Maybe CompletionItemKind
kind = CompletionItemKind -> Maybe CompletionItemKind
forall a. a -> Maybe a
Just CompletionItemKind
compKind
        docs' :: [Text]
docs' = Text
imported Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: SpanDoc -> [Text]
spanDocToMarkdown SpanDoc
docs
        imported :: Text
imported = case Either SrcSpan Text
importedFrom of
          Left SrcSpan
pos -> Text
"*Defined at '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SrcSpan -> Text
forall a. Outputable a => a -> Text
ppr SrcSpan
pos Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'*\n'"
          Right Text
mod -> Text
"*Defined in '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mod Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'*\n"
        colon :: Text
colon = if Bool
optNewColonConvention then Text
": " else Text
":: "

mkNameCompItem :: Name -> ModuleName -> Maybe Type -> Maybe Backtick -> SpanDoc -> CompItem
mkNameCompItem :: Name
-> ModuleName
-> Maybe Type
-> Maybe Backtick
-> SpanDoc
-> CompItem
mkNameCompItem Name
origName ModuleName
origMod Maybe Type
thingType Maybe Backtick
isInfix SpanDoc
docs = CI :: CompletionItemKind
-> Text
-> Either SrcSpan Text
-> Maybe Text
-> Text
-> Maybe Backtick
-> SpanDoc
-> Bool
-> CompItem
CI{Bool
Maybe Text
Maybe Backtick
Either SrcSpan Text
Text
CompletionItemKind
SpanDoc
forall a. Either a Text
isTypeCompl :: Bool
isInfix :: Maybe Backtick
typeText :: Maybe Text
insertText :: Text
label :: Text
isTypeCompl :: Bool
importedFrom :: forall a. Either a Text
compKind :: CompletionItemKind
docs :: SpanDoc
isInfix :: Maybe Backtick
docs :: SpanDoc
label :: Text
typeText :: Maybe Text
importedFrom :: Either SrcSpan Text
insertText :: Text
compKind :: CompletionItemKind
..}
  where
    compKind :: CompletionItemKind
compKind = Maybe Text -> OccName -> CompletionItemKind
occNameToComKind Maybe Text
typeText (OccName -> CompletionItemKind) -> OccName -> CompletionItemKind
forall a b. (a -> b) -> a -> b
$ Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
origName
    importedFrom :: Either a Text
importedFrom = Text -> Either a Text
forall a b. b -> Either a b
Right (Text -> Either a Text) -> Text -> Either a Text
forall a b. (a -> b) -> a -> b
$ ModuleName -> Text
showModName ModuleName
origMod
    isTypeCompl :: Bool
isTypeCompl = OccName -> Bool
isTcOcc (OccName -> Bool) -> OccName -> Bool
forall a b. (a -> b) -> a -> b
$ Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
origName
    label :: Text
label = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Name -> String
forall a. Outputable a => a -> String
showGhc Name
origName
    insertText :: Text
insertText = case Maybe Backtick
isInfix of
            Maybe Backtick
Nothing -> case Type -> Text
getArgText (Type -> Text) -> Maybe Type -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Type
thingType of
                            Maybe Text
Nothing -> Text
label
                            Just Text
argText -> Text
label Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
argText
            Just Backtick
LeftSide -> Text
label Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`"

            Just Backtick
Surrounded -> Text
label
    typeText :: Maybe Text
typeText
          | Just Type
t <- Maybe Type
thingType = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (Text -> Text) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
stripForall (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (Type -> String
forall a. Outputable a => a -> String
showGhc Type
t)
          | Bool
otherwise = Maybe Text
forall a. Maybe a
Nothing


    stripForall :: T.Text -> T.Text
    stripForall :: Text -> Text
stripForall Text
t
      | Text -> Text -> Bool
T.isPrefixOf Text
"forall" Text
t =
        -- We drop 2 to remove the '.' and the space after it
        Int -> Text -> Text
T.drop Int
2 ((Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.') Text
t)
      | Bool
otherwise               = Text
t

    getArgText :: Type -> T.Text
    getArgText :: Type -> Text
getArgText Type
typ = Text
argText
      where
        argTypes :: [Type]
argTypes = Type -> [Type]
getArgs Type
typ
        argText :: T.Text
        argText :: Text
argText =  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
List.intersperse Text
" " ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Int -> Type -> Text) -> Int -> [Type] -> [Text]
forall a b c. Enum a => (a -> b -> c) -> a -> [b] -> [c]
zipWithFrom Int -> Type -> Text
snippet Int
1 [Type]
argTypes
        snippet :: Int -> Type -> T.Text
        snippet :: Int -> Type -> Text
snippet Int
i Type
t = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"${" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Type -> String
forall a. Outputable a => a -> String
showGhc Type
t String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"}"
        getArgs :: Type -> [Type]
        getArgs :: Type -> [Type]
getArgs Type
t
          | HasDebugCallStack => Type -> Bool
Type -> Bool
isPredTy Type
t = []
          | Type -> Bool
isDictTy Type
t = []
          | Type -> Bool
isForAllTy Type
t = Type -> [Type]
getArgs (Type -> [Type]) -> Type -> [Type]
forall a b. (a -> b) -> a -> b
$ ([TyCoVar], Type) -> Type
forall a b. (a, b) -> b
snd (Type -> ([TyCoVar], Type)
splitForAllTys Type
t)
          | Type -> Bool
isFunTy Type
t =
            let ([Type]
args, Type
ret) = Type -> ([Type], Type)
splitFunTys Type
t
              in if Type -> Bool
isForAllTy Type
ret
                  then Type -> [Type]
getArgs Type
ret
                  else (Type -> Bool) -> [Type] -> [Type]
forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter (Bool -> Bool
not (Bool -> Bool) -> (Type -> Bool) -> Type -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Bool
isDictTy) [Type]
args
          | Type -> Bool
isPiTy Type
t = Type -> [Type]
getArgs (Type -> [Type]) -> Type -> [Type]
forall a b. (a -> b) -> a -> b
$ ([TyCoBinder], Type) -> Type
forall a b. (a, b) -> b
snd (Type -> ([TyCoBinder], Type)
splitPiTys Type
t)
#if MIN_GHC_API_VERSION(8,10,0)
          | Just (Pair Type
_ Type
t) <- Coercion -> Pair Type
coercionKind (Coercion -> Pair Type) -> Maybe Coercion -> Maybe (Pair Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Maybe Coercion
isCoercionTy_maybe Type
t
          = Type -> [Type]
getArgs Type
t
#else
          | isCoercionTy t = maybe [] (getArgs . snd) (splitCoercionType_maybe t)
#endif
          | Bool
otherwise = []

mkModCompl :: T.Text -> CompletionItem
mkModCompl :: Text -> CompletionItem
mkModCompl Text
label =
  Text
-> Maybe CompletionItemKind
-> List CompletionItemTag
-> Maybe Text
-> Maybe CompletionDoc
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe InsertTextFormat
-> Maybe TextEdit
-> Maybe (List TextEdit)
-> Maybe (List Text)
-> Maybe Command
-> Maybe Value
-> CompletionItem
CompletionItem Text
label (CompletionItemKind -> Maybe CompletionItemKind
forall a. a -> Maybe a
Just CompletionItemKind
CiModule) ([CompletionItemTag] -> List CompletionItemTag
forall a. [a] -> List a
List []) Maybe Text
forall a. Maybe a
Nothing
    Maybe CompletionDoc
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe InsertTextFormat
forall a. Maybe a
Nothing
    Maybe TextEdit
forall a. Maybe a
Nothing Maybe (List TextEdit)
forall a. Maybe a
Nothing Maybe (List Text)
forall a. Maybe a
Nothing Maybe Command
forall a. Maybe a
Nothing Maybe Value
forall a. Maybe a
Nothing

mkImportCompl :: T.Text -> T.Text -> CompletionItem
mkImportCompl :: Text -> Text -> CompletionItem
mkImportCompl Text
enteredQual Text
label =
  Text
-> Maybe CompletionItemKind
-> List CompletionItemTag
-> Maybe Text
-> Maybe CompletionDoc
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe InsertTextFormat
-> Maybe TextEdit
-> Maybe (List TextEdit)
-> Maybe (List Text)
-> Maybe Command
-> Maybe Value
-> CompletionItem
CompletionItem Text
m (CompletionItemKind -> Maybe CompletionItemKind
forall a. a -> Maybe a
Just CompletionItemKind
CiModule) ([CompletionItemTag] -> List CompletionItemTag
forall a. [a] -> List a
List []) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
label)
    Maybe CompletionDoc
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe InsertTextFormat
forall a. Maybe a
Nothing
    Maybe TextEdit
forall a. Maybe a
Nothing Maybe (List TextEdit)
forall a. Maybe a
Nothing Maybe (List Text)
forall a. Maybe a
Nothing Maybe Command
forall a. Maybe a
Nothing Maybe Value
forall a. Maybe a
Nothing
  where
    m :: Text
m = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Text -> Text -> Maybe Text
T.stripPrefix Text
enteredQual Text
label)

mkExtCompl :: T.Text -> CompletionItem
mkExtCompl :: Text -> CompletionItem
mkExtCompl Text
label =
  Text
-> Maybe CompletionItemKind
-> List CompletionItemTag
-> Maybe Text
-> Maybe CompletionDoc
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe InsertTextFormat
-> Maybe TextEdit
-> Maybe (List TextEdit)
-> Maybe (List Text)
-> Maybe Command
-> Maybe Value
-> CompletionItem
CompletionItem Text
label (CompletionItemKind -> Maybe CompletionItemKind
forall a. a -> Maybe a
Just CompletionItemKind
CiKeyword) ([CompletionItemTag] -> List CompletionItemTag
forall a. [a] -> List a
List []) Maybe Text
forall a. Maybe a
Nothing
    Maybe CompletionDoc
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe InsertTextFormat
forall a. Maybe a
Nothing
    Maybe TextEdit
forall a. Maybe a
Nothing Maybe (List TextEdit)
forall a. Maybe a
Nothing Maybe (List Text)
forall a. Maybe a
Nothing Maybe Command
forall a. Maybe a
Nothing Maybe Value
forall a. Maybe a
Nothing

mkPragmaCompl :: T.Text -> T.Text -> CompletionItem
mkPragmaCompl :: Text -> Text -> CompletionItem
mkPragmaCompl Text
label Text
insertText =
  Text
-> Maybe CompletionItemKind
-> List CompletionItemTag
-> Maybe Text
-> Maybe CompletionDoc
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe InsertTextFormat
-> Maybe TextEdit
-> Maybe (List TextEdit)
-> Maybe (List Text)
-> Maybe Command
-> Maybe Value
-> CompletionItem
CompletionItem Text
label (CompletionItemKind -> Maybe CompletionItemKind
forall a. a -> Maybe a
Just CompletionItemKind
CiKeyword) ([CompletionItemTag] -> List CompletionItemTag
forall a. [a] -> List a
List []) Maybe Text
forall a. Maybe a
Nothing
    Maybe CompletionDoc
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
insertText) (InsertTextFormat -> Maybe InsertTextFormat
forall a. a -> Maybe a
Just InsertTextFormat
Snippet)
    Maybe TextEdit
forall a. Maybe a
Nothing Maybe (List TextEdit)
forall a. Maybe a
Nothing Maybe (List Text)
forall a. Maybe a
Nothing Maybe Command
forall a. Maybe a
Nothing Maybe Value
forall a. Maybe a
Nothing

cacheDataProducer :: HscEnv -> Module -> GlobalRdrEnv -> [LImportDecl GhcPs] -> [ParsedModule] -> IO CachedCompletions
cacheDataProducer :: HscEnv
-> Module
-> GlobalRdrEnv
-> [LImportDecl GhcPs]
-> [ParsedModule]
-> IO CachedCompletions
cacheDataProducer HscEnv
packageState Module
curMod GlobalRdrEnv
rdrEnv [LImportDecl GhcPs]
limports [ParsedModule]
deps = do
  let dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
packageState
      curModName :: ModuleName
curModName = Module -> ModuleName
moduleName Module
curMod

      iDeclToModName :: ImportDecl name -> ModuleName
      iDeclToModName :: ImportDecl name -> ModuleName
iDeclToModName = Located ModuleName -> ModuleName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located ModuleName -> ModuleName)
-> (ImportDecl name -> Located ModuleName)
-> ImportDecl name
-> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl name -> Located ModuleName
forall pass. ImportDecl pass -> Located ModuleName
ideclName

      asNamespace :: ImportDecl name -> ModuleName
      asNamespace :: ImportDecl name -> ModuleName
asNamespace ImportDecl name
imp = ModuleName
-> (Located ModuleName -> ModuleName)
-> Maybe (Located ModuleName)
-> ModuleName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ImportDecl name -> ModuleName
forall name. ImportDecl name -> ModuleName
iDeclToModName ImportDecl name
imp) Located ModuleName -> ModuleName
forall a. HasSrcSpan a => a -> SrcSpanLess a
GHC.unLoc (ImportDecl name -> Maybe (Located ModuleName)
forall pass. ImportDecl pass -> Maybe (Located ModuleName)
ideclAs ImportDecl name
imp)
      -- Full canonical names of imported modules
      importDeclerations :: [ImportDecl GhcPs]
importDeclerations = (LImportDecl GhcPs -> ImportDecl GhcPs)
-> [LImportDecl GhcPs] -> [ImportDecl GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map LImportDecl GhcPs -> ImportDecl GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [LImportDecl GhcPs]
limports

      -- The list of all importable Modules from all packages
      moduleNames :: [Text]
moduleNames = (ModuleName -> Text) -> [ModuleName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> Text
showModName (DynFlags -> [ModuleName]
listVisibleModuleNames DynFlags
dflags)

      -- The given namespaces for the imported modules (ie. full name, or alias if used)
      allModNamesAsNS :: [Text]
allModNamesAsNS = (ImportDecl GhcPs -> Text) -> [ImportDecl GhcPs] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleName -> Text
showModName (ModuleName -> Text)
-> (ImportDecl GhcPs -> ModuleName) -> ImportDecl GhcPs -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl GhcPs -> ModuleName
forall name. ImportDecl name -> ModuleName
asNamespace) [ImportDecl GhcPs]
importDeclerations

      rdrElts :: [GlobalRdrElt]
rdrElts = GlobalRdrEnv -> [GlobalRdrElt]
globalRdrEnvElts GlobalRdrEnv
rdrEnv

      foldMapM :: (Foldable f, Monad m, Monoid b) => (a -> m b) -> f a -> m b
      foldMapM :: (a -> m b) -> f a -> m b
foldMapM a -> m b
f f a
xs = (a -> (b -> m b) -> b -> m b) -> (b -> m b) -> f a -> b -> m b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> (b -> m b) -> b -> m b
forall b. a -> (b -> m b) -> b -> m b
step b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return f a
xs b
forall a. Monoid a => a
mempty where
        step :: a -> (b -> m b) -> b -> m b
step a
x b -> m b
r b
z = a -> m b
f a
x m b -> (b -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b
y -> b -> m b
r (b -> m b) -> b -> m b
forall a b. (a -> b) -> a -> b
$! b
z b -> b -> b
forall a. Monoid a => a -> a -> a
`mappend` b
y

      getCompls :: [GlobalRdrElt] -> IO ([CompItem],QualCompls)
      getCompls :: [GlobalRdrElt] -> IO ([CompItem], QualCompls)
getCompls = (GlobalRdrElt -> IO ([CompItem], QualCompls))
-> [GlobalRdrElt] -> IO ([CompItem], QualCompls)
forall (f :: * -> *) (m :: * -> *) b a.
(Foldable f, Monad m, Monoid b) =>
(a -> m b) -> f a -> m b
foldMapM GlobalRdrElt -> IO ([CompItem], QualCompls)
getComplsForOne

      getComplsForOne :: GlobalRdrElt -> IO ([CompItem],QualCompls)
      getComplsForOne :: GlobalRdrElt -> IO ([CompItem], QualCompls)
getComplsForOne (GRE Name
n Parent
_ Bool
True [ImportSpec]
_) =
        (\CompItem
x -> ([CompItem
x],QualCompls
forall a. Monoid a => a
mempty)) (CompItem -> ([CompItem], QualCompls))
-> IO CompItem -> IO ([CompItem], QualCompls)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Module -> ModuleName -> Name -> IO CompItem
toCompItem Module
curMod ModuleName
curModName Name
n
      getComplsForOne (GRE Name
n Parent
_ Bool
False [ImportSpec]
prov) =
        ((ImpDeclSpec -> IO ([CompItem], QualCompls))
 -> [ImpDeclSpec] -> IO ([CompItem], QualCompls))
-> [ImpDeclSpec]
-> (ImpDeclSpec -> IO ([CompItem], QualCompls))
-> IO ([CompItem], QualCompls)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ImpDeclSpec -> IO ([CompItem], QualCompls))
-> [ImpDeclSpec] -> IO ([CompItem], QualCompls)
forall (f :: * -> *) (m :: * -> *) b a.
(Foldable f, Monad m, Monoid b) =>
(a -> m b) -> f a -> m b
foldMapM ((ImportSpec -> ImpDeclSpec) -> [ImportSpec] -> [ImpDeclSpec]
forall a b. (a -> b) -> [a] -> [b]
map ImportSpec -> ImpDeclSpec
is_decl [ImportSpec]
prov) ((ImpDeclSpec -> IO ([CompItem], QualCompls))
 -> IO ([CompItem], QualCompls))
-> (ImpDeclSpec -> IO ([CompItem], QualCompls))
-> IO ([CompItem], QualCompls)
forall a b. (a -> b) -> a -> b
$ \ImpDeclSpec
spec -> do
          CompItem
compItem <- Module -> ModuleName -> Name -> IO CompItem
toCompItem Module
curMod (ImpDeclSpec -> ModuleName
is_mod ImpDeclSpec
spec) Name
n
          let unqual :: [CompItem]
unqual
                | ImpDeclSpec -> Bool
is_qual ImpDeclSpec
spec = []
                | Bool
otherwise = [CompItem
compItem]
              qual :: Map Text [CompItem]
qual
                | ImpDeclSpec -> Bool
is_qual ImpDeclSpec
spec = Text -> [CompItem] -> Map Text [CompItem]
forall k a. k -> a -> Map k a
Map.singleton Text
asMod [CompItem
compItem]
                | Bool
otherwise = [(Text, [CompItem])] -> Map Text [CompItem]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text
asMod,[CompItem
compItem]),(Text
origMod,[CompItem
compItem])]
              asMod :: Text
asMod = ModuleName -> Text
showModName (ImpDeclSpec -> ModuleName
is_as ImpDeclSpec
spec)
              origMod :: Text
origMod = ModuleName -> Text
showModName (ImpDeclSpec -> ModuleName
is_mod ImpDeclSpec
spec)
          ([CompItem], QualCompls) -> IO ([CompItem], QualCompls)
forall (m :: * -> *) a. Monad m => a -> m a
return ([CompItem]
unqual,Map Text [CompItem] -> QualCompls
QualCompls Map Text [CompItem]
qual)

      toCompItem :: Module -> ModuleName -> Name -> IO CompItem
      toCompItem :: Module -> ModuleName -> Name -> IO CompItem
toCompItem Module
m ModuleName
mn Name
n = do
        SpanDoc
docs <- HscEnv -> Module -> [ParsedModule] -> Name -> IO SpanDoc
getDocumentationTryGhc HscEnv
packageState Module
curMod [ParsedModule]
deps Name
n
        Either [FileDiagnostic] (Maybe Type)
ty <- DynFlags
-> Text
-> IO (Maybe Type)
-> IO (Either [FileDiagnostic] (Maybe Type))
forall a.
DynFlags -> Text -> IO a -> IO (Either [FileDiagnostic] a)
catchSrcErrors (HscEnv -> DynFlags
hsc_dflags HscEnv
packageState) Text
"completion" (IO (Maybe Type) -> IO (Either [FileDiagnostic] (Maybe Type)))
-> IO (Maybe Type) -> IO (Either [FileDiagnostic] (Maybe Type))
forall a b. (a -> b) -> a -> b
$ do
                Maybe TyThing
name' <- HscEnv -> Module -> Name -> IO (Maybe TyThing)
lookupName HscEnv
packageState Module
m Name
n
                Maybe Type -> IO (Maybe Type)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Type -> IO (Maybe Type)) -> Maybe Type -> IO (Maybe Type)
forall a b. (a -> b) -> a -> b
$ Maybe TyThing
name' Maybe TyThing -> (TyThing -> Maybe Type) -> Maybe Type
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TyThing -> Maybe Type
safeTyThingType
        CompItem -> IO CompItem
forall (m :: * -> *) a. Monad m => a -> m a
return (CompItem -> IO CompItem) -> CompItem -> IO CompItem
forall a b. (a -> b) -> a -> b
$ Name
-> ModuleName
-> Maybe Type
-> Maybe Backtick
-> SpanDoc
-> CompItem
mkNameCompItem Name
n ModuleName
mn (([FileDiagnostic] -> Maybe Type)
-> (Maybe Type -> Maybe Type)
-> Either [FileDiagnostic] (Maybe Type)
-> Maybe Type
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Type -> [FileDiagnostic] -> Maybe Type
forall a b. a -> b -> a
const Maybe Type
forall a. Maybe a
Nothing) Maybe Type -> Maybe Type
forall a. a -> a
id Either [FileDiagnostic] (Maybe Type)
ty) Maybe Backtick
forall a. Maybe a
Nothing SpanDoc
docs

  ([CompItem]
unquals,QualCompls
quals) <- [GlobalRdrElt] -> IO ([CompItem], QualCompls)
getCompls [GlobalRdrElt]
rdrElts

  CachedCompletions -> IO CachedCompletions
forall (m :: * -> *) a. Monad m => a -> m a
return (CachedCompletions -> IO CachedCompletions)
-> CachedCompletions -> IO CachedCompletions
forall a b. (a -> b) -> a -> b
$ CC :: [Text] -> [CompItem] -> QualCompls -> [Text] -> CachedCompletions
CC
    { allModNamesAsNS :: [Text]
allModNamesAsNS = [Text]
allModNamesAsNS
    , unqualCompls :: [CompItem]
unqualCompls = [CompItem]
unquals
    , qualCompls :: QualCompls
qualCompls = QualCompls
quals
    , importableModules :: [Text]
importableModules = [Text]
moduleNames
    }

-- | Produces completions from the top level declarations of a module.
localCompletionsForParsedModule :: ParsedModule -> CachedCompletions
localCompletionsForParsedModule :: ParsedModule -> CachedCompletions
localCompletionsForParsedModule pm :: ParsedModule
pm@ParsedModule{pm_parsed_source :: ParsedModule -> ParsedSource
pm_parsed_source = L SrcSpan
_ HsModule{[LHsDecl GhcPs]
hsmodDecls :: [LHsDecl GhcPs]
hsmodDecls :: forall pass. HsModule pass -> [LHsDecl pass]
hsmodDecls, Maybe (Located ModuleName)
hsmodName :: Maybe (Located ModuleName)
hsmodName :: forall pass. HsModule pass -> Maybe (Located ModuleName)
hsmodName}} =
    CC :: [Text] -> [CompItem] -> QualCompls -> [Text] -> CachedCompletions
CC { allModNamesAsNS :: [Text]
allModNamesAsNS = [Text]
forall a. Monoid a => a
mempty
       , unqualCompls :: [CompItem]
unqualCompls = [CompItem]
compls
       , qualCompls :: QualCompls
qualCompls = QualCompls
forall a. Monoid a => a
mempty
       , importableModules :: [Text]
importableModules = [Text]
forall a. Monoid a => a
mempty
        }
  where
    typeSigIds :: Set RdrName
typeSigIds = [RdrName] -> Set RdrName
forall a. Ord a => [a] -> Set a
Set.fromList
        [ RdrName
id
            | L SrcSpan
_ (SigD XSigD GhcPs
_ (TypeSig XTypeSig GhcPs
_ [Located (IdP GhcPs)]
ids LHsSigWcType GhcPs
_)) <- [LHsDecl GhcPs]
hsmodDecls
            , L SrcSpan
_ RdrName
id <- [Located (IdP GhcPs)]
[GenLocated SrcSpan RdrName]
ids
            ]
    hasTypeSig :: GenLocated SrcSpan RdrName -> Bool
hasTypeSig = (RdrName -> Set RdrName -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set RdrName
typeSigIds) (RdrName -> Bool)
-> (GenLocated SrcSpan RdrName -> RdrName)
-> GenLocated SrcSpan RdrName
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpan RdrName -> RdrName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc

    compls :: [CompItem]
compls = [[CompItem]] -> [CompItem]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ case HsDecl GhcPs
decl of
            SigD XSigD GhcPs
_ (TypeSig XTypeSig GhcPs
_ [Located (IdP GhcPs)]
ids LHsSigWcType GhcPs
typ) ->
                [GenLocated SrcSpan RdrName
-> CompletionItemKind -> Maybe Text -> CompItem
forall a.
(HasSrcSpan a, Outputable a) =>
a -> CompletionItemKind -> Maybe Text -> CompItem
mkComp GenLocated SrcSpan RdrName
id CompletionItemKind
CiFunction (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ LHsSigWcType GhcPs -> Text
forall a. Outputable a => a -> Text
ppr LHsSigWcType GhcPs
typ) | GenLocated SrcSpan RdrName
id <- [Located (IdP GhcPs)]
[GenLocated SrcSpan RdrName]
ids]
            ValD XValD GhcPs
_ FunBind{Located (IdP GhcPs)
fun_id :: forall idL idR. HsBindLR idL idR -> Located (IdP idL)
fun_id :: Located (IdP GhcPs)
fun_id} ->
                [ GenLocated SrcSpan RdrName
-> CompletionItemKind -> Maybe Text -> CompItem
forall a.
(HasSrcSpan a, Outputable a) =>
a -> CompletionItemKind -> Maybe Text -> CompItem
mkComp Located (IdP GhcPs)
GenLocated SrcSpan RdrName
fun_id CompletionItemKind
CiFunction Maybe Text
forall a. Maybe a
Nothing
                | Bool -> Bool
not (GenLocated SrcSpan RdrName -> Bool
hasTypeSig Located (IdP GhcPs)
GenLocated SrcSpan RdrName
fun_id)
                ]
            ValD XValD GhcPs
_ PatBind{LPat GhcPs
pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
pat_lhs :: LPat GhcPs
pat_lhs} ->
                [GenLocated SrcSpan RdrName
-> CompletionItemKind -> Maybe Text -> CompItem
forall a.
(HasSrcSpan a, Outputable a) =>
a -> CompletionItemKind -> Maybe Text -> CompItem
mkComp Located (IdP GhcPs)
GenLocated SrcSpan RdrName
id CompletionItemKind
CiVariable Maybe Text
forall a. Maybe a
Nothing
                | VarPat XVarPat GhcPs
_ Located (IdP GhcPs)
id <- (Pat GhcPs -> Bool) -> Located (Pat GhcPs) -> [Pat GhcPs]
forall r. Typeable r => (r -> Bool) -> GenericQ [r]
listify (\(Pat GhcPs
_ :: Pat GhcPs) -> Bool
True) LPat GhcPs
Located (Pat GhcPs)
pat_lhs]
            TyClD XTyClD GhcPs
_ ClassDecl{Located (IdP GhcPs)
tcdLName :: forall pass. TyClDecl pass -> Located (IdP pass)
tcdLName :: Located (IdP GhcPs)
tcdLName, [LSig GhcPs]
tcdSigs :: forall pass. TyClDecl pass -> [LSig pass]
tcdSigs :: [LSig GhcPs]
tcdSigs} ->
                GenLocated SrcSpan RdrName
-> CompletionItemKind -> Maybe Text -> CompItem
forall a.
(HasSrcSpan a, Outputable a) =>
a -> CompletionItemKind -> Maybe Text -> CompItem
mkComp Located (IdP GhcPs)
GenLocated SrcSpan RdrName
tcdLName CompletionItemKind
CiClass Maybe Text
forall a. Maybe a
Nothing CompItem -> [CompItem] -> [CompItem]
forall a. a -> [a] -> [a]
:
                [ GenLocated SrcSpan RdrName
-> CompletionItemKind -> Maybe Text -> CompItem
forall a.
(HasSrcSpan a, Outputable a) =>
a -> CompletionItemKind -> Maybe Text -> CompItem
mkComp GenLocated SrcSpan RdrName
id CompletionItemKind
CiFunction (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ LHsSigWcType GhcPs -> Text
forall a. Outputable a => a -> Text
ppr LHsSigWcType GhcPs
typ)
                | L SrcSpan
_ (TypeSig XTypeSig GhcPs
_ [Located (IdP GhcPs)]
ids LHsSigWcType GhcPs
typ) <- [LSig GhcPs]
tcdSigs
                , GenLocated SrcSpan RdrName
id <- [Located (IdP GhcPs)]
[GenLocated SrcSpan RdrName]
ids]
            TyClD XTyClD GhcPs
_ TyClDecl GhcPs
x ->
                [GenLocated SrcSpan RdrName
-> CompletionItemKind -> Maybe Text -> CompItem
forall a.
(HasSrcSpan a, Outputable a) =>
a -> CompletionItemKind -> Maybe Text -> CompItem
mkComp GenLocated SrcSpan RdrName
id CompletionItemKind
cl Maybe Text
forall a. Maybe a
Nothing
                | GenLocated SrcSpan RdrName
id <- (GenLocated SrcSpan RdrName -> Bool)
-> TyClDecl GhcPs -> [GenLocated SrcSpan RdrName]
forall r. Typeable r => (r -> Bool) -> GenericQ [r]
listify (\(_ :: Located(IdP GhcPs)) -> Bool
True) TyClDecl GhcPs
x
                , let cl :: CompletionItemKind
cl = Maybe Text -> OccName -> CompletionItemKind
occNameToComKind Maybe Text
forall a. Maybe a
Nothing (RdrName -> OccName
rdrNameOcc (RdrName -> OccName) -> RdrName -> OccName
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpan RdrName
-> SrcSpanLess (GenLocated SrcSpan RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc GenLocated SrcSpan RdrName
id)]
            ForD XForD GhcPs
_ ForeignImport{Located (IdP GhcPs)
fd_name :: forall pass. ForeignDecl pass -> Located (IdP pass)
fd_name :: Located (IdP GhcPs)
fd_name,LHsSigType GhcPs
fd_sig_ty :: forall pass. ForeignDecl pass -> LHsSigType pass
fd_sig_ty :: LHsSigType GhcPs
fd_sig_ty} ->
                [GenLocated SrcSpan RdrName
-> CompletionItemKind -> Maybe Text -> CompItem
forall a.
(HasSrcSpan a, Outputable a) =>
a -> CompletionItemKind -> Maybe Text -> CompItem
mkComp Located (IdP GhcPs)
GenLocated SrcSpan RdrName
fd_name CompletionItemKind
CiVariable (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ LHsSigType GhcPs -> Text
forall a. Outputable a => a -> Text
ppr LHsSigType GhcPs
fd_sig_ty)]
            ForD XForD GhcPs
_ ForeignExport{Located (IdP GhcPs)
fd_name :: Located (IdP GhcPs)
fd_name :: forall pass. ForeignDecl pass -> Located (IdP pass)
fd_name,LHsSigType GhcPs
fd_sig_ty :: LHsSigType GhcPs
fd_sig_ty :: forall pass. ForeignDecl pass -> LHsSigType pass
fd_sig_ty} ->
                [GenLocated SrcSpan RdrName
-> CompletionItemKind -> Maybe Text -> CompItem
forall a.
(HasSrcSpan a, Outputable a) =>
a -> CompletionItemKind -> Maybe Text -> CompItem
mkComp Located (IdP GhcPs)
GenLocated SrcSpan RdrName
fd_name CompletionItemKind
CiVariable (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ LHsSigType GhcPs -> Text
forall a. Outputable a => a -> Text
ppr LHsSigType GhcPs
fd_sig_ty)]
            HsDecl GhcPs
_ -> []
            | L SrcSpan
_ HsDecl GhcPs
decl <- [LHsDecl GhcPs]
hsmodDecls
        ]

    mkComp :: a -> CompletionItemKind -> Maybe Text -> CompItem
mkComp a
n CompletionItemKind
ctyp Maybe Text
ty =
        CompletionItemKind
-> Text
-> Either SrcSpan Text
-> Maybe Text
-> Text
-> Maybe Backtick
-> SpanDoc
-> Bool
-> CompItem
CI CompletionItemKind
ctyp Text
pn (Text -> Either SrcSpan Text
forall a b. b -> Either a b
Right Text
thisModName) Maybe Text
ty Text
pn Maybe Backtick
forall a. Maybe a
Nothing SpanDoc
doc (CompletionItemKind
ctyp CompletionItemKind -> [CompletionItemKind] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CompletionItemKind
CiStruct, CompletionItemKind
CiClass])
      where
        pn :: Text
pn = a -> Text
forall a. Outputable a => a -> Text
ppr a
n
        doc :: SpanDoc
doc = [Text] -> SpanDocUris -> SpanDoc
SpanDocText ([ParsedModule] -> a -> [Text]
forall name. HasSrcSpan name => [ParsedModule] -> name -> [Text]
getDocumentation [ParsedModule
pm] a
n) (Maybe Text -> Maybe Text -> SpanDocUris
SpanDocUris Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing)

    thisModName :: Text
thisModName = Maybe (Located ModuleName) -> Text
forall a. Outputable a => a -> Text
ppr Maybe (Located ModuleName)
hsmodName

ppr :: Outputable a => a -> T.Text
ppr :: a -> Text
ppr = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Outputable a => a -> String
prettyPrint

newtype WithSnippets = WithSnippets Bool

toggleSnippets :: ClientCapabilities -> WithSnippets -> CompletionItem -> CompletionItem
toggleSnippets :: ClientCapabilities
-> WithSnippets -> CompletionItem -> CompletionItem
toggleSnippets ClientCapabilities { Maybe TextDocumentClientCapabilities
$sel:_textDocument:ClientCapabilities :: ClientCapabilities -> Maybe TextDocumentClientCapabilities
_textDocument :: Maybe TextDocumentClientCapabilities
_textDocument } (WithSnippets Bool
with) CompletionItem
x
  | Bool
with Bool -> Bool -> Bool
&& Bool
supported = CompletionItem
x
  | Bool
otherwise = CompletionItem
x { $sel:_insertTextFormat:CompletionItem :: Maybe InsertTextFormat
_insertTextFormat = InsertTextFormat -> Maybe InsertTextFormat
forall a. a -> Maybe a
Just InsertTextFormat
PlainText
                  , $sel:_insertText:CompletionItem :: Maybe Text
_insertText       = Maybe Text
forall a. Maybe a
Nothing
                  }
  where supported :: Bool
supported = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== (Maybe TextDocumentClientCapabilities
_textDocument Maybe TextDocumentClientCapabilities
-> (TextDocumentClientCapabilities
    -> Maybe CompletionClientCapabilities)
-> Maybe CompletionClientCapabilities
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TextDocumentClientCapabilities
-> Maybe CompletionClientCapabilities
_completion Maybe CompletionClientCapabilities
-> (CompletionClientCapabilities
    -> Maybe CompletionItemClientCapabilities)
-> Maybe CompletionItemClientCapabilities
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CompletionClientCapabilities
-> Maybe CompletionItemClientCapabilities
_completionItem Maybe CompletionItemClientCapabilities
-> (CompletionItemClientCapabilities -> Maybe Bool) -> Maybe Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CompletionItemClientCapabilities -> Maybe Bool
_snippetSupport)

-- | Returns the cached completions for the given module and position.
getCompletions
    :: IdeOptions
    -> CachedCompletions
    -> Maybe (ParsedModule, PositionMapping)
    -> (Bindings, PositionMapping)
    -> VFS.PosPrefixInfo
    -> ClientCapabilities
    -> WithSnippets
    -> IO [CompletionItem]
getCompletions :: IdeOptions
-> CachedCompletions
-> Maybe (ParsedModule, PositionMapping)
-> (Bindings, PositionMapping)
-> PosPrefixInfo
-> ClientCapabilities
-> WithSnippets
-> IO [CompletionItem]
getCompletions IdeOptions
ideOpts CC { [Text]
allModNamesAsNS :: [Text]
allModNamesAsNS :: CachedCompletions -> [Text]
allModNamesAsNS, [CompItem]
unqualCompls :: [CompItem]
unqualCompls :: CachedCompletions -> [CompItem]
unqualCompls, QualCompls
qualCompls :: QualCompls
qualCompls :: CachedCompletions -> QualCompls
qualCompls, [Text]
importableModules :: [Text]
importableModules :: CachedCompletions -> [Text]
importableModules}
               Maybe (ParsedModule, PositionMapping)
maybe_parsed (Bindings
localBindings, PositionMapping
bmapping) PosPrefixInfo
prefixInfo ClientCapabilities
caps WithSnippets
withSnippets = do
  let VFS.PosPrefixInfo { Text
$sel:fullLine:PosPrefixInfo :: PosPrefixInfo -> Text
fullLine :: Text
fullLine, Text
$sel:prefixModule:PosPrefixInfo :: PosPrefixInfo -> Text
prefixModule :: Text
prefixModule, Text
$sel:prefixText:PosPrefixInfo :: PosPrefixInfo -> Text
prefixText :: Text
prefixText } = PosPrefixInfo
prefixInfo
      enteredQual :: Text
enteredQual = if Text -> Bool
T.null Text
prefixModule then Text
"" else Text
prefixModule Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
      fullPrefix :: Text
fullPrefix  = Text
enteredQual Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
prefixText

      {- correct the position by moving 'foo :: Int -> String ->    '
                                                                    ^
          to                             'foo :: Int -> String ->    '
                                                              ^
      -}
      pos :: Position
pos = PosPrefixInfo -> Position
VFS.cursorPos PosPrefixInfo
prefixInfo

      filtModNameCompls :: [CompletionItem]
filtModNameCompls =
        (Text -> CompletionItem) -> [Text] -> [CompletionItem]
forall a b. (a -> b) -> [a] -> [b]
map Text -> CompletionItem
mkModCompl
          ([Text] -> [CompletionItem]) -> [Text] -> [CompletionItem]
forall a b. (a -> b) -> a -> b
$ (Text -> Maybe Text) -> [Text] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text -> Text -> Maybe Text
T.stripPrefix Text
enteredQual)
          ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> [Text]
forall s. TextualMonoid s => s -> [s] -> [s]
Fuzzy.simpleFilter Text
fullPrefix [Text]
allModNamesAsNS

      filtCompls :: [CompItem]
filtCompls = (Fuzzy CompItem Text -> CompItem)
-> [Fuzzy CompItem Text] -> [CompItem]
forall a b. (a -> b) -> [a] -> [b]
map Fuzzy CompItem Text -> CompItem
forall t s. TextualMonoid s => Fuzzy t s -> t
Fuzzy.original ([Fuzzy CompItem Text] -> [CompItem])
-> [Fuzzy CompItem Text] -> [CompItem]
forall a b. (a -> b) -> a -> b
$ Text
-> [CompItem]
-> Text
-> Text
-> (CompItem -> Text)
-> Bool
-> [Fuzzy CompItem Text]
forall s t.
TextualMonoid s =>
s -> [t] -> s -> s -> (t -> s) -> Bool -> [Fuzzy t s]
Fuzzy.filter Text
prefixText [CompItem]
ctxCompls Text
"" Text
"" CompItem -> Text
label Bool
False
        where

          mcc :: Maybe Context
mcc = case Maybe (ParsedModule, PositionMapping)
maybe_parsed of
            Maybe (ParsedModule, PositionMapping)
Nothing -> Maybe Context
forall a. Maybe a
Nothing
            Just (ParsedModule
pm, PositionMapping
pmapping) ->
              let PositionMapping PositionDelta
pDelta = PositionMapping
pmapping
                  position' :: PositionResult Position
position' = PositionDelta -> Position -> PositionResult Position
fromDelta PositionDelta
pDelta Position
pos
                  lpos :: Position
lpos = PositionResult Position -> Position
forall a. PositionResult a -> a
lowerRange PositionResult Position
position'
                  hpos :: Position
hpos = PositionResult Position -> Position
forall a. PositionResult a -> a
upperRange PositionResult Position
position'
              in Position -> ParsedModule -> Maybe Context
getCContext Position
lpos ParsedModule
pm Maybe Context -> Maybe Context -> Maybe Context
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Position -> ParsedModule -> Maybe Context
getCContext Position
hpos ParsedModule
pm

          -- completions specific to the current context
          ctxCompls' :: [CompItem]
ctxCompls' = case Maybe Context
mcc of
                        Maybe Context
Nothing -> [CompItem]
compls
                        Just Context
TypeContext -> (CompItem -> Bool) -> [CompItem] -> [CompItem]
forall a. (a -> Bool) -> [a] -> [a]
filter CompItem -> Bool
isTypeCompl [CompItem]
compls
                        Just Context
ValueContext -> (CompItem -> Bool) -> [CompItem] -> [CompItem]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (CompItem -> Bool) -> CompItem -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompItem -> Bool
isTypeCompl) [CompItem]
compls
                        Just Context
_ -> (CompItem -> Bool) -> [CompItem] -> [CompItem]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (CompItem -> Bool) -> CompItem -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompItem -> Bool
isTypeCompl) [CompItem]
compls
          -- Add whether the text to insert has backticks
          ctxCompls :: [CompItem]
ctxCompls = (CompItem -> CompItem) -> [CompItem] -> [CompItem]
forall a b. (a -> b) -> [a] -> [b]
map (\CompItem
comp -> CompItem
comp { isInfix :: Maybe Backtick
isInfix = Maybe Backtick
infixCompls }) [CompItem]
ctxCompls'

          infixCompls :: Maybe Backtick
          infixCompls :: Maybe Backtick
infixCompls = Text -> Text -> Text -> Position -> Maybe Backtick
isUsedAsInfix Text
fullLine Text
prefixModule Text
prefixText Position
pos

          PositionMapping PositionDelta
bDelta = PositionMapping
bmapping
          oldPos :: PositionResult Position
oldPos = PositionDelta -> Position -> PositionResult Position
fromDelta PositionDelta
bDelta (Position -> PositionResult Position)
-> Position -> PositionResult Position
forall a b. (a -> b) -> a -> b
$ PosPrefixInfo -> Position
VFS.cursorPos PosPrefixInfo
prefixInfo
          startLoc :: Position
startLoc = PositionResult Position -> Position
forall a. PositionResult a -> a
lowerRange PositionResult Position
oldPos
          endLoc :: Position
endLoc = PositionResult Position -> Position
forall a. PositionResult a -> a
upperRange PositionResult Position
oldPos
          localCompls :: [CompItem]
localCompls = ((Name, Maybe Type) -> CompItem)
-> [(Name, Maybe Type)] -> [CompItem]
forall a b. (a -> b) -> [a] -> [b]
map ((Name -> Maybe Type -> CompItem) -> (Name, Maybe Type) -> CompItem
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Name -> Maybe Type -> CompItem
localBindsToCompItem) ([(Name, Maybe Type)] -> [CompItem])
-> [(Name, Maybe Type)] -> [CompItem]
forall a b. (a -> b) -> a -> b
$ Bindings -> Position -> Position -> [(Name, Maybe Type)]
getFuzzyScope Bindings
localBindings Position
startLoc Position
endLoc
          localBindsToCompItem :: Name -> Maybe Type -> CompItem
          localBindsToCompItem :: Name -> Maybe Type -> CompItem
localBindsToCompItem Name
name Maybe Type
typ = CompletionItemKind
-> Text
-> Either SrcSpan Text
-> Maybe Text
-> Text
-> Maybe Backtick
-> SpanDoc
-> Bool
-> CompItem
CI CompletionItemKind
ctyp Text
pn Either SrcSpan Text
thisModName Maybe Text
ty Text
pn Maybe Backtick
forall a. Maybe a
Nothing SpanDoc
emptySpanDoc (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ OccName -> Bool
isValOcc OccName
occ)
            where
              occ :: OccName
occ = Name -> OccName
nameOccName Name
name
              ctyp :: CompletionItemKind
ctyp = Maybe Text -> OccName -> CompletionItemKind
occNameToComKind Maybe Text
forall a. Maybe a
Nothing OccName
occ
              pn :: Text
pn = Name -> Text
forall a. Outputable a => a -> Text
ppr Name
name
              ty :: Maybe Text
ty = Type -> Text
forall a. Outputable a => a -> Text
ppr (Type -> Text) -> Maybe Type -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Type
typ
              thisModName :: Either SrcSpan Text
thisModName = case Name -> Maybe Module
nameModule_maybe Name
name of
                Maybe Module
Nothing -> SrcSpan -> Either SrcSpan Text
forall a b. a -> Either a b
Left (SrcSpan -> Either SrcSpan Text) -> SrcSpan -> Either SrcSpan Text
forall a b. (a -> b) -> a -> b
$ Name -> SrcSpan
nameSrcSpan Name
name
                Just Module
m -> Text -> Either SrcSpan Text
forall a b. b -> Either a b
Right (Text -> Either SrcSpan Text) -> Text -> Either SrcSpan Text
forall a b. (a -> b) -> a -> b
$ Module -> Text
forall a. Outputable a => a -> Text
ppr Module
m

          compls :: [CompItem]
compls = if Text -> Bool
T.null Text
prefixModule
            then [CompItem]
localCompls [CompItem] -> [CompItem] -> [CompItem]
forall a. [a] -> [a] -> [a]
++ [CompItem]
unqualCompls
            else [CompItem] -> Text -> Map Text [CompItem] -> [CompItem]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] Text
prefixModule (Map Text [CompItem] -> [CompItem])
-> Map Text [CompItem] -> [CompItem]
forall a b. (a -> b) -> a -> b
$ QualCompls -> Map Text [CompItem]
getQualCompls QualCompls
qualCompls

      filtListWith :: (Text -> a) -> [Text] -> [a]
filtListWith Text -> a
f [Text]
list =
        [ Text -> a
f Text
label
        | Text
label <- Text -> [Text] -> [Text]
forall s. TextualMonoid s => s -> [s] -> [s]
Fuzzy.simpleFilter Text
fullPrefix [Text]
list
        , Text
enteredQual Text -> Text -> Bool
`T.isPrefixOf` Text
label
        ]

      filtListWithSnippet :: (Text -> t -> CompletionItem)
-> [(t, Text)] -> t -> [CompletionItem]
filtListWithSnippet Text -> t -> CompletionItem
f [(t, Text)]
list t
suffix =
        [ ClientCapabilities
-> WithSnippets -> CompletionItem -> CompletionItem
toggleSnippets ClientCapabilities
caps WithSnippets
withSnippets (Text -> t -> CompletionItem
f Text
label (t
snippet t -> t -> t
forall a. Semigroup a => a -> a -> a
<> t
suffix))
        | (t
snippet, Text
label) <- [(t, Text)]
list
        , Text -> Text -> Bool
forall s. TextualMonoid s => s -> s -> Bool
Fuzzy.test Text
fullPrefix Text
label
        ]

      filtImportCompls :: [CompletionItem]
filtImportCompls = (Text -> CompletionItem) -> [Text] -> [CompletionItem]
forall a. (Text -> a) -> [Text] -> [a]
filtListWith (Text -> Text -> CompletionItem
mkImportCompl Text
enteredQual) [Text]
importableModules
      filtPragmaCompls :: Text -> [CompletionItem]
filtPragmaCompls = (Text -> Text -> CompletionItem)
-> [(Text, Text)] -> Text -> [CompletionItem]
forall t.
Semigroup t =>
(Text -> t -> CompletionItem)
-> [(t, Text)] -> t -> [CompletionItem]
filtListWithSnippet Text -> Text -> CompletionItem
mkPragmaCompl [(Text, Text)]
validPragmas
      filtOptsCompls :: [Text] -> [CompletionItem]
filtOptsCompls   = (Text -> CompletionItem) -> [Text] -> [CompletionItem]
forall a. (Text -> a) -> [Text] -> [a]
filtListWith Text -> CompletionItem
mkExtCompl
      filtKeywordCompls :: [CompletionItem]
filtKeywordCompls
          | Text -> Bool
T.null Text
prefixModule = (Text -> CompletionItem) -> [Text] -> [CompletionItem]
forall a. (Text -> a) -> [Text] -> [a]
filtListWith Text -> CompletionItem
mkExtCompl (IdeOptions -> [Text]
optKeywords IdeOptions
ideOpts)
          | Bool
otherwise = []

      stripLeading :: Char -> String -> String
      stripLeading :: Char -> ShowS
stripLeading Char
_ [] = []
      stripLeading Char
c (Char
s:String
ss)
        | Char
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c = String
ss
        | Bool
otherwise = Char
sChar -> ShowS
forall a. a -> [a] -> [a]
:String
ss

      result :: [CompletionItem]
result
        | Text
"import " Text -> Text -> Bool
`T.isPrefixOf` Text
fullLine
        = [CompletionItem]
filtImportCompls
        | Text
"{-# language" Text -> Text -> Bool
`T.isPrefixOf` Text -> Text
T.toLower Text
fullLine
        = [Text] -> [CompletionItem]
filtOptsCompls [Text]
languagesAndExts
        | Text
"{-# options_ghc" Text -> Text -> Bool
`T.isPrefixOf` Text -> Text
T.toLower Text
fullLine
        = [Text] -> [CompletionItem]
filtOptsCompls ((String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack (String -> Text) -> ShowS -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
stripLeading Char
'-') ([String] -> [Text]) -> [String] -> [Text]
forall a b. (a -> b) -> a -> b
$ Bool -> [String]
flagsForCompletion Bool
False)
        | Text
"{-# " Text -> Text -> Bool
`T.isPrefixOf` Text
fullLine
        = Text -> [CompletionItem]
filtPragmaCompls (Text -> Text
pragmaSuffix Text
fullLine)
        | Bool
otherwise
        = let uniqueFiltCompls :: [CompItem]
uniqueFiltCompls = (CompItem -> Text) -> [CompItem] -> [CompItem]
forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOrdOn CompItem -> Text
insertText [CompItem]
filtCompls
          in [CompletionItem]
filtModNameCompls [CompletionItem] -> [CompletionItem] -> [CompletionItem]
forall a. [a] -> [a] -> [a]
++ (CompItem -> CompletionItem) -> [CompItem] -> [CompletionItem]
forall a b. (a -> b) -> [a] -> [b]
map (ClientCapabilities
-> WithSnippets -> CompletionItem -> CompletionItem
toggleSnippets ClientCapabilities
caps WithSnippets
withSnippets
                                         (CompletionItem -> CompletionItem)
-> (CompItem -> CompletionItem) -> CompItem -> CompletionItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdeOptions -> CompItem -> CompletionItem
mkCompl IdeOptions
ideOpts (CompItem -> CompletionItem)
-> (CompItem -> CompItem) -> CompItem -> CompletionItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompItem -> CompItem
stripAutoGenerated) [CompItem]
uniqueFiltCompls
                               [CompletionItem] -> [CompletionItem] -> [CompletionItem]
forall a. [a] -> [a] -> [a]
++ [CompletionItem]
filtKeywordCompls

  [CompletionItem] -> IO [CompletionItem]
forall (m :: * -> *) a. Monad m => a -> m a
return [CompletionItem]
result


-- The supported languages and extensions
languagesAndExts :: [T.Text]
#if MIN_GHC_API_VERSION(8,10,0)
languagesAndExts :: [Text]
languagesAndExts = (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack ([String] -> [Text]) -> [String] -> [Text]
forall a b. (a -> b) -> a -> b
$ PlatformMini -> [String]
GHC.supportedLanguagesAndExtensions ( Arch -> OS -> PlatformMini
PlatformMini Arch
ArchUnknown OS
OSUnknown )
#else
languagesAndExts = map T.pack GHC.supportedLanguagesAndExtensions
#endif

-- ---------------------------------------------------------------------
-- helper functions for pragmas
-- ---------------------------------------------------------------------

validPragmas :: [(T.Text, T.Text)]
validPragmas :: [(Text, Text)]
validPragmas =
  [ (Text
"LANGUAGE ${1:extension}"        , Text
"LANGUAGE")
  , (Text
"OPTIONS_GHC -${1:option}"       , Text
"OPTIONS_GHC")
  , (Text
"INLINE ${1:function}"           , Text
"INLINE")
  , (Text
"NOINLINE ${1:function}"         , Text
"NOINLINE")
  , (Text
"INLINABLE ${1:function}"        , Text
"INLINABLE")
  , (Text
"WARNING ${1:message}"           , Text
"WARNING")
  , (Text
"DEPRECATED ${1:message}"        , Text
"DEPRECATED")
  , (Text
"ANN ${1:annotation}"            , Text
"ANN")
  , (Text
"RULES"                          , Text
"RULES")
  , (Text
"SPECIALIZE ${1:function}"       , Text
"SPECIALIZE")
  , (Text
"SPECIALIZE INLINE ${1:function}", Text
"SPECIALIZE INLINE")
  ]

pragmaSuffix :: T.Text -> T.Text
pragmaSuffix :: Text -> Text
pragmaSuffix Text
fullLine
  |  Text
"}" Text -> Text -> Bool
`T.isSuffixOf` Text
fullLine = Text
forall a. Monoid a => a
mempty
  | Bool
otherwise = Text
" #-}"

-- ---------------------------------------------------------------------
-- helper functions for infix backticks
-- ---------------------------------------------------------------------

hasTrailingBacktick :: T.Text -> Position -> Bool
hasTrailingBacktick :: Text -> Position -> Bool
hasTrailingBacktick Text
line Position { Int
_character :: Position -> Int
_character :: Int
_character }
    | Text -> Int
T.length Text
line Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
_character = (Text
line Text -> Int -> Char
`T.index` Int
_character) Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'`'
    | Bool
otherwise = Bool
False

isUsedAsInfix :: T.Text -> T.Text -> T.Text -> Position -> Maybe Backtick
isUsedAsInfix :: Text -> Text -> Text -> Position -> Maybe Backtick
isUsedAsInfix Text
line Text
prefixMod Text
prefixText Position
pos
    | Bool
hasClosingBacktick Bool -> Bool -> Bool
&& Bool
hasOpeningBacktick = Backtick -> Maybe Backtick
forall a. a -> Maybe a
Just Backtick
Surrounded
    | Bool
hasOpeningBacktick = Backtick -> Maybe Backtick
forall a. a -> Maybe a
Just Backtick
LeftSide
    | Bool
otherwise = Maybe Backtick
forall a. Maybe a
Nothing
  where
    hasOpeningBacktick :: Bool
hasOpeningBacktick = Text -> Text -> Text -> Position -> Bool
openingBacktick Text
line Text
prefixMod Text
prefixText Position
pos
    hasClosingBacktick :: Bool
hasClosingBacktick = Text -> Position -> Bool
hasTrailingBacktick Text
line Position
pos

openingBacktick :: T.Text -> T.Text -> T.Text -> Position -> Bool
openingBacktick :: Text -> Text -> Text -> Position -> Bool
openingBacktick Text
line Text
prefixModule Text
prefixText Position { Int
_character :: Int
_character :: Position -> Int
_character }
  | Int
backtickIndex Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Bool
False
  | Bool
otherwise = (Text
line Text -> Int -> Char
`T.index` Int
backtickIndex) Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'`'
    where
    backtickIndex :: Int
    backtickIndex :: Int
backtickIndex =
      let
          prefixLength :: Int
prefixLength = Text -> Int
T.length Text
prefixText
          moduleLength :: Int
moduleLength = if Text
prefixModule Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
""
                    then Int
0
                    else Text -> Int
T.length Text
prefixModule Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 {- Because of "." -}
      in
        -- Points to the first letter of either the module or prefix text
        Int
_character Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
prefixLength Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
moduleLength) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1


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

-- | Under certain circumstance GHC generates some extra stuff that we
-- don't want in the autocompleted symbols
stripAutoGenerated :: CompItem -> CompItem
stripAutoGenerated :: CompItem -> CompItem
stripAutoGenerated CompItem
ci =
    CompItem
ci {label :: Text
label = Text -> Text
stripPrefix (CompItem -> Text
label CompItem
ci)}
    {- When e.g. DuplicateRecordFields is enabled, compiler generates
    names like "$sel:accessor:One" and "$sel:accessor:Two" to disambiguate record selectors
    https://ghc.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/DuplicateRecordFields#Implementation
    -}

-- TODO: Turn this into an alex lexer that discards prefixes as if they were whitespace.

stripPrefix :: T.Text -> T.Text
stripPrefix :: Text -> Text
stripPrefix Text
name = (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
':') (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
go [Text]
prefixes
  where
    go :: [Text] -> Text
go [] = Text
name
    go (Text
p:[Text]
ps)
      | Text -> Text -> Bool
T.isPrefixOf Text
p Text
name = Int -> Text -> Text
T.drop (Text -> Int
T.length Text
p) Text
name
      | Bool
otherwise = [Text] -> Text
go [Text]
ps

-- | Prefixes that can occur in a GHC OccName
prefixes :: [T.Text]
prefixes :: [Text]
prefixes =
  [
    -- long ones
    Text
"$con2tag_"
  , Text
"$tag2con_"
  , Text
"$maxtag_"

  -- four chars
  , Text
"$sel:"
  , Text
"$tc'"

  -- three chars
  , Text
"$dm"
  , Text
"$co"
  , Text
"$tc"
  , Text
"$cp"
  , Text
"$fx"

  -- two chars
  , Text
"$W"
  , Text
"$w"
  , Text
"$m"
  , Text
"$b"
  , Text
"$c"
  , Text
"$d"
  , Text
"$i"
  , Text
"$s"
  , Text
"$f"
  , Text
"$r"
  , Text
"C:"
  , Text
"N:"
  , Text
"D:"
  , Text
"$p"
  , Text
"$L"
  , Text
"$f"
  , Text
"$t"
  , Text
"$c"
  , Text
"$m"
  ]