{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MultiWayIf            #-}
{-# LANGUAGE OverloadedLabels      #-}

-- Mostly taken from "haskell-ide-engine"
module Development.IDE.Plugin.Completions.Logic (
  CachedCompletions
, cacheDataProducer
, localCompletionsForParsedModule
, getCompletions
, fromIdentInfo
, getCompletionPrefix
) where

import           Control.Applicative
import           Control.Lens                             hiding (Context,
                                                           parts)
import           Data.Char                                (isAlphaNum, isUpper)
import           Data.Default                             (def)
import           Data.Generics
import           Data.List.Extra                          as List hiding
                                                                  (stripPrefix)
import qualified Data.Map                                 as Map
import           Data.Row
import           Prelude                                  hiding (mod)

import           Data.Maybe                               (fromMaybe, isJust,
                                                           isNothing,
                                                           listToMaybe,
                                                           mapMaybe)
import qualified Data.Text                                as T
import qualified Text.Fuzzy.Parallel                      as Fuzzy

import           Control.Monad
import           Data.Aeson                               (ToJSON (toJSON))
import           Data.Function                            (on)

import qualified Data.HashSet                             as HashSet
import           Data.Monoid                              (First (..))
import           Data.Ord                                 (Down (Down))
import qualified Data.Set                                 as Set
import           Development.IDE.Core.PositionMapping
import           Development.IDE.GHC.Compat               hiding (isQual, ppr)
import qualified Development.IDE.GHC.Compat               as GHC
import           Development.IDE.GHC.Compat.Util
import           Development.IDE.GHC.CoreFile             (occNamePrefixes)
import           Development.IDE.GHC.Error
import           Development.IDE.GHC.Util
import           Development.IDE.Plugin.Completions.Types
import           Development.IDE.Spans.LocalBindings
import           Development.IDE.Types.Exports
import           Development.IDE.Types.Options
import           Ide.PluginUtils                          (mkLspCommand)
import           Ide.Types                                (CommandId (..),
                                                           IdePlugins (..),
                                                           PluginId)
import qualified Language.LSP.Protocol.Lens               as L
import           Language.LSP.Protocol.Types
import qualified Language.LSP.VFS                         as VFS
import           Text.Fuzzy.Parallel                      (Scored (score),
                                                           original)

import qualified Data.Text.Utf16.Rope.Mixed               as Rope
import           Development.IDE                          hiding (line)

import           Development.IDE.Spans.AtPoint            (pointCommand)

-- See Note [Guidelines For Using CPP In GHCIDE Import Statements]

import           GHC.Plugins                              (Depth (AllTheWay),
                                                           mkUserStyle,
                                                           neverQualify,
                                                           sdocStyle)

#if !MIN_VERSION_ghc(9,3,0)
import           GHC.Plugins                              (defaultSDocContext,
                                                           renderWithContext)
#endif

#if MIN_VERSION_ghc(9,5,0)
import           Language.Haskell.Syntax.Basic
#endif

-- Chunk size used for parallelizing fuzzy matching
chunkSize :: Int
chunkSize :: Int
chunkSize = Int
1000

-- 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
$cshowsPrec :: Int -> Context -> ShowS
showsPrec :: Int -> Context -> ShowS
$cshow :: Context -> String
show :: Context -> String
$cshowList :: [Context] -> ShowS
showList :: [Context] -> ShowS
Show, Context -> Context -> Bool
(Context -> Context -> Bool)
-> (Context -> Context -> Bool) -> Eq Context
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Context -> Context -> Bool
== :: Context -> Context -> Bool
$c/= :: Context -> Context -> Bool
/= :: 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 (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA -> SrcSpan
r) ModuleName
modName) <- Maybe (XRec GhcPs 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 (SrcSpanAnn' (EpAnn AnnList) -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA -> SrcSpan
r) [GenLocated SrcSpanAnnA (IE GhcPs)]
_) <- Maybe (XRec GhcPs [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) -> GenericQ (Maybe Context)
forall u. GenericQ (Maybe u) -> GenericQ (Maybe u)
something (Maybe Context
forall a. Maybe a
Nothing Maybe Context
-> (GenLocated SrcSpanAnnA (HsDecl GhcPs) -> Maybe Context)
-> a
-> Maybe Context
forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
`mkQ` LHsDecl GhcPs -> Maybe Context
GenLocated SrcSpanAnnA (HsDecl GhcPs) -> Maybe Context
go (a -> Maybe Context)
-> (GenLocated SrcSpanAnnA (HsType GhcPs) -> Maybe Context)
-> a
-> Maybe Context
forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` LHsType GhcPs -> Maybe Context
GenLocated SrcSpanAnnA (HsType GhcPs) -> Maybe Context
goInline) [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decl
  = Context -> Maybe Context
forall a. a -> Maybe a
Just Context
ctx

  | Just Context
ctx <- GenericQ (Maybe Context) -> GenericQ (Maybe Context)
forall u. GenericQ (Maybe u) -> GenericQ (Maybe u)
something (Maybe Context
forall a. Maybe a
Nothing Maybe Context
-> (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Maybe Context)
-> a
-> Maybe Context
forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
`mkQ` LImportDecl GhcPs -> Maybe Context
GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Maybe Context
importGo) [LImportDecl GhcPs]
[GenLocated SrcSpanAnnA (ImportDecl 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 p. HsModule p -> [LHsDecl p]
hsmodDecls (HsModule GhcPs -> [LHsDecl GhcPs])
-> HsModule GhcPs -> [LHsDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpan (HsModule GhcPs) -> HsModule GhcPs
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpan (HsModule GhcPs) -> HsModule GhcPs)
-> GenLocated SrcSpan (HsModule GhcPs) -> HsModule GhcPs
forall a b. (a -> b) -> a -> b
$ ParsedModule -> GenLocated SrcSpan (HsModule GhcPs)
pm_parsed_source ParsedModule
pm
        moduleHeader :: Maybe (XRec GhcPs ModuleName)
moduleHeader = HsModule GhcPs -> Maybe (XRec GhcPs ModuleName)
forall p. HsModule p -> Maybe (XRec p ModuleName)
hsmodName (HsModule GhcPs -> Maybe (XRec GhcPs ModuleName))
-> HsModule GhcPs -> Maybe (XRec GhcPs ModuleName)
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpan (HsModule GhcPs) -> HsModule GhcPs
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpan (HsModule GhcPs) -> HsModule GhcPs)
-> GenLocated SrcSpan (HsModule GhcPs) -> HsModule GhcPs
forall a b. (a -> b) -> a -> b
$ ParsedModule -> GenLocated SrcSpan (HsModule GhcPs)
pm_parsed_source ParsedModule
pm
        exportList :: Maybe (XRec GhcPs [LIE GhcPs])
exportList = HsModule GhcPs -> Maybe (XRec GhcPs [LIE GhcPs])
forall p. HsModule p -> Maybe (XRec p [LIE p])
hsmodExports (HsModule GhcPs -> Maybe (XRec GhcPs [LIE GhcPs]))
-> HsModule GhcPs -> Maybe (XRec GhcPs [LIE GhcPs])
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpan (HsModule GhcPs) -> HsModule GhcPs
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpan (HsModule GhcPs) -> HsModule GhcPs)
-> GenLocated SrcSpan (HsModule GhcPs) -> HsModule GhcPs
forall a b. (a -> b) -> a -> b
$ ParsedModule -> GenLocated SrcSpan (HsModule GhcPs)
pm_parsed_source ParsedModule
pm
        imports :: [LImportDecl GhcPs]
imports = HsModule GhcPs -> [LImportDecl GhcPs]
forall p. HsModule p -> [LImportDecl p]
hsmodImports (HsModule GhcPs -> [LImportDecl GhcPs])
-> HsModule GhcPs -> [LImportDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpan (HsModule GhcPs) -> HsModule GhcPs
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpan (HsModule GhcPs) -> HsModule GhcPs)
-> GenLocated SrcSpan (HsModule GhcPs) -> HsModule GhcPs
forall a b. (a -> b) -> a -> b
$ ParsedModule -> GenLocated SrcSpan (HsModule GhcPs)
pm_parsed_source ParsedModule
pm

        go :: LHsDecl GhcPs -> Maybe Context
        go :: LHsDecl GhcPs -> Maybe Context
go (L (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA -> 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 (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA -> 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 (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA -> 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

#if MIN_VERSION_ghc(9,5,0)
        importGo :: GHC.LImportDecl GhcPs -> Maybe Context
        importGo :: LImportDecl GhcPs -> Maybe Context
importGo (L (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA -> SrcSpan
r) ImportDecl GhcPs
impDecl)
          | Position
pos Position -> SrcSpan -> Bool
`isInsideSrcSpan` SrcSpan
r
          = String
-> Maybe
     (ImportListInterpretation,
      GenLocated SrcSpan [GenLocated SrcSpanAnnA (IE GhcPs)])
-> Maybe Context
importInline String
importModuleName (((ImportListInterpretation,
  GenLocated
    (SrcSpanAnn' (EpAnn AnnList)) [GenLocated SrcSpanAnnA (IE GhcPs)])
 -> (ImportListInterpretation,
     GenLocated SrcSpan [GenLocated SrcSpanAnnA (IE GhcPs)]))
-> Maybe
     (ImportListInterpretation,
      GenLocated
        (SrcSpanAnn' (EpAnn AnnList)) [GenLocated SrcSpanAnnA (IE GhcPs)])
-> Maybe
     (ImportListInterpretation,
      GenLocated SrcSpan [GenLocated SrcSpanAnnA (IE GhcPs)])
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((GenLocated
   (SrcSpanAnn' (EpAnn AnnList)) [GenLocated SrcSpanAnnA (IE GhcPs)]
 -> GenLocated SrcSpan [GenLocated SrcSpanAnnA (IE GhcPs)])
-> (ImportListInterpretation,
    GenLocated
      (SrcSpanAnn' (EpAnn AnnList)) [GenLocated SrcSpanAnnA (IE GhcPs)])
-> (ImportListInterpretation,
    GenLocated SrcSpan [GenLocated SrcSpanAnnA (IE GhcPs)])
forall a b.
(a -> b)
-> (ImportListInterpretation, a) -> (ImportListInterpretation, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated
  (SrcSpanAnn' (EpAnn AnnList)) [GenLocated SrcSpanAnnA (IE GhcPs)]
-> GenLocated SrcSpan [GenLocated SrcSpanAnnA (IE GhcPs)]
forall a e. LocatedAn a e -> Located e
reLoc) (Maybe
   (ImportListInterpretation,
    GenLocated
      (SrcSpanAnn' (EpAnn AnnList)) [GenLocated SrcSpanAnnA (IE GhcPs)])
 -> Maybe
      (ImportListInterpretation,
       GenLocated SrcSpan [GenLocated SrcSpanAnnA (IE GhcPs)]))
-> Maybe
     (ImportListInterpretation,
      GenLocated
        (SrcSpanAnn' (EpAnn AnnList)) [GenLocated SrcSpanAnnA (IE GhcPs)])
-> Maybe
     (ImportListInterpretation,
      GenLocated SrcSpan [GenLocated SrcSpanAnnA (IE GhcPs)])
forall a b. (a -> b) -> a -> b
$ ImportDecl GhcPs
-> Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclImportList ImportDecl GhcPs
impDecl)
#else
        importGo :: GHC.LImportDecl GhcPs -> Maybe Context
        importGo (L (locA -> r) impDecl)
          | pos `isInsideSrcSpan` r
          = importInline importModuleName (fmap (fmap reLoc) $ ideclHiding impDecl)
#endif
          Maybe Context -> Maybe Context -> Maybe Context
forall a. Maybe a -> Maybe a -> Maybe a
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
$ GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnA ModuleName -> ModuleName)
-> GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall a b. (a -> b) -> a -> b
$ ImportDecl GhcPs -> XRec GhcPs ModuleName
forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcPs
impDecl

        -- importInline :: String -> Maybe (Bool,  GHC.Located [LIE GhcPs]) -> Maybe Context
#if MIN_VERSION_ghc(9,5,0)
        importInline :: String
-> Maybe
     (ImportListInterpretation,
      GenLocated SrcSpan [GenLocated SrcSpanAnnA (IE GhcPs)])
-> Maybe Context
importInline String
modName (Just (ImportListInterpretation
EverythingBut, L SrcSpan
r [GenLocated SrcSpanAnnA (IE 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
#else
        importInline modName (Just (True, L r _))
          | pos `isInsideSrcSpan` r = Just $ ImportHidingContext modName
          | otherwise = Nothing
#endif

#if MIN_VERSION_ghc(9,5,0)
        importInline String
modName (Just (ImportListInterpretation
Exactly, L SrcSpan
r [GenLocated SrcSpanAnnA (IE 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
#else
        importInline modName (Just (False, L r _))
          | pos `isInsideSrcSpan` r = Just $ ImportListContext modName
          | otherwise = Nothing
#endif

        importInline String
_ Maybe
  (ImportListInterpretation,
   GenLocated SrcSpan [GenLocated SrcSpanAnnA (IE GhcPs)])
_ = Maybe Context
forall a. Maybe a
Nothing

occNameToComKind :: OccName -> CompletionItemKind
occNameToComKind :: OccName -> CompletionItemKind
occNameToComKind OccName
oc
  | OccName -> Bool
isVarOcc  OccName
oc = case OccName -> String
occNameString OccName
oc of
                     Char
i:String
_ | Char -> Bool
isUpper Char
i -> CompletionItemKind
CompletionItemKind_Constructor
                     String
_               -> CompletionItemKind
CompletionItemKind_Function
  | OccName -> Bool
isTcOcc   OccName
oc = CompletionItemKind
CompletionItemKind_Struct
  | OccName -> Bool
isDataOcc OccName
oc = CompletionItemKind
CompletionItemKind_Constructor
  | Bool
otherwise    = CompletionItemKind
CompletionItemKind_Variable


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 :: Maybe PluginId -- ^ Plugin to use for the extend import command
        -> IdeOptions -> Uri -> CompItem -> CompletionItem
mkCompl :: Maybe PluginId -> IdeOptions -> Uri -> CompItem -> CompletionItem
mkCompl
  Maybe PluginId
pId
  IdeOptions
_ideOptions
  Uri
uri
  CI
    { CompletionItemKind
compKind :: CompletionItemKind
compKind :: CompItem -> CompletionItemKind
compKind,
      Maybe Backtick
isInfix :: Maybe Backtick
isInfix :: CompItem -> Maybe Backtick
isInfix,
      Text
insertText :: Text
insertText :: CompItem -> Text
insertText,
      Provenance
provenance :: Provenance
provenance :: CompItem -> Provenance
provenance,
      Text
label :: Text
label :: CompItem -> Text
label,
      Maybe Text
typeText :: Maybe Text
typeText :: CompItem -> Maybe Text
typeText,
      Maybe ExtendImport
additionalTextEdits :: Maybe ExtendImport
additionalTextEdits :: CompItem -> Maybe ExtendImport
additionalTextEdits,
      Maybe NameDetails
nameDetails :: Maybe NameDetails
nameDetails :: CompItem -> Maybe NameDetails
nameDetails
    } = do
  let mbCommand :: Maybe Command
mbCommand = Maybe PluginId -> ExtendImport -> Maybe Command
mkAdditionalEditsCommand Maybe PluginId
pId (ExtendImport -> Maybe Command)
-> Maybe ExtendImport -> Maybe Command
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe ExtendImport
additionalTextEdits
  let ci :: CompletionItem
ci = CompletionItem
                 {$sel:_label:CompletionItem :: Text
_label = Text
label,
                  $sel:_kind:CompletionItem :: Maybe CompletionItemKind
_kind = Maybe CompletionItemKind
kind,
                  $sel:_tags:CompletionItem :: Maybe [CompletionItemTag]
_tags = Maybe [CompletionItemTag]
forall a. Maybe a
Nothing,
                  $sel:_detail:CompletionItem :: Maybe Text
_detail =
                      case (Maybe Text
typeText, Provenance
provenance) of
                          (Just Text
t,Provenance
_) | Bool -> Bool
not(Text -> Bool
T.null Text
t) -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
":: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
                          (Maybe Text
_, ImportedFrom Text
mod)      -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
"from " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mod
                          (Maybe Text
_, DefinedIn Text
mod)         -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
"from " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mod
                          (Maybe Text, Provenance)
_                          -> Maybe Text
forall a. Maybe a
Nothing,
                  $sel:_documentation:CompletionItem :: Maybe (Text |? MarkupContent)
_documentation = Maybe (Text |? MarkupContent)
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
InsertTextFormat_Snippet,
                  $sel:_insertTextMode:CompletionItem :: Maybe InsertTextMode
_insertTextMode = Maybe InsertTextMode
forall a. Maybe a
Nothing,
                  $sel:_textEdit:CompletionItem :: Maybe (TextEdit |? InsertReplaceEdit)
_textEdit = Maybe (TextEdit |? InsertReplaceEdit)
forall a. Maybe a
Nothing,
                  $sel:_additionalTextEdits:CompletionItem :: Maybe [TextEdit]
_additionalTextEdits = Maybe [TextEdit]
forall a. Maybe a
Nothing,
                  $sel:_commitCharacters:CompletionItem :: Maybe [Text]
_commitCharacters = Maybe [Text]
forall a. Maybe a
Nothing,
                  $sel:_command:CompletionItem :: Maybe Command
_command = Maybe Command
mbCommand,
                  $sel:_data_:CompletionItem :: Maybe Value
_data_ = CompletionResolveData -> Value
forall a. ToJSON a => a -> Value
toJSON (CompletionResolveData -> Value)
-> Maybe CompletionResolveData -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NameDetails -> CompletionResolveData)
-> Maybe NameDetails -> Maybe CompletionResolveData
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Uri -> Bool -> NameDetails -> CompletionResolveData
CompletionResolveData Uri
uri (Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Text
typeText)) Maybe NameDetails
nameDetails,
                  $sel:_labelDetails:CompletionItem :: Maybe CompletionItemLabelDetails
_labelDetails = Maybe CompletionItemLabelDetails
forall a. Maybe a
Nothing,
                  $sel:_textEditText:CompletionItem :: Maybe Text
_textEditText = Maybe Text
forall a. Maybe a
Nothing}
  Bool -> CompletionItem -> CompletionItem
removeSnippetsWhen (Maybe Backtick -> Bool
forall a. Maybe a -> Bool
isJust Maybe Backtick
isInfix) CompletionItem
ci

  where kind :: Maybe CompletionItemKind
kind = CompletionItemKind -> Maybe CompletionItemKind
forall a. a -> Maybe a
Just CompletionItemKind
compKind
        docs' :: [Text]
docs' = [Text
imported]
        imported :: Text
imported = case Provenance
provenance of
          Local SrcSpan
pos  -> Text
"*Defined at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SrcLoc -> Text
pprLineCol (SrcSpan -> SrcLoc
srcSpanStart SrcSpan
pos) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in this module*\n"
          ImportedFrom Text
mod -> Text
"*Imported from '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mod Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'*\n"
          DefinedIn 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"
        documentation :: Maybe (Text |? MarkupContent)
documentation = (Text |? MarkupContent) -> Maybe (Text |? MarkupContent)
forall a. a -> Maybe a
Just ((Text |? MarkupContent) -> Maybe (Text |? MarkupContent))
-> (Text |? MarkupContent) -> Maybe (Text |? MarkupContent)
forall a b. (a -> b) -> a -> b
$ MarkupContent -> Text |? MarkupContent
forall a b. b -> a |? b
InR (MarkupContent -> Text |? MarkupContent)
-> MarkupContent -> Text |? MarkupContent
forall a b. (a -> b) -> a -> b
$
                        MarkupKind -> Text -> MarkupContent
MarkupContent MarkupKind
MarkupKind_Markdown (Text -> MarkupContent) -> Text -> MarkupContent
forall a b. (a -> b) -> a -> b
$
                        Text -> [Text] -> Text
T.intercalate Text
sectionSeparator [Text]
docs'
        pprLineCol :: SrcLoc -> T.Text
        pprLineCol :: SrcLoc -> Text
pprLineCol (UnhelpfulLoc FastString
fs) = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ FastString -> String
unpackFS FastString
fs
        pprLineCol (RealSrcLoc RealSrcLoc
loc Maybe BufPos
_) =
            Text
"line " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Outputable a => a -> Text
printOutputable (RealSrcLoc -> Int
srcLocLine RealSrcLoc
loc) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", column " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Outputable a => a -> Text
printOutputable (RealSrcLoc -> Int
srcLocCol RealSrcLoc
loc)


mkAdditionalEditsCommand :: Maybe PluginId -> ExtendImport -> Maybe Command
mkAdditionalEditsCommand :: Maybe PluginId -> ExtendImport -> Maybe Command
mkAdditionalEditsCommand (Just PluginId
pId) ExtendImport
edits = Command -> Maybe Command
forall a. a -> Maybe a
Just (Command -> Maybe Command) -> Command -> Maybe Command
forall a b. (a -> b) -> a -> b
$ PluginId -> CommandId -> Text -> Maybe [Value] -> Command
mkLspCommand PluginId
pId (Text -> CommandId
CommandId Text
extendImportCommandId) Text
"extend import" ([Value] -> Maybe [Value]
forall a. a -> Maybe a
Just [ExtendImport -> Value
forall a. ToJSON a => a -> Value
toJSON ExtendImport
edits])
mkAdditionalEditsCommand Maybe PluginId
_ ExtendImport
_ = Maybe Command
forall a. Maybe a
Nothing

mkNameCompItem :: Uri -> Maybe T.Text -> OccName -> Provenance -> Maybe Backtick -> Maybe (LImportDecl GhcPs) -> Maybe Module -> CompItem
mkNameCompItem :: Uri
-> Maybe Text
-> OccName
-> Provenance
-> Maybe Backtick
-> Maybe (LImportDecl GhcPs)
-> Maybe Module
-> CompItem
mkNameCompItem Uri
doc Maybe Text
thingParent OccName
origName Provenance
provenance Maybe Backtick
isInfix !Maybe (LImportDecl GhcPs)
imp Maybe Module
mod = CI {Bool
Maybe Text
Maybe NameDetails
Maybe ExtendImport
Maybe Backtick
Text
CompletionItemKind
Provenance
forall a. Maybe a
compKind :: CompletionItemKind
isInfix :: Maybe Backtick
insertText :: Text
provenance :: Provenance
label :: Text
typeText :: Maybe Text
additionalTextEdits :: Maybe ExtendImport
nameDetails :: Maybe NameDetails
provenance :: Provenance
isInfix :: Maybe Backtick
isLocalCompletion :: Bool
nameDetails :: Maybe NameDetails
compKind :: CompletionItemKind
isTypeCompl :: Bool
typeText :: forall a. Maybe a
label :: Text
insertText :: Text
additionalTextEdits :: Maybe ExtendImport
isTypeCompl :: Bool
isLocalCompletion :: Bool
..}
  where
    isLocalCompletion :: Bool
isLocalCompletion = Bool
True
    nameDetails :: Maybe NameDetails
nameDetails = Module -> OccName -> NameDetails
NameDetails (Module -> OccName -> NameDetails)
-> Maybe Module -> Maybe (OccName -> NameDetails)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Module
mod Maybe (OccName -> NameDetails)
-> Maybe OccName -> Maybe NameDetails
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OccName -> Maybe OccName
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OccName
origName
    compKind :: CompletionItemKind
compKind = OccName -> CompletionItemKind
occNameToComKind OccName
origName
    isTypeCompl :: Bool
isTypeCompl = OccName -> Bool
isTcOcc OccName
origName
    typeText :: Maybe a
typeText = Maybe a
forall a. Maybe a
Nothing
    label :: Text
label = Text -> Text
stripPrefix (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ OccName -> Text
forall a. Outputable a => a -> Text
printOutputable OccName
origName
    insertText :: Text
insertText = case Maybe Backtick
isInfix of
            Maybe Backtick
Nothing         -> Text
label
            Just Backtick
LeftSide   -> Text
label Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`"

            Just Backtick
Surrounded -> Text
label
    additionalTextEdits :: Maybe ExtendImport
additionalTextEdits =
      Maybe (LImportDecl GhcPs)
Maybe (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
imp Maybe (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ExtendImport)
-> Maybe ExtendImport
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \GenLocated SrcSpanAnnA (ImportDecl GhcPs)
x ->
        ExtendImport
          { Uri
doc :: Uri
doc :: Uri
doc,
            Maybe Text
thingParent :: Maybe Text
thingParent :: Maybe Text
thingParent,
            importName :: Text
importName = ModuleName -> Text
showModName (ModuleName -> Text) -> ModuleName -> Text
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnA ModuleName -> ModuleName)
-> GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall a b. (a -> b) -> a -> b
$ ImportDecl GhcPs -> XRec GhcPs ModuleName
forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName (ImportDecl GhcPs -> XRec GhcPs ModuleName)
-> ImportDecl GhcPs -> XRec GhcPs ModuleName
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (ImportDecl GhcPs)
x,
            importQual :: Maybe Text
importQual = LImportDecl GhcPs -> Maybe Text
getImportQual LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
x,
            newThing :: Text
newThing = OccName -> Text
forall a. Outputable a => a -> Text
printOutputable OccName
origName
          }

showForSnippet :: Outputable a => a -> T.Text
showForSnippet :: forall a. Outputable a => a -> Text
showForSnippet a
x = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ SDocContext -> SDoc -> String
renderWithContext SDocContext
ctxt (SDoc -> String) -> SDoc -> String
forall a b. (a -> b) -> a -> b
$ a -> SDoc
forall a. Outputable a => a -> SDoc
GHC.ppr a
x -- FIXme
    where
        ctxt :: SDocContext
ctxt = SDocContext
defaultSDocContext{sdocStyle = mkUserStyle neverQualify AllTheWay}

mkModCompl :: T.Text -> CompletionItem
mkModCompl :: Text -> CompletionItem
mkModCompl Text
label =
    Text -> CompletionItem
defaultCompletionItemWithLabel Text
label
    CompletionItem
-> (CompletionItem -> CompletionItem) -> CompletionItem
forall a b. a -> (a -> b) -> b
& (Maybe CompletionItemKind -> Identity (Maybe CompletionItemKind))
-> CompletionItem -> Identity CompletionItem
forall s a. HasKind s a => Lens' s a
Lens' CompletionItem (Maybe CompletionItemKind)
L.kind ((Maybe CompletionItemKind -> Identity (Maybe CompletionItemKind))
 -> CompletionItem -> Identity CompletionItem)
-> CompletionItemKind -> CompletionItem -> CompletionItem
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ CompletionItemKind
CompletionItemKind_Module

mkModuleFunctionImport :: T.Text -> T.Text -> CompletionItem
mkModuleFunctionImport :: Text -> Text -> CompletionItem
mkModuleFunctionImport Text
moduleName Text
label =
    Text -> CompletionItem
defaultCompletionItemWithLabel Text
label
    CompletionItem
-> (CompletionItem -> CompletionItem) -> CompletionItem
forall a b. a -> (a -> b) -> b
& (Maybe CompletionItemKind -> Identity (Maybe CompletionItemKind))
-> CompletionItem -> Identity CompletionItem
forall s a. HasKind s a => Lens' s a
Lens' CompletionItem (Maybe CompletionItemKind)
L.kind ((Maybe CompletionItemKind -> Identity (Maybe CompletionItemKind))
 -> CompletionItem -> Identity CompletionItem)
-> CompletionItemKind -> CompletionItem -> CompletionItem
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ CompletionItemKind
CompletionItemKind_Function
    CompletionItem
-> (CompletionItem -> CompletionItem) -> CompletionItem
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text))
-> CompletionItem -> Identity CompletionItem
forall s a. HasDetail s a => Lens' s a
Lens' CompletionItem (Maybe Text)
L.detail ((Maybe Text -> Identity (Maybe Text))
 -> CompletionItem -> Identity CompletionItem)
-> Text -> CompletionItem -> CompletionItem
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
moduleName

mkImportCompl :: T.Text -> T.Text -> CompletionItem
mkImportCompl :: Text -> Text -> CompletionItem
mkImportCompl Text
enteredQual Text
label =
    Text -> CompletionItem
defaultCompletionItemWithLabel Text
m
    CompletionItem
-> (CompletionItem -> CompletionItem) -> CompletionItem
forall a b. a -> (a -> b) -> b
& (Maybe CompletionItemKind -> Identity (Maybe CompletionItemKind))
-> CompletionItem -> Identity CompletionItem
forall s a. HasKind s a => Lens' s a
Lens' CompletionItem (Maybe CompletionItemKind)
L.kind ((Maybe CompletionItemKind -> Identity (Maybe CompletionItemKind))
 -> CompletionItem -> Identity CompletionItem)
-> CompletionItemKind -> CompletionItem -> CompletionItem
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ CompletionItemKind
CompletionItemKind_Module
    CompletionItem
-> (CompletionItem -> CompletionItem) -> CompletionItem
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text))
-> CompletionItem -> Identity CompletionItem
forall s a. HasDetail s a => Lens' s a
Lens' CompletionItem (Maybe Text)
L.detail ((Maybe Text -> Identity (Maybe Text))
 -> CompletionItem -> Identity CompletionItem)
