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
|
import Utility.Kqueue
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
type Handler = FilePath -> Maybe FileStatus -> DaemonStatusHandle -> Annex (Maybe Change)
|
|
||||||
|
|
||||||
checkCanWatch :: Annex ()
|
checkCanWatch :: Annex ()
|
||||||
checkCanWatch = do
|
checkCanWatch = do
|
||||||
#if (WITH_INOTIFY || WITH_KQUEUE)
|
#if (WITH_INOTIFY || WITH_KQUEUE)
|
||||||
|
@ -66,7 +64,7 @@ watchThread st dstatus changechan = withINotify $ \i -> do
|
||||||
showAction "scanning"
|
showAction "scanning"
|
||||||
-- This does not return until the startup scan is done.
|
-- This does not return until the startup scan is done.
|
||||||
-- That can take some time for large trees.
|
-- That can take some time for large trees.
|
||||||
watchDir i "." (ignored . takeFileName) hooks
|
watchDir i "." ignored hooks
|
||||||
runThreadState st $
|
runThreadState st $
|
||||||
modifyDaemonStatus dstatus $ \s -> s { scanComplete = True }
|
modifyDaemonStatus dstatus $ \s -> s { scanComplete = True }
|
||||||
-- Notice any files that were deleted before inotify
|
-- Notice any files that were deleted before inotify
|
||||||
|
@ -86,18 +84,24 @@ watchThread st dstatus changechan = withINotify $ \i -> do
|
||||||
}
|
}
|
||||||
#else
|
#else
|
||||||
#ifdef WITH_KQUEUE
|
#ifdef WITH_KQUEUE
|
||||||
watchThread st dstatus changechan = do
|
watchThread st dstatus changechan = forever $ do
|
||||||
print =<< waitChange [stdError, stdOutput]
|
dirs <- scanRecursive "." ignored
|
||||||
|
changeddir <- waitChange dirs
|
||||||
|
print $ "detected a change in " ++ show changeddir
|
||||||
#else
|
#else
|
||||||
watchThread = undefined
|
watchThread = undefined
|
||||||
#endif /* WITH_KQUEUE */
|
#endif /* WITH_KQUEUE */
|
||||||
#endif /* WITH_INOTIFY */
|
#endif /* WITH_INOTIFY */
|
||||||
|
|
||||||
ignored :: FilePath -> Bool
|
ignored :: FilePath -> Bool
|
||||||
ignored ".git" = True
|
ignored = ig . takeFileName
|
||||||
ignored ".gitignore" = True
|
where
|
||||||
ignored ".gitattributes" = True
|
ig ".git" = True
|
||||||
ignored _ = False
|
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
|
{- Runs an action handler, inside the Annex monad, and if there was a
|
||||||
- change, adds it to the ChangeChan.
|
- change, adds it to the ChangeChan.
|
||||||
|
|
|
@ -7,7 +7,10 @@
|
||||||
|
|
||||||
{-# LANGUAGE ForeignFunctionInterface #-}
|
{-# LANGUAGE ForeignFunctionInterface #-}
|
||||||
|
|
||||||
module Utility.Kqueue ( waitChange ) where
|
module Utility.Kqueue (
|
||||||
|
waitChange,
|
||||||
|
scanRecursive
|
||||||
|
) where
|
||||||
|
|
||||||
import Common
|
import Common
|
||||||
|
|
||||||
|
@ -16,16 +19,26 @@ import Foreign.C.Types
|
||||||
import Foreign.C.Error
|
import Foreign.C.Error
|
||||||
import Foreign.Ptr
|
import Foreign.Ptr
|
||||||
import Foreign.Marshal
|
import Foreign.Marshal
|
||||||
|
import qualified Data.Map as M
|
||||||
|
|
||||||
|
type DirMap = M.Map Fd FilePath
|
||||||
|
|
||||||
foreign import ccall unsafe "libkqueue.h waitchange" c_waitchange
|
foreign import ccall unsafe "libkqueue.h waitchange" c_waitchange
|
||||||
:: Ptr Fd -> IO Fd
|
:: Ptr Fd -> IO Fd
|
||||||
|
|
||||||
waitChange :: [Fd] -> IO (Maybe Fd)
|
waitChange :: DirMap -> IO (Maybe FilePath)
|
||||||
waitChange fds = withArray fds $ \c_fds -> do
|
waitChange dirmap = withArray (M.keys dirmap) $ \c_fds -> do
|
||||||
ret <- c_waitchange c_fds
|
changed <- c_waitchange c_fds
|
||||||
ifM (safeErrno <$> getErrno)
|
ifM (safeErrno <$> getErrno)
|
||||||
( return $ Just ret
|
( return $ M.lookup changed dirmap
|
||||||
, return Nothing
|
, return Nothing
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
safeErrno (Errno v) = v == 0
|
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