module Development.Shake.FilePattern(
FilePattern, (?==),
compatible, extract, substitute
) where
import Data.List
type FilePattern = String
(?==) :: FilePattern -> FilePath -> Bool
(?==) ('/':'/':p) x = any (p ?==) $ x : [i | '/':i <- tails x]
(?==) ('*':p) x = any (p ?==) $ a ++ take 1 b
where (a,b) = break ("/" `isPrefixOf`) $ tails x
(?==) (p:ps) (x:xs) | p == x = ps ?== xs
(?==) [] [] = True
(?==) _ _ = False
compatible :: [FilePattern] -> Bool
compatible [] = True
compatible (x:xs) = all ((==) (f x) . f) xs
where
f ('*':xs) = '*':f xs
f ('/':'/':xs) = '/':f xs
f (x:xs) = f xs
f [] = []
extract :: FilePattern -> FilePath -> [String]
extract p x = head $ f p x ++ [[]]
where
f ('/':'/':p) x = rest p $ ("",x) : [(pre++"/",i) | (pre,'/':i) <- zip (inits x) (tails x)]
f ('*':p) x = rest p $ a ++ take 1 b
where (a,b) = break (isPrefixOf "/" . snd) $ zip (inits x) (tails x)
f (p:ps) (x:xs) | p == x = f ps xs
f [] [] = [[]]
f _ _ = []
rest p xs = [skip:res | (skip,keep) <- xs, res <- f p keep]
substitute :: [String] -> FilePattern -> FilePath
substitute = f
where
f (a:as) ('/':'/':ps) = a ++ f as ps
f (a:as) ('*':ps) = a ++ f as ps
f as (p:ps) = p : f as ps
f as [] = []