-> Text -> CompletionItem -> CompletionItem
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
label
  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 -> CompletionItem
defaultCompletionItemWithLabel Text
label
    CompletionItem
-> (CompletionItem -> CompletionItem) -> CompletionItem
forall a b. a -> (a -> b) -> b
& (Maybe CompletionItemKind -> Identity (Maybe CompletionItemKind))
-> CompletionItem -> Identity CompletionItem
forall s a. HasKind s a => Lens' s a
Lens' CompletionItem (Maybe CompletionItemKind)
L.kind ((Maybe CompletionItemKind -> Identity (Maybe CompletionItemKind))
 -> CompletionItem -> Identity CompletionItem)
-> CompletionItemKind -> CompletionItem -> CompletionItem
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ CompletionItemKind
CompletionItemKind_Keyword

defaultCompletionItemWithLabel :: T.Text -> CompletionItem
defaultCompletionItemWithLabel :: Text -> CompletionItem
defaultCompletionItemWithLabel Text
label =
    Text
-> Maybe CompletionItemLabelDetails
-> Maybe CompletionItemKind
-> Maybe [CompletionItemTag]
-> Maybe Text
-> Maybe (Text |? MarkupContent)
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe InsertTextFormat
-> Maybe InsertTextMode
-> Maybe (TextEdit |? InsertReplaceEdit)
-> Maybe Text
-> Maybe [TextEdit]
-> Maybe [Text]
-> Maybe Command
-> Maybe Value
-> CompletionItem
CompletionItem Text
label Maybe CompletionItemLabelDetails
forall a. Default a => a
def Maybe CompletionItemKind
forall a. Default a => a
def Maybe [CompletionItemTag]
forall a. Default a => a
def Maybe Text
forall a. Default a => a
def Maybe (Text |? MarkupContent)
forall a. Default a => a
def Maybe Bool
forall a. Default a => a
def Maybe Bool
forall a. Default a => a
def Maybe Text
forall a. Default a => a
def Maybe Text
forall a. Default a => a
def
                         Maybe Text
