content: 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 filters matcher options modules =
    modules
    & applyFilters filters
    & matchesFromModules
    & runMatcher matcher
    & applyCompletionOptions options
    <&> completionFromMatch
  
  getExactMatches :: Text -> [Filter] -> ModuleMap [IdeDeclarationAnn] -> [Match IdeDeclarationAnn]
  getExactMatches search filters modules =
    modules
    & applyFilters (exactFilter search : filters)
    & matchesFromModules
  
  getExactCompletions :: Text -> [Filter] -> ModuleMap [IdeDeclarationAnn] -> [Completion]
  getExactCompletions search filters modules =
    modules
    & getExactMatches search filters
    <&> simpleExport
    <&> completionFromMatch
  
  matchesFromModules :: ModuleMap [IdeDeclarationAnn] -> [Match IdeDeclarationAnn]
  matchesFromModules = Map.foldMapWithKey completionFromModule
    where
      completionFromModule moduleName =
        map $ \x -> Match (moduleName, x)
  
  data CompletionOptions = CompletionOptions
    { coMaxResults :: Maybe Int
    , coGroupReexports :: Bool
    }
  
  instance FromJSON CompletionOptions where
    parseJSON = withObject "CompletionOptions" $ \o -> do
      maxResults <- o .:? "maxResults"
      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 =  decls
    & (if coGroupReexports co
        then groupCompletionReexports
        else map simpleExport)
    & maybe identity take (coMaxResults co)
  
  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 & prettyPrintTypeSingleLine)
        IdeDeclTypeSynonym s -> (s ^. ideSynonymName . properNameT, s ^. ideSynonymType & prettyPrintTypeSingleLine)
        IdeDeclDataConstructor d -> (d ^. ideDtorName . properNameT, d ^. ideDtorType & prettyPrintTypeSingleLine)
        IdeDeclTypeClass d -> (d ^. ideTCName . properNameT, d ^. ideTCKind & prettyPrintTypeSingleLine)
        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) prettyPrintTypeSingleLine kind)
        IdeDeclModule mn -> (P.runModuleName mn, "module")
  
      complExportedFrom = mns
  
      complModule = P.runModuleName m
  
      complType = maybe complExpandedType prettyPrintTypeSingleLine (_annTypeAnnotation ann)
  
      complLocation = _annLocation ann
  
      complDocumentation = _annDocumentation ann
  
      complDeclarationType = Just (declarationType decl)
  
      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]
  
  