{-# LANGUAGE GeneralizedNewtypeDeriving, PatternGuards, DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE CPP #-}
module Test.Tasty.Silver.Filter
( filterWithRegex
, checkRF
, RegexFilter (..)
, IncludeFilters (..)
, ExcludeFilters (..)
, TestPath
)
where
import Prelude hiding (fail)
import Test.Tasty hiding (defaultMain)
import Test.Tasty.Runners
import Test.Tasty.Options
import Data.Tagged
import Data.Typeable
import Data.Maybe
import Data.Monoid
import qualified Data.List as L
import Options.Applicative
import qualified Text.Regex.TDFA.String as RS
import qualified Text.Regex.TDFA as R
type TestPath = String
data RegexFilter
= RFInclude String
| RFExclude String
deriving (Typeable)
newtype ExcludeFilters = ExcludeFilters [RegexFilter]
deriving (Typeable)
newtype IncludeFilters = IncludeFilters [RegexFilter]
deriving (Typeable)
instance IsOption ExcludeFilters where
defaultValue :: ExcludeFilters
defaultValue = [RegexFilter] -> ExcludeFilters
ExcludeFilters []
parseValue :: String -> Maybe ExcludeFilters
parseValue = ([RegexFilter] -> ExcludeFilters)
-> Maybe [RegexFilter] -> Maybe ExcludeFilters
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [RegexFilter] -> ExcludeFilters
ExcludeFilters (Maybe [RegexFilter] -> Maybe ExcludeFilters)
-> (String -> Maybe [RegexFilter])
-> String
-> Maybe ExcludeFilters
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> RegexFilter) -> String -> Maybe [RegexFilter]
parseValue1 String -> RegexFilter
RFExclude
optionName :: Tagged ExcludeFilters String
optionName = String -> Tagged ExcludeFilters String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"regex-exclude"
optionHelp :: Tagged ExcludeFilters String
optionHelp = String -> Tagged ExcludeFilters String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"Exclude tests matching a regex (experimental)."
optionCLParser :: Parser ExcludeFilters
optionCLParser = (String -> RegexFilter)
-> ([RegexFilter] -> ExcludeFilters) -> Parser ExcludeFilters
forall v.
IsOption v =>
(String -> RegexFilter) -> ([RegexFilter] -> v) -> Parser v
parseFilter String -> RegexFilter
RFExclude [RegexFilter] -> ExcludeFilters
ExcludeFilters
instance IsOption IncludeFilters where
defaultValue :: IncludeFilters
defaultValue = [RegexFilter] -> IncludeFilters
IncludeFilters []
parseValue :: String -> Maybe IncludeFilters
parseValue = ([RegexFilter] -> IncludeFilters)
-> Maybe [RegexFilter] -> Maybe IncludeFilters
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [RegexFilter] -> IncludeFilters
IncludeFilters (Maybe [RegexFilter] -> Maybe IncludeFilters)
-> (String -> Maybe [RegexFilter])
-> String
-> Maybe IncludeFilters
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> RegexFilter) -> String -> Maybe [RegexFilter]
parseValue1 String -> RegexFilter
RFInclude
optionName :: Tagged IncludeFilters String
optionName = String -> Tagged IncludeFilters String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"regex-include"
optionHelp :: Tagged IncludeFilters String
optionHelp = String -> Tagged IncludeFilters String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"Include only tests matching a regex (experimental)."
optionCLParser :: Parser IncludeFilters
optionCLParser = (String -> RegexFilter)
-> ([RegexFilter] -> IncludeFilters) -> Parser IncludeFilters
forall v.
IsOption v =>
(String -> RegexFilter) -> ([RegexFilter] -> v) -> Parser v
parseFilter String -> RegexFilter
RFInclude [RegexFilter] -> IncludeFilters
IncludeFilters
compileRegex :: String -> Maybe RS.Regex
compileRegex :: String -> Maybe Regex
compileRegex = (String -> Maybe Regex)
-> (Regex -> Maybe Regex) -> Either String Regex -> Maybe Regex
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Regex -> String -> Maybe Regex
forall a b. a -> b -> a
const Maybe Regex
forall a. Maybe a
Nothing) Regex -> Maybe Regex
forall a. a -> Maybe a
Just (Either String Regex -> Maybe Regex)
-> (String -> Either String Regex) -> String -> Maybe Regex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompOption -> ExecOption -> String -> Either String Regex
RS.compile CompOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
compOpt
R.defaultCompOpt ExecOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
execOpt
R.defaultExecOpt
parseFilter :: forall v . IsOption v => (String -> RegexFilter) -> ([RegexFilter] -> v) -> Parser v
parseFilter :: (String -> RegexFilter) -> ([RegexFilter] -> v) -> Parser v
parseFilter String -> RegexFilter
mkRF [RegexFilter] -> v
mkV = [RegexFilter] -> v
mkV ([RegexFilter] -> v) -> Parser [RegexFilter] -> Parser v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RegexFilter -> Parser [RegexFilter]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ( ReadM RegexFilter
-> Mod OptionFields RegexFilter -> Parser RegexFilter
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM RegexFilter
parse ( String -> Mod OptionFields RegexFilter
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
name Mod OptionFields RegexFilter
-> Mod OptionFields RegexFilter -> Mod OptionFields RegexFilter
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields RegexFilter
forall (f :: * -> *) a. String -> Mod f a
help String
helpString))
where
name :: String
name = Tagged v String -> String
forall k (s :: k) b. Tagged s b -> b
untag (Tagged v String
forall v. IsOption v => Tagged v String
optionName :: Tagged v String)
helpString :: String
helpString = Tagged v String -> String
forall k (s :: k) b. Tagged s b -> b
untag (Tagged v String
forall v. IsOption v => Tagged v String
optionHelp :: Tagged v String)
parse :: ReadM RegexFilter
parse = (ReadM String
forall s. IsString s => ReadM s
str ReadM String -> (String -> ReadM RegexFilter) -> ReadM RegexFilter
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
(String -> ReadM RegexFilter)
-> (Regex -> ReadM RegexFilter)
-> Either String Regex
-> ReadM RegexFilter
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\String
err -> String -> ReadM RegexFilter
forall a. String -> ReadM a
readerError (String -> ReadM RegexFilter) -> String -> ReadM RegexFilter
forall a b. (a -> b) -> a -> b
$ String
"Could not parse " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err) (\Regex
_ -> String -> RegexFilter
mkRF (String -> RegexFilter) -> ReadM String -> ReadM RegexFilter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM String
forall s. IsString s => ReadM s
str)
(Either String Regex -> ReadM RegexFilter)
-> (String -> Either String Regex) -> String -> ReadM RegexFilter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CompOption -> ExecOption -> String -> Either String Regex
RS.compile CompOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
compOpt
R.defaultCompOpt ExecOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
execOpt
R.defaultExecOpt)
parseValue1 :: (String -> RegexFilter) -> String -> Maybe [RegexFilter]
parseValue1 :: (String -> RegexFilter) -> String -> Maybe [RegexFilter]
parseValue1 String -> RegexFilter
f String
x = (Regex -> [RegexFilter]) -> Maybe Regex -> Maybe [RegexFilter]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([RegexFilter] -> Regex -> [RegexFilter]
forall a b. a -> b -> a
const ([RegexFilter] -> Regex -> [RegexFilter])
-> [RegexFilter] -> Regex -> [RegexFilter]
forall a b. (a -> b) -> a -> b
$ [String -> RegexFilter
f String
x]) (Maybe Regex -> Maybe [RegexFilter])
-> Maybe Regex -> Maybe [RegexFilter]
forall a b. (a -> b) -> a -> b
$ String -> Maybe Regex
compileRegex String
x
filterWithRegex :: OptionSet -> TestTree -> TestTree
filterWithRegex :: OptionSet -> TestTree -> TestTree
filterWithRegex OptionSet
opts = (String -> Bool) -> TestTree -> TestTree
filterWithPred (Bool -> [RegexFilter] -> String -> Bool
checkRF Bool
True ([RegexFilter] -> String -> Bool)
-> [RegexFilter] -> String -> Bool
forall a b. (a -> b) -> a -> b
$ [RegexFilter]
excRgxs [RegexFilter] -> [RegexFilter] -> [RegexFilter]
forall a. [a] -> [a] -> [a]
++ [RegexFilter]
incRgxs)
where ExcludeFilters [RegexFilter]
excRgxs = OptionSet -> ExcludeFilters
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts
IncludeFilters [RegexFilter]
incRgxs = OptionSet -> IncludeFilters
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts
checkRF :: Bool
-> [RegexFilter]
-> TestPath -> Bool
checkRF :: Bool -> [RegexFilter] -> String -> Bool
checkRF Bool
ignNoInc [RegexFilter]
rf String
tp =
(([RegexFilter] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RegexFilter]
incRgxs Bool -> Bool -> Bool
&& Bool
ignNoInc) Bool -> Bool -> Bool
|| (RegexFilter -> Bool) -> [RegexFilter] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any RegexFilter -> Bool
regexMatches [RegexFilter]
incRgxs)
Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (RegexFilter -> Bool) -> [RegexFilter] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any RegexFilter -> Bool
regexMatches [RegexFilter]
excRgxs)
where ([RegexFilter]
incRgxs, [RegexFilter]
excRgxs) = (RegexFilter -> Bool)
-> [RegexFilter] -> ([RegexFilter], [RegexFilter])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition (RegexFilter -> Bool
isInclude) [RegexFilter]
rf
isInclude :: RegexFilter -> Bool
isInclude (RFInclude String
_) = Bool
True
isInclude (RFExclude String
_) = Bool
False
regexMatches :: RegexFilter -> Bool
regexMatches :: RegexFilter -> Bool
regexMatches (RFInclude String
rgx) = Regex -> String -> Bool
forall regex source.
RegexLike regex source =>
regex -> source -> Bool
R.matchTest (Maybe Regex -> Regex
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Regex -> Regex) -> Maybe Regex -> Regex
forall a b. (a -> b) -> a -> b
$ String -> Maybe Regex
compileRegex String
rgx) String
tp
regexMatches (RFExclude String
rgx) = Regex -> String -> Bool
forall regex source.
RegexLike regex source =>
regex -> source -> Bool
R.matchTest (Maybe Regex -> Regex
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Regex -> Regex) -> Maybe Regex -> Regex
forall a b. (a -> b) -> a -> b
$ String -> Maybe Regex
compileRegex String
rgx) String
tp
filterWithPred :: (TestPath -> Bool) -> TestTree -> TestTree
filterWithPred :: (String -> Bool) -> TestTree -> TestTree
filterWithPred String -> Bool
prd TestTree
tree = TestTree -> Maybe TestTree -> TestTree
forall a. a -> Maybe a -> a
fromMaybe TestTree
emptyTest (String -> TestTree -> Maybe TestTree
filter' String
"/" TestTree
tree)
where String
x <//> :: String -> String -> String
<//> String
y = String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
y
filter' :: TestPath -> TestTree -> Maybe TestTree
filter' :: String -> TestTree -> Maybe TestTree
filter' String
pth (SingleTest String
n t
t) = if String -> Bool
prd (String
pth String -> String -> String
<//> String
n) then TestTree -> Maybe TestTree
forall a. a -> Maybe a
Just (TestTree -> Maybe TestTree) -> TestTree -> Maybe TestTree
forall a b. (a -> b) -> a -> b
$ String -> t -> TestTree
forall t. IsTest t => String -> t -> TestTree
SingleTest String
n t
t else Maybe TestTree
forall a. Maybe a
Nothing
filter' String
pth (TestGroup String
n [TestTree]
ts) = TestTree -> Maybe TestTree
forall a. a -> Maybe a
Just (TestTree -> Maybe TestTree) -> TestTree -> Maybe TestTree
forall a b. (a -> b) -> a -> b
$ String -> [TestTree] -> TestTree
TestGroup String
n ([Maybe TestTree] -> [TestTree]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe TestTree] -> [TestTree]) -> [Maybe TestTree] -> [TestTree]
forall a b. (a -> b) -> a -> b
$ (TestTree -> Maybe TestTree) -> [TestTree] -> [Maybe TestTree]
forall a b. (a -> b) -> [a] -> [b]
map (String -> TestTree -> Maybe TestTree
filter' (String -> TestTree -> Maybe TestTree)
-> String -> TestTree -> Maybe TestTree
forall a b. (a -> b) -> a -> b
$ String
pth String -> String -> String
<//> String
n) [TestTree]
ts)
filter' String
pth (PlusTestOptions OptionSet -> OptionSet
o TestTree
t) = (OptionSet -> OptionSet) -> TestTree -> TestTree
PlusTestOptions OptionSet -> OptionSet
o (TestTree -> TestTree) -> Maybe TestTree -> Maybe TestTree
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> TestTree -> Maybe TestTree
filter' String
pth TestTree
t
filter' String
pth (WithResource ResourceSpec a
r IO a -> TestTree
t) = TestTree -> Maybe TestTree
forall a. a -> Maybe a
Just (TestTree -> Maybe TestTree) -> TestTree -> Maybe TestTree
forall a b. (a -> b) -> a -> b
$ ResourceSpec a -> (IO a -> TestTree) -> TestTree
forall a. ResourceSpec a -> (IO a -> TestTree) -> TestTree
WithResource ResourceSpec a
r (\IO a
x -> TestTree -> Maybe TestTree -> TestTree
forall a. a -> Maybe a -> a
fromMaybe TestTree
emptyTest (String -> TestTree -> Maybe TestTree
filter' String
pth (IO a -> TestTree
t IO a
x)))
filter' String
pth (AskOptions OptionSet -> TestTree
t) = TestTree -> Maybe TestTree
forall a. a -> Maybe a
Just (TestTree -> Maybe TestTree) -> TestTree -> Maybe TestTree
forall a b. (a -> b) -> a -> b
$ (OptionSet -> TestTree) -> TestTree
AskOptions (\OptionSet
o -> TestTree -> Maybe TestTree -> TestTree
forall a. a -> Maybe a -> a
fromMaybe TestTree
emptyTest (String -> TestTree -> Maybe TestTree
filter' String
pth (OptionSet -> TestTree
t OptionSet
o)))
emptyTest :: TestTree
emptyTest = String -> [TestTree] -> TestTree
testGroup String
"" []