forall a. Default a => a
def Maybe InsertTextFormat
forall a. Default a => a
def Maybe InsertTextMode
forall a. Default a => a
def Maybe (TextEdit |? InsertReplaceEdit)
forall a. Default a => a
def Maybe Text
forall a. Default a => a
def Maybe [TextEdit]
forall a. Default a => a
def Maybe [Text]
forall a. Default a => a
def Maybe Command
forall a. Default a => a
def Maybe Value
forall a. Default a => a
def

fromIdentInfo :: Uri -> IdentInfo -> Maybe T.Text -> CompItem
fromIdentInfo :: Uri -> IdentInfo -> Maybe Text -> CompItem
fromIdentInfo Uri
doc identInfo :: IdentInfo
identInfo@IdentInfo{Maybe OccName
ModuleName
OccName
name :: OccName
parent :: Maybe OccName
identModuleName :: ModuleName
name :: IdentInfo -> OccName
parent :: IdentInfo -> Maybe OccName
identModuleName :: IdentInfo -> ModuleName
..} Maybe Text
q = CI
  { compKind :: CompletionItemKind
compKind= OccName -> CompletionItemKind
occNameToComKind OccName
name
  , insertText :: Text
insertText=Text
rend
  , provenance :: Provenance
provenance = Text -> Provenance
DefinedIn Text
mod
  , label :: Text
label=Text
rend
  , typeText :: Maybe Text
typeText = Maybe Text
forall a. Maybe a
Nothing
  , isInfix :: Maybe Backtick
isInfix=Maybe Backtick
forall a. Maybe a
Nothing
  , isTypeCompl :: Bool
isTypeCompl= Bool -> Bool
not (IdentInfo -> Bool
isDatacon IdentInfo
identInfo) Bool -> Bool -> Bool
&& Char -> Bool
isUpper (HasCallStack => Text -> Char
Text -> Char
T.head Text
rend)
  , additionalTextEdits :: Maybe ExtendImport
additionalTextEdits= ExtendImport -> Maybe ExtendImport
forall a. a -> Maybe a
Just (ExtendImport -> Maybe ExtendImport)
-> ExtendImport -> Maybe ExtendImport
forall a b. (a -> b) -> a -> b
$
        ExtendImport
          { Uri
doc :: Uri
doc :: Uri
doc,
            thingParent :: Maybe Text
thingParent = OccName -> Text
occNameText (OccName -> Text) -> Maybe OccName -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe OccName
parent,
            importName :: Text
importName = Text
mod,
            importQual :: Maybe Text
importQual = Maybe Text
q,
            newThing :: Text
newThing = Text
rend
          }
  , nameDetails :: Maybe NameDetails
nameDetails = Maybe NameDetails
forall a. Maybe a
Nothing
  , isLocalCompletion :: Bool
isLocalCompletion = Bool
False
  }
  where rend :: Text
rend = IdentInfo -> Text
rendered IdentInfo
identInfo
        mod :: Text
mod = IdentInfo -> Text
moduleNameText IdentInfo
identInfo

cacheDataProducer :: Uri -> [ModuleName] -> Module -> GlobalRdrEnv-> GlobalRdrEnv -> [LImportDecl GhcPs] -> CachedCompletions
cacheDataProducer :: Uri
-> [ModuleName]
-> Module
-> GlobalRdrEnv
-> GlobalRdrEnv
-> [LImportDecl GhcPs]
-> CachedCompletions
cacheDataProducer Uri
uri [ModuleName]
visibleMods Module
curMod GlobalRdrEnv
globalEnv GlobalRdrEnv
inScopeEnv [LImportDecl GhcPs]
limports =
  let curModName :: ModuleName
curModName = Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
curMod
      curModNameText :: Text
curModNameText = ModuleName -> Text
forall a. Outputable a => a -> Text
printOutputable ModuleName
curModName

      importMap :: Map RealSrcSpan (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
importMap = [(RealSrcSpan, GenLocated SrcSpanAnnA (ImportDecl GhcPs))]
-> Map RealSrcSpan (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (RealSrcSpan
l, GenLocated SrcSpanAnnA (ImportDecl GhcPs)
imp) | imp :: GenLocated SrcSpanAnnA (ImportDecl GhcPs)
imp@(L (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA -> (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_)) ImportDecl GhcPs
_) <- [LImportDecl GhcPs]
[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
limports ]

      iDeclToModName :: ImportDecl GhcPs -> ModuleName
      iDeclToModName :: ImportDecl GhcPs -> ModuleName
iDeclToModName = GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnA ModuleName -> ModuleName)
-> (ImportDecl GhcPs -> GenLocated SrcSpanAnnA ModuleName)
-> ImportDecl GhcPs
-> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl GhcPs -> XRec GhcPs ModuleName
ImportDecl GhcPs -> GenLocated SrcSpanAnnA ModuleName
forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName

      asNamespace :: ImportDecl GhcPs -> ModuleName
      asNamespace :: ImportDecl GhcPs -> ModuleName
asNamespace ImportDecl GhcPs
imp = ModuleName
-> (GenLocated SrcSpanAnnA ModuleName -> ModuleName)
-> Maybe (GenLocated SrcSpanAnnA ModuleName)
-> ModuleName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ImportDecl GhcPs -> ModuleName
iDeclToModName ImportDecl GhcPs
imp) GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
GHC.unLoc (ImportDecl GhcPs -> Maybe (XRec GhcPs ModuleName)
forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclAs ImportDecl GhcPs
imp)
      -- Full canonical names of imported modules
      importDeclarations :: [ImportDecl GhcPs]
