-----------------------------------------------------------------------------
--
-- 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 Int -> Filter -> ShowS
[Filter] -> ShowS
Filter -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Filter] -> ShowS
$cshowList :: [Filter] -> ShowS
show :: Filter -> String
$cshow :: Filter -> String
showsPrec :: Int -> Filter -> ShowS
$cshowsPrec :: Int -> Filter -> ShowS
Show

unFilter :: Filter -> Either (Set P.ModuleName) DeclarationFilter
unFilter :: Filter -> Either (Set ModuleName) DeclarationFilter
unFilter (Filter Either (Set ModuleName) DeclarationFilter
f) = Either (Set ModuleName) DeclarationFilter
f

data DeclarationFilter
  = Prefix Text
  | Exact Text
  | Namespace (Set IdeNamespace)
  | DeclType (Set DeclarationType)
  | Dependencies { DeclarationFilter -> Maybe ModuleName
qualifier :: Maybe P.ModuleName, DeclarationFilter -> ModuleName
currentModuleName :: P.ModuleName, DeclarationFilter -> [Import]
dependencyImports :: [Import] }
  deriving Int -> DeclarationFilter -> ShowS
[DeclarationFilter] -> ShowS
DeclarationFilter -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeclarationFilter] -> ShowS
$cshowList :: [DeclarationFilter] -> ShowS
show :: DeclarationFilter -> String
$cshow :: DeclarationFilter -> String
showsPrec :: Int -> DeclarationFilter -> ShowS
$cshowsPrec :: Int -> DeclarationFilter -> ShowS
Show

-- | Only keeps Declarations in the given modules
moduleFilter :: Set P.ModuleName -> Filter
moduleFilter :: Set ModuleName -> Filter
moduleFilter = Either (Set ModuleName) DeclarationFilter -> Filter
Filter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left

-- | Only keeps Identifiers in the given Namespaces
namespaceFilter :: Set IdeNamespace -> Filter
namespaceFilter :: Set IdeNamespace -> Filter
namespaceFilter Set IdeNamespace
nss = Either (Set ModuleName) DeclarationFilter -> Filter
Filter (forall a b. b -> Either a b
Right (Set IdeNamespace -> DeclarationFilter
Namespace Set IdeNamespace
nss))

-- | Only keeps Identifiers that are equal to the search string
exactFilter :: Text -> Filter
exactFilter :: Text -> Filter
exactFilter Text
t = Either (Set ModuleName) DeclarationFilter -> Filter
Filter (forall a b. b -> Either a b
Right (Text -> DeclarationFilter
Exact Text
t))

-- | Only keeps Identifiers that start with the given prefix
prefixFilter :: Text -> Filter
prefixFilter :: Text -> Filter
prefixFilter Text
t = Either (Set ModuleName) DeclarationFilter -> Filter
Filter (forall a b. b -> Either a b
Right (Text -> DeclarationFilter
Prefix Text
t))

-- | Only keeps Identifiers in the given type declarations
declarationTypeFilter :: Set DeclarationType -> Filter
declarationTypeFilter :: Set DeclarationType -> Filter
declarationTypeFilter Set DeclarationType
dts = Either (Set ModuleName) DeclarationFilter -> Filter
Filter (forall a b. b -> Either a b
Right (Set DeclarationType -> DeclarationFilter
DeclType Set DeclarationType
dts))

dependencyFilter :: Maybe P.ModuleName -> P.ModuleName -> [Import] -> Filter
dependencyFilter :: Maybe ModuleName -> ModuleName -> [Import] -> Filter
dependencyFilter Maybe ModuleName
q ModuleName
m [Import]
f = Either (Set ModuleName) DeclarationFilter -> Filter
Filter (forall a b. b -> Either a b
Right (Maybe ModuleName -> ModuleName -> [Import] -> DeclarationFilter
Dependencies Maybe ModuleName
q ModuleName
m [Import]
f))

optimizeFilters :: [Filter] -> (Maybe (Set P.ModuleName), [DeclarationFilter])
optimizeFilters :: [Filter] -> (Maybe (Set ModuleName), [DeclarationFilter])
optimizeFilters = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall {a}. Ord a => [Set a] -> Maybe (Set a)
smashModuleFilters forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [Either a b] -> ([a], [b])
partitionEithers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Filter -> Either (Set ModuleName) DeclarationFilter
unFilter
  where
    smashModuleFilters :: [Set a] -> Maybe (Set a)
smashModuleFilters [] =
      forall a. Maybe a
Nothing
    smashModuleFilters (Set a
x:[Set a]
xs) =
      forall a. a -> Maybe a
