content: -- | Test patterns
  
  {-# LANGUAGE CPP, 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 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
    ( Show -- ^ @since 1.1
    , Eq   -- ^ @since 1.1
    )
  
  -- | @since 1.0
  noPattern :: TestPattern
  noPattern = TestPattern 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 = noPattern
    parseValue = parseTestPattern
    optionName = return "pattern"
  #if !defined(mingw32_HOST_OS)
    optionHelp = return "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 =
      fmap (TestPattern . fmap (foldr1 And) . nonEmpty . catMaybes . coerce @[TestPattern]) . some $
        mkOptionCLParser (short 'p' <> metavar "PATTERN")
  
  -- | @since 1.2
  parseExpr :: String -> Maybe Expr
  parseExpr s
    | all (\c -> isAlphaNum c || c `elem` "._- ") s =
      Just $ ERE s
    | otherwise = parseAwkExpr s
  
  -- | @since 1.0
  parseTestPattern :: String -> Maybe TestPattern
  parseTestPattern s
    | null s = Just noPattern
    | otherwise = TestPattern . Just <$> parseExpr s
  
  -- | @since 1.2
  exprMatches :: Expr -> Path -> Bool
  exprMatches e fields =
    case withFields fields $ asB =<< eval e of
      Left msg -> error msg
      Right b -> b
  
  -- | @since 1.0
  testPatternMatches :: TestPattern -> Path -> Bool
  testPatternMatches pat fields =
    case pat of
      TestPattern Nothing -> True
      TestPattern (Just e) -> exprMatches e fields
  