importDeclarations = (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [ImportDecl GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
unLoc [LImportDecl GhcPs]
[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
limports


      -- 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
asNamespace) [ImportDecl GhcPs]
importDeclarations

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

      -- construct a map from Parents(type) to their fields
      fieldMap :: Map Name [FieldLabelString]
fieldMap = ([FieldLabelString] -> [FieldLabelString] -> [FieldLabelString])
-> [(Name, [FieldLabelString])] -> Map Name [FieldLabelString]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [FieldLabelString] -> [FieldLabelString] -> [FieldLabelString]
forall a. [a] -> [a] -> [a]
(++) ([(Name, [FieldLabelString])] -> Map Name [FieldLabelString])
-> [(Name, [FieldLabelString])] -> Map Name [FieldLabelString]
forall a b. (a -> b) -> a -> b
$ ((GlobalRdrElt -> Maybe (Name, [FieldLabelString]))
 -> [GlobalRdrElt] -> [(Name, [FieldLabelString])])
-> [GlobalRdrElt]
-> (GlobalRdrElt -> Maybe (Name, [FieldLabelString]))
-> [(Name, [FieldLabelString])]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (GlobalRdrElt -> Maybe (Name, [FieldLabelString]))
-> [GlobalRdrElt] -> [(Name, [FieldLabelString])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [GlobalRdrElt]
rdrElts ((GlobalRdrElt -> Maybe (Name, [FieldLabelString]))
 -> [(Name, [FieldLabelString])])
-> (GlobalRdrElt -> Maybe (Name, [FieldLabelString]))
-> [(Name, [FieldLabelString])]
forall a b. (a -> b) -> a -> b
$ \GlobalRdrElt
elt -> do
        Name
par <- GlobalRdrElt -> Maybe Name
greParent_maybe GlobalRdrElt
elt
#if MIN_VERSION_ghc(9,7,0)
        flbl <- greFieldLabel_maybe elt
#else
        FieldLabel
flbl <- GlobalRdrElt -> Maybe FieldLabel
greFieldLabel GlobalRdrElt
elt
#endif
        (Name, [FieldLabelString]) -> Maybe (Name, [FieldLabelString])
forall a. a -> Maybe a
Just (Name
par,[FieldLabel -> FieldLabelString
flLabel FieldLabel
flbl])

      getCompls :: [GlobalRdrElt] -> ([CompItem],QualCompls)
      getCompls :: [GlobalRdrElt] -> ([CompItem], QualCompls)
getCompls = (GlobalRdrElt -> ([CompItem], QualCompls))
-> [GlobalRdrElt] -> ([CompItem], QualCompls)
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap GlobalRdrElt -> ([CompItem], QualCompls)
getComplsForOne

      getComplsForOne :: GlobalRdrElt -> ([CompItem],QualCompls)
      getComplsForOne :: GlobalRdrElt -> ([CompItem], QualCompls)
getComplsForOne (GRE Name
n Parent
par Bool
True [ImportSpec]
_) =
          (Parent
-> Module
-> Text
-> Name
-> Maybe (LImportDecl GhcPs)
-> [CompItem]
toCompItem Parent
par Module
curMod Text
curModNameText Name
n Maybe (LImportDecl GhcPs)
Maybe (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
forall a. Maybe a
Nothing, QualCompls
forall a. Monoid a => a
mempty)
      getComplsForOne (GRE Name
n Parent
par Bool
False [ImportSpec]
prov) =
        ((ImpDeclSpec -> ([CompItem], QualCompls))
 -> [ImpDeclSpec] -> ([CompItem], QualCompls))
-> [ImpDeclSpec]
-> (ImpDeclSpec -> ([CompItem], QualCompls))
-> ([CompItem], QualCompls)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ImpDeclSpec -> ([CompItem], QualCompls))
-> [ImpDeclSpec] -> ([CompItem], QualCompls)
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((ImportSpec -> ImpDeclSpec) -> [ImportSpec] -> [ImpDeclSpec]
forall a b. (a -> b) -> [a] -> [b]
map ImportSpec -> ImpDeclSpec
is_decl [ImportSpec]
prov) ((ImpDeclSpec -> ([CompItem], QualCompls))
 -> ([CompItem], QualCompls))
-> (ImpDeclSpec -> ([CompItem], QualCompls))
-> ([CompItem], QualCompls)
forall a b. (a -> b) -> a -> b
$ \ImpDeclSpec
spec ->
          let originalImportDecl :: Maybe (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
originalImportDecl = do
                -- we don't want to extend import if it's already in scope
                Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ())
-> (Maybe GlobalRdrElt -> Bool) -> Maybe GlobalRdrElt -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe GlobalRdrElt -> Bool
forall a. Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Maybe GlobalRdrElt -> Maybe ()) -> Maybe GlobalRdrElt -> Maybe ()
forall a b. (a -> b) -> a -> b
$ GlobalRdrEnv -> Name -> Maybe GlobalRdrElt
lookupGRE_Name GlobalRdrEnv
inScopeEnv Name
n
                -- or if it doesn't have a real location
                RealSrcSpan
loc <- SrcSpan -> Maybe RealSrcSpan
realSpan (SrcSpan -> Maybe RealSrcSpan) -> SrcSpan -> Maybe RealSrcSpan
forall a b. (a -> b) -> a -> b
$ ImpDeclSpec -> SrcSpan
is_dloc ImpDeclSpec
spec
                RealSrcSpan
-> Map RealSrcSpan (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> Maybe (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup RealSrcSpan
loc Map RealSrcSpan (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
importMap
              compItem :: [CompItem]
compItem = Parent
-> Module
-> Text
-> Name
-> Maybe (LImportDecl GhcPs)
-> [CompItem]
toCompItem Parent
par Module
curMod (ModuleName -> Text
forall a. Outputable a => a -> Text
printOutputable (ModuleName -> Text) -> ModuleName -> Text
forall a b. (a -> b) -> a -> b
$ ImpDeclSpec -> ModuleName
is_mod ImpDeclSpec
spec) Name
n Maybe (LImportDecl GhcPs)
Maybe (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
originalImportDecl
              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)
#if MIN_VERSION_ghc(9,8,0)
              origMod = showModName (moduleName $ is_mod spec)
#else
              origMod :: Text
origMod = ModuleName -> Text
showModName (ImpDeclSpec -> ModuleName
is_mod ImpDeclSpec
spec)
#endif
          in ([CompItem]
unqual,Map Text [CompItem] -> QualCompls
QualCompls Map Text [CompItem]
qual)

      toCompItem :: Parent -> Module -> T.Text -> Name -> Maybe (LImportDecl GhcPs) -> [CompItem]
      toCompItem :: Parent
-> Module
-> Text
-> Name
-> Maybe (LImportDecl GhcPs)
-> [CompItem]
toCompItem Parent
par Module
_ Text
mn Name
n Maybe (LImportDecl GhcPs)
imp' =
        -- docs <- getDocumentationTryGhc packageState curMod n
        let (Maybe Text
mbParent, OccName
originName) = case Parent
par of
                            Parent
NoParent -> (Maybe Text
forall a. Maybe a
Nothing, Name -> OccName
nameOccName Name
n)
                            ParentIs Name
n' -> (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (String -> Text) -> String -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Maybe Text) -> String -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Name -> String
printName Name
n', Name -> OccName
nameOccName Name
n)
            recordCompls :: [CompItem]
recordCompls = case Parent
par of
                ParentIs Name
parent
                  | Name -> Bool
isDataConName Name
n
                  , Just [FieldLabelString]
flds <- Name -> Map Name [FieldLabelString] -> Maybe [FieldLabelString]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
parent Map Name [FieldLabelString]
fieldMap
                  , Bool -> Bool
not ([FieldLabelString] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FieldLabelString]
flds) ->
                    [Uri
-> Maybe Text
-> Text
-> [Text]
-> Provenance
-> Maybe (LImportDecl GhcPs)
-> CompItem
mkRecordSnippetCompItem Uri
uri Maybe Text
mbParent (OccName -> Text
forall a. Outputable a => a -> Text
printOutputable OccName
originName) ((FieldLabelString -> Text) -> [FieldLabelString] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack (String -> Text)
-> (FieldLabelString -> String) -> FieldLabelString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> String
unpackFS (FastString -> String)
-> (FieldLabelString -> FastString) -> FieldLabelString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLabelString -> FastString
field_label) [FieldLabelString]
flds) (Text -> Provenance
ImportedFrom Text
mn) Maybe (LImportDecl GhcPs)
imp']
                Parent
_ -> []

        in Uri
-> Maybe Text
-> OccName
-> Provenance
-> Maybe Backtick
-> Maybe (LImportDecl GhcPs)
-> Maybe Module
-> CompItem
mkNameCompItem Uri
uri Maybe Text
mbParent OccName
originName (Text -> Provenance
ImportedFrom Text
mn) Maybe Backtick
forall a. Maybe a
Nothing Maybe (LImportDecl GhcPs)
imp' (Name -> Maybe Module
nameModule_maybe Name
n)
           CompItem -> [CompItem] -> [CompItem]
forall a. a -> [a] -> [a]
: [CompItem]
recordCompls

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

      -- 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 [ModuleName]
visibleMods

  in CC
    { allModNamesAsNS :: [Text]
allModNamesAsNS = [Text]
allModNamesAsNS
    , unqualCompls :: [CompItem]
unqualCompls = [CompItem]
unquals
    , qualCompls :: QualCompls
qualCompls = QualCompls
quals
    , anyQualCompls :: [Maybe Text -> CompItem]
anyQualCompls = []
    , importableModules :: [Text]
importableModules = [Text]
moduleNames
    }

-- | Produces completions from the top level declarations of a module.
localCompletionsForParsedModule :: Uri -> ParsedModule -> CachedCompletions
localCompletionsForParsedModule :: Uri -> ParsedModule -> CachedCompletions
localCompletionsForParsedModule Uri
uri pm :: ParsedModule
pm@ParsedModule{pm_parsed_source :: ParsedModule -> GenLocated SrcSpan (HsModule GhcPs)
pm_parsed_source = L SrcSpan
_ HsModule{[LHsDecl GhcPs]
hsmodDecls :: forall p. HsModule p -> [LHsDecl p]
hsmodDecls :: [LHsDecl GhcPs]
hsmodDecls}} =
    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
       , anyQualCompls :: [Maybe Text -> CompItem]
anyQualCompls = []
       , 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
identifier
            | L SrcSpanAnnA
_ (SigD XSigD GhcPs
_ (TypeSig XTypeSig GhcPs
_ [LIdP GhcPs]
ids LHsSigWcType GhcPs
_)) <- [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
hsmodDecls
            , L SrcSpanAnnN
_ RdrName
identifier <- [LIdP GhcPs]
[GenLocated SrcSpanAnnN RdrName]
ids
            ]
    hasTypeSig :: GenLocated SrcSpanAnnN RdrName -> Bool
hasTypeSig = (RdrName -> Set RdrName -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set RdrName
typeSigIds) (RdrName -> Bool)
-> (GenLocated SrcSpanAnnN RdrName -> RdrName)
-> GenLocated SrcSpanAnnN RdrName
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
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
_ [LIdP GhcPs]
ids LHsSigWcType GhcPs
typ) ->
                [GenLocated SrcSpanAnnN RdrName
-> CompletionItemKind -> Maybe Text -> CompItem
mkComp GenLocated SrcSpanAnnN RdrName
identifier CompletionItemKind
CompletionItemKind_Function (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
-> Text
forall a. Outputable a => a -> Text
showForSnippet LHsSigWcType GhcPs
HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
typ) | GenLocated SrcSpanAnnN RdrName
identifier <- [LIdP GhcPs]
[GenLocated SrcSpanAnnN RdrName]
ids]
            ValD XValD GhcPs
_ FunBind{LIdP GhcPs
fun_id :: LIdP GhcPs
fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id} ->
                [ GenLocated SrcSpanAnnN RdrName
-> CompletionItemKind -> Maybe Text -> CompItem
mkComp LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
fun_id CompletionItemKind
CompletionItemKind_Function Maybe Text
forall a. Maybe a
Nothing
                | Bool -> Bool
not (GenLocated SrcSpanAnnN RdrName -> Bool
hasTypeSig LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
fun_id)
                ]
            ValD XValD GhcPs
_ PatBind{LPat GhcPs
pat_lhs :: LPat GhcPs
pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
pat_lhs} ->
                [GenLocated SrcSpanAnnN RdrName
-> CompletionItemKind -> Maybe Text -> CompItem
mkComp LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
identifier CompletionItemKind
CompletionItemKind_Variable Maybe Text
forall a. Maybe a
Nothing
                | VarPat XVarPat GhcPs
_ LIdP GhcPs
identifier <- (Pat GhcPs -> Bool) -> GenericQ [Pat GhcPs]
forall r. Typeable r => (r -> Bool) -> GenericQ [r]
listify (\(Pat GhcPs
_ :: Pat GhcPs) -> Bool
True) LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat_lhs]
            TyClD XTyClD GhcPs
_ ClassDecl{LIdP GhcPs
tcdLName :: LIdP GhcPs
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName, [LSig GhcPs]
tcdSigs :: [LSig GhcPs]
tcdSigs :: forall pass. TyClDecl pass -> [LSig pass]
tcdSigs, [LFamilyDecl GhcPs]
tcdATs :: [LFamilyDecl GhcPs]
tcdATs :: forall pass. TyClDecl pass -> [LFamilyDecl pass]
tcdATs} ->
                GenLocated SrcSpanAnnN RdrName
-> CompletionItemKind -> Maybe Text -> CompItem
mkComp LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
tcdLName CompletionItemKind
CompletionItemKind_Interface (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN RdrName -> Text
forall a. Outputable a => a -> Text
showForSnippet LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
tcdLName) CompItem -> [CompItem] -> [CompItem]
forall a. a -> [a] -> [a]
:
                [ GenLocated SrcSpanAnnN RdrName
-> CompletionItemKind -> Maybe Text -> CompItem
mkComp GenLocated SrcSpanAnnN RdrName
identifier CompletionItemKind
CompletionItemKind_Function (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Text
forall a. Outputable a => a -> Text
showForSnippet LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
typ)
                | L SrcSpanAnnA
_ (ClassOpSig XClassOpSig GhcPs
_ Bool
_ [LIdP GhcPs]
ids LHsSigType GhcPs
typ) <- [LSig GhcPs]
[GenLocated SrcSpanAnnA (Sig GhcPs)]
tcdSigs
                , GenLocated SrcSpanAnnN RdrName
identifier <- [LIdP GhcPs]
[GenLocated SrcSpanAnnN RdrName]
ids] [CompItem] -> [CompItem] -> [CompItem]
forall a. [a] -> [a] -> [a]
++
                [ GenLocated SrcSpanAnnN RdrName
-> CompletionItemKind -> Maybe Text -> CompItem
mkComp LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
fdLName CompletionItemKind
CompletionItemKind_Struct (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN RdrName -> Text
forall a. Outputable a => a -> Text
showForSnippet LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
fdLName)
                | L SrcSpanAnnA
_ (FamilyDecl{LIdP GhcPs
fdLName :: LIdP GhcPs
fdLName :: forall pass. FamilyDecl pass -> LIdP pass
fdLName}) <- [LFamilyDecl GhcPs]
[GenLocated SrcSpanAnnA (FamilyDecl GhcPs)]
tcdATs]
            TyClD XTyClD GhcPs
_ TyClDecl GhcPs
x ->
                let generalCompls :: [CompItem]
generalCompls = [GenLocated SrcSpanAnnN RdrName
-> CompletionItemKind -> Maybe Text -> CompItem
mkComp GenLocated SrcSpanAnnN RdrName
identifier CompletionItemKind
cl (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN RdrName -> Text
forall a. Outputable a => a -> Text
showForSnippet (GenLocated SrcSpanAnnN RdrName -> Text)
-> GenLocated SrcSpanAnnN RdrName -> Text
forall a b. (a -> b) -> a -> b
$ TyClDecl GhcPs -> LocatedN (IdP GhcPs)
forall (p :: Pass).
(Anno (IdGhcP p) ~ SrcSpanAnnN) =>
TyClDecl (GhcPass p) -> LocatedN (IdP (GhcPass p))
tyClDeclLName TyClDecl GhcPs
x)
                        | GenLocated SrcSpanAnnN RdrName
identifier <- (GenLocated SrcSpanAnnN RdrName -> Bool)
-> GenericQ [GenLocated SrcSpanAnnN RdrName]
forall r. Typeable r => (r -> Bool) -> GenericQ [r]
listify (\(LIdP GhcPs
_ :: LIdP GhcPs) -> Bool
True) TyClDecl GhcPs
x
                        , let cl :: CompletionItemKind
cl = OccName -> CompletionItemKind
occNameToComKind (RdrName -> OccName
rdrNameOcc (RdrName -> OccName) -> RdrName -> OccName
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN RdrName
identifier)]
                    -- here we only have to look at the outermost type
                    recordCompls :: [CompItem]
recordCompls = Uri -> Provenance -> TyClDecl GhcPs -> [CompItem]
findRecordCompl Uri
uri (SrcSpan -> Provenance
Local SrcSpan
pos) 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{LIdP GhcPs
fd_name :: LIdP GhcPs
fd_name :: forall pass. ForeignDecl pass -> LIdP pass
fd_name,LHsSigType GhcPs
fd_sig_ty :: LHsSigType GhcPs
fd_sig_ty :: forall pass. ForeignDecl pass -> LHsSigType pass
fd_sig_ty} ->
                [GenLocated SrcSpanAnnN RdrName
-> CompletionItemKind -> Maybe Text -> CompItem
mkComp LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
fd_name CompletionItemKind
CompletionItemKind_Variable (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Text
forall a. Outputable a => a -> Text
showForSnippet LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
fd_sig_ty)]
            ForD XForD GhcPs
_ ForeignExport{LIdP GhcPs
fd_name :: forall pass. ForeignDecl pass -> LIdP pass
fd_name :: LIdP GhcPs
fd_name,LHsSigType GhcPs
fd_sig_ty :: forall pass. ForeignDecl pass -> LHsSigType pass
fd_sig_ty :: LHsSigType GhcPs
fd_sig_ty} ->
                [GenLocated SrcSpanAnnN RdrName
-> CompletionItemKind -> Maybe Text -> CompItem
mkComp LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
fd_name CompletionItemKind
CompletionItemKind_Variable (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Text
forall a. Outputable a => a -> Text
showForSnippet LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
fd_sig_ty)]
            HsDecl GhcPs
_ -> []
            | L (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA -> SrcSpan
pos) HsDecl GhcPs
decl <- [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
hsmodDecls,
            let mkComp :: GenLocated SrcSpanAnnN RdrName
-> CompletionItemKind -> Maybe Text -> CompItem
mkComp = SrcSpan
-> GenLocated SrcSpanAnnN RdrName
-> CompletionItemKind
-> Maybe Text
-> CompItem
mkLocalComp SrcSpan
pos
        ]

    mkLocalComp :: SrcSpan
-> GenLocated SrcSpanAnnN RdrName
-> CompletionItemKind
-> Maybe Text
-> CompItem
mkLocalComp SrcSpan
pos GenLocated SrcSpanAnnN RdrName
n CompletionItemKind
ctyp Maybe Text
ty =
        CompletionItemKind
-> Text
-> Provenance
-> Text
-> Maybe Text
-> Maybe Backtick
-> Bool
-> Maybe ExtendImport
-> Maybe NameDetails
-> Bool
-> CompItem
CI CompletionItemKind
ctyp Text
pn (SrcSpan -> Provenance
Local SrcSpan
pos) Text
pn Maybe Text
ty Maybe Backtick
forall a. Maybe a
Nothing (CompletionItemKind
ctyp CompletionItemKind -> [CompletionItemKind] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CompletionItemKind
CompletionItemKind_Struct, CompletionItemKind
CompletionItemKind_Interface]) Maybe ExtendImport
forall a. Maybe a
Nothing (NameDetails -> Maybe NameDetails
forall a. a -> Maybe a
Just (NameDetails -> Maybe NameDetails)
-> NameDetails -> Maybe NameDetails
forall a b. (a -> b) -> a -> b
$ Module -> OccName -> NameDetails
NameDetails (ModSummary -> Module
ms_mod (ModSummary -> Module) -> ModSummary -> Module
forall a b. (a -> b) -> a -> b
$ ParsedModule -> ModSummary
pm_mod_summary ParsedModule
pm) OccName
occ) Bool
True
      where
        occ :: OccName
occ = RdrName -> OccName
rdrNameOcc (RdrName -> OccName) -> RdrName -> OccName
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN RdrName
n
        pn :: Text
pn = GenLocated SrcSpanAnnN RdrName -> Text
forall a. Outputable a => a -> Text
showForSnippet GenLocated SrcSpanAnnN RdrName
n

findRecordCompl :: Uri -> Provenance -> TyClDecl GhcPs -> [CompItem]
findRecordCompl :: Uri -> Provenance -> TyClDecl GhcPs -> [CompItem]
findRecordCompl Uri
uri Provenance
mn DataDecl {LIdP GhcPs
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName :: LIdP GhcPs
tcdLName, HsDataDefn GhcPs
tcdDataDefn :: HsDataDefn GhcPs
tcdDataDefn :: forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn} = [CompItem]
result
    where
        result :: [CompItem]
