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


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

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

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

import           Control.Monad
import           Data.Aeson                               (ToJSON (toJSON))
import           Data.Either                              (fromRight)
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.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 (..),
                                                           PluginId)
import           Language.LSP.Types
import           Language.LSP.Types.Capabilities
import qualified Language.LSP.VFS                         as VFS
import           Text.Fuzzy.Parallel                      (Scored (score),
                                                           original)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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

mkCompl :: PluginId -> IdeOptions -> CompItem -> CompletionItem
mkCompl :: PluginId -> IdeOptions -> CompItem -> CompletionItem
mkCompl
  PluginId
pId
  IdeOptions {Bool
Int
String
[String]
[Text]
Maybe String
IO Bool
IO CheckParents
ShakeOptions
Action IdeGhcSession
IdePkgLocationOptions
ProgressReportingStyle
IdeOTMemoryProfiling
IdeTesting
IdeDefer
IdeReportProgress
OptHaddockParse
ParsedSource -> IdePreprocessedSource
Config -> DynFlagsModifications
forall a. Typeable a => a -> 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
optOTMemoryProfiling :: IdeOptions -> IdeOTMemoryProfiling
optShakeProfiling :: IdeOptions -> Maybe String
optExtensions :: IdeOptions -> [String]
optPkgLocationOpts :: IdeOptions -> IdePkgLocationOptions
optGhcSession :: IdeOptions -> Action IdeGhcSession
optPreprocessor :: IdeOptions -> ParsedSource -> IdePreprocessedSource
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
optOTMemoryProfiling :: IdeOTMemoryProfiling
optShakeProfiling :: Maybe String
optExtensions :: [String]
optPkgLocationOpts :: IdePkgLocationOptions
optGhcSession :: Action IdeGhcSession
optPreprocessor :: ParsedSource -> IdePreprocessedSource
..}
  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,
      Maybe Text
typeText :: CompItem -> Maybe Text
typeText :: Maybe Text
typeText,
      Text
label :: CompItem -> Text
label :: Text
label,
      SpanDoc
docs :: CompItem -> SpanDoc
docs :: SpanDoc
docs,
      Maybe ExtendImport
additionalTextEdits :: CompItem -> Maybe ExtendImport
additionalTextEdits :: Maybe ExtendImport
additionalTextEdits
    } = do
  let mbCommand :: Maybe Command
mbCommand = PluginId -> ExtendImport -> Command
mkAdditionalEditsCommand PluginId
pId (ExtendImport -> Command) -> Maybe ExtendImport -> Maybe Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe ExtendImport
additionalTextEdits
  let ci :: CompletionItem
ci = CompletionItem :: 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
                 {$sel:_label:CompletionItem :: Text
_label = Text
label,
                  $sel:_kind:CompletionItem :: Maybe CompletionItemKind
_kind = Maybe CompletionItemKind
kind,
                  $sel:_tags:CompletionItem :: Maybe (List CompletionItemTag)
_tags = Maybe (List CompletionItemTag)
forall a. Maybe a
Nothing,
                  $sel:_detail:CompletionItem :: Maybe Text
_detail =
                      case (Maybe Text
typeText, Provenance
provenance) of
                          (Just Text
t,Provenance
_) | Bool -> Bool
not(Text -> Bool
T.null Text
t) -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
colon Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
                          (Maybe Text
_, ImportedFrom Text
mod)      -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
"from " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mod
                          (Maybe Text
_, DefinedIn Text
mod)         -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
"from " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mod
                          (Maybe Text, Provenance)
_                          -> Maybe Text
forall a. Maybe a
Nothing,
                  $sel:_documentation:CompletionItem :: Maybe CompletionDoc
_documentation = Maybe CompletionDoc
documentation,
                  $sel:_deprecated:CompletionItem :: Maybe Bool
_deprecated = Maybe Bool
forall a. Maybe a
Nothing,
                  $sel:_preselect:CompletionItem :: Maybe Bool
_preselect = Maybe Bool
forall a. Maybe a
Nothing,
                  $sel:_sortText:CompletionItem :: Maybe Text
_sortText = Maybe Text
forall a. Maybe a
Nothing,
                  $sel:_filterText:CompletionItem :: Maybe Text
_filterText = Maybe Text
forall a. Maybe a
Nothing,
                  $sel:_insertText:CompletionItem :: Maybe Text
_insertText = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
insertText,
                  $sel:_insertTextFormat:CompletionItem :: Maybe InsertTextFormat
_insertTextFormat = InsertTextFormat -> Maybe InsertTextFormat
forall a. a -> Maybe a
Just InsertTextFormat
Snippet,
                  $sel:_insertTextMode:CompletionItem :: Maybe InsertTextMode
_insertTextMode = Maybe InsertTextMode
forall a. Maybe a
Nothing,
                  $sel:_textEdit:CompletionItem :: Maybe CompletionEdit
_textEdit = Maybe CompletionEdit
forall a. Maybe a
Nothing,
                  $sel:_additionalTextEdits:CompletionItem :: Maybe (List TextEdit)
_additionalTextEdits = Maybe (List TextEdit)
forall a. Maybe a
Nothing,
                  $sel:_commitCharacters:CompletionItem :: Maybe (List Text)
_commitCharacters = Maybe (List Text)
forall a. Maybe a
Nothing,
                  $sel:_command:CompletionItem :: Maybe Command
_command = Maybe Command
mbCommand,
                  $sel:_xdata:CompletionItem :: Maybe Value
_xdata = Maybe Value
forall a. Maybe a
Nothing}
  Bool -> CompletionItem -> CompletionItem
removeSnippetsWhen (Maybe Backtick -> Bool
forall a. Maybe a -> Bool
isJust Maybe Backtick
isInfix) CompletionItem
ci

  where kind :: Maybe CompletionItemKind
kind = CompletionItemKind -> Maybe CompletionItemKind
forall a. a -> Maybe a
Just CompletionItemKind
compKind
        docs' :: [Text]
docs' = Text
imported Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: SpanDoc -> [Text]
spanDocToMarkdown SpanDoc
docs
        imported :: Text
imported = case Provenance
provenance of
          Local SrcSpan
pos  -> Text
"*Defined at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SrcLoc -> Text
pprLineCol (SrcSpan -> SrcLoc
srcSpanStart SrcSpan
pos) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in this module*\n"
          ImportedFrom Text
mod -> Text
"*Imported from '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mod Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'*\n"
          DefinedIn Text
mod -> Text
"*Defined in '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mod Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'*\n"
        colon :: Text
colon = if Bool
optNewColonConvention then Text
": " else Text
":: "
        documentation :: Maybe CompletionDoc
documentation = CompletionDoc -> Maybe CompletionDoc
forall a. a -> Maybe a
Just (CompletionDoc -> Maybe CompletionDoc)
-> CompletionDoc -> Maybe CompletionDoc
forall a b. (a -> b) -> a -> b
$ MarkupContent -> CompletionDoc
CompletionDocMarkup (MarkupContent -> CompletionDoc) -> MarkupContent -> CompletionDoc
forall a b. (a -> b) -> a -> b
$
                        MarkupKind -> Text -> MarkupContent
MarkupContent MarkupKind
MkMarkdown (Text -> MarkupContent) -> Text -> MarkupContent
forall a b. (a -> b) -> a -> b
$
                        Text -> [Text] -> Text
T.intercalate Text
sectionSeparator [Text]
docs'
        pprLineCol :: SrcLoc -> T.Text
        pprLineCol :: SrcLoc -> Text
pprLineCol (UnhelpfulLoc FastString
fs) = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ FastString -> String
unpackFS FastString
fs
        pprLineCol (RealSrcLoc RealSrcLoc
loc Maybe BufPos
_) =
            Text
"line " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Outputable a => a -> Text
printOutputable (RealSrcLoc -> Int
srcLocLine RealSrcLoc
loc) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", column " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Outputable a => a -> Text
printOutputable (RealSrcLoc -> Int
srcLocCol RealSrcLoc
loc)


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

