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


data Token = SlashToken
           | WildcardToken
           | DoubleWildcardToken
           | LiteralToken Char
           deriving (Eq)

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


data TestPatternMatchMode = TestMatchMode
                          | PathMatchMode

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

instance Read TestPattern where
    readsPrec _ string = [(parseTestPattern string, "")]

parseTestPattern :: String -> TestPattern
parseTestPattern string = TestPattern {
        tp_categories_only = categories_only,
        tp_negated = negated,
        tp_match_mode = match_mode,
        tp_tokens = tokens''
    }
  where
    tokens = tokenize string
    (negated, tokens')
      | (LiteralToken '!'):rest <- tokens = (True, rest)
      | otherwise                         = (False, tokens)
    (categories_only, tokens'')
      | (prefix, [SlashToken]) <- splitAt (length tokens' - 1) tokens' = (True, prefix)
      | otherwise                                                      = (False, tokens')
    match_mode
      | SlashToken `elem` tokens = PathMatchMode
      | otherwise                = TestMatchMode


testPatternMatches :: TestPattern -> [String] -> Bool
testPatternMatches test_pattern path = not_maybe $ any (=~ tokens_regex) things_to_match
  where
    not_maybe | tp_negated test_pattern = not
              | otherwise               = id
    path_to_consider | tp_categories_only test_pattern = dropLast 1 path
                     | otherwise                       = path
    tokens_regex = buildTokenRegex (tp_tokens test_pattern)
    
    things_to_match = case tp_match_mode test_pattern of
        -- See if the tokens match any single path component
        TestMatchMode -> path_to_consider
        -- See if the tokens match any prefix of the path
        PathMatchMode -> map pathToString $ inits path_to_consider


buildTokenRegex :: [Token] -> String
buildTokenRegex [] = []
buildTokenRegex (token:tokens) = concat (firstTokenToRegex token : map tokenToRegex tokens)
  where
    firstTokenToRegex SlashToken = "^"
    firstTokenToRegex other = tokenToRegex other
      
    tokenToRegex SlashToken = "/"
    tokenToRegex WildcardToken = "[^/]*"
    tokenToRegex DoubleWildcardToken = "*"
    tokenToRegex (LiteralToken lit) = regexEscapeChar lit

regexEscapeChar :: Char -> String
regexEscapeChar c | c `elem` "\\*+?|{}[]()^$." = '\\' : [c]
                  | otherwise                  = [c]

pathToString :: [String] -> String
pathToString path = "/" ++ concat (intersperse "/" path)