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]