result = [Uri
-> Maybe Text
-> Text
-> [Text]
-> Provenance
-> Maybe (LImportDecl GhcPs)
-> CompItem
mkRecordSnippetCompItem Uri
uri (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ RdrName -> Text
forall a. Outputable a => a -> Text
printOutputable (RdrName -> Text) -> RdrName -> Text
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
tcdLName)
                        (RdrName -> Text
forall a. Outputable a => a -> Text
printOutputable (RdrName -> Text) -> (LIdP GhcPs -> RdrName) -> LIdP GhcPs -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LIdP GhcPs -> RdrName
GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc (LIdP GhcPs -> Text) -> LIdP GhcPs -> Text
forall a b. (a -> b) -> a -> b
$ LIdP GhcPs
con_name) [Text]
field_labels Provenance
mn Maybe (LImportDecl GhcPs)
Maybe (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
forall a. Maybe a
Nothing
                 | ConDeclH98{Bool
[LHsTyVarBndr Specificity GhcPs]
Maybe (LHsContext GhcPs)
Maybe (LHsDoc GhcPs)
XConDeclH98 GhcPs
LIdP GhcPs
HsConDeclH98Details GhcPs
con_name :: LIdP GhcPs
con_ext :: XConDeclH98 GhcPs
con_forall :: Bool
con_ex_tvs :: [LHsTyVarBndr Specificity GhcPs]
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_args :: HsConDeclH98Details GhcPs
con_doc :: Maybe (LHsDoc GhcPs)
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_doc :: forall pass. ConDecl pass -> Maybe (LHsDoc pass)
con_ext :: forall pass. ConDecl pass -> XConDeclH98 pass
con_name :: forall pass. ConDecl pass -> LIdP pass
con_forall :: forall pass. ConDecl pass -> Bool
con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr Specificity pass]
con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
..} <- GenLocated SrcSpanAnnA (ConDecl GhcPs) -> ConDecl GhcPs
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnA (ConDecl GhcPs) -> ConDecl GhcPs)
-> [GenLocated SrcSpanAnnA (ConDecl GhcPs)] -> [ConDecl GhcPs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
-> [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
forall {a}. DataDefnCons a -> [a]
extract_cons (DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
 -> [GenLocated SrcSpanAnnA (ConDecl GhcPs)])
-> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
-> [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
forall a b. (a -> b) -> a -> b
$ HsDataDefn GhcPs -> DataDefnCons (LConDecl GhcPs)
forall pass. HsDataDefn pass -> DataDefnCons (LConDecl pass)
dd_cons HsDataDefn GhcPs
tcdDataDefn)
                 , Just  [ConDeclField GhcPs]
con_details <- [HsConDetails
  Void
  (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
  (GenLocated
     (SrcSpanAnn' (EpAnn AnnList))
     [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
-> Maybe [ConDeclField GhcPs]
forall {tyarg} {arg} {l} {l} {b}.
HsConDetails tyarg arg (GenLocated l [GenLocated l b]) -> Maybe [b]
getFlds HsConDeclH98Details GhcPs
HsConDetails
  Void
  (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
  (GenLocated
     (SrcSpanAnn' (EpAnn AnnList))
     [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
con_args]
                 , let field_names :: [GenLocated SrcSpanAnnN RdrName]
field_names = (ConDeclField GhcPs -> [GenLocated SrcSpanAnnN RdrName])
-> [ConDeclField GhcPs] -> [GenLocated SrcSpanAnnN RdrName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ConDeclField GhcPs -> [XRec GhcPs RdrName]
ConDeclField GhcPs -> [GenLocated SrcSpanAnnN RdrName]
forall {pass} {l}.
(XRec pass (FieldOcc pass) ~ GenLocated l (FieldOcc pass)) =>
ConDeclField pass -> [XRec pass RdrName]
extract [ConDeclField GhcPs]
con_details
                 , let field_labels :: [Text]
field_labels = GenLocated SrcSpanAnnN RdrName -> Text
forall a. Outputable a => a -> Text
printOutputable (GenLocated SrcSpanAnnN RdrName -> Text)
-> [GenLocated SrcSpanAnnN RdrName] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GenLocated SrcSpanAnnN 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 a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null) [Text]
field_labels
                 ]

        getFlds :: HsConDetails tyarg arg (GenLocated l [GenLocated l b]) -> Maybe [b]
getFlds HsConDetails tyarg arg (GenLocated l [GenLocated l b])
conArg = case HsConDetails tyarg arg (GenLocated l [GenLocated l b])
conArg of
                             RecCon GenLocated l [GenLocated l b]
rec  -> [b] -> Maybe [b]
forall a. a -> Maybe a
Just ([b] -> Maybe [b]) -> [b] -> Maybe [b]
forall a b. (a -> b) -> a -> b
$ GenLocated l b -> b
forall l e. GenLocated l e -> e
unLoc (GenLocated l b -> b) -> [GenLocated l b] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenLocated l [GenLocated l b] -> [GenLocated l b]
forall l e. GenLocated l e -> e
unLoc GenLocated l [GenLocated l b]
rec
                             PrefixCon{} -> [b] -> Maybe [b]
forall a. a -> Maybe a
Just []
                             HsConDetails tyarg arg (GenLocated l [GenLocated l b])
_           -> Maybe [b]
forall a. Maybe a
Nothing

            -- NOTE: 'cd_fld_names' is grouped so that the fields
            -- sharing the same type declaration to fit in the same group; e.g.
            --
            -- @
            --   data Foo = Foo {arg1, arg2 :: Int, arg3 :: Int, arg4 :: Bool}
            -- @
            --
            -- is encoded as @[[arg1, arg2], [arg3], [arg4]]@
            -- Hence, we must concat nested arguments into one to get all the fields.
#if MIN_VERSION_ghc(9,3,0)
        extract :: ConDeclField pass -> [XRec pass RdrName]
extract ConDeclField{[XRec pass (FieldOcc pass)]
Maybe (LHsDoc pass)
XConDeclField pass
LBangType pass
cd_fld_ext :: XConDeclField pass
cd_fld_names :: [XRec pass (FieldOcc pass)]
cd_fld_type :: LBangType pass
cd_fld_doc :: Maybe (LHsDoc 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 (LHsDoc pass)
..}
            = (GenLocated l (FieldOcc pass) -> XRec pass RdrName)
-> [GenLocated l (FieldOcc pass)] -> [XRec pass RdrName]
forall a b. (a -> b) -> [a] -> [b]
map (FieldOcc pass -> XRec pass RdrName
forall pass. FieldOcc pass -> XRec pass RdrName
foLabel (FieldOcc pass -> XRec pass RdrName)
-> (GenLocated l (FieldOcc pass) -> FieldOcc pass)
-> GenLocated l (FieldOcc pass)
-> XRec pass RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated l (FieldOcc pass) -> FieldOcc pass
forall l e. GenLocated l e -> e
unLoc) [XRec pass (FieldOcc pass)]
[GenLocated l (FieldOcc pass)]
cd_fld_names
#else
        extract ConDeclField{..}
            = map (rdrNameFieldOcc . unLoc) cd_fld_names
#endif
        -- XConDeclField
        extract ConDeclField pass
_ = []
findRecordCompl Uri
_ Provenance
_ TyClDecl GhcPs
_ = []

toggleSnippets :: ClientCapabilities -> CompletionsConfig -> CompletionItem -> CompletionItem
toggleSnippets :: ClientCapabilities
-> CompletionsConfig -> CompletionItem -> CompletionItem
toggleSnippets ClientCapabilities {Maybe TextDocumentClientCapabilities
_textDocument :: Maybe TextDocumentClientCapabilities
$sel:_textDocument:ClientCapabilities :: ClientCapabilities -> Maybe TextDocumentClientCapabilities
_textDocument} CompletionsConfig{Bool
Int
enableSnippets :: Bool
enableAutoExtend :: Bool
maxCompletions :: Int
enableSnippets :: CompletionsConfig -> Bool
enableAutoExtend :: CompletionsConfig -> Bool
maxCompletions :: CompletionsConfig -> Int
..} =
  Bool -> CompletionItem -> CompletionItem
removeSnippetsWhen (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Bool
enableSnippets Bool -> Bool -> Bool
&& Bool
supported)
  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 a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TextDocumentClientCapabilities
-> Maybe CompletionClientCapabilities
_completion Maybe CompletionClientCapabilities
-> (CompletionClientCapabilities
    -> Maybe
         (Rec
            ('R
               '["commitCharactersSupport" ':-> Maybe Bool,
                 "deprecatedSupport" ':-> Maybe Bool,
                 "documentationFormat" ':-> Maybe [MarkupKind],
                 "insertReplaceSupport" ':-> Maybe Bool,
                 "insertTextModeSupport"
                 ':-> Maybe (Rec ('R '["valueSet" ':-> [InsertTextMode]])),
                 "labelDetailsSupport" ':-> Maybe Bool,
                 "preselectSupport" ':-> Maybe Bool,
                 "resolveSupport" ':-> Maybe (Rec ('R '["properties" ':-> [Text]])),
                 "snippetSupport" ':-> Maybe Bool,
                 "tagSupport"
                 ':-> Maybe (Rec ('R '["valueSet" ':-> [CompletionItemTag]]))])))
-> Maybe
     (Rec
        ('R
           '["commitCharactersSupport" ':-> Maybe Bool,
             "deprecatedSupport" ':-> Maybe Bool,
             "documentationFormat" ':-> Maybe [MarkupKind],
             "insertReplaceSupport" ':-> Maybe Bool,
             "insertTextModeSupport"
             ':-> Maybe (Rec ('R '["valueSet" ':-> [InsertTextMode]])),
             "labelDetailsSupport" ':-> Maybe Bool,
             "preselectSupport" ':-> Maybe Bool,
             "resolveSupport" ':-> Maybe (Rec ('R '["properties" ':-> [Text]])),
             "snippetSupport" ':-> Maybe Bool,
             "tagSupport"
             ':-> Maybe (Rec ('R '["valueSet" ':-> [CompletionItemTag]]))]))
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Getting
  (Maybe
     (Rec
        ('R
           '["commitCharactersSupport" ':-> Maybe Bool,
             "deprecatedSupport" ':-> Maybe Bool,
             "documentationFormat" ':-> Maybe [MarkupKind],
             "insertReplaceSupport" ':-> Maybe Bool,
             "insertTextModeSupport"
             ':-> Maybe (Rec ('R '["valueSet" ':-> [InsertTextMode]])),
             "labelDetailsSupport" ':-> Maybe Bool,
             "preselectSupport" ':-> Maybe Bool,
             "resolveSupport" ':-> Maybe (Rec ('R '["properties" ':-> [Text]])),
             "snippetSupport" ':-> Maybe Bool,
             "tagSupport"
             ':-> Maybe (Rec ('R '["valueSet" ':-> [CompletionItemTag]]))])))
  CompletionClientCapabilities
  (Maybe
     (Rec
        ('R
           '["commitCharactersSupport" ':-> Maybe Bool,
             "deprecatedSupport" ':-> Maybe Bool,
             "documentationFormat" ':-> Maybe [MarkupKind],
             "insertReplaceSupport" ':-> Maybe Bool,
             "insertTextModeSupport"
             ':-> Maybe (Rec ('R '["valueSet" ':-> [InsertTextMode]])),
             "labelDetailsSupport" ':-> Maybe Bool,
             "preselectSupport" ':-> Maybe Bool,
             "resolveSupport" ':-> Maybe (Rec ('R '["properties" ':-> [Text]])),
             "snippetSupport" ':-> Maybe Bool,
             "tagSupport"
             ':-> Maybe (Rec ('R '["valueSet" ':-> [CompletionItemTag]]))])))
-> CompletionClientCapabilities
-> Maybe
     (Rec
        ('R
           '["commitCharactersSupport" ':-> Maybe Bool,
             "deprecatedSupport" ':-> Maybe Bool,
             "documentationFormat" ':-> Maybe [MarkupKind],
             "insertReplaceSupport" ':-> Maybe Bool,
             "insertTextModeSupport"
             ':-> Maybe (Rec ('R '["valueSet" ':-> [InsertTextMode]])),
             "labelDetailsSupport" ':-> Maybe Bool,
             "preselectSupport" ':-> Maybe Bool,
             "resolveSupport" ':-> Maybe (Rec ('R '["properties" ':-> [Text]])),
             "snippetSupport" ':-> Maybe Bool,
             "tagSupport"
             ':-> Maybe (Rec ('R '["valueSet" ':-> [CompletionItemTag]]))]))
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Maybe
     (Rec
        ('R
           '["commitCharactersSupport" ':-> Maybe Bool,
             "deprecatedSupport" ':-> Maybe Bool,
             "documentationFormat" ':-> Maybe [MarkupKind],
             "insertReplaceSupport" ':-> Maybe Bool,
             "insertTextModeSupport"
             ':-> Maybe (Rec ('R '["valueSet" ':-> [InsertTextMode]])),
             "labelDetailsSupport" ':-> Maybe Bool,
             "preselectSupport" ':-> Maybe Bool,
             "resolveSupport" ':-> Maybe (Rec ('R '["properties" ':-> [Text]])),
             "snippetSupport" ':-> Maybe Bool,
             "tagSupport"
             ':-> Maybe (Rec ('R '["valueSet" ':-> [CompletionItemTag]]))])))
  CompletionClientCapabilities
  (Maybe
     (Rec
        ('R
           '["commitCharactersSupport" ':-> Maybe Bool,
             "deprecatedSupport" ':-> Maybe Bool,
             "documentationFormat" ':-> Maybe [MarkupKind],
             "insertReplaceSupport" ':-> Maybe Bool,
             "insertTextModeSupport"
             ':-> Maybe (Rec ('R '["valueSet" ':-> [InsertTextMode]])),
             "labelDetailsSupport" ':-> Maybe Bool,
             "preselectSupport" ':-> Maybe Bool,
             "resolveSupport" ':-> Maybe (Rec ('R '["properties" ':-> [Text]])),
             "snippetSupport" ':-> Maybe Bool,
             "tagSupport"
             ':-> Maybe (Rec ('R '["valueSet" ':-> [CompletionItemTag]]))])))
forall s a. HasCompletionItem s a => Lens' s a
Lens'
  CompletionClientCapabilities
  (Maybe
     (Rec
        ('R
           '["commitCharactersSupport" ':-> Maybe Bool,
             "deprecatedSupport" ':-> Maybe Bool,
             "documentationFormat" ':-> Maybe [MarkupKind],
             "insertReplaceSupport" ':-> Maybe Bool,
             "insertTextModeSupport"
             ':-> Maybe (Rec ('R '["valueSet" ':-> [InsertTextMode]])),
             "labelDetailsSupport" ':-> Maybe Bool,
             "preselectSupport" ':-> Maybe Bool,
             "resolveSupport" ':-> Maybe (Rec ('R '["properties" ':-> [Text]])),
             "snippetSupport" ':-> Maybe Bool,
             "tagSupport"
             ':-> Maybe (Rec ('R '["valueSet" ':-> [CompletionItemTag]]))])))
L.completionItem Maybe
  (Rec
     ('R
        '["commitCharactersSupport" ':-> Maybe Bool,
          "deprecatedSupport" ':-> Maybe Bool,
          "documentationFormat" ':-> Maybe [MarkupKind],
          "insertReplaceSupport" ':-> Maybe Bool,
          "insertTextModeSupport"
          ':-> Maybe (Rec ('R '["valueSet" ':-> [InsertTextMode]])),
          "labelDetailsSupport" ':-> Maybe Bool,
          "preselectSupport" ':-> Maybe Bool,
          "resolveSupport" ':-> Maybe (Rec ('R '["properties" ':-> [Text]])),
          "snippetSupport" ':-> Maybe Bool,
          "tagSupport"
          ':-> Maybe (Rec ('R '["valueSet" ':-> [CompletionItemTag]]))]))
-> (Rec
      ('R
         '["commitCharactersSupport" ':-> Maybe Bool,
           "deprecatedSupport" ':-> Maybe Bool,
           "documentationFormat" ':-> Maybe [MarkupKind],
           "insertReplaceSupport" ':-> Maybe Bool,
           "insertTextModeSupport"
           ':-> Maybe (Rec ('R '["valueSet" ':-> [InsertTextMode]])),
           "labelDetailsSupport" ':-> Maybe Bool,
           "preselectSupport" ':-> Maybe Bool,
           "resolveSupport" ':-> Maybe (Rec ('R '["properties" ':-> [Text]])),
           "snippetSupport" ':-> Maybe Bool,
           "tagSupport"
           ':-> Maybe (Rec ('R '["valueSet" ':-> [CompletionItemTag]]))])
    -> Maybe Bool)
-> Maybe Bool
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Rec
  ('R
     '["commitCharactersSupport" ':-> Maybe Bool,
       "deprecatedSupport" ':-> Maybe Bool,
       "documentationFormat" ':-> Maybe [MarkupKind],
       "insertReplaceSupport" ':-> Maybe Bool,
       "insertTextModeSupport"
       ':-> Maybe (Rec ('R '["valueSet" ':-> [InsertTextMode]])),
       "labelDetailsSupport" ':-> Maybe Bool,
       "preselectSupport" ':-> Maybe Bool,
       "resolveSupport" ':-> Maybe (Rec ('R '["properties" ':-> [Text]])),
       "snippetSupport" ':-> Maybe Bool,
       "tagSupport"
       ':-> Maybe (Rec ('R '["valueSet" ':-> [CompletionItemTag]]))])
x -> Rec
  ('R
     '["commitCharactersSupport" ':-> Maybe Bool,
       "deprecatedSupport" ':-> Maybe Bool,
       "documentationFormat" ':-> Maybe [MarkupKind],
       "insertReplaceSupport" ':-> Maybe Bool,
       "insertTextModeSupport"
       ':-> Maybe (Rec ('R '["valueSet" ':-> [InsertTextMode]])),
       "labelDetailsSupport" ':-> Maybe Bool,
       "preselectSupport" ':-> Maybe Bool,
       "resolveSupport" ':-> Maybe (Rec ('R '["properties" ':-> [Text]])),
       "snippetSupport" ':-> Maybe Bool,
       "tagSupport"
       ':-> Maybe (Rec ('R '["valueSet" ':-> [CompletionItemTag]]))])
x Rec
  ('R
     '["commitCharactersSupport" ':-> Maybe Bool,
       "deprecatedSupport" ':-> Maybe Bool,
       "documentationFormat" ':-> Maybe [MarkupKind],
       "insertReplaceSupport" ':-> Maybe Bool,
       "insertTextModeSupport"
       ':-> Maybe (Rec ('R '["valueSet" ':-> [InsertTextMode]])),
       "labelDetailsSupport" ':-> Maybe Bool,
       "preselectSupport" ':-> Maybe Bool,
       "resolveSupport" ':-> Maybe (Rec ('R '["properties" ':-> [Text]])),
       "snippetSupport" ':-> Maybe Bool,
       "tagSupport"
       ':-> Maybe (Rec ('R '["valueSet" ':-> [CompletionItemTag]]))])
-> Label "snippetSupport"
-> 'R
     '["commitCharactersSupport" ':-> Maybe Bool,
       "deprecatedSupport" ':-> Maybe Bool,
       "documentationFormat" ':-> Maybe [MarkupKind],
       "insertReplaceSupport" ':-> Maybe Bool,
       "insertTextModeSupport"
       ':-> Maybe (Rec ('R '["valueSet" ':-> [InsertTextMode]])),
       "labelDetailsSupport" ':-> Maybe Bool,
       "preselectSupport" ':-> Maybe Bool,
       "resolveSupport" ':-> Maybe (Rec ('R '["properties" ':-> [Text]])),
       "snippetSupport" ':-> Maybe Bool,
       "tagSupport"
       ':-> Maybe (Rec ('R '["valueSet" ':-> [CompletionItemTag]]))]
   .! "snippetSupport"
