Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- -- Implement file globbing directly in haskel.
- -- With excellent suggestions on the type of matchCharClass from
- -- the folks on beginners@haskell.org
- glob :: String -> FilePath -> Either String Bool
- glob ('?':ps) (_:fp) = glob ps fp
- glob ('*':ps) "" = Right $ ps == []
- glob p@('*':ps) ft@(_:fp) = case glob ps ft of
- Right False -> glob p fp
- x -> x
- glob ('[':ps) (f:fp) = case matchCharClass ps f of
- Right Nothing -> Right False
- Right (Just pr) -> glob pr fp
- Left why -> Left why
- glob (p:ps) (f:fp) = if p == f then glob ps fp else Right False
- glob fp ps = Right $ fp == ps
- -- process first character, where "-!]" all need special handling
- matchCharClass :: String -> Char -> Either String (Maybe String)
- matchCharClass ('!':ps) c = case matchCharClass ps c of
- Right Nothing -> findTail $ tail ps
- Right (Just _) -> Right Nothing
- Left why -> Left why
- matchCharClass ps c = matchCharClass' ps c
- -- process single characters, ranges and end of pattern
- matchCharClass' "" _ = Right (Just "Invalid character class")
- matchCharClass' (a:'-':b:ps) c | c `elem` enumFromTo a b = findTail ps
- | otherwise = matchCharClassTail ps c
- matchCharClass' (p:ps) c | p == c = findTail ps
- | otherwise = matchCharClassTail ps c
- -- process the end of the character class.
- matchCharClassTail (']':ps) _ = Right Nothing
- matchCharClassTail ps c = matchCharClass' ps c
- findTail ps = case dropWhile (/= ']') ps of
- "" -> Left "Invalid character class"
- cs -> Right (Just $ tail cs)
- test name pat expected =
- putStr (if actual == (Right expected) then ""
- else "Failure for: " ++ show (name, pat, expected, actual) ++ "\n")
- where actual = glob pat name
- main = do test "foo.c" "foo.c" True
- test "foo.x" "foo.c" False
- test "foo.x" "foo.?" True
- test "foo.c" "?oo.c" True
- test "foo.c" "?oo.x" False
- test "foo.x" "foo.*" True
- test "foo.x" "*.x" True
- test "foo.x" "f*.x" True
- test "foo.x" "f*.*" True
- test "foo.x" "f*.c" False
- test "foo.x" "f*.[cx]" True
- test "foo.x" "f*.[cy]" False
- test "FOO.x" "[Ff][Oo][oO].[xX]" True
- test "foo.x" "f*.[!cx]" False
- test "foo.x" "f*.[!cy]" True
- test "foo-c" "f*[-abc]c" True
- test "f-c" "f[-ab]c" True
- test "f-c" "f[abc]c" False
- test "f-c" "f[a-c]c" False
- test "fbc" "f[a-c]c" True
- test "f]c" "f[]ac]c" True
- test "a.c" "[]-}].c" True
- test "a-c]" "[ab]-c]" True
- test "d" "[ab]-}]" False
- test "a-}]" "[ab]-}]" True
- test "a" "[!]]" True
- test "]" "[!]]" False
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement