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


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

import           Control.Applicative
import           Data.Char                                (isAlphaNum, isUpper)
import           Data.Generics
import           Data.List.Extra                          as List hiding
                                                                  (stripPrefix)
import qualified Data.Map                                 as Map

import           Data.Maybe                               (catMaybes, fromMaybe,
                                                           isJust, listToMaybe,
                                                           mapMaybe, isNothing)
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           Data.Functor
import qualified Data.HashMap.Strict                      as HM

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.Compile
import           Development.IDE.Core.PositionMapping
import           Development.IDE.GHC.Compat               hiding (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.Common
import           Development.IDE.Spans.Documentation
import           Development.IDE.Spans.LocalBindings
import           Development.IDE.Types.Exports
import           Development.IDE.Types.HscEnvEq
import           Development.IDE.Types.Options

#if MIN_VERSION_ghc(9,2,0)
import           GHC.Plugins                              (Depth (AllTheWay),
                                                           defaultSDocContext,
                                                           mkUserStyle,
                                                           neverQualify,
                                                           renderWithContext,
                                                           sdocStyle)
#endif
import           Ide.PluginUtils                          (mkLspCommand)
import           Ide.Types                                (CommandId (..),
                                                           IdePlugins (..),
                                                           PluginId)
import           Language.LSP.Types
import           Language.LSP.Types.Capabilities
import qualified Language.LSP.VFS                         as VFS
import           Text.Fuzzy.Parallel                      (Scored (score),
                                                           original)

import qualified Data.Text.Utf16.Rope                     as Rope
import           Development.IDE

import           Development.IDE.Spans.AtPoint            (pointCommand)

#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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Context] -> ShowS
$cshowList :: [Context] -> ShowS
show :: Context -> String
$cshow :: Context -> String
showsPrec :: Int -> Context -> ShowS
$cshowsPrec :: Int -> Context -> ShowS
Show, Context -> Context -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Context -> Context -> Bool
$c/= :: Context -> Context -> Bool
== :: Context -> Context -> Bool
$c== :: Context -> Context -> Bool
Eq)

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

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

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

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

  | Bool
otherwise
  = forall a. Maybe a
Nothing

  where decl :: [LHsDecl GhcPs]
decl = HsModule -> [LHsDecl GhcPs]
hsmodDecls forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> e
unLoc forall a b. (a -> b) -> a -> b
$ ParsedModule -> ParsedSource
pm_parsed_source ParsedModule
pm
        moduleHeader :: Maybe (LocatedA ModuleName)
moduleHeader = HsModule -> Maybe (LocatedA ModuleName)
hsmodName forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> e
unLoc forall a b. (a -> b) -> a -> b
$ ParsedModule -> ParsedSource
pm_parsed_source ParsedModule
pm
        exportList :: Maybe (LocatedL [LIE GhcPs])
exportList = HsModule -> Maybe (LocatedL [LIE GhcPs])
hsmodExports forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> e
unLoc forall a b. (a -> b) -> a -> b
$ ParsedModule -> ParsedSource
pm_parsed_source ParsedModule
pm
        imports :: [LImportDecl GhcPs]
imports = HsModule -> [LImportDecl GhcPs]
hsmodImports forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> e
unLoc forall a b. (a -> b) -> a -> b
$ ParsedModule -> ParsedSource
pm_parsed_source ParsedModule
pm

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

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

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

          | Bool
otherwise = forall a. Maybe a
Nothing
          where importModuleName :: String
importModuleName = ModuleName -> String
moduleNameString forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> e
unLoc forall a b. (a -> b) -> a -> b
$ 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 modName (Just (EverythingBut, L r _))
#else
        importInline :: String
-> Maybe
     (Bool, GenLocated SrcSpan [GenLocated SrcSpanAnnA (IE GhcPs)])
-> Maybe Context
importInline String
modName (Just (Bool
True, L SrcSpan
r [GenLocated SrcSpanAnnA (IE GhcPs)]
_))
#endif
          | Position
pos Position -> SrcSpan -> Bool
`isInsideSrcSpan` SrcSpan
r = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> Context
ImportHidingContext String
modName
          | Bool
otherwise = forall a. Maybe a
Nothing
#if MIN_VERSION_ghc(9,5,0)
        importInline modName (Just (Exactly, L r _))
#else
        importInline String
modName (Just (Bool
False, L SrcSpan
r [GenLocated SrcSpanAnnA (IE GhcPs)]
_))
#endif
          | Position
pos Position -> SrcSpan -> Bool
`isInsideSrcSpan` SrcSpan
r = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> Context
ImportListContext String
modName
          | Bool
otherwise = forall a. Maybe a
Nothing
        importInline String
_ Maybe
  (Bool, GenLocated SrcSpan [GenLocated SrcSpanAnnA (IE GhcPs)])
_ = 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
CiConstructor
                     String
_               -> CompletionItemKind
CiFunction
  | OccName -> Bool
isTcOcc   OccName
oc = CompletionItemKind
CiStruct
  | OccName -> Bool
isDataOcc OccName
oc = CompletionItemKind
CiConstructor
  | Bool
otherwise    = CompletionItemKind
CiVariable


showModName :: ModuleName -> T.Text
showModName :: ModuleName -> Text
showModName = String -> Text
T.pack 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 {Bool
Int
String
[String]
[Text]
Maybe String
IO Bool
IO CheckParents
ShakeOptions
Action IdeGhcSession
IdePkgLocationOptions
ProgressReportingStyle
IdeTesting
IdeDefer
IdeReportProgress
OptHaddockParse
ParsedSource -> IdePreprocessedSource
Config -> DynFlagsModifications
forall a. Typeable a => a -> Bool
optVerifyCoreFile :: IdeOptions -> Bool
optRunSubset :: IdeOptions -> Bool
optProgressStyle :: IdeOptions -> ProgressReportingStyle
optSkipProgress :: IdeOptions -> forall a. Typeable a => a -> Bool
optShakeOptions :: IdeOptions -> ShakeOptions
optModifyDynFlags :: IdeOptions -> Config -> DynFlagsModifications
optHaddockParse :: IdeOptions -> OptHaddockParse
optCheckParents :: IdeOptions -> IO CheckParents
optCheckProject :: IdeOptions -> IO Bool
optDefer :: IdeOptions -> IdeDefer
optKeywords :: IdeOptions -> [Text]
optNewColonConvention :: IdeOptions -> Bool
optLanguageSyntax :: IdeOptions -> String
optMaxDirtyAge :: IdeOptions -> Int
optReportProgress :: IdeOptions -> IdeReportProgress
optTesting :: IdeOptions -> IdeTesting
optShakeProfiling :: IdeOptions -> Maybe String
optExtensions :: IdeOptions -> [String]
optPkgLocationOpts :: IdeOptions -> IdePkgLocationOptions
optGhcSession :: IdeOptions -> Action IdeGhcSession
optPreprocessor :: IdeOptions -> ParsedSource -> IdePreprocessedSource
optVerifyCoreFile :: Bool
optRunSubset :: Bool
optProgressStyle :: ProgressReportingStyle
optSkipProgress :: forall a. Typeable a => a -> Bool
optShakeOptions :: ShakeOptions
optModifyDynFlags :: Config -> DynFlagsModifications
optHaddockParse :: OptHaddockParse
optCheckParents :: IO CheckParents
optCheckProject :: IO Bool
optDefer :: IdeDefer
optKeywords :: [Text]
optNewColonConvention :: Bool
optLanguageSyntax :: String
optMaxDirtyAge :: Int
optReportProgress :: IdeReportProgress
optTesting :: IdeTesting
optShakeProfiling :: Maybe String
optExtensions :: [String]
optPkgLocationOpts :: IdePkgLocationOptions
optGhcSession :: Action IdeGhcSession
optPreprocessor :: ParsedSource -> IdePreprocessedSource
..}
  Uri