Just (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set a
x [Set a]
xs)

applyFilters :: [Filter] -> ModuleMap [IdeDeclarationAnn] -> ModuleMap [IdeDeclarationAnn]
applyFilters :: [Filter]
-> ModuleMap [IdeDeclarationAnn] -> ModuleMap [IdeDeclarationAnn]
applyFilters [Filter]
fs ModuleMap [IdeDeclarationAnn]
modules = case [Filter] -> (Maybe (Set ModuleName), [DeclarationFilter])
optimizeFilters [Filter]
fs of
  (Maybe (Set ModuleName)
Nothing, [DeclarationFilter]
declarationFilters) ->
    [DeclarationFilter]
-> ModuleMap [IdeDeclarationAnn] -> ModuleMap [IdeDeclarationAnn]
applyDeclarationFilters [DeclarationFilter]
declarationFilters ModuleMap [IdeDeclarationAnn]
modules
  (Just Set ModuleName
moduleFilter', [DeclarationFilter]
declarationFilters) ->
    [DeclarationFilter]
-> ModuleMap [IdeDeclarationAnn] -> ModuleMap [IdeDeclarationAnn]
applyDeclarationFilters [DeclarationFilter]
declarationFilters (forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys ModuleMap [IdeDeclarationAnn]
modules Set ModuleName
moduleFilter')

applyDeclarationFilters
  :: [DeclarationFilter]
  -> ModuleMap [IdeDeclarationAnn]
  -> ModuleMap [IdeDeclarationAnn]
applyDeclarationFilters :: [DeclarationFilter]
-> ModuleMap [IdeDeclarationAnn] -> ModuleMap [IdeDeclarationAnn]
applyDeclarationFilters [DeclarationFilter]
fs =
  forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\ModuleName
modl [IdeDeclarationAnn]
decls -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall a. a -> a
identity (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (ModuleName
-> DeclarationFilter -> [IdeDeclarationAnn] -> [IdeDeclarationAnn]
applyDeclarationFilter ModuleName
modl) [DeclarationFilter]
fs) [IdeDeclarationAnn]
decls)

applyDeclarationFilter
  :: P.ModuleName
  -> DeclarationFilter
  -> [IdeDeclarationAnn]
  -> [IdeDeclarationAnn]
applyDeclarationFilter :: ModuleName
-> DeclarationFilter -> [IdeDeclarationAnn] -> [IdeDeclarationAnn]
applyDeclarationFilter ModuleName
modl DeclarationFilter
f = case DeclarationFilter
f of
  Prefix Text
prefix -> Text -> [IdeDeclarationAnn] -> [IdeDeclarationAnn]
prefixFilter' Text
prefix
  Exact Text
t -> Text -> [IdeDeclarationAnn] -> [IdeDeclarationAnn]
exactFilter' Text
t
  Namespace Set IdeNamespace
namespaces -> Set IdeNamespace -> [IdeDeclarationAnn] -> [IdeDeclarationAnn]
namespaceFilter' Set IdeNamespace
namespaces
  DeclType Set DeclarationType
dts -> Set DeclarationType -> [IdeDeclarationAnn] -> [IdeDeclarationAnn]
declarationTypeFilter' Set DeclarationType
dts
  Dependencies Maybe ModuleName
qual ModuleName
currentModuleName [Import]
imps -> ModuleName
-> Maybe ModuleName
-> ModuleName
-> [Import]
-> [IdeDeclarationAnn]
-> [IdeDeclarationAnn]
dependencyFilter' ModuleName
modl Maybe ModuleName
qual ModuleName
currentModuleName [Import]
imps

namespaceFilter' :: Set IdeNamespace -> [IdeDeclarationAnn] -> [IdeDeclarationAnn]
namespaceFilter' :: Set IdeNamespace -> [IdeDeclarationAnn] -> [IdeDeclarationAnn]
namespaceFilter' Set IdeNamespace
namespaces =
  forall a. (a -> Bool) -> [a] -> [a]
filter (\IdeDeclarationAnn
decl -> IdeDeclaration -> IdeNamespace
namespaceForDeclaration (IdeDeclarationAnn -> IdeDeclaration
discardAnn IdeDeclarationAnn
decl) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Set IdeNamespace
namespaces)

exactFilter' :: Text -> [IdeDeclarationAnn] -> [IdeDeclarationAnn]
exactFilter' :: Text -> [IdeDeclarationAnn] -> [IdeDeclarationAnn]
exactFilter' Text
search =
  forall a. (a -> Bool) -> [a] -> [a]
