module Language.PureScript.Ide.Completion
       ( getCompletions
       , getExactMatches
       , getExactCompletions
       , simpleExport
       , completionFromMatch
       , CompletionOptions(..)
       , defaultCompletionOptions
       , applyCompletionOptions
       ) where

import Protolude hiding ((<&>), moduleName)

import Control.Lens ((.~), (<&>), (^.))
import Data.Aeson (FromJSON(..), withObject, (.!=), (.:?))
import Data.Map qualified as Map
import Data.Text qualified as T
import Language.PureScript qualified as P
import Language.PureScript.Ide.Error (prettyPrintTypeSingleLine)
import Language.PureScript.Ide.Filter (Filter, applyFilters, exactFilter)
import Language.PureScript.Ide.Matcher (Matcher, runMatcher)
import Language.PureScript.Ide.Types
import Language.PureScript.Ide.Util (identT, identifierFromIdeDeclaration, namespaceForDeclaration, properNameT, typeOperatorAliasT, valueOperatorAliasT)

-- | Applies the CompletionFilters and the Matcher to the given Modules
--   and sorts the found Completions according to the Matching Score
getCompletions
  :: [Filter]
  -> Matcher IdeDeclarationAnn
  -> CompletionOptions
  -> ModuleMap [IdeDeclarationAnn]
  -> [Completion]
getCompletions :: [Filter]
-> Matcher IdeDeclarationAnn
-> CompletionOptions
-> ModuleMap [IdeDeclarationAnn]
-> [Completion]
getCompletions [Filter]
filters Matcher IdeDeclarationAnn
matcher CompletionOptions
options ModuleMap [IdeDeclarationAnn]
modules =
  ModuleMap [IdeDeclarationAnn]
modules
  forall a b. a -> (a -> b) -> b
& [Filter]
-> ModuleMap [IdeDeclarationAnn] -> ModuleMap [IdeDeclarationAnn]
applyFilters [Filter]
filters
  forall a b. a -> (a -> b) -> b
& ModuleMap [IdeDeclarationAnn] -> [Match IdeDeclarationAnn]
matchesFromModules
  forall a b. a -> (a -> b) -> b
& forall a. Matcher a -> [Match a] -> [Match a]
runMatcher Matcher IdeDeclarationAnn
matcher
  forall a b. a -> (a -> b) -> b
& CompletionOptions
-> [Match IdeDeclarationAnn]
-> [(Match IdeDeclarationAnn, [ModuleName])]
applyCompletionOptions CompletionOptions
options
  forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Match IdeDeclarationAnn, [ModuleName]) -> Completion
completionFromMatch

getExactMatches :: Text -> [Filter] -> ModuleMap [IdeDeclarationAnn] -> [Match IdeDeclarationAnn]
getExactMatches :: Text
-> [Filter]
-> ModuleMap [IdeDeclarationAnn]
-> [Match IdeDeclarationAnn]
getExactMatches Text
search [Filter]
filters ModuleMap [IdeDeclarationAnn]
modules =
  ModuleMap [IdeDeclarationAnn]
modules
  forall a b. a -> (a -> b) -> b
& [Filter]
-> ModuleMap [IdeDeclarationAnn] -> ModuleMap [IdeDeclarationAnn]
applyFilters (Text -> Filter
exactFilter Text
search forall a. a -> [a] -> [a]
: [Filter]
filters)
  forall a b. a -> (a -> b) -> b
& ModuleMap [IdeDeclarationAnn] -> [Match IdeDeclarationAnn]
matchesFromModules

getExactCompletions :: Text -> [Filter] -> ModuleMap [IdeDeclarationAnn] -> [Completion]
getExactCompletions :: Text -> [Filter] -> ModuleMap [IdeDeclarationAnn] -> [Completion]
getExactCompletions Text
search [Filter]
filters ModuleMap [IdeDeclarationAnn]
modules =
  ModuleMap [IdeDeclarationAnn]
modules
  forall a b. a -> (a -> b) -> b
