glob implementation

-- 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