mkNameCompItem :: Uri -> Maybe T.Text -> OccName -> Provenance -> Maybe Type -> Maybe Backtick -> SpanDoc -> Maybe (LImportDecl GhcPs) -> CompItem
mkNameCompItem :: Uri
-> Maybe Text
-> OccName
-> Provenance
-> Maybe Type
-> Maybe Backtick
-> SpanDoc
-> Maybe (LImportDecl GhcPs)
-> CompItem
mkNameCompItem Uri
doc Maybe Text
thingParent OccName
origName Provenance
provenance Maybe Type
thingType Maybe Backtick
isInfix SpanDoc
docs !Maybe (LImportDecl GhcPs)
imp = CI :: CompletionItemKind
-> Text
-> Provenance
-> Maybe Text
-> Text
-> Maybe Backtick
-> SpanDoc
-> Bool
-> Maybe ExtendImport
-> CompItem
CI {Bool
Maybe Text
Maybe ExtendImport
Maybe Backtick
Text
CompletionItemKind
SpanDoc
Provenance
isTypeCompl :: Bool
additionalTextEdits :: Maybe ExtendImport
typeText :: Maybe Text
insertText :: Text
label :: Text
isTypeCompl :: Bool
compKind :: CompletionItemKind
docs :: SpanDoc
isInfix :: Maybe Backtick
provenance :: Provenance
additionalTextEdits :: Maybe ExtendImport
docs :: SpanDoc
label :: Text
typeText :: Maybe Text
provenance :: Provenance
insertText :: Text
isInfix :: Maybe Backtick
compKind :: CompletionItemKind
..}
  where
    compKind :: CompletionItemKind
compKind = Maybe Text -> OccName -> CompletionItemKind
occNameToComKind Maybe Text
typeText OccName
origName
    isTypeCompl :: Bool
isTypeCompl = OccName -> Bool
isTcOcc OccName
origName
    label :: Text
