recurse dirTree and open the directories for kqueue to watch
This commit is contained in:
parent
dc3d9d1e98
commit
a39b73d118
2 changed files with 31 additions and 14 deletions
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue