Merge posix-paths into hpath

benchmarks/Bench.hs

@@ -0,0 +1,90 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE ViewPatterns #-}
+
+{-# OPTIONS_GHC -Wall #-}
+import Control.Applicative
+import Control.Monad
+import System.Directory
+import System.FilePath ((</>))
+import System.Posix.ByteString.FilePath
+import System.Posix.Directory.ByteString as PosixBS
+import System.Posix.Directory.Traversals
+import qualified System.Posix.FilePath as PosixBS
+import System.Posix.Files.ByteString
+
+import Control.Exception
+import qualified Data.ByteString.Char8 as BS
+
+import System.Environment (getArgs, withArgs)
+import System.IO.Error
+import System.IO.Unsafe
+import System.Process (system)
+import Criterion.Main
+
+
+-- | Based on code from 'Real World Haskell', at
+-- http://book.realworldhaskell.org/read/io-case-study-a-library-for-searching-the-filesystem.html#id620419
+listFilesRecursive :: FilePath -> IO [FilePath]
+listFilesRecursive topdir = do
+    names <- System.Directory.getDirectoryContents topdir
+    let properNames = filter (`notElem` [".", ".."]) names
+    paths <- forM properNames $ \name -> do
+        let path = topdir </> name
+        isDir <- doesDirectoryExist path
+        if isDir
+            then listFilesRecursive path
+            else return [path]
+    return (topdir : concat paths)
+
+----------------------------------------------------------
+
+getDirectoryContentsBS :: RawFilePath -> IO [RawFilePath]
+getDirectoryContentsBS path = 
+  modifyIOError ((`ioeSetFileName` (BS.unpack path)) .
+                 (`ioeSetLocation` "getDirectoryContentsBS")) $ do
+    bracket
+      (PosixBS.openDirStream path)
+      PosixBS.closeDirStream
+      loop
+ where
+  loop dirp = do
+     e <- PosixBS.readDirStream dirp
+     if BS.null e then return [] else do
+       es <- loop dirp
+       return (e:es)
+
+
+-- | similar to 'listFilesRecursive, but uses RawFilePaths
+listFilesRecursiveBS :: RawFilePath -> IO [RawFilePath]
+listFilesRecursiveBS topdir = do
+    names <- getDirectoryContentsBS topdir
+    let properNames = filter (`notElem` [".", ".."]) names
+    paths <- forM properNames $ \name -> unsafeInterleaveIO $ do
+        let path = PosixBS.combine topdir name
+        isDir <- isDirectory <$> getFileStatus path
+        if isDir
+            then listFilesRecursiveBS path
+            else return [path]
+    return (topdir : concat paths)
+----------------------------------------------------------
+
+
+benchTraverse :: RawFilePath -> IO ()
+benchTraverse = traverseDirectory (\() p -> BS.putStrLn p) ()
+
+main :: IO ()
+main = do
+  args <- getArgs
+  let (d,otherArgs) = case args of
+          []   -> ("/usr/local",[])
+          x:xs -> (x,xs)
+  withArgs otherArgs $ defaultMain
+    [ bench "traverse (FilePath)"      $ nfIO $ listFilesRecursive d >>= mapM_ putStrLn
+    , bench "traverse (RawFilePath)"   $ nfIO $ listFilesRecursiveBS (BS.pack d) >>= mapM_ BS.putStrLn
+    , bench "allDirectoryContents"     $ nfIO $ allDirectoryContents (BS.pack d) >>= mapM_ BS.putStrLn
+    , bench "allDirectoryContents'"    $ nfIO $ allDirectoryContents' (BS.pack d) >>= mapM_ BS.putStrLn
+    , bench "traverseDirectory"        $ nfIO $ benchTraverse (BS.pack d)
+    , bench "unix find"                $ nfIO $ void $ system ("find " ++ d)
+    ]