forall (l :: Symbol) (r :: Row (*)).
KnownSymbol l =>
Rec r -> Label l -> r .! l
.! Label "snippetSupport"
#snippetSupport))

toggleAutoExtend :: CompletionsConfig -> CompItem -> CompItem
toggleAutoExtend :: CompletionsConfig -> CompItem -> CompItem
toggleAutoExtend CompletionsConfig{enableAutoExtend :: CompletionsConfig -> Bool
enableAutoExtend=Bool
False} CompItem
x = CompItem
x {additionalTextEdits = Nothing}
toggleAutoExtend CompletionsConfig
_ CompItem
x = CompItem
x

removeSnippetsWhen :: Bool -> CompletionItem -> CompletionItem
removeSnippetsWhen :: Bool -> CompletionItem -> CompletionItem
removeSnippetsWhen Bool
condition CompletionItem
x =
  if Bool
condition
    then
      CompletionItem
x
        { _insertTextFormat = Just InsertTextFormat_PlainText,
          _insertText = Nothing
        }
    else CompletionItem
x

-- | Returns the cached completions for the given module and position.
getCompletions
    :: IdePlugins a
    -> IdeOptions
    -> CachedCompletions
    -> Maybe (ParsedModule, PositionMapping)
    -> Maybe (HieAstResult, PositionMapping)
    -> (Bindings, PositionMapping)
    -> PosPrefixInfo
    -> ClientCapabilities
    -> CompletionsConfig
    -> ModuleNameEnv (HashSet.HashSet IdentInfo)
    -> Uri
    -> [Scored CompletionItem]
getCompletions :: forall a.
IdePlugins a
-> IdeOptions
-> CachedCompletions
-> Maybe (ParsedModule, PositionMapping)
-> Maybe (HieAstResult, PositionMapping)
-> (Bindings, PositionMapping)
-> PosPrefixInfo
-> ClientCapabilities
-> CompletionsConfig
-> ModuleNameEnv (HashSet IdentInfo)
-> Uri
-> [Scored CompletionItem]
getCompletions
    IdePlugins a
plugins
    IdeOptions
ideOpts
    CC {[Text]
allModNamesAsNS :: CachedCompletions -> [Text]
allModNamesAsNS :: [Text]
allModNamesAsNS, [Maybe Text -> CompItem]
anyQualCompls :: CachedCompletions -> [Maybe Text -> CompItem]
anyQualCompls :: [Maybe Text -> CompItem]
anyQualCompls, [CompItem]
unqualCompls :: CachedCompletions -> [CompItem]
unqualCompls :: [CompItem]
unqualCompls, QualCompls
qualCompls :: CachedCompletions -> QualCompls
qualCompls :: QualCompls
qualCompls, [Text]
importableModules :: CachedCompletions -> [Text]
importableModules :: [Text]
importableModules}
    Maybe (ParsedModule, PositionMapping)
maybe_parsed
    Maybe (HieAstResult, PositionMapping)
maybe_ast_res
    (Bindings
localBindings, PositionMapping
bmapping)
    prefixInfo :: PosPrefixInfo
prefixInfo@(PosPrefixInfo { Text
fullLine :: Text
fullLine :: PosPrefixInfo -> Text
fullLine, Text
prefixScope :: Text
prefixScope :: PosPrefixInfo -> Text
prefixScope, Text
prefixText :: Text
prefixText :: PosPrefixInfo -> Text
prefixText })
    ClientCapabilities
caps
    CompletionsConfig
config
    ModuleNameEnv (HashSet IdentInfo)
moduleExportsMap
    Uri
uri
    -- ------------------------------------------------------------------------
    -- IMPORT MODULENAME (NAM|)
    | Just (ImportListContext String
moduleName) <- Maybe Context
maybeContext
    = String -> [Scored CompletionItem]
moduleImportListCompletions String
moduleName

    | Just (ImportHidingContext String
moduleName) <- Maybe Context
maybeContext
    = String -> [Scored CompletionItem]
moduleImportListCompletions String
moduleName

    -- ------------------------------------------------------------------------
    -- IMPORT MODULENAM|
    | Just (ImportContext String
_moduleName) <- Maybe Context
maybeContext
    = [Scored CompletionItem]
filtImportCompls

    -- ------------------------------------------------------------------------
    -- {-# LA| #-}
    -- we leave this condition here to avoid duplications and return empty list
    -- since HLS implements these completions (#haskell-language-server/pull/662)
    | Text
"{-# " Text -> Text -> Bool
`T.isPrefixOf` Text
fullLine
    = []

    -- ------------------------------------------------------------------------
    | Bool
otherwise =
        -- assumes that nubOrdBy is stable
        let uniqueFiltCompls :: [Scored (Bool, CompItem)]
uniqueFiltCompls = (Scored (Bool, CompItem) -> Scored (Bool, CompItem) -> Ordering)
-> [Scored (Bool, CompItem)] -> [Scored (Bool, CompItem)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
nubOrdBy (CompItem -> CompItem -> Ordering
uniqueCompl (CompItem -> CompItem -> Ordering)
-> (Scored (Bool, CompItem) -> CompItem)
-> Scored (Bool, CompItem)
-> Scored (Bool, CompItem)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Bool, CompItem) -> CompItem
forall a b. (a, b) -> b
snd ((Bool, CompItem) -> CompItem)
-> (Scored (Bool, CompItem) -> (Bool, CompItem))
-> Scored (Bool, CompItem)
-> CompItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scored (Bool, CompItem) -> (Bool, CompItem)
forall a. Scored a -> a
Fuzzy.original) [Scored (Bool, CompItem)]
filtCompls
            compls :: [Scored (Bool, CompletionItem)]
compls = ((Scored (Bool, CompItem) -> Scored (Bool, CompletionItem))
-> [Scored (Bool, CompItem)] -> [Scored (Bool, CompletionItem)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((Scored (Bool, CompItem) -> Scored (Bool, CompletionItem))
 -> [Scored (Bool, CompItem)] -> [Scored (Bool, CompletionItem)])
-> ((CompItem -> CompletionItem)
    -> Scored (Bool, CompItem) -> Scored (Bool, CompletionItem))
-> (CompItem -> CompletionItem)
-> [Scored (Bool, CompItem)]
-> [Scored (Bool, CompletionItem)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Bool, CompItem) -> (Bool, CompletionItem))
-> Scored (Bool, CompItem) -> Scored (Bool, CompletionItem)
forall a b. (a -> b) -> Scored a -> Scored b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(((Bool, CompItem) -> (Bool, CompletionItem))
 -> Scored (Bool, CompItem) -> Scored (Bool, CompletionItem))
-> ((CompItem -> CompletionItem)
    -> (Bool, CompItem) -> (Bool, CompletionItem))
-> (CompItem -> CompletionItem)
-> Scored (Bool, CompItem)
-> Scored (Bool, CompletionItem)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CompItem -> CompletionItem)
-> (Bool, CompItem) -> (Bool, CompletionItem)
forall a b. (a -> b) -> (Bool, a) -> (Bool, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (Maybe PluginId -> IdeOptions -> Uri -> CompItem -> CompletionItem
mkCompl Maybe PluginId
pId IdeOptions
ideOpts Uri
uri) [Scored (Bool, CompItem)]
uniqueFiltCompls
            pId :: Maybe PluginId
pId = IdePlugins a -> CommandId -> Maybe PluginId
forall ideState. IdePlugins ideState -> CommandId -> Maybe PluginId
lookupCommandProvider IdePlugins a
plugins (Text -> CommandId
CommandId Text
extendImportCommandId)
        in
          ((Scored (Bool, CompletionItem) -> Scored CompletionItem)
-> [Scored (Bool, CompletionItem)] -> [Scored CompletionItem]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((Scored (Bool, CompletionItem) -> Scored CompletionItem)
 -> [Scored (Bool, CompletionItem)] -> [Scored CompletionItem])
-> (((Bool, CompletionItem) -> CompletionItem)
    -> Scored (Bool, CompletionItem) -> Scored CompletionItem)
-> ((Bool, CompletionItem) -> CompletionItem)
-> [Scored (Bool, CompletionItem)]
-> [Scored CompletionItem]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Bool, CompletionItem) -> CompletionItem)
-> Scored (Bool, CompletionItem) -> Scored CompletionItem
forall a b. (a -> b) -> Scored a -> Scored b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (Bool, CompletionItem) -> CompletionItem
forall a b. (a, b) -> b
snd ([Scored (Bool, CompletionItem)] -> [Scored CompletionItem])
-> [Scored (Bool, CompletionItem)] -> [Scored CompletionItem]
forall a b. (a -> b) -> a -> b
$
          (Scored (Bool, CompletionItem)
 -> Scored (Bool, CompletionItem) -> Ordering)
-> [Scored (Bool, CompletionItem)]
-> [Scored (Bool, CompletionItem)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Down Bool, Down Int, Down Bool, Text, Maybe Text)
-> (Down Bool, Down Int, Down Bool, Text, Maybe Text) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((Down Bool, Down Int, Down Bool, Text, Maybe Text)
 -> (Down Bool, Down Int, Down Bool, Text, Maybe Text) -> Ordering)
-> (Scored (Bool, CompletionItem)
    -> (Down Bool, Down Int, Down Bool, Text, Maybe Text))
-> Scored (Bool, CompletionItem)
-> Scored (Bool, CompletionItem)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Scored (Bool, CompletionItem)
-> (Down Bool, Down Int, Down Bool, Text, Maybe Text)
forall {a}.
Scored (a, CompletionItem)
-> (Down a, Down Int, Down Bool, Text, Maybe Text)
lexicographicOrdering) ([Scored (Bool, CompletionItem)]
 -> [Scored (Bool, CompletionItem)])
-> [Scored (Bool, CompletionItem)]
-> [Scored (Bool, CompletionItem)]
forall a b. (a -> b) -> a -> b
$
          (Scored (Bool, CompletionItem)
 -> Scored (Bool, CompletionItem) -> Ordering)
-> [[Scored (Bool, CompletionItem)]]
-> [Scored (Bool, CompletionItem)]
forall a. (a -> a -> Ordering) -> [[a]] -> [a]
mergeListsBy ((Int -> Int -> Ordering) -> Int -> Int -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> (Scored (Bool, CompletionItem) -> Int)
-> Scored (Bool, CompletionItem)
-> Scored (Bool, CompletionItem)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Scored (Bool, CompletionItem) -> Int
forall a. Scored a -> Int
score)
            [ ((Scored CompletionItem -> Scored (Bool, CompletionItem))
-> [Scored CompletionItem] -> [Scored (Bool, CompletionItem)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((Scored CompletionItem -> Scored (Bool, CompletionItem))
 -> [Scored CompletionItem] -> [Scored (Bool, CompletionItem)])
-> ((CompletionItem -> (Bool, CompletionItem))
    -> Scored CompletionItem -> Scored (Bool, CompletionItem))
-> (CompletionItem -> (Bool, CompletionItem))
-> [Scored CompletionItem]
-> [Scored (Bool, CompletionItem)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CompletionItem -> (Bool, CompletionItem))
-> Scored CompletionItem -> Scored (Bool, CompletionItem)
forall a b. (a -> b) -> Scored a -> Scored b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (Bool
notQual,) [Scored CompletionItem]
filtModNameCompls
            , ((Scored CompletionItem -> Scored (Bool, CompletionItem))
-> [Scored CompletionItem] -> [Scored (Bool, CompletionItem)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((Scored CompletionItem -> Scored (Bool, CompletionItem))
 -> [Scored CompletionItem] -> [Scored (Bool, CompletionItem)])
-> ((CompletionItem -> (Bool, CompletionItem))
    -> Scored CompletionItem -> Scored (Bool, CompletionItem))
-> (CompletionItem -> (Bool, CompletionItem))
-> [Scored CompletionItem]
-> [Scored (Bool, CompletionItem)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CompletionItem -> (Bool, CompletionItem))
-> Scored CompletionItem -> Scored (Bool, CompletionItem)
forall a b. (a -> b) -> Scored a -> Scored b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (Bool
notQual,) [Scored CompletionItem]
filtKeywordCompls
            , ((Scored (Bool, CompletionItem) -> Scored (Bool, CompletionItem))
-> [Scored (Bool, CompletionItem)]
-> [Scored (Bool, CompletionItem)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((Scored (Bool, CompletionItem) -> Scored (Bool, CompletionItem))
 -> [Scored (Bool, CompletionItem)]
 -> [Scored (Bool, CompletionItem)])
-> ((CompletionItem -> CompletionItem)
    -> Scored (Bool, CompletionItem) -> Scored (Bool, CompletionItem))
-> (CompletionItem -> CompletionItem)
-> [Scored (Bool, CompletionItem)]
-> [Scored (Bool, CompletionItem)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Bool, CompletionItem) -> (Bool, CompletionItem))
-> Scored (Bool, CompletionItem) -> Scored (Bool, CompletionItem)
forall a b. (a -> b) -> Scored a -> Scored b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(((Bool, CompletionItem) -> (Bool, CompletionItem))
 -> Scored (Bool, CompletionItem) -> Scored (Bool, CompletionItem))
-> ((CompletionItem -> CompletionItem)
    -> (Bool, CompletionItem) -> (Bool, CompletionItem))
-> (CompletionItem -> CompletionItem)
-> Scored (Bool, CompletionItem)
-> Scored (Bool, CompletionItem)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CompletionItem -> CompletionItem)
-> (Bool, CompletionItem) -> (Bool, CompletionItem)
forall a b. (a -> b) -> (Bool, a) -> (Bool, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (ClientCapabilities
-> CompletionsConfig -> CompletionItem -> CompletionItem
toggleSnippets ClientCapabilities
caps CompletionsConfig
config) [Scored (Bool, CompletionItem)]
compls
            ]
    where
      enteredQual :: Text
enteredQual = if Text -> Bool
T.null Text
prefixScope then Text
"" else Text
prefixScope 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

      -- Boolean labels to tag suggestions as qualified (or not)
      qual :: Bool
qual = Bool -> Bool
not(Text -> Bool
T.null Text
prefixScope)
      notQual :: Bool
notQual = Bool
False

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

      maxC :: Int
maxC = CompletionsConfig -> Int
maxCompletions CompletionsConfig
config

      filtModNameCompls :: [Scored CompletionItem]
      filtModNameCompls :: [Scored CompletionItem]
filtModNameCompls =
        ((Scored Text -> Scored CompletionItem)
-> [Scored Text] -> [Scored CompletionItem]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((Scored Text -> Scored CompletionItem)
 -> [Scored Text] -> [Scored CompletionItem])
-> ((Text -> CompletionItem)
    -> Scored Text -> Scored CompletionItem)
-> (Text -> CompletionItem)
-> [Scored Text]
-> [Scored CompletionItem]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Text -> CompletionItem) -> Scored Text -> Scored CompletionItem
forall a b. (a -> b) -> Scored a -> Scored b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) Text -> CompletionItem
mkModCompl
          ([Scored Text] -> [Scored CompletionItem])
-> [Scored Text] -> [Scored CompletionItem]
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Text -> [Text] -> [Scored Text]
Fuzzy.simpleFilter Int
chunkSize Int
maxC Text
fullPrefix
          ([Text] -> [Scored Text]) -> [Text] -> [Scored Text]
forall a b. (a -> b) -> a -> b
$ (if Text -> Bool
T.null Text
enteredQual then [Text] -> [Text]
forall a. a -> a
id else (Text -> Maybe Text) -> [Text] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text -> Text -> Maybe Text
T.stripPrefix Text
enteredQual))
            [Text]
allModNamesAsNS
      -- If we have a parsed module, use it to determine which completion to show.
      maybeContext :: Maybe Context
      maybeContext :: Maybe Context
maybeContext = 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 a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Position -> ParsedModule -> Maybe Context
getCContext Position
hpos ParsedModule
pm

      filtCompls :: [Scored (Bool, CompItem)]
      filtCompls :: [Scored (Bool, CompItem)]
filtCompls = Int
-> Int
-> Text
-> [(Bool, CompItem)]
-> ((Bool, CompItem) -> Text)
-> [Scored (Bool, CompItem)]
forall t. Int -> Int -> Text -> [t] -> (t -> Text) -> [Scored t]
Fuzzy.filter Int
chunkSize Int
maxC Text
prefixText [(Bool, CompItem)]
ctxCompls (CompItem -> Text
label (CompItem -> Text)
-> ((Bool, CompItem) -> CompItem) -> (Bool, CompItem) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool, CompItem) -> CompItem
forall a b. (a, b) -> b
snd)
        where
          -- We need the hieast to be "fresh". We can't get types from "stale" hie files, so hasfield won't work,
          -- since it gets the record fields from the types.
          -- Perhaps this could be fixed with a refactor to GHC's IfaceTyCon, to have it also contain record fields.
          -- Requiring fresh hieast is fine for normal workflows, because it is generated while the user edits.
          recordDotSyntaxCompls :: [(Bool, CompItem)]
          recordDotSyntaxCompls :: [(Bool, CompItem)]
recordDotSyntaxCompls = case Maybe (HieAstResult, PositionMapping)
maybe_ast_res of
            Just (HAR {hieAst :: ()
hieAst = HieASTs a
hieast, hieKind :: ()
hieKind = HieKind a
HieFresh},PositionMapping
_) -> [[(Bool, CompItem)]] -> [(Bool, CompItem)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Bool, CompItem)]] -> [(Bool, CompItem)])
-> [[(Bool, CompItem)]] -> [(Bool, CompItem)]
forall a b. (a -> b) -> a -> b
$ HieASTs a
-> Position
-> (HieAST a -> [(Bool, CompItem)])
-> [[(Bool, CompItem)]]
forall t a. HieASTs t -> Position -> (HieAST t -> a) -> [a]
pointCommand HieASTs a
hieast (PosPrefixInfo -> Position
completionPrefixPos PosPrefixInfo
prefixInfo) HieAST a -> [(Bool, CompItem)]
HieAST Type -> [(Bool, CompItem)]
nodeCompletions
            Maybe (HieAstResult, PositionMapping)
