pure (CompletionResult (map (completionFromMatch . simpleExport . map withEmptyAnn) question))

pure (CompletionResult (getCompletions filters matcher complOptions modules))

pure (CompletionResult (getExactCompletions search filters modules))

, getExactCompletions

, simpleExport

, completionFromMatch

import Control.Lens hiding ((&), op)

import qualified Data.Map as Map

import qualified Data.Text as T

import qualified Language.PureScript as P

import Language.PureScript.Ide.Error (prettyPrintTypeSingleLine)

import Language.PureScript.Ide.Util

-> [Completion]

& matchesFromModules

<&> completionFromMatch

modules

& applyFilters (equalityFilter search : filters)

& matchesFromModules

getExactCompletions :: Text -> [Filter] -> [Module] -> [Completion]

getExactCompletions search filters modules =

modules

& getExactMatches search filters

<&> simpleExport

<&> completionFromMatch

matchesFromModules :: [Module] -> [Match IdeDeclarationAnn]

matchesFromModules = foldMap completionFromModule

, coGroupReexports :: Bool

groupReexports <- o .:? "groupReexports" .!= False

pure (CompletionOptions { coMaxResults = maxResults

, coGroupReexports = groupReexports

})

defaultCompletionOptions :: CompletionOptions

defaultCompletionOptions = CompletionOptions { coMaxResults = Nothing, coGroupReexports = False }

applyCompletionOptions :: CompletionOptions -> [Match IdeDeclarationAnn] -> [(Match IdeDeclarationAnn, [P.ModuleName])]

applyCompletionOptions co decls =

maybe identity take (coMaxResults co) decls

& if coGroupReexports co

then groupCompletionReexports

else map simpleExport

simpleExport :: Match a -> (Match a, [P.ModuleName])

simpleExport match@(Match (moduleName, _)) = (match, [moduleName])

groupCompletionReexports :: [Match IdeDeclarationAnn] -> [(Match IdeDeclarationAnn, [P.ModuleName])]

groupCompletionReexports initial =

Map.elems (foldr go Map.empty initial)

where

go (Match (moduleName, d@(IdeDeclarationAnn ann decl))) =

let

origin = fromMaybe moduleName (ann^.annExportedFrom)

in

Map.alter

(insertDeclaration moduleName origin d)

(Namespaced (namespaceForDeclaration decl)

(P.runModuleName origin <> "." <> identifierFromIdeDeclaration decl))

insertDeclaration moduleName origin d old = case old of

Nothing -> Just ( Match (origin, d & idaAnnotation.annExportedFrom .~ Nothing)

, [moduleName]

)

Just x -> Just (second (moduleName :) x)

data Namespaced a = Namespaced IdeNamespace a

deriving (Show, Eq, Ord)

completionFromMatch :: (Match IdeDeclarationAnn, [P.ModuleName]) -> Completion

completionFromMatch (Match (m, IdeDeclarationAnn ann decl), mns) =

Completion {..}

where

(complIdentifier, complExpandedType) = case decl of

IdeDeclValue v -> (v ^. ideValueIdent . identT, v ^. ideValueType & prettyPrintTypeSingleLine)

IdeDeclType t -> (t ^. ideTypeName . properNameT, t ^. ideTypeKind & P.prettyPrintKind)

IdeDeclTypeSynonym s -> (s ^. ideSynonymName . properNameT, s ^. ideSynonymType & prettyPrintTypeSingleLine)

IdeDeclDataConstructor d -> (d ^. ideDtorName . properNameT, d ^. ideDtorType & prettyPrintTypeSingleLine)

IdeDeclTypeClass d -> (d ^. ideTCName . properNameT, d ^. ideTCKind & P.prettyPrintKind)

IdeDeclValueOperator (IdeValueOperator op ref precedence associativity typeP) ->

(P.runOpName op, maybe (showFixity precedence associativity (valueOperatorAliasT ref) op) prettyPrintTypeSingleLine typeP)

IdeDeclTypeOperator (IdeTypeOperator op ref precedence associativity kind) ->

(P.runOpName op, maybe (showFixity precedence associativity (typeOperatorAliasT ref) op) P.prettyPrintKind kind)

IdeDeclKind k -> (P.runProperName k, "kind")

complExportedFrom = mns

complModule = P.runModuleName m

complType = maybe complExpandedType prettyPrintTypeSingleLine (_annTypeAnnotation ann)

complLocation = _annLocation ann

complDocumentation = Nothing

showFixity p a r o =

let asso = case a of

P.Infix -> "infix"

P.Infixl -> "infixl"

P.Infixr -> "infixr"

in T.unwords [asso, show p, r, "as", P.runOpName o]

Completion (maybe "" P.runModuleName mn) i (prettyPrintTypeSingleLine ty) (prettyPrintTypeSingleLine ty) Nothing Nothing (maybe [] (\x -> [x]) mn)

Completion "" ("_." <> P.prettyPrintLabel label) (prettyPrintTypeSingleLine ty) (prettyPrintTypeSingleLine ty) Nothing Nothing []

filterNamespaces decl = elem (namespaceForDeclaration decl) namespaces

import qualified Data.Map.Lazy as M

import qualified Language.PureScript as P

import qualified Language.PureScript.Errors.JSON as P

, complExportedFrom :: [P.ModuleName]

, "exportedFrom" .= complExportedFrom

, namespaceForDeclaration

import Language.PureScript.Ide.Error (IdeError(..))

namespaceForDeclaration :: IdeDeclaration -> IdeNamespace

namespaceForDeclaration d = case d of

IdeDeclValue _ -> IdeNSValue

IdeDeclType _ -> IdeNSType

IdeDeclTypeSynonym _ -> IdeNSType

IdeDeclDataConstructor _ -> IdeNSValue

IdeDeclTypeClass _ -> IdeNSType

IdeDeclValueOperator _ -> IdeNSValue

IdeDeclTypeOperator _ -> IdeNSType

IdeDeclKind _ -> IdeNSKind

import Language.PureScript as P

reexportMatches :: [Match IdeDeclarationAnn]

reexportMatches =

map (\d -> Match (mn "A", d)) moduleA

++ map (\d -> Match (mn "B", d)) moduleB

where

moduleA = [ideKind "Kind"]

moduleB = [ideKind "Kind" `annExp` "A"]

matches :: [(Match IdeDeclarationAnn, [P.ModuleName])]

matches = map (\d -> (Match (mn "Main", d), [mn "Main"])) [ ideKind "Kind", ideType "Type" Nothing ]

applyCompletionOptions (defaultCompletionOptions { coMaxResults = Nothing })

(map fst matches) `shouldMatchList` matches

applyCompletionOptions (defaultCompletionOptions { coMaxResults = Just 1 })

(map fst matches) `shouldMatchList` take 1 matches

it "groups reexports for a single identifier" $ do

applyCompletionOptions (defaultCompletionOptions { coGroupReexports = True })

reexportMatches `shouldBe` [(Match (mn "A", ideKind "Kind"), [mn "A", mn "B"])]