& Text
-> [Filter]
-> ModuleMap [IdeDeclarationAnn]
-> [Match IdeDeclarationAnn]
getExactMatches Text
search [Filter]
filters
  forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall a. Match a -> (Match a, [ModuleName])
simpleExport
  forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Match IdeDeclarationAnn, [ModuleName]) -> Completion
completionFromMatch

matchesFromModules :: ModuleMap [IdeDeclarationAnn] -> [Match IdeDeclarationAnn]
matchesFromModules :: ModuleMap [IdeDeclarationAnn] -> [Match IdeDeclarationAnn]
matchesFromModules = forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey forall {f :: * -> *} {a}.
Functor f =>
ModuleName -> f a -> f (Match a)
completionFromModule
  where
    completionFromModule :: ModuleName -> f a -> f (Match a)
completionFromModule ModuleName
moduleName =
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map forall a b. (a -> b) -> a -> b
$ \a
x -> forall a. (ModuleName, a) -> Match a
Match (ModuleName
moduleName, a
x)

data CompletionOptions = CompletionOptions
  { CompletionOptions -> Maybe Int
coMaxResults :: Maybe Int
  , CompletionOptions -> Bool
coGroupReexports :: Bool
  }

instance FromJSON CompletionOptions where
  parseJSON :: Value -> Parser CompletionOptions
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"CompletionOptions" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Maybe Int
maxResults <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"maxResults"
    Bool
groupReexports <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"groupReexports" forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (CompletionOptions { coMaxResults :: Maybe Int
coMaxResults = Maybe Int
maxResults
                            , coGroupReexports :: Bool
coGroupReexports = Bool
groupReexports
                            })

defaultCompletionOptions :: CompletionOptions
defaultCompletionOptions :: CompletionOptions
defaultCompletionOptions = CompletionOptions { coMaxResults :: Maybe Int
coMaxResults = forall a. Maybe a
Nothing, coGroupReexports :: Bool
coGroupReexports = Bool
False }

applyCompletionOptions :: CompletionOptions -> [Match IdeDeclarationAnn] -> [(Match IdeDeclarationAnn, [P.ModuleName])]
applyCompletionOptions :: CompletionOptions
-> [Match IdeDeclarationAnn]
-> [(Match IdeDeclarationAnn, [ModuleName])]
applyCompletionOptions CompletionOptions
co [Match IdeDeclarationAnn]
decls =  [Match IdeDeclarationAnn]
decls
  forall a b. a -> (a -> b) -> b
& (if CompletionOptions -> Bool
coGroupReexports CompletionOptions
co
      then [Match IdeDeclarationAnn]
-> [(Match IdeDeclarationAnn, [ModuleName])]
groupCompletionReexports
      else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map forall a. Match a -> (Match a, [ModuleName])
simpleExport)
  forall a b. a -> (a -> b) -> b
& forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
identity forall a. Int -> [a] -> [a]
take (CompletionOptions -> Maybe Int
coMaxResults CompletionOptions
co)

simpleExport :: Match a -> (Match a, [P.ModuleName])
simpleExport :: forall a. Match a -> (Match a, [ModuleName])
simpleExport match :: Match a
match@(Match (ModuleName
moduleName, a
_)) = (Match a
match, [ModuleName
moduleName])

groupCompletionReexports :: [Match IdeDeclarationAnn] -> [(Match IdeDeclarationAnn, [P.ModuleName])]
groupCompletionReexports :: [Match IdeDeclarationAnn]
-> [(Match IdeDeclarationAnn, [ModuleName])]
groupCompletionReexports [Match IdeDeclarationAnn]
initial =
  forall k a. Map k a -> [a]
Map.elems (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Match IdeDeclarationAnn
-> Map (Namespaced Text) (Match IdeDeclarationAnn, [ModuleName])
-> Map (Namespaced Text) (Match IdeDeclarationAnn, [ModuleName])
go forall k a. Map k a
Map.empty [Match IdeDeclarationAnn]
initial)
  where
    go :: Match IdeDeclarationAnn