uri
  CI
    { CompletionItemKind
compKind :: CompItem -> CompletionItemKind
compKind :: CompletionItemKind
compKind,
      Maybe Backtick
isInfix :: CompItem -> Maybe Backtick
isInfix :: Maybe Backtick
isInfix,
      Text
insertText :: CompItem -> Text
insertText :: Text
insertText,
      Provenance
provenance :: CompItem -> Provenance
provenance :: Provenance
provenance,
      Text
label :: CompItem -> Text
label :: Text
label,
      Maybe Text
typeText :: CompItem -> Maybe Text
typeText :: Maybe Text
typeText,
      Maybe ExtendImport
additionalTextEdits :: CompItem -> Maybe ExtendImport
additionalTextEdits :: Maybe ExtendImport
additionalTextEdits,
      Maybe NameDetails
nameDetails :: CompItem -> Maybe NameDetails
nameDetails :: Maybe NameDetails
nameDetails
    } = do
  let mbCommand :: Maybe Command
mbCommand = Maybe PluginId -> ExtendImport -> Maybe Command
mkAdditionalEditsCommand Maybe PluginId
pId 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 (List CompletionItemTag)
_tags = 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) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text
":: " forall a. Semigroup a => a -> a -> a
<> Text
t
                          (Maybe Text
_, ImportedFrom Text
mod)      -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text
"from " forall a. Semigroup a => a -> a -> a
<> Text
mod
                          (Maybe Text
_, DefinedIn Text
mod)         -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text
"from " forall a. Semigroup a => a -> a -> a
<> Text
mod
                          (Maybe Text, Provenance)
_                          -> forall a. Maybe a
Nothing,
                  $sel:_documentation:CompletionItem :: Maybe CompletionDoc
_documentation = Maybe CompletionDoc
documentation,
                  $sel:_deprecated:CompletionItem :: Maybe Bool
_deprecated = forall a. Maybe a
Nothing,
                  $sel:_preselect:CompletionItem :: Maybe Bool
_preselect = forall a. Maybe a
Nothing,
                  $sel:_sortText:CompletionItem :: Maybe Text
_sortText = forall a. Maybe a
Nothing,
                  $sel:_filterText:CompletionItem :: Maybe Text
_filterText = forall a. Maybe a
Nothing,
                  $sel:_insertText:CompletionItem :: Maybe Text
_insertText = forall a. a -> Maybe a
Just Text
insertText,
                  $sel:_insertTextFormat:CompletionItem :: Maybe InsertTextFormat
_insertTextFormat = forall a. a -> Maybe a
Just InsertTextFormat
Snippet,
                  $sel:_insertTextMode:CompletionItem :: Maybe InsertTextMode
_insertTextMode = forall a. Maybe a
Nothing,
                  $sel:_textEdit:CompletionItem :: Maybe CompletionEdit
_textEdit = forall a. Maybe a
Nothing,
                  $sel:_additionalTextEdits:CompletionItem :: Maybe (List TextEdit)
_additionalTextEdits = forall a. Maybe a
Nothing,
                  $sel:_commitCharacters:CompletionItem :: Maybe (List Text)
_commitCharacters = forall a. Maybe a
Nothing,
                  $sel:_command:CompletionItem :: Maybe Command
_command = Maybe Command
mbCommand,
                  $sel:_xdata:CompletionItem :: Maybe Value
_xdata = forall a. ToJSON a => a -> Value
toJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Uri -> Bool -> NameDetails -> CompletionResolveData
CompletionResolveData Uri
uri (forall a. Maybe a -> Bool
isNothing Maybe Text
typeText)) Maybe NameDetails
nameDetails}
  Bool -> CompletionItem -> CompletionItem
removeSnippetsWhen (forall a. Maybe a -> Bool
isJust Maybe Backtick
isInfix) CompletionItem
ci

  where kind :: Maybe CompletionItemKind
kind = 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 " forall a. Semigroup a => a -> a -> a
<> SrcLoc -> Text
pprLineCol (SrcSpan -> SrcLoc
srcSpanStart SrcSpan
pos) forall a. Semigroup a => a -> a -> a
<> Text
" in this module*\n"
          ImportedFrom Text
mod -> Text
"*Imported from '" forall a. Semigroup a => a -> a -> a
<> Text
mod forall a. Semigroup a => a -> a -> a
<> Text
"'*\n"
          DefinedIn Text
mod -> Text
"*Defined in '" forall a. Semigroup a => a -> a -> a
<> Text
mod forall a. Semigroup a => a -> a -> a
<> Text
"'*\n"
        documentation :: Maybe CompletionDoc
documentation = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ MarkupContent -> CompletionDoc
CompletionDocMarkup forall a b. (a -> b) -> a -> b
$
                        MarkupKind -> Text -> MarkupContent
MarkupContent MarkupKind
MkMarkdown 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 forall a b. (a -> b) -> a -> b
$ FastString -> String
unpackFS FastString
fs
        pprLineCol (RealSrcLoc RealSrcLoc
loc Maybe BufPos
_) =
            Text
"line " forall a. Semigroup a => a -> a -> a
<> forall a. Outputable a => a -> Text
printOutputable (RealSrcLoc -> Int
srcLocLine RealSrcLoc
loc) forall a. Semigroup a => a -> a -> a
<> Text
", column " forall a. Semigroup a => a -> a -> a
<> 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 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ PluginId -> CommandId -> Text -> Maybe [Value] -> Command
mkLspCommand PluginId
pId (Text -> CommandId
CommandId Text
extendImportCommandId) Text
"extend import" (forall a. a -> Maybe a
Just [forall a. ToJSON a => a -> Value
toJSON ExtendImport
edits])
mkAdditionalEditsCommand Maybe PluginId
_ ExtendImport
_ = 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 NameDetails
Maybe ExtendImport
Maybe Backtick
Text
CompletionItemKind
Provenance
forall a. Maybe a
isLocalCompletion :: Bool
isTypeCompl :: Bool
additionalTextEdits :: Maybe ExtendImport
insertText :: Text
label :: Text
typeText :: forall a. Maybe a
isTypeCompl :: Bool
compKind :: CompletionItemKind
nameDetails :: Maybe NameDetails
isLocalCompletion :: Bool
isInfix :: Maybe Backtick
provenance :: Provenance
nameDetails :: Maybe NameDetails
additionalTextEdits :: Maybe ExtendImport
typeText :: Maybe Text
label :: Text
provenance :: Provenance
insertText :: Text
isInfix :: Maybe Backtick
compKind :: CompletionItemKind
..}
  where
    isLocalCompletion :: Bool
