-- | 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.Semigroup (Semigroup((<>)))
#endif

newtype TestPattern = TestPattern (Maybe Expr)
  deriving (Typeable, Int -> TestPattern -> ShowS
[TestPattern] -> ShowS
TestPattern -> String
(Int -> TestPattern -> ShowS)
-> (TestPattern -> String)
-> ([TestPattern] -> ShowS)
-> Show TestPattern
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
(TestPattern -> TestPattern -> Bool)
-> (TestPattern -> TestPattern -> Bool) -> Eq TestPattern
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 Maybe Expr
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 = String -> Tagged TestPattern String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"pattern"
  optionHelp :: Tagged TestPattern String
optionHelp = String -> Tagged TestPattern String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"Select only tests which satisfy a pattern or awk expression"
  optionCLParser :: Parser TestPattern
optionCLParser = Mod OptionFields TestPattern -> Parser TestPattern
forall v. IsOption v => Mod OptionFields v -> Parser v
mkOptionCLParser (Char -> Mod OptionFields TestPattern
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'p' Mod OptionFields TestPattern
-> Mod OptionFields TestPattern -> Mod OptionFields TestPattern
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields TestPattern
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"PATTERN")

parseExpr :: String -> Maybe Expr
parseExpr :: String -> Maybe Expr
parseExpr String
s
  | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"._- ") String
s =
    Expr -> Maybe Expr
forall a. a -> Maybe a
Just (Expr -> Maybe Expr) -> Expr -> Maybe Expr
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
  | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s = TestPattern -> Maybe TestPattern
forall a. a -> Maybe a
Just TestPattern
noPattern
  | Bool
otherwise = Maybe Expr -> TestPattern
TestPattern (Maybe Expr -> TestPattern)
-> (Expr -> Maybe Expr) -> Expr -> TestPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Maybe Expr
forall a. a -> Maybe a
Just (Expr -> TestPattern) -> Maybe Expr -> Maybe TestPattern
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 Path -> M Bool -> Either String Bool
forall a. Path -> M a -> Either String a
withFields Path
fields (M Bool -> Either String Bool) -> M Bool -> Either String Bool
forall a b. (a -> b) -> a -> b
$ Value -> M Bool
asB (Value -> M Bool) -> ReaderT Path (Either String) Value -> M Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Expr -> ReaderT Path (Either String) Value
eval Expr
e of
    Left String
msg -> String -> Bool
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