-> Map (Namespaced Text) (Match IdeDeclarationAnn, [ModuleName])
-> Map (Namespaced Text) (Match IdeDeclarationAnn, [ModuleName])
go (Match (ModuleName
moduleName, d :: IdeDeclarationAnn
d@(IdeDeclarationAnn Annotation
ann IdeDeclaration
decl))) =
      let
        origin :: ModuleName
origin = forall a. a -> Maybe a -> a
fromMaybe ModuleName
moduleName (Annotation
ann forall s a. s -> Getting a s a -> a
^. Lens' Annotation (Maybe ModuleName)
annExportedFrom)
      in
        forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter
        (forall {a}.
a
-> ModuleName
-> IdeDeclarationAnn
-> Maybe (Match IdeDeclarationAnn, [a])
-> Maybe (Match IdeDeclarationAnn, [a])
insertDeclaration ModuleName
moduleName ModuleName
origin IdeDeclarationAnn
d)
        (forall a. IdeNamespace -> a -> Namespaced a
Namespaced (IdeDeclaration -> IdeNamespace
namespaceForDeclaration IdeDeclaration
decl)
         (ModuleName -> Text
P.runModuleName ModuleName
origin forall a. Semigroup a => a -> a -> a
<> Text
"." forall a. Semigroup a => a -> a -> a
<> IdeDeclaration -> Text
identifierFromIdeDeclaration IdeDeclaration
decl))
    insertDeclaration :: a
-> ModuleName
-> IdeDeclarationAnn
-> Maybe (Match IdeDeclarationAnn, [a])
-> Maybe (Match IdeDeclarationAnn, [a])
insertDeclaration a
moduleName ModuleName
origin IdeDeclarationAnn
d Maybe (Match IdeDeclarationAnn, [a])
old = case Maybe (Match IdeDeclarationAnn, [a])
old of
      Maybe (Match IdeDeclarationAnn, [a])
Nothing -> forall a. a -> Maybe a
Just ( forall a. (ModuleName, a) -> Match a
Match (ModuleName
origin, IdeDeclarationAnn
d forall a b. a -> (a -> b) -> b
& Lens' IdeDeclarationAnn Annotation
idaAnnotation forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Annotation (Maybe ModuleName)
annExportedFrom forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Maybe a
Nothing)
                      , [a
moduleName]
                      )
      Just (Match IdeDeclarationAnn, [a])
x -> forall a. a -> Maybe a
Just (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (a
moduleName forall a. a -> [a] -> [a]
:) (Match IdeDeclarationAnn, [a])
x)

data Namespaced a = Namespaced IdeNamespace a
  deriving (Int -> Namespaced a -> ShowS
forall a. Show a => Int -> Namespaced a -> ShowS
forall a. Show a => [Namespaced a] -> ShowS
forall a. Show a => Namespaced a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Namespaced a] -> ShowS
$cshowList :: forall a. Show a => [Namespaced a] -> ShowS
show :: Namespaced a -> String
$cshow :: forall a. Show a => Namespaced a -> String
showsPrec :: Int -> Namespaced a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Namespaced a -> ShowS
Show, Namespaced a -> Namespaced a -> Bool
forall a. Eq a => Namespaced a -> Namespaced a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Namespaced a -> Namespaced a -> Bool
$c/= :: forall a. Eq a => Namespaced a -> Namespaced a -> Bool
== :: Namespaced a -> Namespaced a -> Bool
$c== :: forall a. Eq a => Namespaced a -> Namespaced a -> Bool
Eq, Namespaced a -> Namespaced a -> Bool
Namespaced a -> Namespaced a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Namespaced a)
forall a. Ord a => Namespaced a -> Namespaced a -> Bool
forall a. Ord a => Namespaced a -> Namespaced a -> Ordering
forall a. Ord a => Namespaced a -> Namespaced a -> Namespaced a
min :: Namespaced a -> Namespaced a -> Namespaced a
$cmin :: forall a. Ord a => Namespaced a -> Namespaced a -> Namespaced a
max :: Namespaced a -> Namespaced a -> Namespaced a
$cmax :: forall a. Ord a => Namespaced a -> Namespaced a -> Namespaced a
>= :: Namespaced a -> Namespaced a -> Bool
$c>= :: forall a. Ord a => Namespaced a -> Namespaced a -> Bool
> :: Namespaced a -> Namespaced a -> Bool
$c> :: forall a. Ord a => Namespaced a -> Namespaced a -> Bool
<= :: Namespaced a -> Namespaced a -> Bool
$c<= :: forall a. Ord a => Namespaced a -> Namespaced a -> Bool
< :: Namespaced a -> Namespaced a -> Bool
$c< :: forall a. Ord a => Namespaced a -> Namespaced a -> Bool
compare :: Namespaced a -> Namespaced a -> Ordering
$ccompare :: forall a. Ord a => Namespaced a -> Namespaced a -> Ordering
Ord)