isLocalCompletion = Bool
True
    nameDetails :: Maybe NameDetails
nameDetails = Module -> OccName -> NameDetails
NameDetails forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Module
mod forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 = forall a. Maybe a
Nothing
    label :: Text
label = Text -> Text
stripPrefix forall a b. (a -> b) -> a -> b
$ 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 forall a. Semigroup a => a -> a -> a
<> Text
"`"

            Just Backtick
Surrounded -> Text
label
    additionalTextEdits :: Maybe ExtendImport
additionalTextEdits =
      Maybe (LImportDecl GhcPs)
imp 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 forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> e
unLoc forall a b. (a -> b) -> a -> b
$ forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (ImportDecl GhcPs)
x,
            importQual :: Maybe Text
importQual = LImportDecl GhcPs -> Maybe Text
getImportQual GenLocated SrcSpanAnnA (ImportDecl GhcPs)
x,
            newThing :: Text
newThing = forall a. Outputable a => a -> Text
printOutputable OccName
origName
          }

showForSnippet :: Outputable a => a -> T.Text
#if MIN_VERSION_ghc(9,2,0)
showForSnippet :: forall a. Outputable a => a -> Text
showForSnippet a
x = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ SDocContext -> SDoc -> String
renderWithContext SDocContext
ctxt forall a b. (a -> b) -> a -> b
$ forall a. Outputable a => a -> SDoc
GHC.ppr a
x -- FIXme
    where
        ctxt :: SDocContext
ctxt = SDocContext
defaultSDocContext{sdocStyle :: PprStyle
sdocStyle = PrintUnqualified -> Depth -> PprStyle
mkUserStyle PrintUnqualified
neverQualify Depth
AllTheWay}
#else
showForSnippet x = printOutputable x
#endif

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

mkModuleFunctionImport :: T.Text -> T.Text -> CompletionItem
mkModuleFunctionImport :: Text -> Text -> CompletionItem
mkModuleFunctionImport Text
moduleName Text
label =
  Text
-> Maybe CompletionItemKind
-> Maybe (List CompletionItemTag)
-> Maybe Text
-> Maybe CompletionDoc
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe InsertTextFormat
-> Maybe InsertTextMode
-> Maybe CompletionEdit
-> Maybe (List TextEdit)
-> Maybe (List Text)
-> Maybe Command
-> Maybe Value
-> CompletionItem
CompletionItem Text
label (forall a. a -> Maybe a
Just CompletionItemKind
CiFunction) forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Text
moduleName)
    forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing
    forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing

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

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


fromIdentInfo :: Uri -> IdentInfo -> Maybe T.Text -> CompItem
fromIdentInfo :: Uri -> IdentInfo -> Maybe Text -> CompItem
fromIdentInfo Uri
doc id :: IdentInfo
id@IdentInfo{Maybe OccName
OccName
ModuleName
identModuleName :: IdentInfo -> ModuleName
parent :: IdentInfo -> Maybe OccName
name :: IdentInfo -> OccName
identModuleName :: ModuleName
parent :: Maybe OccName
name :: OccName
..} 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 = forall a. Maybe a
Nothing
  , isInfix :: Maybe Backtick
isInfix=forall a. Maybe a
Nothing
  , isTypeCompl :: Bool
isTypeCompl= Bool -> Bool
not (IdentInfo -> Bool
isDatacon IdentInfo
id) Bool -> Bool -> Bool
&& Char -> Bool
isUpper (Text -> Char
T.head Text
rend)
  , additionalTextEdits :: Maybe ExtendImport
additionalTextEdits= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
        ExtendImport
          { Uri
doc :: Uri
doc :: Uri
doc,
            thingParent :: Maybe Text
thingParent = OccName -> Text
occNameText 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 = forall a. Maybe a
Nothing
  , isLocalCompletion :: Bool
isLocalCompletion = Bool
False
  }
  where rend :: Text
rend = IdentInfo -> Text
rendered IdentInfo
id
        mod :: Text
mod = IdentInfo -> Text
moduleNameText IdentInfo
id

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 = forall unit. GenModule unit -> ModuleName
moduleName Module
curMod
      curModNameText :: Text
curModNameText = forall a. Outputable a => a -> Text
printOutputable ModuleName
curModName

      importMap :: Map RealSrcSpan (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
importMap = 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 (forall a. SrcSpanAnn' a -> SrcSpan
locA -> (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_)) ImportDecl GhcPs
_) <- [LImportDecl GhcPs]
limports ]

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

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


      -- The given namespaces for the imported modules (ie. full name, or alias if used)
      allModNamesAsNS :: [Text]
allModNamesAsNS = forall a b. (a -> b) -> [a] -> [b]
map (ModuleName -> Text
showModName 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 [FastString]
fieldMap = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. [a] -> [a] -> [a]
(++) forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [GlobalRdrElt]
rdrElts forall a b. (a -> b) -> a -> b
$ \GlobalRdrElt
elt -> do
#if MIN_VERSION_ghc(9,2,0)
        Name
par <- GlobalRdrElt -> Maybe Name
greParent_maybe GlobalRdrElt
elt
        FieldLabel
flbl <- GlobalRdrElt -> Maybe FieldLabel
greFieldLabel GlobalRdrElt
elt
        forall a. a -> Maybe a
Just (Name
par,[FieldLabel -> FastString
flLabel FieldLabel
flbl])
#else
        case gre_par elt of
          FldParent n ml -> do
            l <- ml
            Just (n, [l])
          _ -> Nothing
#endif

      getCompls :: [GlobalRdrElt] -> ([CompItem],QualCompls)
      getCompls :: [GlobalRdrElt] -> ([CompItem], QualCompls)
getCompls = 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 forall a. Maybe a
Nothing, forall a. Monoid a => a
mempty)
      getComplsForOne (GRE Name
n Parent
par Bool
False [ImportSpec]
prov) =
        forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a b. (a -> b) -> [a] -> [b]
map ImportSpec -> ImpDeclSpec
is_decl [ImportSpec]
prov) 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
                forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null 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 forall a b. (a -> b) -> a -> b
$ ImpDeclSpec -> SrcSpan
is_dloc ImpDeclSpec
spec
                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 (forall a. Outputable a => a -> Text
printOutputable forall a b. (a -> b) -> a -> b
$ ImpDeclSpec -> ModuleName
is_mod ImpDeclSpec
spec) Name
n 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 = forall k a. k -> a -> Map k a
Map.singleton Text
asMod [CompItem]
compItem
                | Bool
