-- | 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
(Int -> TestPattern -> ShowS)
-> (TestPattern -> String)
-> ([TestPattern] -> ShowS)
-> Show TestPattern
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TestPattern -> ShowS
showsPrec :: Int -> TestPattern -> ShowS
$cshow :: TestPattern -> String
show :: TestPattern -> String
$cshowList :: [TestPattern] -> ShowS
showList :: [TestPattern] -> ShowS
Show -- ^ @since 1.1
  , TestPattern -> TestPattern -> Bool
(TestPattern -> TestPattern -> Bool)
-> (TestPattern -> TestPattern -> Bool) -> Eq TestPattern
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TestPattern -> TestPattern -> Bool
== :: TestPattern -> TestPattern -> Bool
$c/= :: TestPattern -> TestPattern -> Bool
/= :: TestPattern -> TestPattern -> Bool
Eq   -- ^ @since 1.1
  )

-- | @since 1.0
noPattern :: TestPattern
noPattern :: TestPattern
noPattern = Maybe Expr -> TestPattern
TestPattern Maybe Expr
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 = String -> Tagged TestPattern String
forall a. a -> Tagged TestPattern a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"pattern"
#if !defined(mingw32_HOST_OS)
  optionHelp :: Tagged TestPattern String
optionHelp = String -> Tagged TestPattern String
forall a. a -> Tagged TestPattern a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"Select only tests which satisfy a pattern or awk expression."
#else
  optionHelp = return
    $ unwords [ "Select only tests which satisfy a pattern or awk expression."
              , "Consider using `MSYS_NO_PATHCONV=1` or `MSYS2_ARG_CONV_EXCL=*`"
              , "to prevent pattern mangling."
              ]
#endif
  optionCLParser :: Parser TestPattern
optionCLParser =
    ([TestPattern] -> TestPattern)
-> Parser [TestPattern] -> Parser TestPattern
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Expr -> TestPattern
TestPattern (Maybe Expr -> TestPattern)
-> ([TestPattern] -> Maybe Expr) -> [TestPattern] -> TestPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty Expr -> Expr) -> Maybe (NonEmpty Expr) -> Maybe Expr
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Expr -> Expr -> Expr) -> NonEmpty Expr -> Expr
forall a. (a -> a -> a) -> NonEmpty a -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Expr -> Expr -> Expr
And) (Maybe (NonEmpty Expr) -> Maybe Expr)
-> ([TestPattern] -> Maybe (NonEmpty Expr))
-> [TestPattern]
-> Maybe Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Expr] -> Maybe (NonEmpty Expr)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Expr] -> Maybe (NonEmpty Expr))
-> ([TestPattern] -> [Expr])
-> [TestPattern]
-> Maybe (NonEmpty Expr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Expr] -> [Expr]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Expr] -> [Expr])
-> ([TestPattern] -> [Maybe Expr]) -> [TestPattern] -> [Expr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @[TestPattern]) (Parser [TestPattern] -> Parser TestPattern)
-> (Parser TestPattern -> Parser [TestPattern])
-> Parser TestPattern
-> Parser TestPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser TestPattern -> Parser [TestPattern]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (Parser TestPattern -> Parser TestPattern)
-> Parser TestPattern -> Parser TestPattern
forall a b. (a -> b) -> a -> b
$
      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")

-- | @since 1.2
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 a. Eq a => a -> [a] -> 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

-- | @since 1.0
parseTestPattern :: String -> Maybe TestPattern
parseTestPattern :: String -> Maybe TestPattern
parseTestPattern String
s
  | String -> Bool
forall a. [a] -> 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

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

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