completionFromMatch :: (Match IdeDeclarationAnn, [P.ModuleName]) -> Completion
completionFromMatch :: (Match IdeDeclarationAnn, [ModuleName]) -> Completion
completionFromMatch (Match (ModuleName
m, IdeDeclarationAnn Annotation
ann IdeDeclaration
decl), [ModuleName]
mns) =
  Completion {[ModuleName]
Maybe Text
Maybe SourceSpan
Maybe DeclarationType
Text
complDeclarationType :: Maybe DeclarationType
complExportedFrom :: [ModuleName]
complDocumentation :: Maybe Text
complLocation :: Maybe SourceSpan
complExpandedType :: Text
complType :: Text
complIdentifier :: Text
complModule :: Text
complDeclarationType :: Maybe DeclarationType
complDocumentation :: Maybe Text
complLocation :: Maybe SourceSpan
complType :: Text
complModule :: Text
complExportedFrom :: [ModuleName]
complExpandedType :: Text
complIdentifier :: Text
..}
  where
    (Text
complIdentifier, Text
complExpandedType) = case IdeDeclaration
decl of
      IdeDeclValue IdeValue
v -> (IdeValue
v forall s a. s -> Getting a s a -> a
^. Lens' IdeValue Ident
ideValueIdent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. Getting r Ident Text
identT, IdeValue
v forall s a. s -> Getting a s a -> a
^. Lens' IdeValue SourceType
ideValueType forall a b. a -> (a -> b) -> b
& forall a. Type a -> Text
prettyPrintTypeSingleLine)
      IdeDeclType IdeType
t -> (IdeType
t forall s a. s -> Getting a s a -> a
^. Lens' IdeType (ProperName 'TypeName)
ideTypeName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (a :: ProperNameType). Getting r (ProperName a) Text
properNameT, IdeType
t forall s a. s -> Getting a s a -> a
^. Lens' IdeType SourceType
ideTypeKind forall a b. a -> (a -> b) -> b
& forall a. Type a -> Text
prettyPrintTypeSingleLine)
      IdeDeclTypeSynonym IdeTypeSynonym
s -> (IdeTypeSynonym
s forall s a. s -> Getting a s a -> a
^. Lens' IdeTypeSynonym (ProperName 'TypeName)
ideSynonymName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (a :: ProperNameType). Getting r (ProperName a) Text
properNameT, IdeTypeSynonym
s forall s a. s -> Getting a s a -> a
^. Lens' IdeTypeSynonym SourceType
ideSynonymType forall a b. a -> (a -> b) -> b
& forall a. Type a -> Text
prettyPrintTypeSingleLine)
      IdeDeclDataConstructor IdeDataConstructor
