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
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))
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)