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