    module Test.Framework.Runners.TestPattern (
            TestPattern, parseTestPattern, testPatternMatches
        ) where

    import Test.Framework.Utilities

    import Text.Regex.Posix.Wrap ( (=~) )
    import Text.Regex.Posix.String()

    import Data.List ( inits, intersperse )

    data Token = SlashToken
               | WildcardToken
               | DoubleWildcardToken
               | LiteralToken Char
               deriving (Token -> Token -> Bool
    (Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Token -> Token -> Bool
    == :: Token -> Token -> Bool
    $c/= :: Token -> Token -> Bool
    /= :: Token -> Token -> Bool
    Eq)

    tokenize :: String -> [Token]
    tokenize :: String -> [Token]
    tokenize (Char
    '/':String
    rest)     = Token
    SlashToken Token -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : String -> [Token]
    tokenize String
    rest
    tokenize (Char
    '*':Char
    '*':String
    rest) = Token
    DoubleWildcardToken Token -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : String -> [Token]
    tokenize String
    rest
    tokenize (Char
    '*':String
    rest)     = Token
    WildcardToken Token -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : String -> [Token]
    tokenize String
    rest
    tokenize (Char
    c:String
    rest)       = Char -> Token
    LiteralToken Char
    c Token -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : String -> [Token]
    tokenize String
    rest
    tokenize []             = []

    data TestPatternMatchMode = TestMatchMode
                              | PathMatchMode

    data TestPattern = TestPattern {
            TestPattern -> Bool
    tp_categories_only :: Bool,
            TestPattern -> Bool
    tp_negated :: Bool,
            TestPattern -> TestPatternMatchMode
    tp_match_mode :: TestPatternMatchMode,
            TestPattern -> [Token]
    tp_tokens :: [Token]
        }

    instance Read TestPattern where
        readsPrec :: Int -> ReadS TestPattern
    readsPrec Int
    _ String
    string = [(String -> TestPattern
    parseTestPattern String
    string, String
    "")]

    parseTestPattern :: String -> TestPattern
    parseTestPattern :: String -> TestPattern
    parseTestPattern String
    string = TestPattern {
            tp_categories_only :: Bool
    tp_categories_only = Bool
    categories_only,
            tp_negated :: Bool
    tp_negated = Bool
    negated,
            tp_match_mode :: TestPatternMatchMode
    tp_match_mode = TestPatternMatchMode
    match_mode,
            tp_tokens :: [Token]
    tp_tokens = [Token]
    tokens''
        }
      where
        tokens :: [Token]
    tokens = String -> [Token]
    tokenize String
    string
        (Bool
    negated, [Token]
    tokens')
          | (LiteralToken Char
    '!'):[Token]
    rest <- [Token]
    tokens = (Bool
    True, [Token]
    rest)
          | Bool
    otherwise                         = (Bool
    False, [Token]
    tokens)
        (Bool
    categories_only, [Token]
    tokens'')
          | ([Token]
    prefix, [Token
    SlashToken]) <- Int -> [Token] -> ([Token], [Token])
    forall a. Int -> [a] -> ([a], [a])
    splitAt ([Token] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Token]
    tokens' Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) [Token]
    tokens' = (Bool
    True, [Token]
    prefix)
          | Bool
    otherwise                                                      = (Bool
    False, [Token]
    tokens')
        match_mode :: TestPatternMatchMode
    match_mode
          | Token
    SlashToken Token -> [Token] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Token]
    tokens = TestPatternMatchMode
    PathMatchMode
          | Bool
    otherwise                = TestPatternMatchMode
    TestMatchMode

    testPatternMatches :: TestPattern -> [String] -> Bool
    testPatternMatches :: TestPattern -> [String] -> Bool
    testPatternMatches TestPattern
    test_pattern [String]
    path = Bool -> Bool
    not_maybe (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ (String -> Bool) -> [String] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (String -> String -> Bool
    forall source source1 target.
    (RegexMaker Regex CompOption ExecOption source,
     RegexContext Regex source1 target) =>
    source1 -> source -> target
    =~ String
    tokens_regex) [String]
    things_to_match
      where
        not_maybe :: Bool -> Bool
    not_maybe | TestPattern -> Bool
    tp_negated TestPattern
    test_pattern = Bool -> Bool
    not
                  | Bool
    otherwise               = Bool -> Bool
    forall a. a -> a
    id
        path_to_consider :: [String]
    path_to_consider | TestPattern -> Bool
    tp_categories_only TestPattern
    test_pattern = Int -> [String] -> [String]
    forall a. Int -> [a] -> [a]
    dropLast Int
    1 [String]
    path
                         | Bool
    otherwise                       = [String]
    path
        tokens_regex :: String
    tokens_regex = [Token] -> String
    buildTokenRegex (TestPattern -> [Token]
    tp_tokens TestPattern
    test_pattern)

        things_to_match :: [String]
    things_to_match = case TestPattern -> TestPatternMatchMode
    tp_match_mode TestPattern
    test_pattern of
            -- See if the tokens match any single path component
            TestPatternMatchMode
    TestMatchMode -> [String]
    path_to_consider
            -- See if the tokens match any prefix of the path
            TestPatternMatchMode
    PathMatchMode -> ([String] -> String) -> [[String]] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map [String] -> String
    pathToString ([[String]] -> [String]) -> [[String]] -> [String]
    forall a b. (a -> b) -> a -> b
    $ [String] -> [[String]]
    forall a. [a] -> [[a]]
    inits [String]
    path_to_consider

    buildTokenRegex :: [Token] -> String
    buildTokenRegex :: [Token] -> String
    buildTokenRegex [] = []
    buildTokenRegex (Token
    token:[Token]
    tokens) = [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat (Token -> String
    firstTokenToRegex Token
    token String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : (Token -> String) -> [Token] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Token -> String
    tokenToRegex [Token]
    tokens)
      where
        firstTokenToRegex :: Token -> String
    firstTokenToRegex Token
    SlashToken = String
    "^"
        firstTokenToRegex Token
    other = Token -> String
    tokenToRegex Token
    other

        tokenToRegex :: Token -> String
    tokenToRegex Token
    SlashToken = String
    "/"
        tokenToRegex Token
    WildcardToken = String
    "[^/]*"
        tokenToRegex Token
    DoubleWildcardToken = String
    "*"
        tokenToRegex (LiteralToken Char
    lit) = Char -> String
    regexEscapeChar Char
    lit

    regexEscapeChar :: Char -> String
    regexEscapeChar :: Char -> String
    regexEscapeChar Char
    c | 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
    "\\*+?|{}[]()^$." = Char
    '\\' Char -> String -> String
    forall a. a -> [a] -> [a]
    : [Char
    c]
                      | Bool
    otherwise                  = [Char
    c]

    pathToString :: [String] -> String
    pathToString :: [String] -> String
    pathToString [String]
    path = String
    "/" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat (String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    intersperse String
    "/" [String]
    path)