mwm

glob implementation

mwm
Apr 5th, 2011
168
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. -- Implement file globbing directly in haskel.
  2. -- With excellent suggestions on the type of matchCharClass from
  3. -- the folks on beginners@haskell.org
  4.  
  5. glob :: String -> FilePath -> Either String Bool
  6. glob ('?':ps) (_:fp) = glob ps fp
  7. glob ('*':ps) "" = Right $ ps == []
  8. glob p@('*':ps) ft@(_:fp) = case glob ps ft of
  9.   Right False -> glob p fp
  10.   x -> x
  11. glob ('[':ps) (f:fp) = case matchCharClass ps f of
  12.   Right Nothing -> Right False
  13.   Right (Just pr) -> glob pr fp
  14.   Left why -> Left why
  15. glob (p:ps) (f:fp) = if p == f then glob ps fp else Right False
  16. glob fp ps = Right $ fp == ps
  17.  
  18. -- process first character, where "-!]" all need special handling
  19. matchCharClass :: String -> Char -> Either String (Maybe String)
  20. matchCharClass ('!':ps) c = case matchCharClass ps c of
  21.   Right Nothing -> findTail $ tail ps
  22.   Right (Just _)  -> Right Nothing
  23.   Left why -> Left why
  24. matchCharClass ps c = matchCharClass' ps c
  25.  
  26. -- process single characters, ranges and end of pattern
  27. matchCharClass' "" _ = Right (Just "Invalid character class")
  28. matchCharClass' (a:'-':b:ps) c | c `elem` enumFromTo a b = findTail ps
  29.                               | otherwise = matchCharClassTail ps c
  30. matchCharClass' (p:ps) c | p == c = findTail ps
  31.                          | otherwise = matchCharClassTail ps c
  32.  
  33. -- process the end of the character class.
  34. matchCharClassTail (']':ps) _ = Right Nothing
  35. matchCharClassTail ps c = matchCharClass' ps c
  36.  
  37. findTail ps = case dropWhile (/= ']') ps of
  38.  "" -> Left "Invalid character class"
  39.  cs -> Right (Just $ tail cs)
  40.  
  41.  
  42. test name pat expected =
  43.  putStr (if actual == (Right expected) then ""
  44.          else "Failure for: " ++ show (name, pat, expected, actual) ++ "\n")
  45.    where actual = glob pat name
  46.  
  47. main = do test "foo.c" "foo.c" True
  48.          test "foo.x" "foo.c" False
  49.          test "foo.x" "foo.?" True
  50.          test "foo.c" "?oo.c" True
  51.          test "foo.c" "?oo.x" False
  52.          test "foo.x" "foo.*" True
  53.          test "foo.x" "*.x" True
  54.          test "foo.x" "f*.x" True
  55.          test "foo.x" "f*.*" True
  56.          test "foo.x" "f*.c" False
  57.          test "foo.x" "f*.[cx]" True
  58.          test "foo.x" "f*.[cy]" False
  59.          test "FOO.x" "[Ff][Oo][oO].[xX]" True
  60.          test "foo.x" "f*.[!cx]" False
  61.          test "foo.x" "f*.[!cy]" True
  62.          test "foo-c" "f*[-abc]c" True
  63.          test "f-c" "f[-ab]c" True
  64.          test "f-c" "f[abc]c" False
  65.          test "f-c" "f[a-c]c" False
  66.          test "fbc" "f[a-c]c" True
  67.          test "f]c" "f[]ac]c" True
  68.          test "a.c" "[]-}].c" True
  69.          test "a-c]"  "[ab]-c]" True
  70.          test "d"  "[ab]-}]" False
  71.          test "a-}]"  "[ab]-}]" True
  72.          test "a" "[!]]" True
  73.          test "]" "[!]]" False
RAW Paste Data