label = Text -> Text
stripPrefix (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ OccName -> Text
forall a. Outputable a => a -> Text
printOutputable OccName
origName
    insertText :: Text
insertText = case Maybe Backtick
isInfix of
            Maybe Backtick
Nothing -> case Type -> Text
getArgText (Type -> Text) -> Maybe Type -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Type
thingType of
                            Maybe Text
Nothing      -> Text
label
                            Just Text
argText -> if Text -> Bool
T.null Text
argText then Text
label else Text
label Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
argText
            Just Backtick
LeftSide -> Text
label Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`"

            Just Backtick
Surrounded -> Text
label
    typeText :: Maybe Text
typeText
          | Just Type
t <- Maybe Type
thingType = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (Text -> Text) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
stripForall (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Type -> Text
forall a. Outputable a => a -> Text
printOutputable Type
t
          | Bool
otherwise = Maybe Text
forall a. Maybe a
Nothing
    additionalTextEdits :: Maybe ExtendImport
additionalTextEdits =
      Maybe (LImportDecl GhcPs)
imp Maybe (LImportDecl GhcPs)
-> (LImportDecl GhcPs -> ExtendImport) -> Maybe ExtendImport
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \LImportDecl GhcPs
x ->
        ExtendImport :: Uri -> Text -> Maybe Text -> Text -> Maybe Text -> ExtendImport
ExtendImport
          { Uri
doc :: Uri
doc :: Uri
doc,
            Maybe Text
thingParent :: Maybe Text
thingParent :: Maybe Text
thingParent,
            importName :: Text
importName = ModuleName -> Text
showModName (ModuleName -> Text) -> ModuleName -> Text
forall a b. (a -> b) -> a -> b
$ Located ModuleName -> SrcSpanLess (Located ModuleName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located ModuleName -> SrcSpanLess (Located ModuleName))
-> Located ModuleName -> SrcSpanLess (Located ModuleName)
forall a b. (a -> b) -> a -> b
$ ImportDecl GhcPs -> Located ModuleName
forall pass. ImportDecl pass -> Located ModuleName
ideclName (ImportDecl GhcPs -> Located ModuleName)
-> ImportDecl GhcPs -> Located ModuleName
forall a b. (a -> b) -> a -> b
$ LImportDecl GhcPs -> SrcSpanLess (LImportDecl GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LImportDecl GhcPs
x,
            importQual :: Maybe Text
importQual = LImportDecl GhcPs -> Maybe Text
getImportQual LImportDecl GhcPs
x,
            newThing :: Text
newThing = OccName -> Text
forall a. Outputable a => a -> Text
printOutputable OccName
origName
          }

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

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


showForSnippet :: Outputable a => a -> T.Text
#if MIN_VERSION_ghc(9,2,0)
showForSnippet x = T.pack $ renderWithContext ctxt $ GHC.ppr x -- FIXme
    where
        ctxt = defaultSDocContext{sdocStyle = mkUserStyle neverQualify AllTheWay}
#else
showForSnippet :: a -> Text
showForSnippet a
x = a -> Text
forall a. Outputable a => a -> Text
printOutputable a
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 (CompletionItemKind -> Maybe CompletionItemKind
forall a. a -> Maybe a
Just CompletionItemKind
CiModule) Maybe (List CompletionItemTag)
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing
    Maybe CompletionDoc
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe InsertTextFormat
forall a. Maybe a
Nothing
    Maybe InsertTextMode
forall a. Maybe a
Nothing Maybe CompletionEdit
forall a. Maybe a
Nothing Maybe (List TextEdit)
forall a. Maybe a
Nothing Maybe (List Text)
forall a. Maybe a
Nothing Maybe Command
forall a. Maybe a
Nothing Maybe Value
forall a. Maybe a
Nothing

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 (CompletionItemKind -> Maybe CompletionItemKind
forall a. a -> Maybe a
Just CompletionItemKind
CiFunction) Maybe (List CompletionItemTag)
forall a. Maybe a
Nothing (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
moduleName)
    Maybe CompletionDoc
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe InsertTextFormat
forall a. Maybe a
Nothing
    Maybe InsertTextMode
forall a. Maybe a
Nothing Maybe CompletionEdit
forall a. Maybe a
Nothing Maybe (List TextEdit)
forall a. Maybe a
Nothing Maybe (List Text)
forall a. Maybe a
Nothing Maybe Command
forall a. Maybe a
Nothing Maybe Value
forall a. Maybe a
Nothing

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

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


fromIdentInfo :: Uri -> IdentInfo -> Maybe T.Text -> CompItem
fromIdentInfo :: Uri -> IdentInfo -> Maybe Text -> CompItem
fromIdentInfo Uri
doc IdentInfo{Bool
Maybe Text
Text
OccName
moduleNameText :: IdentInfo -> Text
isDatacon :: IdentInfo -> Bool
parent :: IdentInfo -> Maybe Text
rendered :: IdentInfo -> Text
name :: IdentInfo -> OccName
moduleNameText :: Text
isDatacon :: Bool
parent :: Maybe Text
rendered :: Text
name :: OccName
..} Maybe Text
q = CI :: CompletionItemKind
-> Text
-> Provenance
-> Maybe Text
-> Text
-> Maybe Backtick
-> SpanDoc
-> Bool
-> Maybe ExtendImport
-> CompItem
CI
  { compKind :: CompletionItemKind
compKind= Maybe Text -> OccName -> CompletionItemKind
occNameToComKind Maybe Text
forall a. Maybe a
Nothing OccName
name
  , insertText :: Text
insertText=Text
rendered
  , provenance :: Provenance
provenance = Text -> Provenance
DefinedIn Text
moduleNameText
  , typeText :: Maybe Text
typeText=Maybe Text
forall a. Maybe a
Nothing
  , label :: Text
label=Text
rendered
  , isInfix :: Maybe Backtick
isInfix=Maybe Backtick
forall a. Maybe a
Nothing
  , docs :: SpanDoc
docs=SpanDoc
emptySpanDoc
  , isTypeCompl :: Bool
isTypeCompl= Bool -> Bool
not Bool
isDatacon Bool -> Bool -> Bool
&& Char -> Bool
isUpper (Text -> Char
T.head Text
rendered)
  , additionalTextEdits :: Maybe ExtendImport
additionalTextEdits= ExtendImport -> Maybe ExtendImport
forall a. a -> Maybe a
Just (ExtendImport -> Maybe ExtendImport)
-> ExtendImport -> Maybe ExtendImport
forall a b. (a -> b) -> a -> b
$
        ExtendImport :: Uri -> Text -> Maybe Text -> Text -> Maybe Text -> ExtendImport
ExtendImport
          { Uri
doc :: Uri
doc :: Uri
doc,
            thingParent :: Maybe Text
thingParent = Maybe Text
parent,
            importName :: Text
importName = Text
moduleNameText,
            importQual :: Maybe Text
importQual = Maybe Text
q,
            newThing :: Text
newThing = Text
rendered
          }
  }

cacheDataProducer :: Uri -> HscEnvEq -> Module -> GlobalRdrEnv-> GlobalRdrEnv -> [LImportDecl GhcPs] -> IO CachedCompletions
cacheDataProducer :: Uri
-> HscEnvEq
-> Module
-> GlobalRdrEnv
-> GlobalRdrEnv
-> [LImportDecl GhcPs]
-> IO CachedCompletions
cacheDataProducer Uri
uri HscEnvEq
env Module
curMod GlobalRdrEnv
globalEnv GlobalRdrEnv
inScopeEnv [LImportDecl GhcPs]
limports = do
  let
      packageState :: HscEnv
packageState = HscEnvEq -> HscEnv
hscEnv HscEnvEq
env
      curModName :: ModuleName
curModName = Module -> ModuleName
moduleName Module
curMod
      curModNameText :: Text
curModNameText = ModuleName -> Text
forall a. Outputable a => a -> Text
printOutputable ModuleName
curModName

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

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

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


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

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

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

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

      getComplsForOne :: GlobalRdrElt -> IO ([CompItem],QualCompls)
      getComplsForOne :: GlobalRdrElt -> IO ([CompItem], QualCompls)
getComplsForOne (GRE Name
n Parent
par Bool
True [ImportSpec]
_) =
          (, QualCompls
forall a. Monoid a => a
mempty) ([CompItem] -> ([CompItem], QualCompls))
-> IO [CompItem] -> IO ([CompItem], QualCompls)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parent
-> Module
-> Text
-> Name
-> Maybe (LImportDecl GhcPs)
-> IO [CompItem]
toCompItem Parent
par Module
curMod Text
curModNameText Name
n Maybe (LImportDecl GhcPs)
forall a. Maybe a
Nothing
      getComplsForOne (GRE Name
n Parent
par Bool
False [ImportSpec]
prov) =
        ((ImpDeclSpec -> IO ([CompItem], QualCompls))
 -> [ImpDeclSpec] -> IO ([CompItem], QualCompls))
-> [ImpDeclSpec]
-> (ImpDeclSpec -> IO ([CompItem], QualCompls))
-> IO ([CompItem], QualCompls)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ImpDeclSpec -> IO ([CompItem], QualCompls))
-> [ImpDeclSpec] -> IO ([CompItem], QualCompls)
forall (f :: * -> *) (m :: * -> *) b a.
(Foldable f, Monad m, Monoid b) =>
(a -> m b) -> f a -> m b
foldMapM ((ImportSpec -> ImpDeclSpec) -> [ImportSpec] -> [ImpDeclSpec]
forall a b. (a -> b) -> [a] -> [b]
map ImportSpec -> ImpDeclSpec
is_decl [ImportSpec]
prov) ((ImpDeclSpec -> IO ([CompItem], QualCompls))
 -> IO ([CompItem], QualCompls))
-> (ImpDeclSpec -> IO ([CompItem], QualCompls))
-> IO ([CompItem], QualCompls)
forall a b. (a -> b) -> a -> b
$ \ImpDeclSpec
spec -> do
          let originalImportDecl :: Maybe (LImportDecl GhcPs)
originalImportDecl = do
                -- we don't want to extend import if it's already in scope
                Bool -> Maybe BufPos
forall (f :: * -> *). Alternative f => Bool -> f BufPos
guard (Bool -> Maybe BufPos)
-> (Maybe GlobalRdrElt -> Bool)
-> Maybe GlobalRdrElt
-> Maybe BufPos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe GlobalRdrElt -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Maybe GlobalRdrElt -> Maybe BufPos)
-> Maybe GlobalRdrElt -> Maybe BufPos
forall a b. (a -> b) -> a -> b
$ GlobalRdrEnv -> Name -> Maybe GlobalRdrElt
lookupGRE_Name GlobalRdrEnv
inScopeEnv Name
n
                -- or if it doesn't have a real location
                RealSrcSpan
loc <- SrcSpan -> Maybe RealSrcSpan
realSpan (SrcSpan -> Maybe RealSrcSpan) -> SrcSpan -> Maybe RealSrcSpan
forall a b. (a -> b) -> a -> b
$ ImpDeclSpec -> SrcSpan
is_dloc ImpDeclSpec
spec
                RealSrcSpan
-> Map RealSrcSpan (LImportDecl GhcPs) -> Maybe (LImportDecl GhcPs)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup RealSrcSpan
loc Map RealSrcSpan (LImportDecl GhcPs)
importMap
          [CompItem]
compItem <- Parent
-> Module
-> Text
-> Name
-> Maybe (LImportDecl GhcPs)
-> IO [CompItem]
toCompItem Parent
par Module
curMod (ModuleName -> Text
forall a. Outputable a => a -> Text
printOutputable (ModuleName -> Text) -> ModuleName -> Text
forall a b. (a -> b) -> a -> b
$ ImpDeclSpec -> ModuleName
is_mod ImpDeclSpec
spec) Name
n Maybe (LImportDecl GhcPs)
originalImportDecl
          let unqual :: [CompItem]
unqual
                | ImpDeclSpec -> Bool
is_qual ImpDeclSpec
spec = []
                | Bool
otherwise = [CompItem]
compItem
              qual :: Map Text [CompItem]
qual
                | ImpDeclSpec -> Bool
is_qual ImpDeclSpec
spec = Text -> [CompItem] -> Map Text [CompItem]
forall k a. k -> a -> Map k a
Map.singleton Text
asMod [CompItem]
compItem
                | Bool
otherwise = [(Text, [CompItem])] -> Map Text [CompItem]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text
asMod,[CompItem]
compItem),(Text
origMod,[CompItem]
compItem)]
              asMod :: Text
asMod = ModuleName -> Text
showModName (ImpDeclSpec -> ModuleName
is_as ImpDeclSpec
spec)
              origMod :: Text
origMod = ModuleName -> Text
showModName (ImpDeclSpec -> ModuleName
is_mod ImpDeclSpec
spec)
          ([CompItem], QualCompls) -> IO ([CompItem], QualCompls)
forall (m :: * -> *) a. Monad m => a -> m a
return ([CompItem]
unqual,Map Text [CompItem] -> QualCompls
QualCompls Map Text [CompItem]
qual)

      toCompItem :: Parent -> Module -> T.Text -> Name -> Maybe (LImportDecl GhcPs) -> IO [CompItem]
      toCompItem :: Parent
-> Module
-> Text
-> Name
-> Maybe (LImportDecl GhcPs)
-> IO [CompItem]
toCompItem Parent
par Module
m Text
mn Name
n Maybe (LImportDecl GhcPs)
imp' = do
        SpanDoc
docs <- HscEnv -> Module -> Name -> IO SpanDoc
getDocumentationTryGhc HscEnv
packageState Module
curMod Name
n
        let (Maybe Text
mbParent, OccName
originName) = case Parent
par of
                            Parent
NoParent -> (Maybe Text
forall a. Maybe a
Nothing, Name -> OccName
nameOccName Name
n)
                            ParentIs Name
n' -> (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (String -> Text) -> String -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Maybe Text) -> String -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Name -> String
printName Name
n', Name -> OccName
nameOccName Name
n)
#if !MIN_VERSION_ghc(9,2,0)
                            FldParent Name
n' Maybe FastString
lbl -> (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (String -> Text) -> String -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Maybe Text) -> String -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Name -> String
printName Name
n', OccName -> (FastString -> OccName) -> Maybe FastString -> OccName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Name -> OccName
nameOccName Name
n) FastString -> OccName
mkVarOccFS Maybe FastString
lbl)
#endif
        Either [FileDiagnostic] (Maybe Type, Maybe (Text, [Text]))
tys <- DynFlags
-> Text
-> IO (Maybe Type, Maybe (Text, [Text]))
-> IO (Either [FileDiagnostic] (Maybe Type, Maybe (Text, [Text])))
forall a.
DynFlags -> Text -> IO a -> IO (Either [FileDiagnostic] a)
catchSrcErrors (HscEnv -> DynFlags
hsc_dflags HscEnv
packageState) Text
"completion" (IO (Maybe Type, Maybe (Text, [Text]))
 -> IO (Either [FileDiagnostic] (Maybe Type, Maybe (Text, [Text]))))
-> IO (Maybe Type, Maybe (Text, [Text]))
-> IO (Either [FileDiagnostic] (Maybe Type, Maybe (Text, [Text])))
forall a b. (a -> b) -> a -> b
$ do
                Maybe TyThing
name' <- HscEnv -> Module -> Name -> IO (Maybe TyThing)
lookupName HscEnv
packageState Module
m Name
n
                (Maybe Type, Maybe (Text, [Text]))
-> IO (Maybe Type, Maybe (Text, [Text]))
forall (m :: * -> *) a. Monad m => a -> m a
return ( Maybe TyThing
name' Maybe TyThing -> (TyThing -> Maybe Type) -> Maybe Type
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TyThing -> Maybe Type
safeTyThingType
                       , Bool -> Maybe BufPos
forall (f :: * -> *). Alternative f => Bool -> f BufPos
guard (Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
mbParent) Maybe BufPos -> Maybe TyThing -> Maybe TyThing
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe TyThing
name' Maybe TyThing
-> (TyThing -> Maybe (Text, [Text])) -> Maybe (Text, [Text])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TyThing -> Maybe (Text, [Text])
safeTyThingForRecord
                       )
        let (Maybe Type
ty, Maybe (Text, [Text])
record_ty) = (Maybe Type, Maybe (Text, [Text]))
-> Either [FileDiagnostic] (Maybe Type, Maybe (Text, [Text]))
-> (Maybe Type, Maybe (Text, [Text]))
forall b a. b -> Either a b -> b
fromRight (Maybe Type
forall a. Maybe a
Nothing, Maybe (Text, [Text])
forall a. Maybe a
Nothing) Either [FileDiagnostic] (Maybe Type, Maybe (Text, [Text]))
tys

        let recordCompls :: [CompItem]
recordCompls = case Maybe (Text, [Text])
record_ty of
                Just (Text
ctxStr, [Text]
flds) | Bool -> Bool
not ([Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
flds) ->
                    [Uri
-> Maybe Text
-> Text
-> [Text]
-> Provenance
-> SpanDoc
-> Maybe (LImportDecl GhcPs)
-> CompItem
mkRecordSnippetCompItem Uri
uri Maybe Text
mbParent Text
ctxStr [Text]
flds (Text -> Provenance
ImportedFrom Text
mn) SpanDoc
docs Maybe (LImportDecl GhcPs)
imp']
                Maybe (Text, [Text])
_ -> []

        [CompItem] -> IO [CompItem]
forall (m :: * -> *) a. Monad m => a -> m a
return ([CompItem] -> IO [CompItem]) -> [CompItem] -> IO [CompItem]
forall a b. (a -> b) -> a -> b
$ Uri
-> Maybe Text
-> OccName
-> Provenance
-> Maybe Type
-> Maybe Backtick
-> SpanDoc
-> Maybe (LImportDecl GhcPs)
-> CompItem
mkNameCompItem Uri
uri Maybe Text
mbParent OccName
originName (Text -> Provenance
ImportedFrom Text
mn) Maybe Type
ty Maybe Backtick
forall a. Maybe a
Nothing SpanDoc
docs Maybe (LImportDecl GhcPs)
imp'
               CompItem -> [CompItem] -> [CompItem]
forall a. a -> [a] -> [a]
: [CompItem]
recordCompls

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

  -- The list of all importable Modules from all packages
  [Text]
moduleNames <- [Text] -> ([ModuleName] -> [Text]) -> Maybe [ModuleName] -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((ModuleName -> Text) -> [ModuleName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> Text
showModName) (Maybe [ModuleName] -> [Text])
-> IO (Maybe [ModuleName]) -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HscEnvEq -> IO (Maybe [ModuleName])
envVisibleModuleNames HscEnvEq
env

  CachedCompletions -> IO CachedCompletions
forall (m :: * -> *) a. Monad m => a -> m a
return (CachedCompletions -> IO CachedCompletions)
-> CachedCompletions -> IO CachedCompletions
forall a b. (a -> b) -> a -> b
$ CC :: [Text]
-> [CompItem]
-> QualCompls
-> [Maybe Text -> CompItem]
-> [Text]
-> CachedCompletions
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 :: forall pass. HsModule pass -> [LHsDecl pass]
hsmodDecls}} =
    CC :: [Text]
-> [CompItem]
-> QualCompls
-> [Maybe Text -> CompItem]
-> [Text]
-> CachedCompletions
CC { allModNamesAsNS :: [Text]
allModNamesAsNS = [Text]
forall a. Monoid a => a
mempty
       , unqualCompls :: [CompItem]
unqualCompls = [CompItem]
compls
       , qualCompls :: QualCompls
qualCompls = QualCompls
forall a. Monoid a => a
mempty
       , anyQualCompls :: [Maybe Text -> CompItem]
anyQualCompls = []
       , importableModules :: [Text]
importableModules = [Text]
forall a. Monoid a => a
mempty
        }
  where
    typeSigIds :: Set RdrName
typeSigIds = [RdrName] -> Set RdrName
forall a. Ord a => [a] -> Set a
Set.fromList
        [ RdrName
id
            | L SrcSpan
_ (SigD XSigD GhcPs
_ (TypeSig XTypeSig GhcPs
_ [Located (IdP GhcPs)]
ids LHsSigWcType GhcPs
_)) <- [LHsDecl GhcPs]
hsmodDecls
            , L SrcSpan
_ RdrName
id <- [Located (IdP GhcPs)]
[GenLocated SrcSpan RdrName]
ids
            ]
    hasTypeSig :: GenLocated SrcSpan RdrName -> Bool
hasTypeSig = (RdrName -> Set RdrName -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set RdrName
typeSigIds) (RdrName -> Bool)
-> (GenLocated SrcSpan RdrName -> RdrName)
-> GenLocated SrcSpan RdrName
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpan RdrName -> RdrName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc

    compls :: [CompItem]
compls = [[CompItem]] -> [CompItem]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ case HsDecl GhcPs
decl of
            SigD XSigD GhcPs
_ (TypeSig XTypeSig GhcPs
_ [Located (IdP GhcPs)]
ids LHsSigWcType GhcPs
typ) ->
                [GenLocated SrcSpan RdrName
-> CompletionItemKind -> Maybe Text -> CompItem
mkComp GenLocated SrcSpan RdrName
id CompletionItemKind
CiFunction (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ LHsSigWcType GhcPs -> Text
forall a. Outputable a => a -> Text
showForSnippet LHsSigWcType GhcPs
typ) | GenLocated SrcSpan RdrName
id <- [Located (IdP GhcPs)]
[GenLocated SrcSpan RdrName]
ids]
            ValD XValD GhcPs
_ FunBind{Located (IdP GhcPs)
fun_id :: forall idL idR. HsBindLR idL idR -> Located (IdP idL)
fun_id :: Located (IdP GhcPs)
fun_id} ->
                [ GenLocated SrcSpan RdrName
-> CompletionItemKind -> Maybe Text -> CompItem
mkComp Located (IdP GhcPs)
GenLocated SrcSpan RdrName
fun_id CompletionItemKind
CiFunction Maybe Text
forall a. Maybe a
Nothing
                | Bool -> Bool
not (GenLocated SrcSpan RdrName -> Bool
hasTypeSig Located (IdP GhcPs)
GenLocated SrcSpan RdrName
fun_id)
                ]
            ValD XValD GhcPs
_ PatBind{LPat GhcPs
pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
pat_lhs :: LPat GhcPs
pat_lhs} ->
                [GenLocated SrcSpan RdrName
-> CompletionItemKind -> Maybe Text -> CompItem
mkComp Located (IdP GhcPs)
GenLocated SrcSpan RdrName
id CompletionItemKind
CiVariable Maybe Text
forall a. Maybe a
Nothing
                | VarPat XVarPat GhcPs
_ Located (IdP GhcPs)
id <- (Pat GhcPs -> Bool) -> Located (Pat GhcPs) -> [Pat GhcPs]
forall r. Typeable r => (r -> Bool) -> GenericQ [r]
listify (\(Pat GhcPs
_ :: Pat GhcPs) -> Bool
True) LPat GhcPs
Located (Pat GhcPs)
pat_lhs]
            TyClD XTyClD GhcPs
_ ClassDecl{Located (IdP GhcPs)
tcdLName :: forall pass. TyClDecl pass -> Located (IdP pass)
tcdLName :: Located (IdP GhcPs)
tcdLName, [LSig GhcPs]
tcdSigs :: forall pass. TyClDecl pass -> [LSig pass]
tcdSigs :: [LSig GhcPs]
tcdSigs} ->
                GenLocated SrcSpan RdrName
-> CompletionItemKind -> Maybe Text -> CompItem
mkComp Located (IdP GhcPs)
GenLocated SrcSpan RdrName
tcdLName CompletionItemKind
CiInterface (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpan RdrName -> Text
forall a. Outputable a => a -> Text
showForSnippet Located (IdP GhcPs)
GenLocated SrcSpan RdrName
tcdLName) CompItem -> [CompItem] -> [CompItem]
forall a. a -> [a] -> [a]
:
                [ GenLocated SrcSpan RdrName
-> CompletionItemKind -> Maybe Text -> CompItem
mkComp GenLocated SrcSpan RdrName
id CompletionItemKind
CiFunction (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ LHsSigType GhcPs -> Text
forall a. Outputable a => a -> Text
showForSnippet LHsSigType GhcPs
typ)
                | L SrcSpan
_ (ClassOpSig XClassOpSig GhcPs
_ Bool
_ [Located (IdP GhcPs)]
ids LHsSigType GhcPs
typ) <- [LSig GhcPs]
tcdSigs
                , GenLocated SrcSpan RdrName
id <- [Located (IdP GhcPs)]
[GenLocated SrcSpan RdrName]
ids]
            TyClD XTyClD GhcPs
_ TyClDecl GhcPs
x ->
                let generalCompls :: [CompItem]
generalCompls = [GenLocated SrcSpan RdrName
-> CompletionItemKind -> Maybe Text -> CompItem
mkComp GenLocated SrcSpan RdrName
id CompletionItemKind
cl (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpan RdrName -> Text
forall a. Outputable a => a -> Text
showForSnippet (GenLocated SrcSpan RdrName -> Text)
-> GenLocated SrcSpan RdrName -> Text
forall a b. (a -> b) -> a -> b
$ TyClDecl GhcPs -> Located (IdP GhcPs)
forall (p :: Pass).
TyClDecl (GhcPass p) -> Located (IdP (GhcPass p))
tyClDeclLName TyClDecl GhcPs
x)
                        | GenLocated SrcSpan RdrName
id <- (GenLocated SrcSpan RdrName -> Bool)
-> TyClDecl GhcPs -> [GenLocated SrcSpan RdrName]
forall r. Typeable r => (r -> Bool) -> GenericQ [r]
listify (\(_ :: LIdP GhcPs) -> Bool
True) TyClDecl GhcPs
x
                        , let cl :: CompletionItemKind
cl = Maybe Text -> OccName -> CompletionItemKind
occNameToComKind Maybe Text
forall a. Maybe a
Nothing (RdrName -> OccName
rdrNameOcc (RdrName -> OccName) -> RdrName -> OccName
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpan RdrName
-> SrcSpanLess (GenLocated SrcSpan RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc GenLocated SrcSpan RdrName
id)]
                    -- here we only have to look at the outermost type
                    recordCompls :: [CompItem]
recordCompls = Uri -> ParsedModule -> Provenance -> TyClDecl GhcPs -> [CompItem]
findRecordCompl Uri
uri ParsedModule
pm (SrcSpan -> Provenance
Local SrcSpan
pos) TyClDecl GhcPs
x
                in
                   -- the constructors and snippets will be duplicated here giving the user 2 choices.
                   [CompItem]
generalCompls [CompItem] -> [CompItem] -> [CompItem]
forall a. [a] -> [a] -> [a]
++ [CompItem]
recordCompls
            ForD XForD GhcPs
_ ForeignImport{Located (IdP GhcPs)
fd_name :: forall pass. ForeignDecl pass -> Located (IdP pass)
fd_name :: Located (IdP GhcPs)
fd_name,LHsSigType GhcPs
fd_sig_ty :: forall pass. ForeignDecl pass -> LHsSigType pass
fd_sig_ty :: LHsSigType GhcPs
fd_sig_ty} ->
                [GenLocated SrcSpan RdrName
-> CompletionItemKind -> Maybe Text -> CompItem
mkComp Located (IdP GhcPs)
GenLocated SrcSpan RdrName
fd_name CompletionItemKind
CiVariable (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ LHsSigType GhcPs -> Text
forall a. Outputable a => a -> Text
showForSnippet LHsSigType GhcPs
fd_sig_ty)]
            ForD XForD GhcPs
_ ForeignExport{Located (IdP GhcPs)
fd_name :: Located (IdP GhcPs)
fd_name :: forall pass. ForeignDecl pass -> Located (IdP pass)
fd_name,LHsSigType GhcPs
fd_sig_ty :: LHsSigType GhcPs
fd_sig_ty :: forall pass. ForeignDecl pass -> LHsSigType pass
fd_sig_ty} ->
                [GenLocated SrcSpan RdrName
-> CompletionItemKind -> Maybe Text -> CompItem
mkComp Located (IdP GhcPs)
GenLocated SrcSpan RdrName
fd_name CompletionItemKind
CiVariable (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ LHsSigType GhcPs -> Text
forall a. Outputable a => a -> Text
showForSnippet LHsSigType GhcPs
fd_sig_ty)]
            HsDecl GhcPs
_ -> []
            | L (SrcSpan -> SrcSpan
forall a. a -> a
locA -> SrcSpan
pos) HsDecl GhcPs
decl <- [LHsDecl GhcPs]
hsmodDecls,
            let mkComp :: GenLocated SrcSpan RdrName
-> CompletionItemKind -> Maybe Text -> CompItem
mkComp = SrcSpan
-> GenLocated SrcSpan RdrName
-> CompletionItemKind
-> Maybe Text
-> CompItem
mkLocalComp SrcSpan
pos
        ]

    mkLocalComp :: SrcSpan
-> GenLocated SrcSpan RdrName
-> CompletionItemKind
-> Maybe Text
-> CompItem
mkLocalComp SrcSpan
pos GenLocated SrcSpan RdrName
n CompletionItemKind
ctyp Maybe Text
ty =
        CompletionItemKind
-> Text
-> Provenance
-> Maybe Text
-> Text
-> Maybe Backtick
-> SpanDoc
-> Bool
-> Maybe ExtendImport
-> CompItem
CI CompletionItemKind
ctyp Text
pn (SrcSpan -> Provenance
Local SrcSpan
pos) Maybe Text
ensureTypeText Text
pn Maybe Backtick
forall a. Maybe a
Nothing SpanDoc
doc (CompletionItemKind
ctyp CompletionItemKind -> [CompletionItemKind] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CompletionItemKind
CiStruct, CompletionItemKind
CiInterface]) Maybe ExtendImport
forall a. Maybe a
Nothing
      where
        -- when sorting completions, we use the presence of typeText
        -- to tell local completions and global completions apart
        -- instead of using the empty string here, we should probably introduce a new field...
        ensureTypeText :: Maybe Text
ensureTypeText = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
ty
        pn :: Text
pn = GenLocated SrcSpan RdrName -> Text
forall a. Outputable a => a -> Text
showForSnippet GenLocated SrcSpan RdrName
n
        doc :: SpanDoc
doc = [Text] -> SpanDocUris -> SpanDoc
SpanDocText ([ParsedModule] -> GenLocated SrcSpan RdrName -> [Text]
forall name. HasSrcSpan name => [ParsedModule] -> name -> [Text]
getDocumentation [ParsedModule
pm] (GenLocated SrcSpan RdrName -> [Text])
-> GenLocated SrcSpan RdrName -> [Text]
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpan RdrName -> GenLocated SrcSpan RdrName
forall a. Located a -> Located a
reLoc GenLocated SrcSpan RdrName
n) (Maybe Text -> Maybe Text -> SpanDocUris
SpanDocUris Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing)

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

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

        extract :: ConDeclField pass -> [GenLocated SrcSpan RdrName]
extract ConDeclField{[LFieldOcc pass]
Maybe LHsDocString
XConDeclField pass
LBangType pass
cd_fld_ext :: forall pass. ConDeclField pass -> XConDeclField pass
cd_fld_names :: forall pass. ConDeclField pass -> [LFieldOcc pass]
cd_fld_type :: forall pass. ConDeclField pass -> LBangType pass
cd_fld_doc :: forall pass. ConDeclField pass -> Maybe LHsDocString
cd_fld_doc :: Maybe LHsDocString
cd_fld_type :: LBangType pass
cd_fld_names :: [LFieldOcc pass]
cd_fld_ext :: XConDeclField pass
..}
            -- 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.
            = (LFieldOcc pass -> GenLocated SrcSpan RdrName)
-> [LFieldOcc pass] -> [GenLocated SrcSpan RdrName]
forall a b. (a -> b) -> [a] -> [b]
map (FieldOcc pass -> GenLocated SrcSpan RdrName
forall pass. FieldOcc pass -> GenLocated SrcSpan RdrName
rdrNameFieldOcc (FieldOcc pass -> GenLocated SrcSpan RdrName)
-> (LFieldOcc pass -> FieldOcc pass)
-> LFieldOcc pass
-> GenLocated SrcSpan RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LFieldOcc pass -> FieldOcc pass
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [LFieldOcc pass]
cd_fld_names
        -- XConDeclField
        extract ConDeclField pass
_ = []
findRecordCompl Uri
_ ParsedModule
_ 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 (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Bool
enableSnippets Bool -> Bool -> Bool
&& Bool
supported)
  where
    supported :: Bool
supported =
      Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== (Maybe TextDocumentClientCapabilities
_textDocument Maybe TextDocumentClientCapabilities
-> (TextDocumentClientCapabilities
    -> Maybe CompletionClientCapabilities)
-> Maybe CompletionClientCapabilities
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TextDocumentClientCapabilities
-> Maybe CompletionClientCapabilities
_completion Maybe CompletionClientCapabilities
-> (CompletionClientCapabilities
    -> Maybe CompletionItemClientCapabilities)
-> Maybe CompletionItemClientCapabilities
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CompletionClientCapabilities
-> Maybe CompletionItemClientCapabilities
_completionItem Maybe CompletionItemClientCapabilities
-> (CompletionItemClientCapabilities -> Maybe Bool) -> Maybe Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CompletionItemClientCapabilities -> Maybe Bool
_snippetSupport)

toggleAutoExtend :: CompletionsConfig -> CompItem -> CompItem
toggleAutoExtend :: CompletionsConfig -> CompItem -> CompItem
toggleAutoExtend CompletionsConfig{enableAutoExtend :: CompletionsConfig -> Bool
enableAutoExtend=Bool
False} CompItem
x = CompItem
x {additionalTextEdits :: Maybe ExtendImport
additionalTextEdits = Maybe ExtendImport
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 = InsertTextFormat -> Maybe InsertTextFormat
forall a. a -> Maybe a
Just InsertTextFormat
PlainText,
          $sel:_insertText:CompletionItem :: Maybe Text
_insertText = Maybe Text
forall a. Maybe a
Nothing
        }
    else CompletionItem
x

-- | Returns the cached completions for the given module and position.
getCompletions
    :: PluginId
    -> IdeOptions
    -> CachedCompletions
    -> Maybe (ParsedModule, PositionMapping)
    -> (Bindings, PositionMapping)
    -> VFS.PosPrefixInfo
    -> ClientCapabilities
    -> CompletionsConfig
    -> HM.HashMap T.Text (HashSet.HashSet IdentInfo)
    -> IO [Scored CompletionItem]
getCompletions :: PluginId
-> IdeOptions
-> CachedCompletions
-> Maybe (ParsedModule, PositionMapping)
-> (Bindings, PositionMapping)
-> PosPrefixInfo
-> ClientCapabilities
-> CompletionsConfig
-> HashMap Text (HashSet IdentInfo)
-> IO [Scored CompletionItem]
getCompletions PluginId
plId 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 (Bindings
localBindings, PositionMapping
bmapping) PosPrefixInfo
prefixInfo ClientCapabilities
caps CompletionsConfig
config HashMap Text (HashSet IdentInfo)
moduleExportsMap = do
  let VFS.PosPrefixInfo { Text
$sel:fullLine:PosPrefixInfo :: PosPrefixInfo -> Text
fullLine :: Text
fullLine, Text
$sel:prefixModule:PosPrefixInfo :: PosPrefixInfo -> Text
prefixModule :: Text
prefixModule, Text
$sel:prefixText:PosPrefixInfo :: PosPrefixInfo -> Text
prefixText :: Text
prefixText } = PosPrefixInfo
prefixInfo
      enteredQual :: Text
enteredQual = if Text -> Bool
T.null Text
prefixModule then Text
"" else Text
prefixModule Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
      fullPrefix :: Text
fullPrefix  = Text
enteredQual Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
prefixText

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

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

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

      filtModNameCompls :: [Scored CompletionItem]
      filtModNameCompls :: [Scored CompletionItem]
filtModNameCompls =
        ((Scored Text -> Scored CompletionItem)
-> [Scored Text] -> [Scored CompletionItem]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((Scored Text -> Scored CompletionItem)
 -> [Scored Text] -> [Scored CompletionItem])
-> ((Text -> CompletionItem)
    -> Scored Text -> Scored CompletionItem)
-> (Text -> CompletionItem)
-> [Scored Text]
-> [Scored CompletionItem]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Text -> CompletionItem) -> Scored Text -> Scored CompletionItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) Text -> CompletionItem
mkModCompl
          ([Scored Text] -> [Scored CompletionItem])
-> [Scored Text] -> [Scored CompletionItem]
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Text -> [Text] -> [Scored Text]
Fuzzy.simpleFilter Int
chunkSize Int
maxC Text
fullPrefix
          ([Text] -> [Scored Text]) -> [Text] -> [Scored Text]
forall a b. (a -> b) -> a -> b
$ (if Text -> Bool
T.null Text
enteredQual then [Text] -> [Text]
forall a. a -> a
id else (Text -> Maybe Text) -> [Text] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text -> Text -> Maybe Text
T.stripPrefix Text
enteredQual))
            [Text]
allModNamesAsNS

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

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

          -- completions specific to the current context
          ctxCompls' :: [(Bool, CompItem)]
ctxCompls' = case Maybe Context
mcc of
                        Maybe Context
Nothing           -> [(Bool, CompItem)]
compls
                        Just Context
TypeContext  -> ((Bool, CompItem) -> Bool)
-> [(Bool, CompItem)] -> [(Bool, CompItem)]
forall a. (a -> Bool) -> [a] -> [a]
filter ( CompItem -> Bool
isTypeCompl (CompItem -> Bool)
-> ((Bool, CompItem) -> CompItem) -> (Bool, CompItem) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool, CompItem) -> CompItem
forall a b. (a, b) -> b
snd) [(Bool, CompItem)]
compls
                        Just Context
ValueContext -> ((Bool, CompItem) -> Bool)
-> [(Bool, CompItem)] -> [(Bool, CompItem)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((Bool, CompItem) -> Bool) -> (Bool, CompItem) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompItem -> Bool
isTypeCompl (CompItem -> Bool)
-> ((Bool, CompItem) -> CompItem) -> (Bool, CompItem) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool, CompItem) -> CompItem
forall a b. (a, b) -> b
snd) [(Bool, CompItem)]
compls
                        Just Context
_            -> ((Bool, CompItem) -> Bool)
-> [(Bool, CompItem)] -> [(Bool, CompItem)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((Bool, CompItem) -> Bool) -> (Bool, CompItem) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompItem -> Bool
isTypeCompl (CompItem -> Bool)
-> ((Bool, CompItem) -> CompItem) -> (Bool, CompItem) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool, CompItem) -> CompItem
forall a b. (a, b) -> b
snd) [(Bool, CompItem)]
compls
          -- Add whether the text to insert has backticks
          ctxCompls :: [(Bool, CompItem)]
ctxCompls = (((Bool, CompItem) -> (Bool, CompItem))
-> [(Bool, CompItem)] -> [(Bool, CompItem)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(((Bool, CompItem) -> (Bool, CompItem))
 -> [(Bool, CompItem)] -> [(Bool, CompItem)])
-> ((CompItem -> CompItem) -> (Bool, CompItem) -> (Bool, CompItem))
-> (CompItem -> CompItem)
-> [(Bool, CompItem)]
-> [(Bool, CompItem)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CompItem -> CompItem) -> (Bool, CompItem) -> (Bool, CompItem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (\CompItem
comp -> CompletionsConfig -> CompItem -> CompItem
toggleAutoExtend CompletionsConfig
config (CompItem -> CompItem) -> CompItem -> CompItem
forall a b. (a -> b) -> a -> b
$ CompItem
comp { isInfix :: 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
prefixModule Text
prefixText Position
pos

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

          compls :: [(Bool, CompItem)]
compls = if Text -> Bool
T.null Text
prefixModule
            then (CompItem -> (Bool, CompItem)) -> [CompItem] -> [(Bool, CompItem)]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
notQual,) [CompItem]
localCompls [(Bool, CompItem)] -> [(Bool, CompItem)] -> [(Bool, CompItem)]
forall a. [a] -> [a] -> [a]
++ (CompItem -> (Bool, CompItem)) -> [CompItem] -> [(Bool, CompItem)]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
qual,) [CompItem]
unqualCompls [(Bool, CompItem)] -> [(Bool, CompItem)] -> [(Bool, CompItem)]
forall a. [a] -> [a] -> [a]
++ ((Bool
notQual,) (CompItem -> (Bool, CompItem))
-> ((Maybe Text -> CompItem) -> CompItem)
-> (Maybe Text -> CompItem)
-> (Bool, CompItem)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe Text -> CompItem) -> Maybe Text -> CompItem
forall a b. (a -> b) -> a -> b
$Maybe Text
forall a. Maybe a
Nothing) ((Maybe Text -> CompItem) -> (Bool, CompItem))
-> [Maybe Text -> CompItem] -> [(Bool, CompItem)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Maybe Text -> CompItem]
anyQualCompls)
            else ((Bool
qual,) (CompItem -> (Bool, CompItem)) -> [CompItem] -> [(Bool, CompItem)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CompItem] -> Text -> Map Text [CompItem] -> [CompItem]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] Text
prefixModule (QualCompls -> Map Text [CompItem]
getQualCompls QualCompls
qualCompls))
                 [(Bool, CompItem)] -> [(Bool, CompItem)] -> [(Bool, CompItem)]
forall a. [a] -> [a] -> [a]
++ ((Bool
notQual,) (CompItem -> (Bool, CompItem))
-> ((Maybe Text -> CompItem) -> CompItem)
-> (Maybe Text -> CompItem)
-> (Bool, CompItem)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe Text -> CompItem) -> Maybe Text -> CompItem
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
prefixModule) ((Maybe Text -> CompItem) -> (Bool, CompItem))
-> [Maybe Text -> CompItem] -> [(Bool, CompItem)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Maybe Text -> CompItem]
anyQualCompls)

      filtListWith :: (Text -> CompletionItem) -> [Text] -> [Scored CompletionItem]
filtListWith Text -> CompletionItem
f [Text]
list =
        [ (Text -> CompletionItem) -> Scored Text -> Scored CompletionItem
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` Scored Text -> Text
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 ((Text -> CompletionItem) -> [Text] -> [Scored CompletionItem])
-> (Text -> CompletionItem) -> [Text] -> [Scored CompletionItem]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> CompletionItem
mkModuleFunctionImport Text
moduleName
      filtKeywordCompls :: [Scored CompletionItem]
filtKeywordCompls
          | Text -> Bool
T.null Text
prefixModule = (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
&& ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length (String -> [String]
words (Text -> String
T.unpack Text
fullLine)) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2)
      Bool -> Bool -> Bool
&& String
"(" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` Text -> String
T.unpack Text
fullLine
    -> do
      let moduleName :: Text
moduleName = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> [String]
words (Text -> String
T.unpack Text
fullLine) [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
1
          funcs :: HashSet IdentInfo
funcs = HashSet IdentInfo
-> Text -> HashMap Text (HashSet IdentInfo) -> HashSet IdentInfo
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
HM.lookupDefault HashSet IdentInfo
forall a. HashSet a
HashSet.empty Text
moduleName HashMap Text (HashSet IdentInfo)
moduleExportsMap
          funs :: [String]
funs = (IdentInfo -> String) -> [IdentInfo] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (OccName -> String
forall a. Show a => a -> String
show (OccName -> String)
-> (IdentInfo -> OccName) -> IdentInfo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentInfo -> OccName
name) ([IdentInfo] -> [String]) -> [IdentInfo] -> [String]
forall a b. (a -> b) -> a -> b
$ HashSet IdentInfo -> [IdentInfo]
forall a. HashSet a -> [a]
HashSet.toList HashSet IdentInfo
funcs
      [Scored CompletionItem] -> IO [Scored CompletionItem]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Scored CompletionItem] -> IO [Scored CompletionItem])
-> [Scored CompletionItem] -> IO [Scored CompletionItem]
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> [Scored CompletionItem]
filterModuleExports Text
moduleName ([Text] -> [Scored CompletionItem])
-> [Text] -> [Scored CompletionItem]
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack [String]
funs
    | Text
"import " Text -> Text -> Bool
`T.isPrefixOf` Text
fullLine
    -> [Scored CompletionItem] -> IO [Scored CompletionItem]
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
    -> [Scored CompletionItem] -> IO [Scored CompletionItem]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    | Bool
otherwise -> do
        -- assumes that nubOrdBy is stable
        let uniqueFiltCompls :: [Scored (Bool, CompItem)]
uniqueFiltCompls = (Scored (Bool, CompItem) -> Scored (Bool, CompItem) -> Ordering)
-> [Scored (Bool, CompItem)] -> [Scored (Bool, CompItem)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
nubOrdBy (CompItem -> CompItem -> Ordering
uniqueCompl (CompItem -> CompItem -> Ordering)
-> (Scored (Bool, CompItem) -> CompItem)
-> Scored (Bool, CompItem)
-> Scored (Bool, CompItem)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Bool, CompItem) -> CompItem
forall a b. (a, b) -> b
snd ((Bool, CompItem) -> CompItem)
-> (Scored (Bool, CompItem) -> (Bool, CompItem))
-> Scored (Bool, CompItem)
-> CompItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scored (Bool, CompItem) -> (Bool, CompItem)
forall a. Scored a -> a
Fuzzy.original) [Scored (Bool, CompItem)]
filtCompls
        let compls :: [Scored (Bool, CompletionItem)]
compls = ((Scored (Bool, CompItem) -> Scored (Bool, CompletionItem))
-> [Scored (Bool, CompItem)] -> [Scored (Bool, CompletionItem)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((Scored (Bool, CompItem) -> Scored (Bool, CompletionItem))
 -> [Scored (Bool, CompItem)] -> [Scored (Bool, CompletionItem)])
-> ((CompItem -> CompletionItem)
    -> Scored (Bool, CompItem) -> Scored (Bool, CompletionItem))
-> (CompItem -> CompletionItem)
-> [Scored (Bool, CompItem)]
-> [Scored (Bool, CompletionItem)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Bool, CompItem) -> (Bool, CompletionItem))
-> Scored (Bool, CompItem) -> Scored (Bool, CompletionItem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(((Bool, CompItem) -> (Bool, CompletionItem))
 -> Scored (Bool, CompItem) -> Scored (Bool, CompletionItem))
-> ((CompItem -> CompletionItem)
    -> (Bool, CompItem) -> (Bool, CompletionItem))
-> (CompItem -> CompletionItem)
-> Scored (Bool, CompItem)
-> Scored (Bool, CompletionItem)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CompItem -> CompletionItem)
-> (Bool, CompItem) -> (Bool, CompletionItem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (PluginId -> IdeOptions -> CompItem -> CompletionItem
mkCompl PluginId
plId IdeOptions
ideOpts) [Scored (Bool, CompItem)]
uniqueFiltCompls
        [Scored CompletionItem] -> IO [Scored CompletionItem]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Scored CompletionItem] -> IO [Scored CompletionItem])
-> [Scored CompletionItem] -> IO [Scored CompletionItem]
forall a b. (a -> b) -> a -> b
$
          ((Scored (Bool, CompletionItem) -> Scored CompletionItem)
-> [Scored (Bool, CompletionItem)] -> [Scored CompletionItem]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((Scored (Bool, CompletionItem) -> Scored CompletionItem)
 -> [Scored (Bool, CompletionItem)] -> [Scored CompletionItem])
-> (((Bool, CompletionItem) -> CompletionItem)
    -> Scored (Bool, CompletionItem) -> Scored CompletionItem)
-> ((Bool, CompletionItem) -> CompletionItem)
-> [Scored (Bool, CompletionItem)]
-> [Scored CompletionItem]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Bool, CompletionItem) -> CompletionItem)
-> Scored (Bool, CompletionItem) -> Scored CompletionItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (Bool, CompletionItem) -> CompletionItem
forall a b. (a, b) -> b
snd ([Scored (Bool, CompletionItem)] -> [Scored CompletionItem])
-> [Scored (Bool, CompletionItem)] -> [Scored CompletionItem]
forall a b. (a -> b) -> a -> b
$
          (Scored (Bool, CompletionItem)
 -> Scored (Bool, CompletionItem) -> Ordering)
-> [Scored (Bool, CompletionItem)]
-> [Scored (Bool, CompletionItem)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Down Bool, Down Int, Down Bool, Text, Maybe Text)
-> (Down Bool, Down Int, Down Bool, Text, Maybe Text) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((Down Bool, Down Int, Down Bool, Text, Maybe Text)
 -> (Down Bool, Down Int, Down Bool, Text, Maybe Text) -> Ordering)
-> (Scored (Bool, CompletionItem)
    -> (Down Bool, Down Int, Down Bool, Text, Maybe Text))
-> Scored (Bool, CompletionItem)
-> Scored (Bool, CompletionItem)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Scored (Bool, CompletionItem)
-> (Down Bool, Down Int, Down Bool, Text, Maybe Text)
forall a.
Scored (a, CompletionItem)
-> (Down a, Down Int, Down Bool, Text, Maybe Text)
lexicographicOrdering) ([Scored (Bool, CompletionItem)]
 -> [Scored (Bool, CompletionItem)])
-> [Scored (Bool, CompletionItem)]
-> [Scored (Bool, CompletionItem)]
forall a b. (a -> b) -> a -> b
$
          (Scored (Bool, CompletionItem)
 -> Scored (Bool, CompletionItem) -> Ordering)
-> [[Scored (Bool, CompletionItem)]]
-> [Scored (Bool, CompletionItem)]
forall a. (a -> a -> Ordering) -> [[a]] -> [a]
mergeListsBy ((Int -> Int -> Ordering) -> Int -> Int -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> (Scored (Bool, CompletionItem) -> Int)
-> Scored (Bool, CompletionItem)
-> Scored (Bool, CompletionItem)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Scored (Bool, CompletionItem) -> Int
forall a. Scored a -> Int
score)
            [ ((Scored CompletionItem -> Scored (Bool, CompletionItem))
-> [Scored CompletionItem] -> [Scored (Bool, CompletionItem)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((Scored CompletionItem -> Scored (Bool, CompletionItem))
 -> [Scored CompletionItem] -> [Scored (Bool, CompletionItem)])
-> ((CompletionItem -> (Bool, CompletionItem))
    -> Scored CompletionItem -> Scored (Bool, CompletionItem))
-> (CompletionItem -> (Bool, CompletionItem))
-> [Scored CompletionItem]
-> [Scored (Bool, CompletionItem)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CompletionItem -> (Bool, CompletionItem))
-> Scored CompletionItem -> Scored (Bool, CompletionItem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (Bool
notQual,) [Scored CompletionItem]
filtModNameCompls
            , ((Scored CompletionItem -> Scored (Bool, CompletionItem))
-> [Scored CompletionItem] -> [Scored (Bool, CompletionItem)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((Scored CompletionItem -> Scored (Bool, CompletionItem))
 -> [Scored CompletionItem] -> [Scored (Bool, CompletionItem)])
-> ((CompletionItem -> (Bool, CompletionItem))
    -> Scored CompletionItem -> Scored (Bool, CompletionItem))
-> (CompletionItem -> (Bool, CompletionItem))
-> [Scored CompletionItem]
-> [Scored (Bool, CompletionItem)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CompletionItem -> (Bool, CompletionItem))
-> Scored CompletionItem -> Scored (Bool, CompletionItem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (Bool
notQual,) [Scored CompletionItem]
filtKeywordCompls
            , ((Scored (Bool, CompletionItem) -> Scored (Bool, CompletionItem))
-> [Scored (Bool, CompletionItem)]
-> [Scored (Bool, CompletionItem)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((Scored (Bool, CompletionItem) -> Scored (Bool, CompletionItem))
 -> [Scored (Bool, CompletionItem)]
 -> [Scored (Bool, CompletionItem)])
-> ((CompletionItem -> CompletionItem)
    -> Scored (Bool, CompletionItem) -> Scored (Bool, CompletionItem))
-> (CompletionItem -> CompletionItem)
-> [Scored (Bool, CompletionItem)]
-> [Scored (Bool, CompletionItem)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Bool, CompletionItem) -> (Bool, CompletionItem))
-> Scored (Bool, CompletionItem) -> Scored (Bool, CompletionItem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(((Bool, CompletionItem) -> (Bool, CompletionItem))
 -> Scored (Bool, CompletionItem) -> Scored (Bool, CompletionItem))
-> ((CompletionItem -> CompletionItem)
    -> (Bool, CompletionItem) -> (Bool, CompletionItem))
-> (CompletionItem -> CompletionItem)
-> Scored (Bool, CompletionItem)
-> Scored (Bool, CompletionItem)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CompletionItem -> CompletionItem)
-> (Bool, CompletionItem) -> (Bool, CompletionItem)
forall (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 = Bool -> (Text -> Bool) -> Maybe Text -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Text
":" Text -> Text -> Bool
`T.isPrefixOf`) Maybe Text
_detail
              (a -> Down a
forall a. a -> Down a
Down a
isQual, Int -> Down Int
forall a. a -> Down a
Down Int
score, Bool -> Down Bool
forall a. a -> Down a
Down Bool
isLocal, Text
_label, Maybe Text
_detail)



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

      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"
#if __GLASGOW_HASKELL__ < 810
      importedFrom _                              = ""
#endif

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

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

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

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


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

-- | Under certain circumstance GHC generates some extra stuff that we
-- don't want in the autocompleted symbols
    {- When e.g. DuplicateRecordFields is enabled, compiler generates
    names like "$sel:accessor:One" and "$sel:accessor:Two" to disambiguate record selectors
    https://ghc.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/DuplicateRecordFields#Implementation
    -}
-- TODO: Turn this into an alex lexer that discards prefixes as if they were whitespace.
stripPrefix :: T.Text -> T.Text
stripPrefix :: Text -> Text
stripPrefix Text
name = (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
':') (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
name (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$
  First Text -> Maybe Text
forall a. First a -> Maybe a
getFirst (First Text -> Maybe Text) -> First Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ (Text -> First Text) -> [Text] -> First Text
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Maybe Text -> First Text
forall a. Maybe a -> First a
First (Maybe Text -> First Text)
-> (Text -> Maybe Text) -> Text -> First Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Maybe Text
`T.stripPrefix` Text
name)) [Text]
prefixes

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

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

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

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


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

mkRecordSnippetCompItem :: Uri -> Maybe T.Text -> T.Text -> [T.Text] -> Provenance -> SpanDoc -> Maybe (LImportDecl GhcPs) -> CompItem
mkRecordSnippetCompItem :: Uri
-> Maybe Text
-> Text
-> [Text]
-> Provenance
-> SpanDoc
-> Maybe (LImportDecl GhcPs)
-> CompItem
mkRecordSnippetCompItem Uri
uri Maybe Text
parent Text
ctxStr [Text]
compl Provenance
importedFrom SpanDoc
docs Maybe (LImportDecl GhcPs)
imp = CompItem
r
  where
      r :: CompItem
r  = CI :: CompletionItemKind
-> Text
-> Provenance
-> Maybe Text
-> Text
-> Maybe Backtick
-> SpanDoc
-> Bool
-> Maybe ExtendImport
-> CompItem
CI {
            compKind :: CompletionItemKind
compKind = CompletionItemKind
CiSnippet
          , insertText :: Text
insertText = Text
buildSnippet
          , provenance :: Provenance
provenance = Provenance
importedFrom
          , typeText :: Maybe Text
typeText = Maybe Text
forall a. Maybe a
Nothing
          , label :: Text
label = Text
ctxStr
          , isInfix :: Maybe Backtick
isInfix = Maybe Backtick
forall a. Maybe a
Nothing
          , docs :: SpanDoc
docs = SpanDoc
docs
          , isTypeCompl :: Bool
isTypeCompl = Bool
False
          , additionalTextEdits :: Maybe ExtendImport
additionalTextEdits = Maybe (LImportDecl GhcPs)
imp Maybe (LImportDecl GhcPs)
-> (LImportDecl GhcPs -> ExtendImport) -> Maybe ExtendImport
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \LImportDecl GhcPs
x ->
            ExtendImport :: Uri -> Text -> Maybe Text -> Text -> Maybe Text -> ExtendImport
ExtendImport
                { doc :: Uri
doc = Uri
uri,
                  thingParent :: Maybe Text
thingParent = Maybe Text
parent,
                  importName :: Text
importName = ModuleName -> Text
showModName (ModuleName -> Text) -> ModuleName -> Text
forall a b. (a -> b) -> a -> b
$ Located ModuleName -> SrcSpanLess (Located ModuleName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located ModuleName -> SrcSpanLess (Located ModuleName))
-> Located ModuleName -> SrcSpanLess (Located ModuleName)
forall a b. (a -> b) -> a -> b
$ ImportDecl GhcPs -> Located ModuleName
forall pass. ImportDecl pass -> Located ModuleName
ideclName (ImportDecl GhcPs -> Located ModuleName)
-> ImportDecl GhcPs -> Located ModuleName
forall a b. (a -> b) -> a -> b
$ LImportDecl GhcPs -> SrcSpanLess (LImportDecl GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LImportDecl GhcPs
x,
                  importQual :: Maybe Text
importQual = LImportDecl GhcPs -> Maybe Text
getImportQual LImportDecl GhcPs
x,
                  newThing :: Text
newThing = Text
ctxStr
                }
          }

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

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

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

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

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

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

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