otherwise = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text
asMod,[CompItem]
compItem),(Text
origMod,[CompItem]
compItem)]
              asMod :: Text
asMod = ModuleName -> Text
showModName (ImpDeclSpec -> ModuleName
is_as ImpDeclSpec
spec)
              origMod :: Text
origMod = ModuleName -> Text
showModName (ImpDeclSpec -> ModuleName
is_mod ImpDeclSpec
spec)
          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
m 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 -> (forall a. Maybe a
Nothing, Name -> OccName
nameOccName Name
n)
                            ParentIs Name
n' -> (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ Name -> String
printName Name
n', Name -> OccName
nameOccName Name
n)
#if !MIN_VERSION_ghc(9,2,0)
                            FldParent n' lbl -> (Just . T.pack $ printName n', maybe (nameOccName n) mkVarOccFS lbl)
#endif
            recordCompls :: [CompItem]
recordCompls = case Parent
par of
                ParentIs Name
parent
                  | Name -> Bool
isDataConName Name
n
                  , Just [FastString]
flds <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
parent Map Name [FastString]
fieldMap
                  , Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FastString]
flds) ->
                    [Uri
-> Maybe Text
-> Text
-> [Text]
-> Provenance
-> Maybe (LImportDecl GhcPs)
-> CompItem
mkRecordSnippetCompItem Uri
uri Maybe Text
mbParent (forall a. Outputable a => a -> Text
printOutputable OccName
originName) (forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> String
unpackFS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> a
field_label) [FastString]
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) forall a. Maybe a
Nothing Maybe (LImportDecl GhcPs)
imp' (Name -> Maybe Module
nameModule_maybe Name
n)
           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 = 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 -> ParsedSource
pm_parsed_source = L SrcSpan
_ HsModule{[LHsDecl GhcPs]
hsmodDecls :: [LHsDecl GhcPs]
hsmodDecls :: HsModule -> [LHsDecl GhcPs]
hsmodDecls}} =
    CC { allModNamesAsNS :: [Text]
allModNamesAsNS = forall a. Monoid a => a
mempty
       , unqualCompls :: [CompItem]
unqualCompls = [CompItem]
compls
       , qualCompls :: QualCompls
qualCompls = forall a. Monoid a => a
mempty
       , anyQualCompls :: [Maybe Text -> CompItem]
anyQualCompls = []
       , importableModules :: [Text]
importableModules = forall a. Monoid a => a
mempty
        }
  where
    typeSigIds :: Set RdrName
typeSigIds = forall a. Ord a => [a] -> Set a
Set.fromList
        [ RdrName
id
            | L SrcSpanAnnA
_ (SigD XSigD GhcPs
_ (TypeSig XTypeSig GhcPs
_ [LIdP GhcPs]
ids LHsSigWcType GhcPs
_)) <- [LHsDecl GhcPs]
hsmodDecls
            , L SrcSpanAnnN
_ RdrName
id <- [LIdP GhcPs]
ids
            ]
    hasTypeSig :: LocatedN RdrName -> Bool
hasTypeSig = (forall a. Ord a => a -> Set a -> Bool
`Set.member` Set RdrName
typeSigIds) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc

    compls :: [CompItem]
compls = 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) ->
                [LocatedN RdrName -> CompletionItemKind -> Maybe Text -> CompItem
mkComp LocatedN RdrName
id CompletionItemKind
CiFunction (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Outputable a => a -> Text
showForSnippet LHsSigWcType GhcPs
typ) | LocatedN RdrName
id <- [LIdP GhcPs]
ids]
            ValD XValD GhcPs
_ FunBind{LIdP GhcPs
fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id :: LIdP GhcPs
fun_id} ->
                [ LocatedN RdrName -> CompletionItemKind -> Maybe Text -> CompItem
mkComp LIdP GhcPs
fun_id CompletionItemKind
CiFunction forall a. Maybe a
Nothing
                | Bool -> Bool
not (LocatedN RdrName -> Bool
hasTypeSig LIdP GhcPs
fun_id)
                ]
            ValD XValD GhcPs
_ PatBind{LPat GhcPs
pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
pat_lhs :: LPat GhcPs
pat_lhs} ->
                [LocatedN RdrName -> CompletionItemKind -> Maybe Text -> CompItem
mkComp LIdP GhcPs
id CompletionItemKind
CiVariable forall a. Maybe a
Nothing
                | VarPat XVarPat GhcPs
_ LIdP GhcPs
id <- forall r. Typeable r => (r -> Bool) -> GenericQ [r]
listify (\(Pat GhcPs
_ :: Pat GhcPs) -> Bool
True) LPat GhcPs
pat_lhs]
            TyClD XTyClD GhcPs
_ ClassDecl{LIdP GhcPs
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName :: LIdP GhcPs
tcdLName, [LSig GhcPs]
tcdSigs :: forall pass. TyClDecl pass -> [LSig pass]
tcdSigs :: [LSig GhcPs]
tcdSigs, [LFamilyDecl GhcPs]
tcdATs :: forall pass. TyClDecl pass -> [LFamilyDecl pass]
tcdATs :: [LFamilyDecl GhcPs]
tcdATs} ->
                LocatedN RdrName -> CompletionItemKind -> Maybe Text -> CompItem
mkComp LIdP GhcPs
tcdLName CompletionItemKind
CiInterface (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Outputable a => a -> Text
showForSnippet LIdP GhcPs
tcdLName) forall a. a -> [a] -> [a]
:
                [ LocatedN RdrName -> CompletionItemKind -> Maybe Text -> CompItem
mkComp LocatedN RdrName
id CompletionItemKind
CiFunction (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Outputable a => a -> Text
showForSnippet LHsSigType GhcPs
typ)
                | L SrcSpanAnnA
_ (ClassOpSig XClassOpSig GhcPs
_ Bool
_ [LIdP GhcPs]
ids LHsSigType GhcPs
typ) <- [LSig GhcPs]
tcdSigs
                , LocatedN RdrName
id <- [LIdP GhcPs]
ids] forall a. [a] -> [a] -> [a]
++
                [ LocatedN RdrName -> CompletionItemKind -> Maybe Text -> CompItem
mkComp LIdP GhcPs
fdLName CompletionItemKind
CiStruct (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Outputable a => a -> Text
showForSnippet LIdP GhcPs
fdLName)
                | L SrcSpanAnnA
_ (FamilyDecl{LIdP GhcPs
fdLName :: forall pass. FamilyDecl pass -> LIdP pass
fdLName :: LIdP GhcPs
fdLName}) <- [LFamilyDecl GhcPs]
tcdATs]
            TyClD XTyClD GhcPs
_ TyClDecl GhcPs
x ->
                let generalCompls :: [CompItem]
