diff options
| author |  Joey Hess <joeyh@fischer.debian.org> | 2012-06-19 04:04:40 +0000 |
|---|---|---|
| committer | Joey Hess <joeyh@fischer.debian.org> | 2012-06-19 04:07:48 +0000 |
| commit | 02e9fdb0a5940a1c059445c616338dc147a32544 (patch) | |
| tree | 1ac86cecbfba52ef95932c647f39c4a472c4e948 /Utility/Kqueue.hs | |
| parent | 7a09d74319c0e68dddfa2cf1979731a030e8881e (diff) | |
kqueue build fix
new event dispatch seems a bit broken though
Diffstat (limited to 'Utility/Kqueue.hs')
| -rw-r--r-- | Utility/Kqueue.hs | 26 |
1 files changed, 16 insertions, 10 deletions
diff --git a/Utility/Kqueue.hs b/Utility/Kqueue.hs index 30218bc29..da43a2d86 100644 --- a/Utility/Kqueue.hs +++ b/Utility/Kqueue.hs @@ -8,6 +8,7 @@ {-# LANGUAGE ForeignFunctionInterface #-} module Utility.Kqueue ( + Kqueue, initKqueue, stopKqueue, waitChange, @@ -27,6 +28,7 @@ import Foreign.Ptr import Foreign.Marshal import qualified Data.Map as M import qualified Data.Set as S +import qualified System.Posix.Files as Files data Change = Deleted FilePath @@ -194,21 +196,25 @@ handleChange (Kqueue h dirmap pruner) fd olddirinfo = - Never returns. -} runHooks :: Kqueue -> WatchHooks -> IO () runHooks kq hooks = do - (kq', changes) <- Kqueue.waitChange kq - forM_ changes $ dispatch kq' + (kq', changes) <- waitChange kq + forM_ changes $ \c -> do + print c + dispatch kq' c runHooks kq' hooks where -- Kqueue returns changes for both whole directories -- being added and deleted, and individual files being -- added and deleted. - dispatch q change status - | isAdd change = withstatus s (dispatchadd q) - | isDelete change = callhook delDirHook change + dispatch q change + | isAdd change = withstatus change $ dispatchadd q + | otherwise = callhook delDirHook Nothing change dispatchadd q change s - | Files.isSymbolicLink = callhook addSymlinkHook change - | Files.isDirectory = print $ "TODO: recursive directory add: " ++ show change - | Files.isRegularFile = callhook addHook change + | Files.isSymbolicLink s = callhook addSymlinkHook (Just s) change + | Files.isDirectory s = print $ "TODO: recursive directory add: " ++ show change + | Files.isRegularFile s = callhook addHook (Just s) change | otherwise = noop - callhook h change = hooks h $ changedFile change + callhook h s change = case h hooks of + Nothing -> noop + Just a -> a (changedFile change) s withstatus change a = maybe noop (a change) =<< - (catchMaybeIO (getSymbolicLinkStatus (changedFile change) + (catchMaybeIO (getSymbolicLinkStatus (changedFile change))) |