-- | Test patterns

{-# LANGUAGE CPP, DeriveDataTypeable, TypeApplications #-}

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.Coerce (coerce)
import Data.List.NonEmpty (nonEmpty)
import Data.Maybe (catMaybes)
import Data.Typeable
import Options.Applicative hiding (Success)
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid
#endif

-- | @since 1.0
newtype TestPattern =
  -- | @since 1.1
  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 -- ^ @since 1.1
  , 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   -- ^ @since 1.1
  )

-- | @since 1.0
noPattern :: TestPattern
noPattern :: TestPattern
noPattern = Maybe Expr -> TestPattern
TestPattern forall a. Maybe a
Nothing

-- | Since tasty-1.5, this option can be specified multiple times on the
-- command line. Only the tests matching all given patterns will be selected.
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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Expr -> TestPattern
TestPattern forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Expr -> Expr -> Expr
And) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe (NonEmpty a)
nonEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce @[TestPattern]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Alternative f => f a -> f [a]
some forall a b. (a -> b) -> a -> b
$
      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")

-- | @since 1.2
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

-- | @since 1.0
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

-- | @since 1.2
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

-- | @since 1.0
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