recurse dirTree and open the directories for kqueue to watch

This commit is contained in:
Joey Hess 2012-06-18 13:01:58 -04:00
parent dc3d9d1e98
commit a39b73d118
2 changed files with 31 additions and 14 deletions

View file

@ -7,7 +7,10 @@
{-# LANGUAGE ForeignFunctionInterface #-}
module Utility.Kqueue ( waitChange ) where
module Utility.Kqueue (
waitChange,
scanRecursive
) where
import Common
@ -16,16 +19,26 @@ import Foreign.C.Types
import Foreign.C.Error
import Foreign.Ptr
import Foreign.Marshal
import qualified Data.Map as M
type DirMap = M.Map Fd FilePath
foreign import ccall unsafe "libkqueue.h waitchange" c_waitchange
:: Ptr Fd -> IO Fd
waitChange :: [Fd] -> IO (Maybe Fd)
waitChange fds = withArray fds $ \c_fds -> do
ret <- c_waitchange c_fds
waitChange :: DirMap -> IO (Maybe FilePath)
waitChange dirmap = withArray (M.keys dirmap) $ \c_fds -> do
changed <- c_waitchange c_fds
ifM (safeErrno <$> getErrno)
( return $ Just ret
( return $ M.lookup changed dirmap
, return Nothing
)
where
safeErrno (Errno v) = v == 0
scanRecursive :: FilePath -> (FilePath -> Bool) -> IO DirMap
scanRecursive dir prune = M.fromList <$> (mapM opendir =<< dirTree dir prune)
where
opendir d = (,)
<$> openFd d ReadOnly Nothing defaultFileFlags
<*> pure d