{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs#-}

#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 (isAlphaNum, isUpper)
import Data.Generics
import Data.List.Extra as List hiding (stripPrefix)
import qualified Data.Map  as Map

import Data.Maybe (listToMaybe, 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 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
import ConLike
import GhcPlugins (
    flLabel,
    unpackFS)
import Data.Either (fromRight)
import Ide.Types(WithSnippets(..))

-- 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{..} CI{compKind,insertText, importedFrom,typeText,label,docs} =

--   CompletionItem label kind (List []) ((colon <>) <$> typeText)

--     (Just $ CompletionDocMarkup $ MarkupContent MkMarkdown $ T.intercalate sectionSeparator docs')

--     Nothing Nothing Nothing Nothing (Just insertText) (Just Snippet)

--     Nothing Nothing Nothing Nothing Nothing


mkCompl :: IdeOptions -> CompItem -> CompletionItem
mkCompl :: IdeOptions -> CompItem -> CompletionItem
mkCompl IdeOptions{Bool
String
[String]
[Text]
Maybe String
CheckParents
Action IdeGhcSession
ShakeOptions
IdePkgLocationOptions
IdeOTMemoryProfiling
IdeTesting
IdeDefer
IdeReportProgress
OptHaddockParse
ParsedSource -> IdePreprocessedSource
DynFlags -> DynFlags
optShakeOptions :: IdeOptions -> ShakeOptions
optCustomDynFlags :: IdeOptions -> DynFlags -> DynFlags
optHaddockParse :: IdeOptions -> OptHaddockParse
optCheckParents :: IdeOptions -> CheckParents
optCheckProject :: IdeOptions -> Bool
optDefer :: IdeOptions -> IdeDefer
optKeywords :: IdeOptions -> [Text]
optNewColonConvention :: IdeOptions -> Bool
optLanguageSyntax :: IdeOptions -> String
optReportProgress :: IdeOptions -> IdeReportProgress
optTesting :: IdeOptions -> IdeTesting
optOTMemoryProfiling :: IdeOptions -> IdeOTMemoryProfiling
optShakeProfiling :: IdeOptions -> Maybe String
optExtensions :: IdeOptions -> [String]
optPkgLocationOpts :: IdeOptions -> IdePkgLocationOptions
optGhcSession :: IdeOptions -> Action IdeGhcSession
optPreprocessor :: IdeOptions -> ParsedSource -> IdePreprocessedSource
optShakeOptions :: ShakeOptions
optCustomDynFlags :: DynFlags -> DynFlags
optHaddockParse :: OptHaddockParse
optCheckParents :: CheckParents
optCheckProject :: Bool
optDefer :: IdeDefer
optKeywords :: [Text]
optNewColonConvention :: Bool
optLanguageSyntax :: String
optReportProgress :: IdeReportProgress
optTesting :: IdeTesting
optOTMemoryProfiling :: IdeOTMemoryProfiling
optShakeProfiling :: Maybe String
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, Maybe [TextEdit]
additionalTextEdits :: CompItem -> Maybe [TextEdit]
additionalTextEdits :: Maybe [TextEdit]
additionalTextEdits} =
  CompletionItem :: Text
-> Maybe CompletionItemKind
-> Maybe (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 {$sel:_label:CompletionItem :: Text
_label = Text
label,
                  $sel:_kind:CompletionItem :: Maybe CompletionItemKind
_kind = Maybe CompletionItemKind
kind,
                  $sel:_tags:CompletionItem :: Maybe (List CompletionItemTag)
_tags = Maybe (List CompletionItemTag)
forall a. Maybe a
Nothing,
                  $sel:_detail:CompletionItem :: Maybe Text
_detail = (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,
                  $sel:_documentation:CompletionItem :: Maybe CompletionDoc
_documentation = Maybe CompletionDoc
documentation,
                  $sel:_deprecated:CompletionItem :: Maybe Bool
_deprecated = Maybe Bool
forall a. Maybe a
Nothing,
                  $sel:_preselect:CompletionItem :: Maybe Bool
_preselect = Maybe Bool
forall a. Maybe a
Nothing,
                  $sel:_sortText:CompletionItem :: Maybe Text
_sortText = Maybe Text
forall a. Maybe a
Nothing,
                  $sel:_filterText:CompletionItem :: Maybe Text
_filterText = Maybe Text
forall a. Maybe a
Nothing,
                  $sel:_insertText:CompletionItem :: Maybe Text
_insertText = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
insertText,
                  $sel:_insertTextFormat:CompletionItem :: Maybe InsertTextFormat
_insertTextFormat = InsertTextFormat -> Maybe InsertTextFormat
forall a. a -> Maybe a
Just InsertTextFormat
Snippet,
                  $sel:_textEdit:CompletionItem :: Maybe TextEdit
_textEdit = Maybe TextEdit
forall a. Maybe a
Nothing,
                  $sel:_additionalTextEdits:CompletionItem :: Maybe (List TextEdit)
_additionalTextEdits = [TextEdit] -> List TextEdit
forall a. [a] -> List a
List ([TextEdit] -> List TextEdit)
-> Maybe [TextEdit] -> Maybe (List TextEdit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [TextEdit]
additionalTextEdits,
                  $sel:_commitCharacters:CompletionItem :: Maybe (List Text)
_commitCharacters = Maybe (List Text)
forall a. Maybe a
Nothing,
                  $sel:_command:CompletionItem :: Maybe Command
_command = Maybe Command
forall a. Maybe a
Nothing,
                  $sel:_xdata:CompletionItem :: Maybe Value
_xdata = 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
":: "
        documentation :: Maybe CompletionDoc
documentation = 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'

mkNameCompItem :: Name -> ModuleName -> Maybe Type -> Maybe Backtick -> SpanDoc -> Maybe (LImportDecl GhcPs) -> CompItem
mkNameCompItem :: Name
-> ModuleName
-> Maybe Type
-> Maybe Backtick
-> SpanDoc
-> Maybe (LImportDecl GhcPs)
-> CompItem
mkNameCompItem Name
origName ModuleName
origMod Maybe Type
thingType Maybe Backtick
isInfix SpanDoc
docs !Maybe (LImportDecl GhcPs)
imp = CI :: CompletionItemKind
-> Text
-> Either SrcSpan Text
-> Maybe Text
-> Text
-> Maybe Backtick
-> SpanDoc
-> Bool
-> Maybe [TextEdit]
-> CompItem
CI{Bool
Maybe [TextEdit]
Maybe Text
Maybe Backtick
Either SrcSpan Text
Text
CompletionItemKind
SpanDoc
isTypeCompl :: Bool
isInfix :: Maybe Backtick
additionalTextEdits :: Maybe [TextEdit]
typeText :: Maybe Text
insertText :: Text
label :: Text
isTypeCompl :: Bool
importedFrom :: Either SrcSpan Text
compKind :: CompletionItemKind
docs :: SpanDoc
isInfix :: Maybe Backtick
additionalTextEdits :: Maybe [TextEdit]
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 SrcSpan Text
importedFrom = 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
$ 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
    additionalTextEdits :: Maybe [TextEdit]
additionalTextEdits = Maybe (LImportDecl GhcPs)
imp Maybe (LImportDecl GhcPs)
-> (LImportDecl GhcPs -> Maybe [TextEdit]) -> Maybe [TextEdit]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> LImportDecl GhcPs -> Maybe [TextEdit]
extendImportList (Name -> String
forall a. Outputable a => a -> String
showGhc Name
origName)

    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
-> Maybe (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) Maybe (List CompletionItemTag)
forall a. Maybe a
Nothing 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
-> Maybe (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) Maybe (List CompletionItemTag)
forall a. Maybe a
Nothing (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
-> Maybe (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) Maybe (List CompletionItemTag)
forall a. Maybe a
Nothing 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
-> Maybe (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) Maybe (List CompletionItemTag)
forall a. Maybe a
Nothing 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

extendImportList :: String -> LImportDecl GhcPs -> Maybe [TextEdit]
extendImportList :: String -> LImportDecl GhcPs -> Maybe [TextEdit]
extendImportList String
name LImportDecl GhcPs
lDecl = let
    f :: Maybe Range -> ImportDecl GhcPs -> Maybe [TextEdit]
f (Just Range
range) ImportDecl {Maybe (Bool, Located [LIE GhcPs])
ideclHiding :: Maybe (Bool, Located [LIE GhcPs])
ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding} = case Maybe (Bool, Located [LIE GhcPs])
ideclHiding of
        Just (Bool
False, Located [LIE GhcPs]
x)
          | String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember String
name ([String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList [LIE GhcPs -> String
forall a. Show a => a -> String
show LIE GhcPs
y| LIE GhcPs
y <- Located [LIE GhcPs] -> SrcSpanLess (Located [LIE GhcPs])
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located [LIE GhcPs]
x])
          -> let
            start_pos :: Position
start_pos = Range -> Position
_end Range
range
            new_start_pos :: Position
new_start_pos = Position
start_pos {_character :: Int
_character = Position -> Int
_character Position
start_pos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1}
            -- use to same start_pos to handle situation where we do not have latest edits due to caching of Rules

            new_range :: Range
new_range = Position -> Position -> Range
Range Position
new_start_pos Position
new_start_pos
            -- we cannot wrap mapM_ inside (mapM_) but we need to wrap (<$)

            alpha :: Bool
alpha = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isAlphaNum (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'_') String
name
            result :: String
result = if Bool
alpha then String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", "
                else String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"), "
            in [TextEdit] -> Maybe [TextEdit]
forall a. a -> Maybe a
Just [Range -> Text -> TextEdit
TextEdit Range
new_range (String -> Text
T.pack String
result)]
          | Bool
otherwise -> Maybe [TextEdit]
forall a. Maybe a
Nothing
        Maybe (Bool, Located [LIE GhcPs])
_ -> Maybe [TextEdit]
forall a. Maybe a
Nothing  -- hiding import list and no list

    f Maybe Range
_ ImportDecl GhcPs
_ = Maybe [TextEdit]
forall a. Maybe a
Nothing
    src_span :: Maybe Range
src_span = SrcSpan -> Maybe Range
srcSpanToRange (SrcSpan -> Maybe Range)
-> (LImportDecl GhcPs -> SrcSpan)
-> LImportDecl GhcPs
-> Maybe Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LImportDecl GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (LImportDecl GhcPs -> Maybe Range)
-> LImportDecl GhcPs -> Maybe Range
forall a b. (a -> b) -> a -> b
$ LImportDecl GhcPs
lDecl
    in Maybe Range -> ImportDecl GhcPs -> Maybe [TextEdit]
f Maybe Range
src_span (ImportDecl GhcPs -> Maybe [TextEdit])
-> (LImportDecl GhcPs -> ImportDecl GhcPs)
-> LImportDecl GhcPs
-> Maybe [TextEdit]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LImportDecl GhcPs -> ImportDecl GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LImportDecl GhcPs -> Maybe [TextEdit])
-> LImportDecl GhcPs -> Maybe [TextEdit]
forall a b. (a -> b) -> a -> b
$ LImportDecl GhcPs
lDecl


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
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]
_) =
          (, 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 -> Maybe (LImportDecl GhcPs) -> IO [CompItem]
toCompItem Module
curMod ModuleName
curModName Name
n Maybe (LImportDecl GhcPs)
forall a. Maybe a
Nothing
      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 -> Maybe (LImportDecl GhcPs) -> IO [CompItem]
toCompItem Module
curMod (ImpDeclSpec -> ModuleName
is_mod ImpDeclSpec
spec) Name
n Maybe (LImportDecl GhcPs)
forall a. Maybe a
Nothing
          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 -> Maybe (LImportDecl GhcPs) -> IO [CompItem]
      toCompItem :: Module
-> ModuleName -> Name -> Maybe (LImportDecl GhcPs) -> IO [CompItem]
toCompItem Module
m ModuleName
mn Name
n Maybe (LImportDecl GhcPs)
imp' = 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
        -- use the same pass to also capture any Record snippets that we can collect

        Either [FileDiagnostic] (Maybe (Text, [Text]))
record_ty <- DynFlags
-> Text
-> IO (Maybe (Text, [Text]))
-> IO (Either [FileDiagnostic] (Maybe (Text, [Text])))
forall a.
DynFlags -> Text -> IO a -> IO (Either [FileDiagnostic] a)
catchSrcErrors (HscEnv -> DynFlags
hsc_dflags HscEnv
packageState) Text
"record-completion" (IO (Maybe (Text, [Text]))
 -> IO (Either [FileDiagnostic] (Maybe (Text, [Text]))))
-> IO (Maybe (Text, [Text]))
-> IO (Either [FileDiagnostic] (Maybe (Text, [Text])))
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 (Text, [Text]) -> IO (Maybe (Text, [Text]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Text, [Text]) -> IO (Maybe (Text, [Text])))
-> Maybe (Text, [Text]) -> IO (Maybe (Text, [Text]))
forall a b. (a -> b) -> a -> b
$ Maybe TyThing
name' Maybe TyThing
-> (TyThing -> Maybe (Text, [Text])) -> Maybe (Text, [Text])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TyThing -> Maybe (Text, [Text])
safeTyThingForRecord

        let recordCompls :: [CompItem]
recordCompls = case Maybe (Text, [Text])
-> Either [FileDiagnostic] (Maybe (Text, [Text]))
-> Maybe (Text, [Text])
forall b a. b -> Either a b -> b
fromRight Maybe (Text, [Text])
forall a. Maybe a
Nothing Either [FileDiagnostic] (Maybe (Text, [Text]))
record_ty of
                Just (Text
ctxStr, [Text]
flds) -> case [Text]
flds of
                    [] -> []
                    [Text]
_ -> [Text
-> [Text]
-> Text
-> SpanDoc
-> Maybe (LImportDecl GhcPs)
-> CompItem
mkRecordSnippetCompItem Text
ctxStr [Text]
flds (ModuleName -> Text
forall a. Outputable a => a -> Text
ppr ModuleName
mn) SpanDoc
docs Maybe (LImportDecl GhcPs)
imp']
                Maybe (Text, [Text])
Nothing -> []

        [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
-> Maybe (LImportDecl GhcPs)
-> CompItem
mkNameCompItem Name
n ModuleName
mn (Maybe Type -> Either [FileDiagnostic] (Maybe Type) -> Maybe Type
forall b a. b -> Either a b -> b
fromRight Maybe Type
forall a. Maybe a
Nothing Either [FileDiagnostic] (Maybe Type)
ty) Maybe Backtick
forall a. Maybe a
Nothing SpanDoc
docs Maybe (LImportDecl GhcPs)
imp'
                 CompItem -> [CompItem] -> [CompItem]
forall a. a -> [a] -> [a]
: [CompItem]
recordCompls

  ([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
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
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
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
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
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 ->
                let generalCompls :: [CompItem]
generalCompls = [GenLocated SrcSpan RdrName
-> 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)]
                    -- here we only have to look at the outermost type

                    recordCompls :: [CompItem]
recordCompls = ParsedModule -> Text -> TyClDecl GhcPs -> [CompItem]
findRecordCompl ParsedModule
pm Text
thisModName TyClDecl GhcPs
x
                in
                   -- the constructors and snippets will be duplicated here giving the user 2 choices.

                   [CompItem]
generalCompls [CompItem] -> [CompItem] -> [CompItem]
forall a. [a] -> [a] -> [a]
++ [CompItem]
recordCompls
            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
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
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 :: GenLocated SrcSpan RdrName
-> CompletionItemKind -> Maybe Text -> CompItem
mkComp GenLocated SrcSpan RdrName
n CompletionItemKind
ctyp Maybe Text
ty =
        CompletionItemKind
-> Text
-> Either SrcSpan Text
-> Maybe Text
-> Text
-> Maybe Backtick
-> SpanDoc
-> Bool
-> Maybe [TextEdit]
-> 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]) Maybe [TextEdit]
forall a. Maybe a
Nothing
      where
        pn :: Text
pn = GenLocated SrcSpan RdrName -> Text
forall a. Outputable a => a -> Text
ppr GenLocated SrcSpan RdrName
n
        doc :: SpanDoc
doc = [Text] -> SpanDocUris -> SpanDoc
SpanDocText ([ParsedModule] -> GenLocated SrcSpan RdrName -> [Text]
forall name. HasSrcSpan name => [ParsedModule] -> name -> [Text]
getDocumentation [ParsedModule
pm] GenLocated SrcSpan RdrName
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

findRecordCompl :: ParsedModule -> T.Text -> TyClDecl GhcPs -> [CompItem]
findRecordCompl :: ParsedModule -> Text -> TyClDecl GhcPs -> [CompItem]
findRecordCompl ParsedModule
pmod Text
mn DataDecl {Located (IdP GhcPs)
tcdLName :: Located (IdP GhcPs)
tcdLName :: forall pass. TyClDecl pass -> Located (IdP pass)
tcdLName, HsDataDefn GhcPs
tcdDataDefn :: forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn :: HsDataDefn GhcPs
tcdDataDefn} = [CompItem]
result
    where
        result :: [CompItem]
result = [Text
-> [Text]
-> Text
-> SpanDoc
-> Maybe (LImportDecl GhcPs)
-> CompItem
mkRecordSnippetCompItem (String -> Text
T.pack (String -> Text)
-> (GenLocated SrcSpan RdrName -> String)
-> GenLocated SrcSpan RdrName
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> String
forall a. Outputable a => a -> String
showGhc (RdrName -> String)
-> (GenLocated SrcSpan RdrName -> RdrName)
-> GenLocated SrcSpan RdrName
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpan RdrName -> RdrName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (GenLocated SrcSpan RdrName -> Text)
-> GenLocated SrcSpan RdrName -> Text
forall a b. (a -> b) -> a -> b
$ Located (IdP GhcPs)
GenLocated SrcSpan RdrName
con_name) [Text]
field_labels Text
mn SpanDoc
doc Maybe (LImportDecl GhcPs)
forall a. Maybe a
Nothing
                 | ConDeclH98{[LHsTyVarBndr GhcPs]
Maybe (LHsContext GhcPs)
Maybe LHsDocString
HsConDeclDetails GhcPs
XConDeclH98 GhcPs
Located Bool
Located (IdP GhcPs)
con_forall :: forall pass. ConDecl pass -> Located Bool
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_args :: forall pass. ConDecl pass -> HsConDeclDetails pass
con_doc :: forall pass. ConDecl pass -> Maybe LHsDocString
con_ext :: forall pass. ConDecl pass -> XConDeclH98 pass
con_name :: forall pass. ConDecl pass -> Located (IdP pass)
con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr pass]
con_doc :: Maybe LHsDocString
con_args :: HsConDeclDetails GhcPs
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_ex_tvs :: [LHsTyVarBndr GhcPs]
con_forall :: Located Bool
con_ext :: XConDeclH98 GhcPs
con_name :: Located (IdP GhcPs)
..} <- LConDecl GhcPs -> ConDecl GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LConDecl GhcPs -> ConDecl GhcPs)
-> [LConDecl GhcPs] -> [ConDecl GhcPs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsDataDefn GhcPs -> [LConDecl GhcPs]
forall pass. HsDataDefn pass -> [LConDecl pass]
dd_cons HsDataDefn GhcPs
tcdDataDefn
                 , Just  [ConDeclField GhcPs]
con_details <- [HsConDeclDetails GhcPs -> Maybe [ConDeclField GhcPs]
forall arg.
HsConDetails arg (Located [LConDeclField GhcPs])
-> Maybe [ConDeclField GhcPs]
getFlds HsConDeclDetails GhcPs
con_args]
                 , let field_names :: [GenLocated SrcSpan RdrName]
field_names = (ConDeclField GhcPs -> Maybe (GenLocated SrcSpan RdrName))
-> [ConDeclField GhcPs] -> [GenLocated SrcSpan RdrName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ConDeclField GhcPs -> Maybe (GenLocated SrcSpan RdrName)
forall pass.
ConDeclField pass -> Maybe (GenLocated SrcSpan RdrName)
extract [ConDeclField GhcPs]
con_details
                 , let field_labels :: [Text]
field_labels = String -> Text
T.pack (String -> Text)
-> (GenLocated SrcSpan RdrName -> String)
-> GenLocated SrcSpan RdrName
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> String
forall a. Outputable a => a -> String
showGhc (RdrName -> String)
-> (GenLocated SrcSpan RdrName -> RdrName)
-> GenLocated SrcSpan RdrName
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpan RdrName -> RdrName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (GenLocated SrcSpan RdrName -> Text)
-> [GenLocated SrcSpan RdrName] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GenLocated SrcSpan RdrName]
field_names
                 , (Bool -> Bool
not (Bool -> Bool) -> ([Text] -> Bool) -> [Text] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null) [Text]
field_labels
                 ]
        doc :: SpanDoc
doc = [Text] -> SpanDocUris -> SpanDoc
SpanDocText ([ParsedModule] -> GenLocated SrcSpan RdrName -> [Text]
forall name. HasSrcSpan name => [ParsedModule] -> name -> [Text]
getDocumentation [ParsedModule
pmod] Located (IdP GhcPs)
GenLocated SrcSpan RdrName
tcdLName) (Maybe Text -> Maybe Text -> SpanDocUris
SpanDocUris Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing)

        getFlds :: HsConDetails arg (Located [LConDeclField GhcPs]) -> Maybe [ConDeclField GhcPs]
        getFlds :: HsConDetails arg (Located [LConDeclField GhcPs])
-> Maybe [ConDeclField GhcPs]
getFlds HsConDetails arg (Located [LConDeclField GhcPs])
conArg = case HsConDetails arg (Located [LConDeclField GhcPs])
conArg of
                             RecCon Located [LConDeclField GhcPs]
rec -> [ConDeclField GhcPs] -> Maybe [ConDeclField GhcPs]
forall a. a -> Maybe a
Just ([ConDeclField GhcPs] -> Maybe [ConDeclField GhcPs])
-> [ConDeclField GhcPs] -> Maybe [ConDeclField GhcPs]
forall a b. (a -> b) -> a -> b
$ LConDeclField GhcPs -> ConDeclField GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LConDeclField GhcPs -> ConDeclField GhcPs)
-> [LConDeclField GhcPs] -> [ConDeclField GhcPs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Located [LConDeclField GhcPs]
-> SrcSpanLess (Located [LConDeclField GhcPs])
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located [LConDeclField GhcPs]
rec
                             PrefixCon [arg]
_ -> [ConDeclField GhcPs] -> Maybe [ConDeclField GhcPs]
forall a. a -> Maybe a
Just []
                             HsConDetails arg (Located [LConDeclField GhcPs])
_ -> Maybe [ConDeclField GhcPs]
forall a. Maybe a
Nothing

        extract :: ConDeclField pass -> Maybe (GenLocated SrcSpan RdrName)
extract ConDeclField{[LFieldOcc pass]
Maybe LHsDocString
XConDeclField pass
LBangType pass
cd_fld_ext :: forall pass. ConDeclField pass -> XConDeclField pass
cd_fld_names :: forall pass. ConDeclField pass -> [LFieldOcc pass]
cd_fld_type :: forall pass. ConDeclField pass -> LBangType pass
cd_fld_doc :: forall pass. ConDeclField pass -> Maybe LHsDocString
cd_fld_doc :: Maybe LHsDocString
cd_fld_type :: LBangType pass
cd_fld_names :: [LFieldOcc pass]
cd_fld_ext :: XConDeclField pass
..}
             -- TODO: Why is cd_fld_names a list?

            | Just GenLocated SrcSpan RdrName
fld_name <- FieldOcc pass -> GenLocated SrcSpan RdrName
forall pass. FieldOcc pass -> GenLocated SrcSpan RdrName
rdrNameFieldOcc (FieldOcc pass -> GenLocated SrcSpan RdrName)
-> (LFieldOcc pass -> FieldOcc pass)
-> LFieldOcc pass
-> GenLocated SrcSpan RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LFieldOcc pass -> FieldOcc pass
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LFieldOcc pass -> GenLocated SrcSpan RdrName)
-> Maybe (LFieldOcc pass) -> Maybe (GenLocated SrcSpan RdrName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LFieldOcc pass] -> Maybe (LFieldOcc pass)
forall a. [a] -> Maybe a
listToMaybe [LFieldOcc pass]
cd_fld_names = GenLocated SrcSpan RdrName -> Maybe (GenLocated SrcSpan RdrName)
forall a. a -> Maybe a
Just GenLocated SrcSpan RdrName
fld_name
            | Bool
otherwise = Maybe (GenLocated SrcSpan RdrName)
forall a. Maybe a
Nothing
        -- XConDeclField

        extract ConDeclField pass
_ = Maybe (GenLocated SrcSpan RdrName)
forall a. Maybe a
Nothing
findRecordCompl ParsedModule
_ Text
_ TyClDecl GhcPs
_ = []

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

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
-> Maybe [TextEdit]
-> 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) Maybe [TextEdit]
forall a. Maybe a
Nothing
            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 -> CompletionItem) -> [Text] -> [CompletionItem]
filtListWith Text -> CompletionItem
f [Text]
list =
        [ Text -> CompletionItem
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 -> Text -> CompletionItem)
-> [(Text, Text)] -> Text -> [CompletionItem]
filtListWithSnippet Text -> Text -> CompletionItem
f [(Text, Text)]
list Text
suffix =
        [ ClientCapabilities
-> WithSnippets -> CompletionItem -> CompletionItem
toggleSnippets ClientCapabilities
caps WithSnippets
withSnippets (Text -> Text -> CompletionItem
f Text
label (Text
snippet Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suffix))
        | (Text
snippet, Text
label) <- [(Text, 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]
filtListWith (Text -> Text -> CompletionItem
mkImportCompl Text
enteredQual) [Text]
importableModules
      filtPragmaCompls :: Text -> [CompletionItem]
filtPragmaCompls = (Text -> Text -> CompletionItem)
-> [(Text, Text)] -> Text -> [CompletionItem]
filtListWithSnippet Text -> Text -> CompletionItem
mkPragmaCompl [(Text, Text)]
validPragmas
      filtOptsCompls :: [Text] -> [CompletionItem]
filtOptsCompls   = (Text -> CompletionItem) -> [Text] -> [CompletionItem]
filtListWith Text -> CompletionItem
mkExtCompl
      filtKeywordCompls :: [CompletionItem]
filtKeywordCompls
          | Text -> Bool
T.null Text
prefixModule = (Text -> CompletionItem) -> [Text] -> [CompletionItem]
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
        -- we leave this condition here to avoid duplications and return empty list

        -- since HLS implements this completion (#haskell-language-server/pull/662)

        | Text
"{-# language" Text -> Text -> Bool
`T.isPrefixOf` Text -> Text
T.toLower Text
fullLine
        = []
        | 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]
++ [CompletionItem]
filtKeywordCompls
          [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] -> IO [CompletionItem]
forall (m :: * -> *) a. Monad m => a -> m a
return [CompletionItem]
result


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

-- 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 :: Int
_character :: Position -> 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"
  ]


safeTyThingForRecord :: TyThing -> Maybe (T.Text, [T.Text])
safeTyThingForRecord :: TyThing -> Maybe (Text, [Text])
safeTyThingForRecord (AnId TyCoVar
_) = Maybe (Text, [Text])
forall a. Maybe a
Nothing
safeTyThingForRecord (AConLike ConLike
dc) =
    let ctxStr :: Text
ctxStr =   String -> Text
T.pack (String -> Text) -> (ConLike -> String) -> ConLike -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> String
forall a. Outputable a => a -> String
showGhc (OccName -> String) -> (ConLike -> OccName) -> ConLike -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> OccName
forall name. HasOccName name => name -> OccName
occName (Name -> OccName) -> (ConLike -> Name) -> ConLike -> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConLike -> Name
conLikeName (ConLike -> Text) -> ConLike -> Text
forall a b. (a -> b) -> a -> b
$ ConLike
dc
        field_names :: [Text]
field_names = String -> Text
T.pack (String -> Text)
-> (FieldLbl Name -> String) -> FieldLbl Name -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> String
unpackFS (FastString -> String)
-> (FieldLbl Name -> FastString) -> FieldLbl Name -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLbl Name -> FastString
forall a. FieldLbl a -> FastString
flLabel (FieldLbl Name -> Text) -> [FieldLbl Name] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConLike -> [FieldLbl Name]
conLikeFieldLabels ConLike
dc
    in
        (Text, [Text]) -> Maybe (Text, [Text])
forall a. a -> Maybe a
Just (Text
ctxStr, [Text]
field_names)
safeTyThingForRecord TyThing
_ = Maybe (Text, [Text])
forall a. Maybe a
Nothing

mkRecordSnippetCompItem :: T.Text -> [T.Text] -> T.Text -> SpanDoc -> Maybe (LImportDecl GhcPs) -> CompItem
mkRecordSnippetCompItem :: Text
-> [Text]
-> Text
-> SpanDoc
-> Maybe (LImportDecl GhcPs)
-> CompItem
mkRecordSnippetCompItem Text
ctxStr [Text]
compl Text
mn SpanDoc
docs Maybe (LImportDecl GhcPs)
imp = CompItem
r
  where
      r :: CompItem
r  = CI :: CompletionItemKind
-> Text
-> Either SrcSpan Text
-> Maybe Text
-> Text
-> Maybe Backtick
-> SpanDoc
-> Bool
-> Maybe [TextEdit]
-> CompItem
CI {
            compKind :: CompletionItemKind
compKind = CompletionItemKind
CiSnippet
          , insertText :: Text
insertText = Text
buildSnippet
          , importedFrom :: Either SrcSpan Text
importedFrom = Either SrcSpan Text
importedFrom
          , typeText :: Maybe Text
typeText = Maybe Text
forall a. Maybe a
Nothing
          , label :: Text
label = Text
ctxStr
          , isInfix :: Maybe Backtick
isInfix = Maybe Backtick
forall a. Maybe a
Nothing
          , docs :: SpanDoc
docs = SpanDoc
docs
          , isTypeCompl :: Bool
isTypeCompl = Bool
False
          , additionalTextEdits :: Maybe [TextEdit]
additionalTextEdits = Maybe (LImportDecl GhcPs)
imp Maybe (LImportDecl GhcPs)
-> (LImportDecl GhcPs -> Maybe [TextEdit]) -> Maybe [TextEdit]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> LImportDecl GhcPs -> Maybe [TextEdit]
extendImportList (Text -> String
T.unpack Text
ctxStr)
          }

      placeholder_pairs :: [(Text, Int)]
placeholder_pairs = [Text] -> [Int] -> [(Text, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
compl ([Int
1..]::[Int])
      snippet_parts :: [Text]
snippet_parts = ((Text, Int) -> Text) -> [(Text, Int)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
x, Int
i) -> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=${" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
i) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}") [(Text, Int)]
placeholder_pairs
      snippet :: Text
snippet = Text -> [Text] -> Text
T.intercalate (String -> Text
T.pack String
", ") [Text]
snippet_parts
      buildSnippet :: Text
buildSnippet = Text
ctxStr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" {" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
snippet Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
      importedFrom :: Either SrcSpan Text
importedFrom = Text -> Either SrcSpan Text
forall a b. b -> Either a b
Right Text
mn