content: -----------------------------------------------------------------------------
  --
  -- Module      : Language.PureScript.Ide.Filter
  -- Description : Filters for psc-ide commands
  -- Copyright   : Christoph Hegemann 2016
  -- License     : MIT (http://opensource.org/licenses/MIT)
  --
  -- Maintainer  : Christoph Hegemann <christoph.hegemann1337@gmail.com>
  -- Stability   : experimental
  --
  -- |
  -- Filters for psc-ide commands
  -----------------------------------------------------------------------------
  
  module Language.PureScript.Ide.Filter
         ( Filter
         , moduleFilter
         , namespaceFilter
         , exactFilter
         , prefixFilter
         , declarationTypeFilter
         , dependencyFilter
         , applyFilters
         ) where
  
  import Protolude                     hiding (isPrefixOf, Prefix)
  
  import Control.Monad.Fail (fail)
  import Data.Aeson (FromJSON(..), withObject, (.:), (.:?))
  import Data.Text (isPrefixOf)
  import Data.Set qualified as Set
  import Data.Map qualified as Map
  import Language.PureScript.Ide.Filter.Declaration (DeclarationType)
  import Language.PureScript.Ide.Types (IdeDeclarationAnn, IdeNamespace, ModuleMap, declarationType)
  import Language.PureScript.Ide.Imports (Import, sliceImportSection)
  import Language.PureScript.Ide.Util (discardAnn, identifierFromIdeDeclaration, namespaceForDeclaration)
  
  import Language.PureScript qualified as P
  import Data.Text qualified as T
  
  import Language.PureScript.Ide.Filter.Imports (matchImport)
  
  newtype Filter = Filter (Either (Set P.ModuleName) DeclarationFilter)
    deriving Show
  
  unFilter :: Filter -> Either (Set P.ModuleName) DeclarationFilter
  unFilter (Filter f) = f
  
  data DeclarationFilter
    = Prefix Text
    | Exact Text
    | Namespace (Set IdeNamespace)
    | DeclType (Set DeclarationType)
    | Dependencies { qualifier :: Maybe P.ModuleName, currentModuleName :: P.ModuleName, dependencyImports :: [Import] }
    deriving Show
  
  -- | Only keeps Declarations in the given modules
  moduleFilter :: Set P.ModuleName -> Filter
  moduleFilter = Filter . Left
  
  -- | Only keeps Identifiers in the given Namespaces
  namespaceFilter :: Set IdeNamespace -> Filter
  namespaceFilter nss = Filter (Right (Namespace nss))
  
  -- | Only keeps Identifiers that are equal to the search string
  exactFilter :: Text -> Filter
  exactFilter t = Filter (Right (Exact t))
  
  -- | Only keeps Identifiers that start with the given prefix
  prefixFilter :: Text -> Filter
  prefixFilter t = Filter (Right (Prefix t))
  
  -- | Only keeps Identifiers in the given type declarations
  declarationTypeFilter :: Set DeclarationType -> Filter
  declarationTypeFilter dts = Filter (Right (DeclType dts))
  
  dependencyFilter :: Maybe P.ModuleName -> P.ModuleName -> [Import] -> Filter
  dependencyFilter q m f = Filter (Right (Dependencies q m f))
  
  optimizeFilters :: [Filter] -> (Maybe (Set P.ModuleName), [DeclarationFilter])
  optimizeFilters = first smashModuleFilters . partitionEithers . map unFilter
    where
      smashModuleFilters [] =
        Nothing
      smashModuleFilters (x:xs) =
        Just (foldr Set.intersection x xs)
  
  applyFilters :: [Filter] -> ModuleMap [IdeDeclarationAnn] -> ModuleMap [IdeDeclarationAnn]
  applyFilters fs modules = case optimizeFilters fs of
    (Nothing, declarationFilters) ->
      applyDeclarationFilters declarationFilters modules
    (Just moduleFilter', declarationFilters) ->
      applyDeclarationFilters declarationFilters (Map.restrictKeys modules moduleFilter')
  
  applyDeclarationFilters
    :: [DeclarationFilter]
    -> ModuleMap [IdeDeclarationAnn]
    -> ModuleMap [IdeDeclarationAnn]
  applyDeclarationFilters fs =
    Map.filter (not . null)
    . Map.mapWithKey (\modl decls -> foldr (.) identity (map (applyDeclarationFilter modl) fs) decls)
  
  applyDeclarationFilter
    :: P.ModuleName
    -> DeclarationFilter
    -> [IdeDeclarationAnn]
    -> [IdeDeclarationAnn]
  applyDeclarationFilter modl f = case f of
    Prefix prefix -> prefixFilter' prefix
    Exact t -> exactFilter' t
    Namespace namespaces -> namespaceFilter' namespaces
    DeclType dts -> declarationTypeFilter' dts
    Dependencies qual currentModuleName imps -> dependencyFilter' modl qual currentModuleName imps
  
  namespaceFilter' :: Set IdeNamespace -> [IdeDeclarationAnn] -> [IdeDeclarationAnn]
  namespaceFilter' namespaces =
    filter (\decl -> namespaceForDeclaration (discardAnn decl) `elem` namespaces)
  
  exactFilter' :: Text -> [IdeDeclarationAnn] -> [IdeDeclarationAnn]
  exactFilter' search =
    filter (\decl -> identifierFromIdeDeclaration (discardAnn decl) == search)
  
  prefixFilter' :: Text -> [IdeDeclarationAnn] -> [IdeDeclarationAnn]
  prefixFilter' prefix =
    filter (\decl -> prefix `isPrefixOf` identifierFromIdeDeclaration (discardAnn decl))
  
  declarationTypeFilter' :: Set DeclarationType -> [IdeDeclarationAnn] -> [IdeDeclarationAnn]
  declarationTypeFilter' declTypes =
    filter (\decl -> declarationType (discardAnn decl) `Set.member` declTypes)
  
  dependencyFilter' :: P.ModuleName -> Maybe P.ModuleName -> P.ModuleName -> [Import] -> [IdeDeclarationAnn] -> [IdeDeclarationAnn]
  dependencyFilter' modl qual currentModuleName imports =
    if modl == currentModuleName && isNothing qual then
      identity
    else
      filter (\decl -> any (matchImport qual modl decl) imports)
  
  instance FromJSON Filter where
    parseJSON = withObject "filter" $ \o -> do
      (filter' :: Text) <- o .: "filter"
      case filter' of
        "modules" -> do
          params <- o .: "params"
          modules <- map P.moduleNameFromString <$> params .: "modules"
          pure (moduleFilter (Set.fromList modules))
        "exact" -> do
          params <- o .: "params"
          search <- params .: "search"
          pure (exactFilter search)
        "prefix" -> do
          params <- o .: "params"
          search <- params .: "search"
          pure (prefixFilter search)
        "namespace" -> do
          params <- o .: "params"
          namespaces <- params .: "namespaces"
          pure (namespaceFilter (Set.fromList namespaces))
        "declarations" -> do
          declarations <- o .: "params"
          pure (declarationTypeFilter (Set.fromList declarations))
        "dependencies" -> do
          params <- o .: "params"
          moduleText <- params .: "moduleText"
          qualifier <- fmap P.moduleNameFromString <$> params .:? "qualifier"
          case sliceImportSection (T.lines moduleText) of
            Left err -> fail ("Couldn't parse module imports: " <> T.unpack err)
            Right (currentModuleName, _, imports, _ ) -> pure (dependencyFilter qualifier currentModuleName imports)
        s -> fail ("Unknown filter: " <> show s)
  