d -> (IdeDataConstructor
d forall s a. s -> Getting a s a -> a
^. Lens' IdeDataConstructor (ProperName 'ConstructorName)
ideDtorName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (a :: ProperNameType). Getting r (ProperName a) Text
properNameT, IdeDataConstructor
d forall s a. s -> Getting a s a -> a
^. Lens' IdeDataConstructor SourceType
ideDtorType forall a b. a -> (a -> b) -> b
& forall a. Type a -> Text
prettyPrintTypeSingleLine)
      IdeDeclTypeClass IdeTypeClass
d -> (IdeTypeClass
d forall s a. s -> Getting a s a -> a
^. Lens' IdeTypeClass (ProperName 'ClassName)
ideTCName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (a :: ProperNameType). Getting r (ProperName a) Text
properNameT, IdeTypeClass
d forall s a. s -> Getting a s a -> a
^. Lens' IdeTypeClass SourceType
ideTCKind forall a b. a -> (a -> b) -> b
& forall a. Type a -> Text
prettyPrintTypeSingleLine)
      IdeDeclValueOperator (IdeValueOperator OpName 'ValueOpName
op Qualified (Either Ident (ProperName 'ConstructorName))
ref Precedence
precedence Associativity
associativity Maybe SourceType
typeP) ->
        (forall (a :: OpNameType). OpName a -> Text
P.runOpName OpName 'ValueOpName
op, forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall {a} {a :: OpNameType}.
Show a =>
a -> Associativity -> Text -> OpName a -> Text
showFixity Precedence
precedence Associativity
associativity (Qualified (Either Ident (ProperName 'ConstructorName)) -> Text
valueOperatorAliasT Qualified (Either Ident (ProperName 'ConstructorName))
ref) OpName 'ValueOpName
op) forall a. Type a -> Text
prettyPrintTypeSingleLine Maybe SourceType
typeP)
      IdeDeclTypeOperator (IdeTypeOperator OpName 'TypeOpName
op Qualified (ProperName 'TypeName)
ref Precedence
precedence Associativity
associativity Maybe SourceType
kind) ->
        (forall (a :: OpNameType). OpName a -> Text
P.runOpName OpName 'TypeOpName
op, forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall {a} {a :: OpNameType}.
Show a =>
a -> Associativity -> Text -> OpName a -> Text
showFixity Precedence
precedence Associativity
associativity (Qualified (ProperName 'TypeName) -> Text
typeOperatorAliasT Qualified (ProperName 'TypeName)
ref) OpName 'TypeOpName
op) forall a. Type a -> Text
prettyPrintTypeSingleLine Maybe SourceType
kind)
      IdeDeclModule ModuleName
mn -> (ModuleName -> Text
P.runModuleName ModuleName
mn, Text
"module")

    complExportedFrom :: [ModuleName]
complExportedFrom = [ModuleName]
mns

    complModule :: Text
complModule = ModuleName -> Text
P.runModuleName ModuleName
m

    complType :: Text
complType = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
complExpandedType forall a. Type a -> Text
prettyPrintTypeSingleLine (Annotation -> Maybe SourceType
_annTypeAnnotation Annotation
ann)

    complLocation :: Maybe SourceSpan
complLocation = Annotation -> Maybe SourceSpan
_annLocation Annotation
ann

    complDocumentation :: Maybe Text
complDocumentation = Annotation -> Maybe Text
_annDocumentation Annotation
ann

    complDeclarationType :: Maybe DeclarationType
complDeclarationType = forall a. a -> Maybe a
Just (IdeDeclaration -> DeclarationType
declarationType IdeDeclaration
decl)

    showFixity :: a -> Associativity -> Text -> OpName a -> Text
showFixity a
p Associativity
a Text
r OpName a
o =
      let asso :: Text
asso = case Associativity
a of
            Associativity
P.Infix -> Text
"infix"
            Associativity
P.Infixl -> Text
"infixl"
            Associativity
P.Infixr -> Text
"infixr"
      in [Text] -> Text
T.unwords [Text
asso, forall a b. (Show a, StringConv String b) => a -> b
show a
p, Text
r, Text
"as", forall (a :: OpNameType). OpName a -> Text
P.runOpName OpName a
o]