From a39b73d118c18707e6549d57a902fca9966119f8 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 18 Jun 2012 13:01:58 -0400 Subject: recurse dirTree and open the directories for kqueue to watch --- Utility/Kqueue.hs | 23 ++++++++++++++++++----- 1 file changed, 18 insertions(+), 5 deletions(-) (limited to 'Utility') diff --git a/Utility/Kqueue.hs b/Utility/Kqueue.hs index bfc6ee9fc..aabea7d03 100644 --- a/Utility/Kqueue.hs +++ b/Utility/Kqueue.hs @@ -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 -- cgit v1.2.3