moduleTest.Framework.Runners.TestPattern(TestPattern,parseTestPattern,testPatternMatches)whereimportTest.Framework.UtilitiesimportText.Regex.Posix.WrapimportText.Regex.Posix.String()importData.ListdataToken=SlashToken|WildcardToken|DoubleWildcardToken|LiteralTokenCharderiving(Eq)tokenize::String->[Token]tokenize('/':rest)=SlashToken:tokenizeresttokenize('*':'*':rest)=DoubleWildcardToken:tokenizeresttokenize('*':rest)=WildcardToken:tokenizeresttokenize(c:rest)=LiteralTokenc:tokenizeresttokenize[]=[]dataTestPatternMatchMode=TestMatchMode|PathMatchModedataTestPattern=TestPattern{tp_categories_only::Bool,tp_negated::Bool,tp_match_mode::TestPatternMatchMode,tp_tokens::[Token]}instanceReadTestPatternwherereadsPrec_string=[(parseTestPatternstring,"")]parseTestPattern::String->TestPatternparseTestPatternstring=TestPattern{tp_categories_only=categories_only,tp_negated=negated,tp_match_mode=match_mode,tp_tokens=tokens''}wheretokens=tokenizestring(negated,tokens')|(LiteralToken'!'):rest<-tokens=(True,rest)|otherwise=(False,tokens)(categories_only,tokens'')|(prefix,[SlashToken])<-splitAt(lengthtokens'-1)tokens'=(True,prefix)|otherwise=(False,tokens')match_mode|SlashToken`elem`tokens=PathMatchMode|otherwise=TestMatchModetestPatternMatches::TestPattern->[String]->BooltestPatternMatchestest_patternpath=not_maybe$any(=~tokens_regex)things_to_matchwherenot_maybe|tp_negatedtest_pattern=not|otherwise=idpath_to_consider|tp_categories_onlytest_pattern=dropLast1path|otherwise=pathtokens_regex=buildTokenRegex(tp_tokenstest_pattern)things_to_match=casetp_match_modetest_patternof-- See if the tokens match any single path componentTestMatchMode->path_to_consider-- See if the tokens match any prefix of the pathPathMatchMode->mappathToString$initspath_to_considerbuildTokenRegex::[Token]->StringbuildTokenRegex[]=[]buildTokenRegex(token:tokens)=concat(firstTokenToRegextoken:maptokenToRegextokens)wherefirstTokenToRegexSlashToken="^"firstTokenToRegexother=tokenToRegexothertokenToRegexSlashToken="/"tokenToRegexWildcardToken="[^/]*"tokenToRegexDoubleWildcardToken="*"tokenToRegex(LiteralTokenlit)=regexEscapeCharlitregexEscapeChar::Char->StringregexEscapeCharc|c`elem`"\\*+?|{}[]()^$."='\\':[c]|otherwise=[c]pathToString::[String]->StringpathToStringpath="/"++concat(intersperse"/"path)