generalCompls = [LocatedN RdrName -> CompletionItemKind -> Maybe Text -> CompItem
mkComp LocatedN RdrName
id CompletionItemKind
cl (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Outputable a => a -> Text
showForSnippet forall a b. (a -> b) -> a -> b
$ forall (p :: Pass).
(Anno (IdGhcP p) ~ SrcSpanAnnN) =>
TyClDecl (GhcPass p) -> LocatedN (IdP (GhcPass p))
tyClDeclLName TyClDecl GhcPs
x)
                        | LocatedN RdrName
id <- 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 forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> e
unLoc LocatedN RdrName
id)]
                    -- 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 forall a. [a] -> [a] -> [a]
++ [CompItem]
recordCompls
            ForD XForD GhcPs
_ ForeignImport{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} ->
                [LocatedN RdrName -> CompletionItemKind -> Maybe Text -> CompItem
mkComp LIdP GhcPs
fd_name CompletionItemKind
CiVariable (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Outputable a => a -> Text
showForSnippet LHsSigType GhcPs
fd_sig_ty)]
            ForD XForD GhcPs
_ ForeignExport{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} ->
                [LocatedN RdrName -> CompletionItemKind -> Maybe Text -> CompItem
mkComp LIdP GhcPs
fd_name CompletionItemKind
CiVariable (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Outputable a => a -> Text
showForSnippet LHsSigType GhcPs
fd_sig_ty)]
            HsDecl GhcPs
_ -> []
            | L (forall a. SrcSpanAnn' a -> SrcSpan
locA -> SrcSpan
pos) HsDecl GhcPs
decl <- [LHsDecl GhcPs]
hsmodDecls,
            let mkComp :: LocatedN RdrName -> CompletionItemKind -> Maybe Text -> CompItem
mkComp = SrcSpan
-> LocatedN RdrName -> CompletionItemKind -> Maybe Text -> CompItem
mkLocalComp SrcSpan
pos
        ]

    mkLocalComp :: SrcSpan
-> LocatedN RdrName -> CompletionItemKind -> Maybe Text -> CompItem
mkLocalComp SrcSpan
pos LocatedN 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 forall a. Maybe a
Nothing (CompletionItemKind
ctyp forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CompletionItemKind
CiStruct, CompletionItemKind
CiInterface]) forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Module -> OccName -> NameDetails
NameDetails (ModSummary -> Module
ms_mod 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 forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> e
unLoc LocatedN RdrName
n
        pn :: Text
pn = forall a. Outputable a => a -> Text
showForSnippet LocatedN RdrName
n

findRecordCompl :: Uri -> Provenance -> TyClDecl GhcPs -> [CompItem]
findRecordCompl :: Uri -> Provenance -> TyClDecl GhcPs -> [CompItem]
findRecordCompl Uri
uri Provenance
mn DataDecl {LIdP GhcPs
tcdLName :: LIdP GhcPs
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName, HsDataDefn GhcPs
tcdDataDefn :: forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn :: HsDataDefn GhcPs
tcdDataDefn} = [CompItem]
result
    where
        result :: [CompItem]
result = [Uri
-> Maybe Text
-> Text
-> [Text]
-> Provenance
-> Maybe (LImportDecl GhcPs)
-> CompItem
mkRecordSnippetCompItem Uri
uri (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Outputable a => a -> Text
printOutputable forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> e
unLoc LIdP GhcPs
tcdLName)
                        (forall a. Outputable a => a -> Text
printOutputable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc forall a b. (a -> b) -> a -> b
$ LIdP GhcPs
con_name) [Text]
field_labels Provenance
mn forall a. Maybe a
Nothing
                 | ConDeclH98{Bool
[LHsTyVarBndr Specificity GhcPs]
Maybe (LHsContext GhcPs)
Maybe LHsDocString
HsConDeclH98Details GhcPs
LIdP GhcPs
XConDeclH98 GhcPs
con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_doc :: forall pass. ConDecl pass -> Maybe LHsDocString
con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr Specificity pass]
con_ext :: forall pass. ConDecl pass -> XConDeclH98 pass
con_forall :: forall pass. ConDecl pass -> Bool
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_name :: forall pass. ConDecl pass -> LIdP pass
con_doc :: Maybe LHsDocString
con_args :: HsConDeclH98Details GhcPs
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_ex_tvs :: [LHsTyVarBndr Specificity GhcPs]
con_forall :: Bool
con_ext :: XConDeclH98 GhcPs
con_name :: LIdP GhcPs
..} <- forall l e. GenLocated l e -> e
unLoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. a -> a
extract_cons forall a b. (a -> b) -> a -> b
$ forall pass. HsDataDefn pass -> [LConDecl pass]
dd_cons HsDataDefn GhcPs
tcdDataDefn)
                 , Just  [ConDeclField GhcPs]
con_details <- [forall {tyarg} {arg} {l} {l} {b}.
HsConDetails tyarg arg (GenLocated l [GenLocated l b]) -> Maybe [b]
getFlds HsConDeclH98Details GhcPs
con_args]
                 , let field_names :: [LocatedN RdrName]
field_names = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {pass} {l}.
(XRec pass (FieldOcc pass) ~ GenLocated l (FieldOcc pass)) =>
ConDeclField pass -> [LocatedN RdrName]
extract [ConDeclField GhcPs]
con_details
                 , let field_labels :: [Text]
