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
|
@ -37,8 +37,6 @@ import System.INotify
|
|||
import Utility.Kqueue
|
||||
#endif
|
||||
|
||||
type Handler = FilePath -> Maybe FileStatus -> DaemonStatusHandle -> Annex (Maybe Change)
|
||||
|
||||
checkCanWatch :: Annex ()
|
||||
checkCanWatch = do
|
||||
#if (WITH_INOTIFY || WITH_KQUEUE)
|
||||
|
@ -66,7 +64,7 @@ watchThread st dstatus changechan = withINotify $ \i -> do
|
|||
showAction "scanning"
|
||||
-- This does not return until the startup scan is done.
|
||||
-- That can take some time for large trees.
|
||||
watchDir i "." (ignored . takeFileName) hooks
|
||||
watchDir i "." ignored hooks
|
||||
runThreadState st $
|
||||
modifyDaemonStatus dstatus $ \s -> s { scanComplete = True }
|
||||
-- Notice any files that were deleted before inotify
|
||||
|
@ -86,18 +84,24 @@ watchThread st dstatus changechan = withINotify $ \i -> do
|
|||
}
|
||||
#else
|
||||
#ifdef WITH_KQUEUE
|
||||
watchThread st dstatus changechan = do
|
||||
print =<< waitChange [stdError, stdOutput]
|
||||
watchThread st dstatus changechan = forever $ do
|
||||
dirs <- scanRecursive "." ignored
|
||||
changeddir <- waitChange dirs
|
||||
print $ "detected a change in " ++ show changeddir
|
||||
#else
|
||||
watchThread = undefined
|
||||
#endif /* WITH_KQUEUE */
|
||||
#endif /* WITH_INOTIFY */
|
||||
|
||||
ignored :: FilePath -> Bool
|
||||
ignored ".git" = True
|
||||
ignored ".gitignore" = True
|
||||
ignored ".gitattributes" = True
|
||||
ignored _ = False
|
||||
ignored = ig . takeFileName
|
||||
where
|
||||
ig ".git" = True
|
||||
ig ".gitignore" = True
|
||||
ig ".gitattributes" = True
|
||||
ig _ = False
|
||||
|
||||
type Handler = FilePath -> Maybe FileStatus -> DaemonStatusHandle -> Annex (Maybe Change)
|
||||
|
||||
{- Runs an action handler, inside the Annex monad, and if there was a
|
||||
- change, adds it to the ChangeChan.
|
||||
|
|
|
@ -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
Reference in a new issue