_ -> []
            where
              nodeCompletions :: HieAST Type -> [(Bool, CompItem)]
              nodeCompletions :: HieAST Type -> [(Bool, CompItem)]
nodeCompletions HieAST Type
node = (Type -> [(Bool, CompItem)]) -> [Type] -> [(Bool, CompItem)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Type -> [(Bool, CompItem)]
g (NodeInfo Type -> [Type]
forall a. NodeInfo a -> [a]
nodeType (NodeInfo Type -> [Type]) -> NodeInfo Type -> [Type]
forall a b. (a -> b) -> a -> b
$ HieAST Type -> NodeInfo Type
nodeInfo HieAST Type
node)
              g :: Type -> [(Bool, CompItem)]
              g :: Type -> [(Bool, CompItem)]
g (TyConApp TyCon
theTyCon [Type]
_) = (Text -> (Bool, CompItem)) -> [Text] -> [(Bool, CompItem)]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text -> (Bool, CompItem)
dotFieldSelectorToCompl (Name -> Text
forall a. Outputable a => a -> Text
printOutputable (Name -> Text) -> Name -> Text
forall a b. (a -> b) -> a -> b
$ TyCon -> Name
GHC.tyConName TyCon
theTyCon)) ([Text] -> [(Bool, CompItem)]) -> [Text] -> [(Bool, CompItem)]
forall a b. (a -> b) -> a -> b
$ TyCon -> [Text]
getSels TyCon
theTyCon
              g Type
_ = []
              getSels :: GHC.TyCon -> [T.Text]
              getSels :: TyCon -> [Text]
getSels TyCon
tycon = let f :: a -> Text
f a
fieldLabel = a -> Text
forall a. Outputable a => a -> Text
printOutputable a
fieldLabel
                              in (FieldLabel -> Text) -> [FieldLabel] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map FieldLabel -> Text
forall a. Outputable a => a -> Text
f ([FieldLabel] -> [Text]) -> [FieldLabel] -> [Text]
forall a b. (a -> b) -> a -> b
$ TyCon -> [FieldLabel]
tyConFieldLabels TyCon
tycon
              -- Completions can return more information that just the completion itself, but it will
              -- require more than what GHC currently gives us in the HieAST, since it only gives the Type
              -- of the fields, not where they are defined, etc. So for now the extra fields remain empty.
              -- Also: additionalTextEdits is a todo, since we may want to import the record. It requires a way
              -- to get the record's module, which isn't included in the type information used to get the fields.
              dotFieldSelectorToCompl :: T.Text -> T.Text -> (Bool, CompItem)
              dotFieldSelectorToCompl :: Text -> Text -> (Bool, CompItem)
dotFieldSelectorToCompl Text
recname Text
label = (Bool
True, CI
                { compKind :: CompletionItemKind
compKind = CompletionItemKind
CompletionItemKind_Field
                , insertText :: Text
insertText = Text
label
                , provenance :: Provenance
provenance = Text -> Provenance
DefinedIn Text
recname
                , label :: Text
label = Text
label
                , typeText :: Maybe Text
typeText = Maybe Text
forall a. Maybe a
Nothing
                , isInfix :: Maybe Backtick
isInfix = Maybe Backtick
forall a. Maybe a
Nothing
                , isTypeCompl :: Bool
isTypeCompl = Bool
False
                , additionalTextEdits :: Maybe ExtendImport
additionalTextEdits = Maybe ExtendImport
forall a. Maybe a
Nothing
                , nameDetails :: Maybe NameDetails
nameDetails = Maybe NameDetails
forall a. Maybe a
Nothing
                , isLocalCompletion :: Bool
isLocalCompletion = Bool
False
                })

          -- completions specific to the current context
          ctxCompls' :: [(Bool, CompItem)]
ctxCompls' = case Maybe Context
maybeContext of
                        Maybe Context
Nothing           -> [(Bool, CompItem)]
compls
                        Just Context
TypeContext  -> ((Bool, CompItem) -> Bool)
-> [(Bool, CompItem)] -> [(Bool, CompItem)]
forall a. (a -> Bool) -> [a] -> [a]
filter ( CompItem -> Bool
isTypeCompl (CompItem -> Bool)
-> ((Bool, CompItem) -> CompItem) -> (Bool, CompItem) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool, CompItem) -> CompItem
forall a b. (a, b) -> b
snd) [(Bool, CompItem)]
compls
                        Just Context
ValueContext -> ((Bool, CompItem) -> Bool)
-> [(Bool, CompItem)] -> [(Bool, CompItem)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((Bool, CompItem) -> Bool) -> (Bool, CompItem) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompItem -> Bool
isTypeCompl (CompItem -> Bool)
-> ((Bool, CompItem) -> CompItem) -> (Bool, CompItem) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool, CompItem) -> CompItem
forall a b. (a, b) -> b
snd) [(Bool, CompItem)]
compls
                        Just Context
_            -> ((Bool, CompItem) -> Bool)
-> [(Bool, CompItem)] -> [(Bool, CompItem)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((Bool, CompItem) -> Bool) -> (Bool, CompItem) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompItem -> Bool
isTypeCompl (CompItem -> Bool)
-> ((Bool, CompItem) -> CompItem) -> (Bool, CompItem) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool, CompItem) -> CompItem
forall a b. (a, b) -> b
snd) [(Bool, CompItem)]
compls
          -- Add whether the text to insert has backticks
          ctxCompls :: [(Bool, CompItem)]
ctxCompls = (((Bool, CompItem) -> (Bool, CompItem))
-> [(Bool, CompItem)] -> [(Bool, CompItem)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(((Bool, CompItem) -> (Bool, CompItem))
 -> [(Bool, CompItem)] -> [(Bool, CompItem)])
-> ((CompItem -> CompItem) -> (Bool, CompItem) -> (Bool, CompItem))
-> (CompItem -> CompItem)
-> [(Bool, CompItem)]
-> [(Bool, CompItem)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CompItem -> CompItem) -> (Bool, CompItem) -> (Bool, CompItem)
forall a b. (a -> b) -> (Bool, a) -> (Bool, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (\CompItem
comp -> CompletionsConfig -> CompItem -> CompItem
toggleAutoExtend CompletionsConfig
config (CompItem -> CompItem) -> CompItem -> CompItem
forall a b. (a -> b) -> a -> b
$ CompItem
comp { isInfix = infixCompls }) [(Bool, CompItem)]
ctxCompls'

          infixCompls :: Maybe Backtick
          infixCompls :: Maybe Backtick
infixCompls = Text -> Text -> Text -> Position -> Maybe Backtick
isUsedAsInfix Text
fullLine Text
prefixScope 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
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
-> Provenance
-> Text
-> Maybe Text
-> Maybe Backtick
-> Bool
-> Maybe ExtendImport
-> Maybe NameDetails
-> Bool
-> CompItem
CI CompletionItemKind
ctyp Text
pn Provenance
thisModName Text
pn Maybe Text
ty Maybe Backtick
forall a. Maybe a
Nothing (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ OccName -> Bool
isValOcc OccName
occ) Maybe ExtendImport
forall a. Maybe a
Nothing Maybe NameDetails
dets Bool
True
            where
              occ :: OccName
occ = Name -> OccName
nameOccName Name
name
              ctyp :: CompletionItemKind
ctyp = OccName -> CompletionItemKind
occNameToComKind OccName
occ
              pn :: Text
pn = Name -> Text
forall a. Outputable a => a -> Text
showForSnippet Name
name
              ty :: Maybe Text
ty = Type -> Text
forall a. Outputable a => a -> Text
showForSnippet (Type -> Text) -> Maybe Type -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Type
typ
              thisModName :: Provenance
thisModName = SrcSpan -> Provenance
Local (SrcSpan -> Provenance) -> SrcSpan -> Provenance
forall a b. (a -> b) -> a -> b
$ Name -> SrcSpan
nameSrcSpan Name
name
              dets :: Maybe NameDetails
dets = Module -> OccName -> NameDetails
NameDetails (Module -> OccName -> NameDetails)
-> Maybe Module -> Maybe (OccName -> NameDetails)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Maybe Module
nameModule_maybe Name
name Maybe (OccName -> NameDetails)
-> Maybe OccName -> Maybe NameDetails
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OccName -> Maybe OccName
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> OccName
nameOccName Name
name)

          -- When record-dot-syntax completions are available, we return them exclusively.
          -- They are only available when we write i.e. `myrecord.` with OverloadedRecordDot enabled.
          -- Anything that isn't a field is invalid, so those completion don't make sense.
          compls :: [(Bool, CompItem)]
compls
            | Text -> Bool
T.null Text
prefixScope = (CompItem -> (Bool, CompItem)) -> [CompItem] -> [(Bool, CompItem)]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
notQual,) [CompItem]
localCompls [(Bool, CompItem)] -> [(Bool, CompItem)] -> [(Bool, CompItem)]
forall a. [a] -> [a] -> [a]
++ (CompItem -> (Bool, CompItem)) -> [CompItem] -> [(Bool, CompItem)]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
qual,) [CompItem]
unqualCompls [(Bool, CompItem)] -> [(Bool, CompItem)] -> [(Bool, CompItem)]
forall a. [a] -> [a] -> [a]
++ ((Maybe Text -> CompItem) -> (Bool, CompItem))
-> [Maybe Text -> CompItem] -> [(Bool, CompItem)]
forall a b. (a -> b) -> [a] -> [b]
map (\Maybe Text -> CompItem
compl -> (Bool
notQual, Maybe Text -> CompItem
compl Maybe Text
forall a. Maybe a
Nothing)) [Maybe Text -> CompItem]
anyQualCompls
            | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(Bool, CompItem)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Bool, CompItem)]
recordDotSyntaxCompls = [(Bool, CompItem)]
recordDotSyntaxCompls
            | Bool
otherwise = ((Bool
qual,) (CompItem -> (Bool, CompItem)) -> [CompItem] -> [(Bool, CompItem)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CompItem] -> Text -> Map Text [CompItem] -> [CompItem]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] Text
prefixScope (QualCompls -> Map Text [CompItem]
getQualCompls QualCompls
qualCompls))
                 [(Bool, CompItem)] -> [(Bool, CompItem)] -> [(Bool, CompItem)]
forall a. [a] -> [a] -> [a]
++ ((Maybe Text -> CompItem) -> (Bool, CompItem))
-> [Maybe Text -> CompItem] -> [(Bool, CompItem)]
forall a b. (a -> b) -> [a] -> [b]
map (\Maybe Text -> CompItem
compl -> (Bool
notQual, Maybe Text -> CompItem
compl (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
prefixScope))) [Maybe Text -> CompItem]
anyQualCompls

      filtListWith :: (Text -> CompletionItem) -> [Text] -> [Scored CompletionItem]
filtListWith Text -> CompletionItem
f [Text]
xs =
        [ (Text -> CompletionItem) -> Scored Text -> Scored CompletionItem
forall a b. (a -> b) -> Scored a -> Scored b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> CompletionItem
f Scored Text
label
        | Scored Text
label <- Int -> Int -> Text -> [Text] -> [Scored Text]
Fuzzy.simpleFilter Int
chunkSize Int
maxC Text
fullPrefix [Text]
xs
        , Text
enteredQual Text -> Text -> Bool
`T.isPrefixOf` Scored Text -> Text
forall a. Scored a -> a
original Scored Text
label
        ]

      moduleImportListCompletions :: String -> [Scored CompletionItem]
      moduleImportListCompletions :: String -> [Scored CompletionItem]
moduleImportListCompletions String
moduleNameS =
        let moduleName :: Text
moduleName = String -> Text
T.pack String
moduleNameS
            funcs :: HashSet IdentInfo
funcs = ModuleNameEnv (HashSet IdentInfo)
-> HashSet IdentInfo -> ModuleName -> HashSet IdentInfo
forall key elt.
Uniquable key =>
UniqFM key elt -> elt -> key -> elt
lookupWithDefaultUFM ModuleNameEnv (HashSet IdentInfo)
moduleExportsMap HashSet IdentInfo
forall a. HashSet a
HashSet.empty (ModuleName -> HashSet IdentInfo)
-> ModuleName -> HashSet IdentInfo
forall a b. (a -> b) -> a -> b
$ String -> ModuleName
mkModuleName String
moduleNameS
            funs :: [String]
funs = (IdentInfo -> String) -> [IdentInfo] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (OccName -> String
forall a. Show a => a -> String
show (OccName -> String)
-> (IdentInfo -> OccName) -> IdentInfo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentInfo -> OccName
name) ([IdentInfo] -> [String]) -> [IdentInfo] -> [String]
forall a b. (a -> b) -> a -> b
$ HashSet IdentInfo -> [IdentInfo]
forall a. HashSet a -> [a]
HashSet.toList HashSet IdentInfo
funcs
        in Text -> [Text] -> [Scored CompletionItem]
filterModuleExports Text
moduleName ([Text] -> [Scored CompletionItem])
-> [Text] -> [Scored CompletionItem]
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack [String]
funs

      filtImportCompls :: [Scored CompletionItem]
      filtImportCompls :: [Scored CompletionItem]
