summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@fischer.debian.org>2012-06-19 04:04:40 +0000
committerGravatar Joey Hess <joeyh@fischer.debian.org>2012-06-19 04:07:48 +0000
commit02e9fdb0a5940a1c059445c616338dc147a32544 (patch)
tree1ac86cecbfba52ef95932c647f39c4a472c4e948
parent7a09d74319c0e68dddfa2cf1979731a030e8881e (diff)
kqueue build fix
new event dispatch seems a bit broken though
-rw-r--r--Utility/Kqueue.hs26
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)))