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

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

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)