filter (\IdeDeclarationAnn
decl -> IdeDeclaration -> Text
identifierFromIdeDeclaration (IdeDeclarationAnn -> IdeDeclaration
discardAnn IdeDeclarationAnn
decl) forall a. Eq a => a -> a -> Bool
== Text
search)

prefixFilter' :: Text -> [IdeDeclarationAnn] -> [IdeDeclarationAnn]
prefixFilter' :: Text -> [IdeDeclarationAnn] -> [IdeDeclarationAnn]
prefixFilter' Text
prefix =
  forall a. (a -> Bool) -> [a] -> [a]
filter (\IdeDeclarationAnn
decl -> Text
prefix Text -> Text -> Bool
`isPrefixOf` IdeDeclaration -> Text
identifierFromIdeDeclaration (IdeDeclarationAnn -> IdeDeclaration
discardAnn IdeDeclarationAnn
decl))

declarationTypeFilter' :: Set DeclarationType -> [IdeDeclarationAnn] -> [IdeDeclarationAnn]
declarationTypeFilter' :: Set DeclarationType -> [IdeDeclarationAnn] -> [IdeDeclarationAnn]
declarationTypeFilter' Set DeclarationType
declTypes =
  forall a. (a -> Bool) -> [a] -> [a]
filter (\IdeDeclarationAnn
decl -> IdeDeclaration -> DeclarationType
declarationType (IdeDeclarationAnn -> IdeDeclaration
discardAnn IdeDeclarationAnn
decl) forall a. Ord a => a -> Set a -> Bool
`Set.member` Set DeclarationType
declTypes)

dependencyFilter' :: P.ModuleName -> Maybe P.ModuleName -> P.ModuleName -> [Import] -> [IdeDeclarationAnn] -> [IdeDeclarationAnn]
dependencyFilter' :: ModuleName
-> Maybe ModuleName
-> ModuleName
-> [Import]
-> [IdeDeclarationAnn]
-> [IdeDeclarationAnn]
dependencyFilter' ModuleName
modl Maybe ModuleName
qual ModuleName
currentModuleName [Import]
imports =
  if ModuleName
modl forall a. Eq a => a -> a -> Bool
== ModuleName
currentModuleName Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing Maybe ModuleName
qual then
    forall a. a -> a
identity
  else
    forall a. (a -> Bool) -> [a] -> [a]
filter (\IdeDeclarationAnn
decl -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Maybe ModuleName
-> ModuleName -> IdeDeclarationAnn -> Import -> Bool
matchImport Maybe ModuleName
qual ModuleName
modl IdeDeclarationAnn
decl) [Import]
imports)

instance FromJSON Filter where
  parseJSON :: Value -> Parser Filter
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"filter" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    (Text
filter' :: Text) <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"filter"
    case Text
filter' of
      Text
"modules" -> do
        Object
params <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"params"
        [ModuleName]
modules <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Text -> ModuleName
P.moduleNameFromString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
params forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"modules"
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set ModuleName -> Filter
moduleFilter (forall a. Ord a => [a] -> Set a
Set.fromList [ModuleName]
modules))
      Text
"exact" -> do
        Object
params <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"params"
        Text
search <- Object
params forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"search"
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Filter
exactFilter Text
search)
      Text
"prefix" -> do
        Object
params <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"params"
        Text
search <- Object
params forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"search"
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Filter
prefixFilter Text
search)
      Text
"namespace" -> do
        Object
params <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"params"
        [IdeNamespace]
namespaces <- Object
params forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"namespaces"
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set IdeNamespace -> Filter
namespaceFilter (forall a. Ord a => [a] -> Set a
Set.fromList [IdeNamespace]
namespaces))
      Text
"declarations" -> do
        [DeclarationType]
declarations <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"params"
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set DeclarationType -> Filter
declarationTypeFilter (forall a. Ord a => [a] -> Set a
Set.fromList [DeclarationType]
declarations))
      Text
"dependencies" -> do
        Object
params <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"params"
        Text
moduleText <- Object
params forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"moduleText"
        Maybe ModuleName
qualifier <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ModuleName
P.moduleNameFromString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
params forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"qualifier"
        case [Text] -> Either Text (ModuleName, [Text], [Import], [Text])
sliceImportSection (Text -> [Text]
T.lines Text
moduleText) of
          Left Text
err -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Couldn't parse module imports: " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
err)
          Right (ModuleName
currentModuleName, [Text]
_, [Import]
imports, [Text]
_ ) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ModuleName -> ModuleName -> [Import] -> Filter
dependencyFilter Maybe ModuleName
qualifier ModuleName
currentModuleName [Import]
imports)
      Text
s -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unknown filter: " forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, StringConv String b) => a -> b
show Text
s)