module Language.PureScript.Ide.Filter
( Filter
, moduleFilter
, namespaceFilter
, exactFilter
, prefixFilter
, declarationTypeFilter
, applyFilters
) where
import Protolude hiding (isPrefixOf, Prefix)
import Control.Monad.Fail (fail)
import Data.Aeson
import Data.Text (isPrefixOf)
import qualified Data.Set as Set
import qualified Data.Map as Map
import Language.PureScript.Ide.Filter.Declaration (DeclarationType)
import Language.PureScript.Ide.Types
import Language.PureScript.Ide.Util
import qualified Language.PureScript as P
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)
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
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
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))
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))
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))
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))
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 a b k. (a -> b) -> Map k a -> Map k b
Map.map (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 DeclarationFilter -> [IdeDeclarationAnn] -> [IdeDeclarationAnn]
applyDeclarationFilter [DeclarationFilter]
fs))
applyDeclarationFilter
:: DeclarationFilter
-> [IdeDeclarationAnn]
-> [IdeDeclarationAnn]
applyDeclarationFilter :: DeclarationFilter -> [IdeDeclarationAnn] -> [IdeDeclarationAnn]
applyDeclarationFilter 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
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)
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
oforall 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
oforall 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
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)