-- File created: 2008-10-10 13:29:03moduleSystem.FilePath.Glob.Match(match,matchWith)whereimportControl.Exception(assert)importData.Char(isDigit,toLower,toUpper)importData.Monoid(mappend)importSystem.FilePath(isPathSeparator,isExtSeparator)importSystem.FilePath.Glob.Base(Pattern(..),Token(..),MatchOptions(..),matchDefault,tokToLower)importSystem.FilePath.Glob.Utils(dropLeadingZeroes,inRange,pathParts)-- |Matches the given 'Pattern' against the given 'FilePath', returning 'True'-- if the pattern matches and 'False' otherwise.match::Pattern->FilePath->Boolmatch=matchWithmatchDefault-- |Like 'match', but applies the given 'MatchOptions' instead of the defaults.matchWith::MatchOptions->Pattern->FilePath->BoolmatchWithoptspf=begMatchopts(lcPat$unPatternp)(lcPathf)wherelcPath=ifignoreCaseoptsthenmaptoLowerelseidlcPat=ifignoreCaseoptsthenmaptokToLowerelseid-- begMatch takes care of some things at the beginning of a pattern or after /:-- - . needs to be matched explicitly-- - ./foo is equivalent to foo (for any number of /)---- .*/foo still needs to match ./foo though, and it won't match plain foo;-- special case that one---- and .**/foo should /not/ match ../foo; more special casing---- (All of the above is modulo options, of course)begMatch,match'::MatchOptions->[Token]->FilePath->BoolbegMatch_(ExtSeparator:AnyDirectory:_)(x:y:_)|isExtSeparatorx&&isExtSeparatory=FalsebegMatchopts(ExtSeparator:PathSeparator:pat)s|ignoreDotSlashopts=begMatchopts(dropWhileisSlashpat)swhereisSlashPathSeparator=TrueisSlash_=FalsebegMatchoptspat(x:y:s)|dotSlash&&dotStarSlash=match'optspat's|ignoreDotSlashopts&&dotSlash=begMatchoptspatswheredotSlash=isExtSeparatorx&&isPathSeparatory(dotStarSlash,pat')=casepatofExtSeparator:AnyNonPathSeparator:PathSeparator:rest->(True,rest)_->(False,pat)begMatchoptspats=ifnot(nulls)&&isExtSeparator(heads)&&not(matchDotsImplicitlyopts)thencasepatofExtSeparator:pat'->match'optspat'(tails)_->Falseelsematch'optspatsmatch'_[]s=nullsmatch'_(AnyNonPathSeparator:s)""=nullsmatch'__""=Falsematch'o(Literall:xs)(c:cs)=l==c&&match'oxscsmatch'o(ExtSeparator:xs)(c:cs)=isExtSeparatorc&&match'oxscsmatch'o(NonPathSeparator:xs)(c:cs)=not(isPathSeparatorc)&&match'oxscsmatch'o(PathSeparator:xs)(c:cs)=isPathSeparatorc&&begMatchoxs(dropWhileisPathSeparatorcs)match'o(CharRangebrng:xs)(c:cs)=letrangeMatchr=either(==c)(`inRange`c)r||-- See comment near Base.tokToLower for an explanation of why we-- do thisifignoreCaseotheneither(==toUpperc)(`inRange`toUpperc)relseFalseinnot(isPathSeparatorc)&&anyrangeMatchrng==b&&match'oxscsmatch'o(OpenRangelohi:xs)path=let(lzNum,cs)=spanisDigitpathnum=dropLeadingZeroeslzNumnumChoices=tail.takeWhile(not.null.snd).map(flipsplitAtnum)$[0..]inifnulllzNumthenFalse-- no digitselse-- So, given the path "123foo" what we've got is:-- cs = "foo"-- num = "123"-- numChoices = [("1","23"),("12","3")]---- We want to try matching x against each of 123, 12, and 1.-- 12 and 1 are in numChoices already, but we need to add (num,"")-- manually.any(\(n,rest)->inOpenRangelohin&&match'oxs(rest++cs))((num,""):numChoices)match'oagain@(AnyNonPathSeparator:xs)path@(c:cs)=match'oxspath||(ifisPathSeparatorcthenFalseelsematch'oagaincs)match'oagain@(AnyDirectory:xs)path=letparts=pathParts(dropWhileisPathSeparatorpath)matches=any(match'oxs)parts||any(match'oagain)(tailparts)inifnullxs&&not(matchDotsImplicitlyo)-- **/ shouldn't match foo/.bar, so check that remaining bits don't-- start with .thenall(not.isExtSeparator.head)(initparts)&&matcheselsematchesmatch'o(LongLiterallens:xs)path=let(pre,cs)=splitAtlenpathinpre==s&&match'oxscs-- Does the actual open range matching: finds whether the third parameter-- is between the first two or not.---- It does this by keeping track of the Ordering so far (e.g. having-- looked at "12" and "34" the Ordering of the two would be LT: 12 < 34)-- and aborting if a String "runs out": a longer string is automatically-- greater.---- Assumes that the input strings contain only digits, and no leading zeroes.inOpenRange::MaybeString->MaybeString->String->BoolinOpenRangel_h_s_=assert(allisDigits_)$gol_h_s_EQEQwheregoNothingNothing___=True-- no boundsgo(Just[])_[]LT_=False-- lesser than lower boundgo_(Just[])__GT=False-- greater than upper boundgo_(Just[])(_:_)__=False-- longer than upper boundgo(Just(_:_))_[]__=False-- shorter than lower boundgo__[]__=Truego(Just(l:ls))(Just(h:hs))(c:cs)ordlordh=letordl'=ordl`mappend`compareclordh'=ordh`mappend`comparechingo(Justls)(Jusths)csordl'ordh'goNothing(Just(h:hs))(c:cs)_ordh=letordh'=ordh`mappend`comparechingoNothing(Jusths)csGTordh'go(Just(l:ls))Nothing(c:cs)ordl_=letordl'=ordl`mappend`compareclingo(Justls)Nothingcsordl'LT-- lower bound is shorter: s is greatergo(Just[])his_ordh=goNothinghisGTordh