make flags haskellish

bench/Main.hs

@@ -10,15 +10,8 @@ main :: IO ()
 main = defaultMain [
     bgroup "FnMatch" [
         bench "matches a pattern" $
-          whnf (FnMatch.fnmatch "abc") "abc"
-      , bench "doesn't match a pattern" $
-          whnf (FnMatch.fnmatch "abc") "def"
-      , bench "matches a pattern with a ?" $
-          whnf (FnMatch.fnmatch "a?c") "abc"
-      , bench "matches a pattern with a *" $ 
-          whnf (FnMatch.fnmatch "a*c") "abc"
+          whnf (FnMatch.fnmatch "abc" "abc") []
       , bench "matches a long pattern with a *" $ 
-          whnf (FnMatch.fnmatch "a*c")
-            (BS.replicate 1000000 98 `BS.append` "a")
+          whnf (FnMatch.fnmatch "a*c" (BS.replicate 1000000 98 `BS.append` "c")) []
       ]
   ]

src/FnMatch.hs

@@ -1,17 +1,35 @@
-module FnMatch (fnmatch) where
+module FnMatch (fnmatch, FnMatchFlags(..)) where
 
 import Foreign.C
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Unsafe as BU
 import GHC.IO (unsafePerformIO)
+import Data.Bits ((.|.))
 
 
 foreign import ccall "fnmatch" c_fnmatch 
   :: CString -> CString -> CInt -> IO CInt
 
-fnmatch :: BS.ByteString -> BS.ByteString -> Int -> Bool
+data FnMatchFlags 
+  = FlagNoEscape
+  | FlagPathName
+  | FlagPeriod
+  | FlagLeadingDir
+  | FlagCaseFold
+  | FlagExtMatch
+  deriving (Eq, Show)
+
+fnmatch :: BS.ByteString -> BS.ByteString -> [FnMatchFlags] -> Bool
 fnmatch pattern str flags = unsafePerformIO $
   BU.unsafeUseAsCString pattern $ \c_pattern ->
     BU.unsafeUseAsCString str $ \c_str -> do
-      result <- c_fnmatch c_pattern c_str (fromIntegral flags)
-      return (result == 0)
+      result <- c_fnmatch c_pattern c_str flags'
+      return (result == 0)
+  where 
+    flags' = foldr (\flag acc -> acc .|. flag) 0 (map flagToCInt flags)
+    flagToCInt FlagNoEscape = 1
+    flagToCInt FlagPathName = 2
+    flagToCInt FlagPeriod = 4
+    flagToCInt FlagLeadingDir = 8
+    flagToCInt FlagCaseFold = 16
+    flagToCInt FlagExtMatch = 32

test/Main.hs

@@ -10,10 +10,14 @@ main = do
     hspec $ do
       describe "FnMatch" $ do
         it "matches a pattern" $ do
-          FnMatch.fnmatch "abc" "abc" 0 `shouldBe` True
+          FnMatch.fnmatch "abc" "abc" [] `shouldBe` True
         it "doesn't match a pattern" $ do
-          FnMatch.fnmatch "abc" "def" 0 `shouldBe` False
+          FnMatch.fnmatch "abc" "def" [] `shouldBe` False
         it "matches a pattern with a ?" $ do
-          FnMatch.fnmatch "a?c" "abc" 0 `shouldBe` True
+          FnMatch.fnmatch "a?c" "abc" [] `shouldBe` True
         it "matches a pattern with a *" $ do
-          FnMatch.fnmatch "a*c" "abc" 0 `shouldBe` True
+          FnMatch.fnmatch "a*c" "abc" [] `shouldBe` True
+        -- we pass a FlagCaseFold to fnmatch 
+        it "matches a pattern with a case fold flag" $ do
+          FnMatch.fnmatch "a*c" "ABC" [FnMatch.FlagCaseFold] `shouldBe` True
+          FnMatch.fnmatch "a*c" "ABC" [] `shouldBe` False