field_labels = forall a. Outputable a => a -> Text
printOutputable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LocatedN RdrName]
field_names
                 , (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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  -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> e
unLoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall l e. GenLocated l e -> e
unLoc GenLocated l [GenLocated l b]
rec
                             PrefixCon{} -> forall a. a -> Maybe a
Just []
                             HsConDetails tyarg arg (GenLocated l [GenLocated l 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{..}
            = map (foLabel . unLoc) cd_fld_names
#else
        extract :: ConDeclField pass -> [LocatedN RdrName]
extract ConDeclField{[XRec pass (FieldOcc pass)]
Maybe LHsDocString
LBangType pass
XConDeclField pass
cd_fld_doc :: forall pass. ConDeclField pass -> Maybe LHsDocString
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 :: Maybe LHsDocString
cd_fld_type :: LBangType pass
cd_fld_names :: [XRec pass (FieldOcc pass)]
cd_fld_ext :: XConDeclField pass
..}
            = forall a b. (a -> b) -> [a] -> [b]
map (forall pass. FieldOcc pass -> LocatedN RdrName
rdrNameFieldOcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) [XRec pass (FieldOcc pass)]
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
$sel:_textDocument:ClientCapabilities :: ClientCapabilities -> Maybe TextDocumentClientCapabilities
_textDocument :: Maybe TextDocumentClientCapabilities
_textDocument} CompletionsConfig{Bool
Int
maxCompletions :: CompletionsConfig -> Int
enableAutoExtend :: CompletionsConfig -> Bool
enableSnippets :: CompletionsConfig -> Bool
maxCompletions :: Int
enableAutoExtend :: Bool
enableSnippets :: Bool
..} =
  Bool -> CompletionItem -> CompletionItem
removeSnippetsWhen (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Bool
enableSnippets Bool -> Bool -> Bool
&& Bool
supported)
  where
    supported :: Bool
supported =
      forall a. a -> Maybe a
Just Bool
True forall a. Eq a => a -> a -> Bool
== (Maybe TextDocumentClientCapabilities
_textDocument forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TextDocumentClientCapabilities
-> Maybe CompletionClientCapabilities
_completion forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CompletionClientCapabilities
-> Maybe CompletionItemClientCapabilities
_completionItem forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CompletionItemClientCapabilities -> Maybe Bool
_snippetSupport)

toggleAutoExtend :: CompletionsConfig -> CompItem -> CompItem
toggleAutoExtend :: CompletionsConfig -> CompItem -> CompItem
toggleAutoExtend CompletionsConfig{enableAutoExtend :: CompletionsConfig -> Bool
enableAutoExtend=Bool
False} CompItem
x = CompItem
x {additionalTextEdits :: Maybe ExtendImport
additionalTextEdits = forall a. Maybe a
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
        { $sel:_insertTextFormat:CompletionItem :: Maybe InsertTextFormat
_insertTextFormat = forall a. a -> Maybe a
Just InsertTextFormat
PlainText,
          $sel:_insertText:CompletionItem :: Maybe Text
_insertText = forall a. Maybe a
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
    -> IO [Scored CompletionItem]
getCompletions :: forall a.
IdePlugins a
-> IdeOptions
-> CachedCompletions
-> Maybe (ParsedModule, PositionMapping)
-> Maybe (HieAstResult, PositionMapping)
-> (Bindings, PositionMapping)
-> PosPrefixInfo
-> ClientCapabilities
-> CompletionsConfig
-> ModuleNameEnv (HashSet IdentInfo)
-> Uri
-> IO [Scored CompletionItem]
getCompletions IdePlugins a
plugins IdeOptions
ideOpts CC {[Text]
allModNamesAsNS :: [Text]
allModNamesAsNS :: CachedCompletions -> [Text]
allModNamesAsNS, [Maybe Text -> CompItem]
anyQualCompls :: [Maybe Text -> CompItem]
anyQualCompls :: CachedCompletions -> [Maybe Text -> CompItem]
anyQualCompls, [CompItem]
unqualCompls :: [CompItem]
unqualCompls :: CachedCompletions -> [CompItem]
unqualCompls, QualCompls
qualCompls :: QualCompls
qualCompls :: CachedCompletions -> QualCompls
qualCompls, [Text]
importableModules :: [Text]
importableModules :: CachedCompletions -> [Text]
importableModules}
               Maybe (ParsedModule, PositionMapping)
maybe_parsed Maybe (HieAstResult, PositionMapping)
maybe_ast_res (Bindings
localBindings, PositionMapping
bmapping) PosPrefixInfo
prefixInfo ClientCapabilities
caps CompletionsConfig
config ModuleNameEnv (HashSet IdentInfo)
moduleExportsMap Uri
uri = do
  let PosPrefixInfo { Text
fullLine :: PosPrefixInfo -> Text
fullLine :: Text
fullLine, Text
prefixScope :: PosPrefixInfo -> Text
prefixScope :: Text
prefixScope, Text
prefixText :: PosPrefixInfo -> Text
prefixText :: Text
prefixText } = PosPrefixInfo
prefixInfo
      enteredQual :: Text
enteredQual = if Text -> Bool
T.null Text
prefixScope then Text
"" else Text
prefixScope forall a. Semigroup a => a -> a -> a
<> Text
"."
      fullPrefix :: Text
fullPrefix  = Text
enteredQual 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 =
        (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) Text -> CompletionItem
mkModCompl
          forall a b. (a -> b) -> a -> b
$ Int -> Int -> Text -> [Text] -> [Scored Text]
Fuzzy.simpleFilter Int
chunkSize Int
maxC Text
fullPrefix
          forall a b. (a -> b) -> a -> b
$ (if Text -> Bool
T.null Text
enteredQual then forall a. a -> a
id else forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text -> Text -> Maybe Text
T.stripPrefix Text
enteredQual))
            [Text]
allModNamesAsNS

      filtCompls :: [Scored (Bool, CompItem)]
filtCompls = forall t. Int -> Int -> Text -> [t] -> (t -> Text) -> [Scored t]
Fuzzy.filter Int
chunkSize Int
maxC Text
prefixText [(Bool, CompItem)]
ctxCompls (CompItem -> Text
label forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
        where

          mcc :: Maybe Context
mcc = case Maybe (ParsedModule, PositionMapping)
maybe_parsed of
            Maybe (ParsedModule, PositionMapping)
Nothing -> 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 = forall a. PositionResult a -> a
lowerRange PositionResult Position
position'
                  hpos :: Position
hpos = forall a. PositionResult a -> a
upperRange PositionResult Position
position'
              in Position -> ParsedModule -> Maybe Context
getCContext Position
lpos ParsedModule
pm forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Position -> ParsedModule -> Maybe Context
getCContext Position
hpos ParsedModule
pm


          -- 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
_) -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall t a. HieASTs t -> Position -> (HieAST t -> a) -> [a]
pointCommand HieASTs a
hieast (PosPrefixInfo -> Position
completionPrefixPos PosPrefixInfo
prefixInfo) HieAST Type -> [(Bool, CompItem)]
nodeCompletions
            Maybe (HieAstResult, PositionMapping)
_ -> []
            where
              nodeCompletions :: HieAST Type -> [(Bool, CompItem)]
              nodeCompletions :: HieAST Type -> [(Bool, CompItem)]
nodeCompletions HieAST Type
node = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Type -> [(Bool, CompItem)]
g (forall a. NodeInfo a -> [a]
nodeType 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]
_) = forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text -> (Bool, CompItem)
dotFieldSelectorToCompl (forall a. Outputable a => a -> Text
printOutputable forall a b. (a -> b) -> a -> b
$ TyCon -> Name
GHC.tyConName TyCon
theTyCon)) 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 = forall a. Outputable a => a -> Text
printOutputable a
fieldLabel
                              in forall a b. (a -> b) -> [a] -> [b]
map forall a. Outputable a => a -> Text
f 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
CiField
                , insertText :: Text
insertText = Text
label
                , provenance :: Provenance
provenance = Text -> Provenance
DefinedIn Text
recname
                , label :: Text
label = Text
label
                , typeText :: Maybe Text
typeText = forall a. Maybe a
Nothing
                , isInfix :: Maybe Backtick
isInfix = forall a. Maybe a
Nothing
                , isTypeCompl :: Bool
isTypeCompl = Bool
False
                , additionalTextEdits :: Maybe ExtendImport
additionalTextEdits = forall a. Maybe a
Nothing
                , nameDetails :: Maybe NameDetails
nameDetails = forall a. Maybe a
Nothing
                , isLocalCompletion :: Bool
isLocalCompletion = Bool
False
                })

          -- completions specific to the current context
          ctxCompls' :: [(Bool, CompItem)]
