module System.FilePath.Glob.Match (match) where
import Control.Exception (assert)
import Data.Char (isDigit)
import Data.Monoid (mappend)
import System.FilePath (isPathSeparator, isExtSeparator)
import System.FilePath.Glob.Base
import System.FilePath.Glob.Utils (dropLeadingZeroes, inRange, pathParts)
match :: Pattern -> FilePath -> Bool
match = begMatch . unPattern
begMatch, match' :: [Token] -> FilePath -> Bool
begMatch _ "." = False
begMatch _ ".." = False
begMatch (ExtSeparator:PathSeparator:pat) s = begMatch pat s
begMatch pat (x:y:s) | isExtSeparator x && isPathSeparator y = begMatch pat s
begMatch pat s =
if not (null s) && isExtSeparator (head s)
then case pat of
ExtSeparator:pat' -> match' pat' (tail s)
_ -> False
else match' pat s
match' [] s = null s
match' (AnyNonPathSeparator:s) "" = null s
match' _ "" = False
match' (Literal l :xs) (c:cs) = l == c && match' xs cs
match' ( ExtSeparator :xs) (c:cs) = isExtSeparator c && match' xs cs
match' (PathSeparator :xs) (c:cs) = isPathSeparator c && begMatch xs cs
match' (NonPathSeparator:xs) (c:cs) = not (isPathSeparator c) && match' xs cs
match' (CharRange b rng :xs) (c:cs) =
not (isPathSeparator c) &&
any (either (== c) (`inRange` c)) rng == b &&
match' xs cs
match' (OpenRange lo hi :xs) path =
let
(lzNum,cs) = span isDigit path
num = dropLeadingZeroes lzNum
numChoices =
tail . takeWhile (not.null.snd) . map (flip splitAt num) $ [0..]
in if null lzNum
then False
else
any (\(n,rest) -> inOpenRange lo hi n && match' xs (rest ++ cs))
((num,"") : numChoices)
match' again@(AnyNonPathSeparator:xs) path@(c:cs) =
match' xs path || (if isPathSeparator c then False else match' again cs)
match' again@(AnyDirectory:xs) path =
let parts = pathParts path
matches = any (match' xs) parts || any (match' again) (tail parts)
in if null xs
then all (not.isExtSeparator.head) (init parts) && matches
else matches
match' (LongLiteral len s:xs) path =
let (pre,cs) = splitAt len path
in pre == s && match' xs cs
inOpenRange :: Maybe String -> Maybe String -> String -> Bool
inOpenRange l_ h_ s_ = assert (all isDigit s_) $ go l_ h_ s_ EQ EQ
where
go Nothing Nothing _ _ _ = True
go (Just []) _ [] LT _ = False
go _ (Just []) _ _ GT = False
go _ (Just []) (_:_) _ _ = False
go (Just (_:_)) _ [] _ _ = False
go _ _ [] _ _ = True
go (Just (l:ls)) (Just (h:hs)) (c:cs) ordl ordh =
let ordl' = ordl `mappend` compare c l
ordh' = ordh `mappend` compare c h
in go (Just ls) (Just hs) cs ordl' ordh'
go Nothing (Just (h:hs)) (c:cs) _ ordh =
let ordh' = ordh `mappend` compare c h
in go Nothing (Just hs) cs GT ordh'
go (Just (l:ls)) Nothing (c:cs) ordl _ =
let ordl' = ordl `mappend` compare c l
in go (Just ls) Nothing cs ordl' LT
go (Just []) hi s _ ordh = go Nothing hi s GT ordh