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