ctxCompls' = case Maybe Context
mcc of
                        Maybe Context
Nothing           -> [(Bool, CompItem)]
compls
                        Just Context
TypeContext  -> forall a. (a -> Bool) -> [a] -> [a]
filter ( CompItem -> Bool
isTypeCompl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Bool, CompItem)]
compls
                        Just Context
ValueContext -> forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompItem -> Bool
isTypeCompl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Bool, CompItem)]
compls
                        Just Context
_            -> forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompItem -> Bool
isTypeCompl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Bool, CompItem)]
compls
          -- Add whether the text to insert has backticks
          ctxCompls :: [(Bool, CompItem)]
ctxCompls = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (\CompItem
comp -> CompletionsConfig -> CompItem -> CompItem
toggleAutoExtend CompletionsConfig
config forall a b. (a -> b) -> a -> b
$ CompItem
comp { isInfix :: Maybe Backtick
isInfix = Maybe Backtick
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 forall a b. (a -> b) -> a -> b
$ PosPrefixInfo -> Position
cursorPos PosPrefixInfo
prefixInfo
          startLoc :: Position
startLoc = forall a. PositionResult a -> a
lowerRange PositionResult Position
oldPos
          endLoc :: Position
endLoc = forall a. PositionResult a -> a
upperRange PositionResult Position
oldPos
          localCompls :: [CompItem]
localCompls = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Name -> Maybe Type -> CompItem
localBindsToCompItem) 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 forall a. Maybe a
Nothing (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ OccName -> Bool
isValOcc OccName
occ) 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 = forall a. Outputable a => a -> Text
showForSnippet Name
name
              ty :: Maybe Text
ty = forall a. Outputable a => a -> Text
showForSnippet forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Type
typ
              thisModName :: Provenance
thisModName = SrcSpan -> Provenance
Local forall a b. (a -> b) -> a -> b
$ Name -> SrcSpan
nameSrcSpan Name
name
              dets :: Maybe NameDetails
dets = Module -> OccName -> NameDetails
NameDetails forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Name -> Maybe Module
nameModule_maybe Name
name) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 = forall a b. (a -> b) -> [a] -> [b]
map (Bool
notQual,) [CompItem]
localCompls forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (Bool
qual,) [CompItem]
unqualCompls forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (\Maybe Text -> CompItem
compl -> (Bool
notQual, Maybe Text -> CompItem
compl forall a. Maybe a
Nothing)) [Maybe Text -> CompItem]
anyQualCompls
            | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Bool, CompItem)]
recordDotSyntaxCompls = [(Bool, CompItem)]
recordDotSyntaxCompls
            | Bool
otherwise = ((Bool
qual,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] Text
prefixScope (QualCompls -> Map Text [CompItem]
getQualCompls QualCompls
qualCompls))
                 forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (\Maybe Text -> CompItem
compl -> (Bool
notQual, Maybe Text -> CompItem
compl (forall a. a -> Maybe a
Just Text
prefixScope))) [Maybe Text -> CompItem]
anyQualCompls

      filtListWith :: (Text -> CompletionItem) -> [Text] -> [Scored CompletionItem]
filtListWith Text -> CompletionItem
f [Text]
list =
        [ 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]
list
        , Text
enteredQual Text -> Text -> Bool
`T.isPrefixOf` forall a. Scored a -> a
original Scored Text
label
        ]

      filtImportCompls :: [Scored CompletionItem]
filtImportCompls = (Text -> CompletionItem) -> [Text] -> [Scored CompletionItem]
filtListWith (Text -> Text -> CompletionItem
mkImportCompl Text
enteredQual) [Text]
importableModules
      filterModuleExports :: Text -> [Text] -> [Scored CompletionItem]
filterModuleExports Text
moduleName = (Text -> CompletionItem) -> [Text] -> [Scored CompletionItem]
filtListWith forall a b. (a -> b) -> a -> b
$ Text -> Text -> CompletionItem
mkModuleFunctionImport Text
moduleName
      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 = []

  if
    -- TODO: handle multiline imports
    | Text
"import " Text -> Text -> Bool
`T.isPrefixOf` Text
fullLine
      Bool -> Bool -> Bool
&& (forall (t :: * -> *) a. Foldable t => t a -> Int
List.length (String -> [String]
words (Text -> String
T.unpack Text
fullLine)) forall a. Ord a => a -> a -> Bool
>= Int
2)
      Bool -> Bool -> Bool
