-- | Test patterns

{-# LANGUAGE CPP, DeriveDataTypeable #-}

module Test.Tasty.Patterns
  ( TestPattern(..)
  , parseExpr
  , parseTestPattern
  , noPattern
  , Path
  , exprMatches
  , testPatternMatches
  ) where

import Test.Tasty.Options
import Test.Tasty.Patterns.Types
import Test.Tasty.Patterns.Parser
import Test.Tasty.Patterns.Eval

import Data.Char
import Data.Typeable
import Options.Applicative hiding (Success)
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid
#endif

newtype TestPattern = TestPattern (Maybe Expr)
  deriving (Typeable, Int -> TestPattern -> ShowS
[TestPattern] -> ShowS
TestPattern -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestPattern] -> ShowS
$cshowList :: [TestPattern] -> ShowS
show :: TestPattern -> String
$cshow :: TestPattern -> String
showsPrec :: Int -> TestPattern -> ShowS
$cshowsPrec :: Int -> TestPattern -> ShowS
Show, TestPattern -> TestPattern -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestPattern -> TestPattern -> Bool
$c/= :: TestPattern -> TestPattern -> Bool
== :: TestPattern -> TestPattern -> Bool
$c== :: TestPattern -> TestPattern -> Bool
Eq)

noPattern :: TestPattern
noPattern :: TestPattern
noPattern = Maybe Expr -> TestPattern
TestPattern forall a. Maybe a
Nothing

instance IsOption TestPattern where
  defaultValue :: TestPattern
defaultValue = TestPattern
noPattern
  parseValue :: String -> Maybe TestPattern
parseValue = String -> Maybe TestPattern
parseTestPattern
  optionName :: Tagged TestPattern String
optionName = forall (m :: * -> *) a. Monad m => a -> m a
return String
"pattern"
  optionHelp :: Tagged TestPattern String
optionHelp = forall (m :: * -> *) a. Monad m => a -> m a
return String
"Select only tests which satisfy a pattern or awk expression"
  optionCLParser :: Parser TestPattern
optionCLParser = forall v. IsOption v => Mod OptionFields v -> Parser v
mkOptionCLParser (forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'p' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"PATTERN")

parseExpr :: String -> Maybe Expr
parseExpr :: String -> Maybe Expr
parseExpr String
s
  | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"._- ") String
s =
    forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> Expr
ERE String
s
  | Bool
otherwise = String -> Maybe Expr
parseAwkExpr String
s

parseTestPattern :: String -> Maybe TestPattern
parseTestPattern :: String -> Maybe TestPattern
parseTestPattern String
s
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s = forall a. a -> Maybe a
Just TestPattern
noPattern
  | Bool
otherwise = Maybe Expr -> TestPattern
TestPattern forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Expr
parseExpr String
s

exprMatches :: Expr -> Path -> Bool
exprMatches :: Expr -> Path -> Bool
exprMatches Expr
e Path
fields =
  case forall a. Path -> M a -> Either String a
withFields Path
fields forall a b. (a -> b) -> a -> b
$ Value -> ReaderT Path (Either String) Bool
asB forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Expr -> M Value
eval Expr
e of
    Left String
msg -> forall a. HasCallStack => String -> a
error String
msg
    Right Bool
b -> Bool
b

testPatternMatches :: TestPattern -> Path -> Bool
testPatternMatches :: TestPattern -> Path -> Bool
testPatternMatches TestPattern
pat Path
fields =
  case TestPattern
pat of
    TestPattern Maybe Expr
Nothing -> Bool
True
    TestPattern (Just Expr
e) -> Expr -> Path -> Bool
exprMatches Expr
e Path
fields