filtImportCompls = (Text -> CompletionItem) -> [Text] -> [Scored CompletionItem]
filtListWith (Text -> Text -> CompletionItem
mkImportCompl Text
enteredQual) [Text]
importableModules

      filterModuleExports :: T.Text -> [T.Text] -> [Scored CompletionItem]
      filterModuleExports :: Text -> [Text] -> [Scored CompletionItem]
filterModuleExports Text
moduleName = (Text -> CompletionItem) -> [Text] -> [Scored CompletionItem]
filtListWith ((Text -> CompletionItem) -> [Text] -> [Scored CompletionItem])
-> (Text -> CompletionItem) -> [Text] -> [Scored CompletionItem]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> CompletionItem
mkModuleFunctionImport Text
moduleName

      filtKeywordCompls :: [Scored CompletionItem]
      filtKeywordCompls :: [Scored CompletionItem]
filtKeywordCompls
          | Text -> Bool
T.null Text
prefixScope = (Text -> CompletionItem) -> [Text] -> [Scored CompletionItem]
filtListWith Text -> CompletionItem
mkExtCompl (IdeOptions -> [Text]
optKeywords IdeOptions
ideOpts)
          | Bool
otherwise = []

      -- We use this ordering to alphabetically sort suggestions while respecting
      -- all the previously applied ordering sources. These are:
      --  1. Qualified suggestions go first
      --  2. Fuzzy score ranks next
      --  3. In-scope completions rank next
      --  4. label alphabetical ordering next
      --  4. detail alphabetical ordering (proxy for module)
      lexicographicOrdering :: Scored (a, CompletionItem)
-> (Down a, Down Int, Down Bool, Text, Maybe Text)
lexicographicOrdering Fuzzy.Scored{Int
score :: forall a. Scored a -> Int
score :: Int
score, (a, CompletionItem)
original :: forall a. Scored a -> a
original :: (a, CompletionItem)
original} =
        case (a, CompletionItem)
original of
          (a
isQual, CompletionItem{Text
$sel:_label:CompletionItem :: CompletionItem -> Text
_label :: Text
_label,Maybe Text
$sel:_detail:CompletionItem :: CompletionItem -> Maybe Text
_detail :: Maybe Text
_detail}) -> do
            let isLocal :: Bool
isLocal = Bool -> (Text -> Bool) -> Maybe Text -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Text
":" `T.isPrefixOf`) Maybe Text
_detail
            (a -> Down a
forall a. a -> Down a
Down a
isQual, Int -> Down Int
forall a. a -> Down a
Down Int
score, Bool -> Down Bool
forall a. a -> Down a
Down Bool
isLocal, Text
_label, Maybe Text
_detail)




uniqueCompl :: CompItem -> CompItem -> Ordering
uniqueCompl :: CompItem -> CompItem -> Ordering
uniqueCompl CompItem
candidate CompItem
unique =
  case (Text, CompletionItemKind)
-> (Text, CompletionItemKind) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (CompItem -> Text
label CompItem
candidate, CompItem -> CompletionItemKind
compKind CompItem
candidate)
               (CompItem -> Text
label CompItem
unique, CompItem -> CompletionItemKind
compKind CompItem
unique) of
    Ordering
EQ ->
      -- preserve completions for duplicate record fields where the only difference is in the type
      -- remove redundant completions with less type info than the previous
      if CompItem -> Bool
isLocalCompletion CompItem
unique
        -- filter global completions when we already have a local one
        Bool -> Bool -> Bool
|| Bool -> Bool
not(CompItem -> Bool
isLocalCompletion CompItem
candidate) Bool -> Bool -> Bool
&& CompItem -> Bool
isLocalCompletion CompItem
unique
        then Ordering
EQ
        else (Text, Text) -> (Text, Text) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (CompItem -> Text
importedFrom CompItem
candidate, CompItem -> Text
insertText CompItem
candidate) (CompItem -> Text
importedFrom CompItem
unique, CompItem -> Text
insertText CompItem
unique)
    Ordering
other -> Ordering
other
  where
      importedFrom :: CompItem -> T.Text
      importedFrom :: CompItem -> Text
importedFrom (CompItem -> Provenance
provenance -> ImportedFrom Text
m) = Text
m
      importedFrom (CompItem -> Provenance
provenance -> DefinedIn Text
m)    = Text
m
      importedFrom (CompItem -> Provenance
provenance -> Local SrcSpan
_)        = Text
"local"

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

hasTrailingBacktick :: T.Text -> Position -> Bool
hasTrailingBacktick :: Text -> Position -> Bool
hasTrailingBacktick Text
line Position { $sel:_character:Position :: Position -> UInt
_character=(UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
c) }
    | Text -> Int
T.length Text
line Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
c = (Text
line HasCallStack => Text -> Int -> Char
Text -> Int -> Char
`T.index` Int
c) 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 { $sel:_character:Position :: Position -> UInt
_character=(UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
c) }
  | Int
backtickIndex Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
backtickIndex Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Text -> Int
T.length Text
line = Bool
False
  | Bool
otherwise = (Text
line HasCallStack => Text -> Int -> Char
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
c 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
    {- 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 -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
name (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$
  First Text -> Maybe Text
forall a. First a -> Maybe a
getFirst (First Text -> Maybe Text) -> First Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ (Text -> First Text) -> [Text] -> First Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Maybe Text -> First Text
forall a. Maybe a -> First a
First (Maybe Text -> First Text)
-> (Text -> Maybe Text) -> Text -> First Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Maybe Text
`T.stripPrefix` Text
name)) [Text]
occNamePrefixes

mkRecordSnippetCompItem :: Uri -> Maybe T.Text -> T.Text -> [T.Text] -> Provenance -> Maybe (LImportDecl GhcPs) -> CompItem
mkRecordSnippetCompItem :: Uri
-> Maybe Text
-> Text
-> [Text]
-> Provenance
-> Maybe (LImportDecl GhcPs)
-> CompItem
mkRecordSnippetCompItem Uri
uri Maybe Text
parent Text
ctxStr [Text]
compl Provenance
importedFrom Maybe (LImportDecl GhcPs)
imp = CompItem
r
  where
      r :: CompItem
r  = CI {
            compKind :: CompletionItemKind
compKind = CompletionItemKind
CompletionItemKind_Snippet
          , insertText :: Text
insertText = Text
buildSnippet
          , provenance :: Provenance
provenance = Provenance
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
          , isTypeCompl :: Bool
isTypeCompl = Bool
False
          , additionalTextEdits :: Maybe ExtendImport
additionalTextEdits = Maybe (LImportDecl GhcPs)
Maybe (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
imp Maybe (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ExtendImport)
-> Maybe ExtendImport
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \GenLocated SrcSpanAnnA (ImportDecl GhcPs)
x ->
            ExtendImport
                { doc :: Uri
doc = Uri
uri,
                  thingParent :: Maybe Text
thingParent = Maybe Text
parent,
                  importName :: Text
importName = ModuleName -> Text
showModName (ModuleName -> Text) -> ModuleName -> Text
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnA ModuleName -> ModuleName)
-> GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall a b. (a -> b) -> a -> b
$ ImportDecl GhcPs -> XRec GhcPs ModuleName
forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName (ImportDecl GhcPs -> XRec GhcPs ModuleName)
-> ImportDecl GhcPs -> XRec GhcPs ModuleName
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (ImportDecl GhcPs)
x,
                  importQual :: Maybe Text
importQual = LImportDecl GhcPs -> Maybe Text
getImportQual LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
x,
                  newThing :: Text
newThing = Text
ctxStr
                }
          , nameDetails :: Maybe NameDetails
nameDetails = Maybe NameDetails
forall a. Maybe a
Nothing
          , isLocalCompletion :: Bool
isLocalCompletion = Bool
True
          }

      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
"}"

getImportQual :: LImportDecl GhcPs -> Maybe T.Text
getImportQual :: LImportDecl GhcPs -> Maybe Text
getImportQual (L SrcSpanAnnA
_ ImportDecl GhcPs
imp)
    | ImportDecl GhcPs -> Bool
forall a. ImportDecl a -> Bool
isQualifiedImport ImportDecl GhcPs
imp = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ModuleName -> String
moduleNameString (ModuleName -> String) -> ModuleName -> String
forall a b. (a -> b) -> a -> b
$ ModuleName
-> (GenLocated SrcSpanAnnA ModuleName -> ModuleName)
-> Maybe (GenLocated SrcSpanAnnA ModuleName)
-> ModuleName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnA ModuleName -> ModuleName)
-> GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall a b. (a -> b) -> a -> b
$ ImportDecl GhcPs -> XRec GhcPs ModuleName
forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcPs
imp) GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (ImportDecl GhcPs -> Maybe (XRec GhcPs ModuleName)
forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclAs ImportDecl GhcPs
imp)
    | Bool
otherwise = Maybe Text
forall a. Maybe a
Nothing

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

-- This comes from the GHC.Utils.Misc module (not exported)
-- | Merge an unsorted list of sorted lists, for example:
--
--  > mergeListsBy compare [ [2,5,15], [1,10,100] ] = [1,2,5,10,15,100]
--
--  \( O(n \log{} k) \)
mergeListsBy :: forall a. (a -> a -> Ordering) -> [[a]] -> [a]
mergeListsBy :: forall a. (a -> a -> Ordering) -> [[a]] -> [a]
mergeListsBy a -> a -> Ordering
cmp [[a]]
all_lists = [[a]] -> [a]
merge_lists [[a]]
all_lists
  where
    -- Implements "Iterative 2-Way merge" described at
    -- https://en.wikipedia.org/wiki/K-way_merge_algorithm

    -- Merge two sorted lists into one in O(n).
    merge2 :: [a] -> [a] -> [a]
    merge2 :: [a] -> [a] -> [a]
merge2 [] [a]
ys = [a]
ys
    merge2 [a]
xs [] = [a]
xs
    merge2 (a
x:[a]
xs) (a
y:[a]
ys) =
      case a -> a -> Ordering
cmp a
x a
y of
        Ordering
Prelude.GT -> a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
merge2 (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) [a]
ys
        Ordering
_          -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
merge2 [a]
xs (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys)

    -- Merge the first list with the second, the third with the fourth, and so
    -- on. The output has half as much lists as the input.
    merge_neighbours :: [[a]] -> [[a]]
    merge_neighbours :: [[a]] -> [[a]]
merge_neighbours []   = []
    merge_neighbours [[a]
xs] = [[a]
xs]
    merge_neighbours ([a]
xs : [a]
ys : [[a]]
lists) =
      [a] -> [a] -> [a]
merge2 [a]
xs [a]
ys [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]] -> [[a]]
merge_neighbours [[a]]
lists

    -- Since 'merge_neighbours' halves the amount of lists in each iteration,
    -- we perform O(log k) iteration. Each iteration is O(n). The total running
    -- time is therefore O(n log k).
    merge_lists :: [[a]] -> [a]
    merge_lists :: [[a]] -> [a]
merge_lists [[a]]
lists =
      case [[a]] -> [[a]]
merge_neighbours [[a]]
lists of
        []     -> []
        [[a]
xs]   -> [a]
xs
        [[a]]
lists' -> [[a]] -> [a]
merge_lists [[a]]
lists'

-- |From the given cursor position, gets the prefix module or record for autocompletion
getCompletionPrefix :: Position -> VFS.VirtualFile -> PosPrefixInfo
getCompletionPrefix :: Position -> VirtualFile -> PosPrefixInfo
getCompletionPrefix pos :: Position
pos@(Position UInt
l UInt
c) (VFS.VirtualFile Int32
_ Int
_ Rope
ropetext) =
      PosPrefixInfo -> Maybe PosPrefixInfo -> PosPrefixInfo
forall a. a -> Maybe a -> a
fromMaybe (Text -> Text -> Text -> Position -> PosPrefixInfo
PosPrefixInfo Text
"" Text
"" Text
"" Position
pos) (Maybe PosPrefixInfo -> PosPrefixInfo)
-> Maybe PosPrefixInfo -> PosPrefixInfo
forall a b. (a -> b) -> a -> b
$ do -- Maybe monad
        let headMaybe :: [a] -> Maybe a
headMaybe = [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe
            lastMaybe :: [a] -> Maybe a
lastMaybe = [a] -> Maybe a
forall a. [a] -> Maybe a
headMaybe ([a] -> Maybe a) -> ([a] -> [a]) -> [a] -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
reverse

        -- grab the entire line the cursor is at
        Text
curLine <- [Text] -> Maybe Text
forall a. [a] -> Maybe a
headMaybe ([Text] -> Maybe Text) -> [Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Rope -> [Text]
Rope.lines
                             (Rope -> [Text]) -> Rope -> [Text]
forall a b. (a -> b) -> a -> b
$ (Rope, Rope) -> Rope
forall a b. (a, b) -> a
fst ((Rope, Rope) -> Rope) -> (Rope, Rope) -> Rope
forall a b. (a -> b) -> a -> b
$ Word -> Rope -> (Rope, Rope)
Rope.splitAtLine Word
1 (Rope -> (Rope, Rope)) -> Rope -> (Rope, Rope)
forall a b. (a -> b) -> a -> b
$ (Rope, Rope) -> Rope
forall a b. (a, b) -> b
snd ((Rope, Rope) -> Rope) -> (Rope, Rope) -> Rope
forall a b. (a -> b) -> a -> b
$ Word -> Rope -> (Rope, Rope)
Rope.splitAtLine (UInt -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
l) Rope
ropetext
        let beforePos :: Text
beforePos = Int -> Text -> Text
T.take (UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
c) Text
curLine
        -- the word getting typed, after previous space and before cursor
        Text
curWord <-
            if | Text -> Bool
T.null Text
beforePos        -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
""
               | HasCallStack => Text -> Char
Text -> Char
T.last Text
beforePos Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"" -- don't count abc as the curword in 'abc '
               | Bool
otherwise               -> [Text] -> Maybe Text
forall a. [a] -> Maybe a
lastMaybe (Text -> [Text]
T.words Text
beforePos)

        let parts :: [Text]
parts = (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'.')
                      (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.takeWhileEnd (\Char
x -> Char -> Bool
isAlphaNum Char
x Bool -> Bool -> Bool
|| Char
x Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"._'"::String)) Text
curWord
        case [Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
parts of
          [] -> Maybe PosPrefixInfo
forall a. Maybe a
Nothing
          (Text
x:[Text]
xs) -> do
            let modParts :: [Text]
modParts = [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Text -> Bool
T.null) [Text]
xs
                modName :: Text
modName = Text -> [Text] -> Text
T.intercalate Text
"." [Text]
modParts
            PosPrefixInfo -> Maybe PosPrefixInfo
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (PosPrefixInfo -> Maybe PosPrefixInfo)
-> PosPrefixInfo -> Maybe PosPrefixInfo
forall a b. (a -> b) -> a -> b
$ PosPrefixInfo { fullLine :: Text
fullLine = Text
curLine, prefixScope :: Text
prefixScope = Text
modName, prefixText :: Text
prefixText = Text
x, cursorPos :: Position
cursorPos = Position
pos }

completionPrefixPos :: PosPrefixInfo -> Position
completionPrefixPos :: PosPrefixInfo -> Position
completionPrefixPos PosPrefixInfo { cursorPos :: PosPrefixInfo -> Position
cursorPos = Position UInt
ln UInt
co, prefixText :: PosPrefixInfo -> Text
prefixText = Text
str} = UInt -> UInt -> Position
Position UInt
ln (UInt
co UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
- (Integer -> UInt
forall a. Num a => Integer -> a
fromInteger (Integer -> UInt) -> (Text -> Integer) -> Text -> UInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (Text -> Int) -> Text -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
T.length (Text -> UInt) -> Text -> UInt
forall a b. (a -> b) -> a -> b
$ Text
str) UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
- UInt
1)