content: {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE ScopedTypeVariables        #-}
  module PureScript.Ide.Filter
         (Filter, moduleFilter, prefixFilter, equalityFilter, dependencyFilter,
          runFilter, applyFilters)
         where
  
  import           Control.Monad
  import           Data.Aeson
  import           Data.Foldable
  import           Data.Maybe           (listToMaybe, mapMaybe)
  import           Data.Monoid
  import           Data.Text            (Text, isPrefixOf)
  import           PureScript.Ide.Types
  
  newtype Filter = Filter (Endo [Module]) deriving(Monoid)
  
  mkFilter :: ([Module] -> [Module]) -> Filter
  mkFilter = Filter . Endo
  
  -- | Only keeps the given Modules
  moduleFilter :: [ModuleIdent] -> Filter
  moduleFilter =
      mkFilter . moduleFilter'
  
  moduleFilter' :: [ModuleIdent] -> [Module] -> [Module]
  moduleFilter' moduleIdents = filter (flip elem moduleIdents . fst)
  
  -- | Only keeps the given Modules and all of their dependencies
  dependencyFilter :: [ModuleIdent] -> Filter
  dependencyFilter = mkFilter . dependencyFilter'
  
  dependencyFilter' :: [ModuleIdent] -> [Module] -> [Module]
  dependencyFilter' moduleIdents mods =
    moduleFilter' (concatMap (getDepForModule mods) moduleIdents) mods
    where
      getDepForModule :: [Module] -> ModuleIdent -> [ModuleIdent]
      getDepForModule ms moduleIdent =
        moduleIdent : maybe [] extractDeps (findModule moduleIdent ms)
  
      findModule :: ModuleIdent -> [Module] -> Maybe Module
      findModule i ms = listToMaybe $ filter go ms
        where go (mn, _) = i == mn
  
      extractDeps :: Module -> [ModuleIdent]
      extractDeps = mapMaybe extractDep . snd
        where extractDep (Dependency n _ _) = Just n
              extractDep (ModuleDecl _ _) = Nothing
              extractDep _ = Nothing
  
  -- | Only keeps Identifiers that start with the given prefix
  prefixFilter :: Text -> Filter
  prefixFilter "" = mkFilter id
  prefixFilter t = mkFilter $ identFilter prefix t
    where
      prefix :: ExternDecl -> Text -> Bool
      prefix (FunctionDecl name _) search = search `isPrefixOf` name
      prefix (DataDecl name _) search = search `isPrefixOf` name
      prefix (ModuleDecl name _) search = search `isPrefixOf` name
      prefix _ _ = False
  
  
  -- | Only keeps Identifiers that are equal to the search string
  equalityFilter :: Text -> Filter
  equalityFilter = mkFilter . identFilter equality
    where
      equality :: ExternDecl -> Text -> Bool
      equality (FunctionDecl name _) prefix = prefix == name
      equality (DataDecl name _) prefix = prefix == name
      equality _ _ = False
  
  
  identFilter :: (ExternDecl -> Text -> Bool ) -> Text -> [Module] -> [Module]
  identFilter predicate search =
      filter (not . null . snd) . fmap filterModuleDecls
    where
      filterModuleDecls :: Module -> Module
      filterModuleDecls (moduleIdent,decls) =
          (moduleIdent, filter (`predicate` search) decls)
  
  runFilter :: Filter -> [Module] -> [Module]
  runFilter (Filter f)= appEndo f
  
  applyFilters :: [Filter] -> [Module] -> [Module]
  applyFilters = runFilter . fold
  
  instance FromJSON Filter where
    parseJSON = withObject "filter" $ \o -> do
      (filter' :: String) <- o .: "filter"
      case filter' of
        "exact" -> do
          params <- o .: "params"
          search <- params .: "search"
          return $ equalityFilter search
        "prefix" -> do
          params <- o.: "params"
          search <- params .: "search"
          return $ prefixFilter search
        "modules" -> do
          params <- o .: "params"
          modules <- params .: "modules"
          return $ moduleFilter modules
        "dependencies" -> do
          params <- o .: "params"
          deps <- params .: "modules"
          return $ dependencyFilter deps
        _ -> mzero
  