&& String
"(" forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` Text -> String
T.unpack Text
fullLine
    -> do
      let moduleName :: String
moduleName = String -> [String]
words (Text -> String
T.unpack Text
fullLine) forall a. [a] -> Int -> a
!! Int
1
          funcs :: HashSet IdentInfo
funcs = forall key elt.
Uniquable key =>
UniqFM key elt -> elt -> key -> elt
lookupWithDefaultUFM ModuleNameEnv (HashSet IdentInfo)
moduleExportsMap forall a. HashSet a
HashSet.empty forall a b. (a -> b) -> a -> b
$ String -> ModuleName
mkModuleName String
moduleName
          funs :: [Text]
funs = forall a b. (a -> b) -> [a] -> [b]
map (OccName -> Text
renderOcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentInfo -> OccName
name) forall a b. (a -> b) -> a -> b
$ forall a. HashSet a -> [a]
HashSet.toList HashSet IdentInfo
funcs
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> [Scored CompletionItem]
filterModuleExports (String -> Text
T.pack String
moduleName) [Text]
funs
    | Text
"import " Text -> Text -> Bool
`T.isPrefixOf` Text
fullLine
    -> forall (m :: * -> *) a. Monad m => a -> m a
return [Scored CompletionItem]
filtImportCompls
    -- 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
    -> forall (m :: * -> *) a. Monad m => a -> m a
return []
    | Bool
otherwise -> do
        -- assumes that nubOrdBy is stable
        let uniqueFiltCompls :: [Scored (Bool, CompItem)]
uniqueFiltCompls = forall a. (a -> a -> Ordering) -> [a] -> [a]
nubOrdBy (CompItem -> CompItem -> Ordering
uniqueCompl forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Scored a -> a
Fuzzy.original) [Scored (Bool, CompItem)]
filtCompls
        let compls :: [Scored (Bool, CompletionItem)]
compls = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapforall b c a. (b -> c) -> (a -> b) -> a -> c
.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 = forall ideState. IdePlugins ideState -> CommandId -> Maybe PluginId
lookupCommandProvider IdePlugins a
plugins (Text -> CommandId
CommandId Text
extendImportCommandId)
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
          (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$
          forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall {a}.
Scored (a, CompletionItem)
-> (Down a, Down Int, Down Bool, Text, Maybe Text)
lexicographicOrdering) forall a b. (a -> b) -> a -> b
$
          forall a. (a -> a -> Ordering) -> [[a]] -> [a]
mergeListsBy (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. Scored a -> Int
score)
            [ (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (Bool
notQual,) [Scored CompletionItem]
filtModNameCompls
            , (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (Bool
notQual,) [Scored CompletionItem]
filtKeywordCompls
            , (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapforall b c a. (b -> c) -> (a -> b) -> a -> c
.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
        -- 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 :: Int
score :: forall a. Scored a -> Int
score, (a, CompletionItem)
original :: (a, CompletionItem)
original :: forall a. Scored a -> a
original} =
          case (a, CompletionItem)
original of
            (a
isQual, CompletionItem{Text
_label :: Text
$sel:_label:CompletionItem :: CompletionItem -> Text
_label,Maybe Text
_detail :: Maybe Text
$sel:_detail:CompletionItem :: CompletionItem -> Maybe Text
_detail}) -> do
              let isLocal :: Bool
isLocal = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Text
":" Text -> Text -> Bool
`T.isPrefixOf`) Maybe Text
_detail
              (forall a. a -> Down a
Down a
isQual, forall a. a -> Down a
Down Int
score, 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 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 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 { _character :: Position -> UInt
_character=(forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
c) }
    | Text -> Int
T.length Text
line forall a. Ord a => a -> a -> Bool
> Int
c = (Text
line Text -> Int -> Char
`T.index` Int
c) 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 = forall a. a -> Maybe a
Just Backtick
Surrounded
    | Bool
hasOpeningBacktick = forall a. a -> Maybe a
Just Backtick
LeftSide
    | Bool
otherwise = 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 { _character :: Position -> UInt
_character=(forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
c) }
  | Int
backtickIndex forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
backtickIndex forall a. Ord a => a -> a -> Bool
>= Text -> Int
T.length Text
line = Bool
False
  | Bool
otherwise = (Text
line Text -> Int -> Char
`T.index` Int
backtickIndex) 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 forall a. Eq a => a -> a -> Bool
== Text
""
                    then Int
0
                    else Text -> Int
T.length Text
prefixModule 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 forall a. Num a => a -> a -> a
- (Int
prefixLength forall a. Num a => a -> a -> a
+ Int
moduleLength) 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 (forall a. Eq a => a -> a -> Bool
/=Char
':') forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Text
name forall a b. (a -> b) -> a -> b
$
  forall a. First a -> Maybe a
getFirst forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a. Maybe a -> First a
First 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
CiSnippet
          , insertText :: Text
insertText = Text
buildSnippet
          , provenance :: Provenance
provenance = Provenance
importedFrom
          , typeText :: Maybe Text
typeText = forall a. Maybe a
Nothing
          , label :: Text
label = Text
ctxStr
          , isInfix :: Maybe Backtick
isInfix = forall a. Maybe a
Nothing
          , isTypeCompl :: Bool
isTypeCompl = Bool
False
          , additionalTextEdits :: Maybe ExtendImport
additionalTextEdits = Maybe (LImportDecl GhcPs)
imp 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 forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> e
unLoc forall a b. (a -> b) -> a -> b
$ forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (ImportDecl GhcPs)
x,
                  importQual :: Maybe Text
importQual = LImportDecl GhcPs -> Maybe Text
getImportQual GenLocated SrcSpanAnnA (ImportDecl GhcPs)
x,
                  newThing :: Text
newThing = Text
ctxStr
                }
          , nameDetails :: Maybe NameDetails
nameDetails = forall a. Maybe a
Nothing
          , isLocalCompletion :: Bool
isLocalCompletion = Bool
True
          }

      placeholder_pairs :: [(Text, Int)]
placeholder_pairs = forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
compl ([Int
1..]::[Int])
      snippet_parts :: [Text]
snippet_parts = forall a b. (a -> b) -> [a] -> [b]
map (\(Text
x, Int
i) -> Text
x forall a. Semigroup a => a -> a -> a
<> Text
"=${" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show Int
i) forall a. Semigroup a => a -> a -> a
<> Text
":_" forall a. Semigroup a => a -> a -> a
<> Text
x 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 forall a. Semigroup a => a -> a -> a
<> Text
" {" forall a. Semigroup a => a -> a -> a
<> Text
snippet 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)
    | forall a. ImportDecl a -> Bool
isQualifiedImport ImportDecl GhcPs
imp = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ ModuleName -> String
moduleNameString forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall l e. GenLocated l e -> e
unLoc forall a b. (a -> b) -> a -> b
$ forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcPs
imp) forall l e. GenLocated l e -> e
unLoc (forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclAs ImportDecl GhcPs
imp)
    | Bool
otherwise = 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 forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
merge2 (a
xforall a. a -> [a] -> [a]
:[a]
xs) [a]
ys
        Ordering
_          -> a
x forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
merge2 [a]
xs (a
yforall 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 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) =
      forall a. a -> Maybe a -> a
fromMaybe (Text -> Text -> Text -> Position -> PosPrefixInfo
PosPrefixInfo Text
"" Text
"" Text
"" Position
pos) forall a b. (a -> b) -> a -> b
$ do -- Maybe monad
        let headMaybe :: [a] -> Maybe a
headMaybe = forall a. [a] -> Maybe a
listToMaybe
            lastMaybe :: [a] -> Maybe a
lastMaybe = forall a. [a] -> Maybe a
headMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse

        -- grab the entire line the cursor is at
        Text
curLine <- forall a. [a] -> Maybe a
headMaybe forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines forall a b. (a -> b) -> a -> b
$ Rope -> Text
Rope.toText
                             forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ Word -> Rope -> (Rope, Rope)
Rope.splitAtLine Word
1 forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ Word -> Rope -> (Rope, Rope)
Rope.splitAtLine (forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
l) Rope
ropetext
        let beforePos :: Text
beforePos = Int -> Text -> Text
T.take (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        -> forall a. a -> Maybe a
Just Text
""
               | Text -> Char
T.last Text
beforePos forall a. Eq a => a -> a -> Bool
== Char
' ' -> forall a. a -> Maybe a
Just Text
"" -- don't count abc as the curword in 'abc '
               | Bool
otherwise               -> forall a. [a] -> Maybe a
lastMaybe (Text -> [Text]
T.words Text
beforePos)

        let parts :: [Text]
parts = (Char -> Bool) -> Text -> [Text]
T.split (forall a. Eq a => a -> a -> Bool
==Char
'.')
                      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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"._'"::String)) Text
curWord
        case forall a. [a] -> [a]
reverse [Text]
parts of
          [] -> forall a. Maybe a
Nothing
          (Text
x:[Text]
xs) -> do
            let modParts :: [Text]
modParts = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not 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
            forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a. Num a => a -> a -> a
- (forall a. Num a => Integer -> a
fromInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
T.length forall a b. (a -> b) -> a -> b
$ Text
str) forall a. Num a => a -> a -> a
- UInt
1)