lifted out the kqueue and inotify to a generic DirWatcher interface

Kqueue code for dispatching events is not tested and probably doesn't
build.

4 files changed, 102 insertions, 11 deletions

diff --git a/Utility/DirWatcher.hs b/Utility/DirWatcher.hs
new file mode 100644
index 000000000..575036190
--- /dev/null
+++ b/Utility/DirWatcher.hs
@@ -0,0 +1,53 @@
+{- generic directory watching interface
+ -
+ - Uses either inotify or kqueue to watch a directory (and subdirectories)
+ - for changes, and runs hooks for different sorts of events as they occur.
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE CPP #-}
+
+module Utility.DirWatcher where
+
+import Utility.Types.DirWatcher
+
+#if WITH_INOTIFY
+import qualified Utility.INotify as INotify
+import qualified System.INotify as INotify
+import Utility.ThreadScheduler
+#endif
+#if WITH_KQUEUE
+import qualified Utility.Kqueue as Kqueue
+#endif
+
+type Pruner = FilePath -> Bool
+
+canWatch :: Bool
+#if (WITH_INOTIFY || WITH_KQUEUE)
+canWatch = True
+#else
+#if defined linux_HOST_OS
+#warning "Building without inotify support"
+#endif
+canWatch = False
+#endif
+
+#if WITH_INOTIFY
+watchDir :: FilePath -> Pruner -> WatchHooks -> (IO () -> IO ()) -> IO ()
+watchDir dir prune hooks runstartup = INotify.withINotify $ \i -> do
+	runstartup $ INotify.watchDir i dir prune hooks
+	waitForTermination -- Let the inotify thread run.
+#else
+#if WITH_KQUEUE
+watchDir :: FilePath -> Pruner -> WatchHooks -> (IO Kqueue.Kqueue -> IO Kqueue.Kqueue) -> IO ()
+watchDir dir ignored hooks runstartup = do
+	kq <- runstartup $ Kqueue.initKqueue dir ignored
+	Kqueue.runHooks kq hooks
+#else
+watchDir :: FilePath -> Pruner -> WatchHooks -> (IO () -> IO ()) -> IO ()
+watchDir = undefined
+#endif
+#endif
diff --git a/Utility/Inotify.hs b/Utility/INotify.hs
index 9ad947f31..bf87f4e71 100644
--- a/Utility/Inotify.hs
+++ b/Utility/INotify.hs
@@ -5,26 +5,17 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-module Utility.Inotify where
+module Utility.INotify where
 
 import Common hiding (isDirectory)
 import Utility.ThreadLock
+import Utility.Types.DirWatcher
 
 import System.INotify
 import qualified System.Posix.Files as Files
 import System.IO.Error
 import Control.Exception (throw)
 
-type Hook a = Maybe (a -> Maybe FileStatus -> IO ())
-
-data WatchHooks = WatchHooks
-	{ addHook :: Hook FilePath
-	, addSymlinkHook :: Hook FilePath
-	, delHook :: Hook FilePath
-	, delDirHook :: Hook FilePath
-	, errHook :: Hook String -- error message
-	}
-
 {- Watches for changes to files in a directory, and all its subdirectories
  - that are not ignored, using inotify. This function returns after
  - its initial scan is complete, leaving a thread running. Callbacks are
diff --git a/Utility/Kqueue.hs b/Utility/Kqueue.hs
index 5b4920f2f..30218bc29 100644
--- a/Utility/Kqueue.hs
+++ b/Utility/Kqueue.hs
@@ -15,9 +15,11 @@ module Utility.Kqueue (
 	changedFile,
 	isAdd,
 	isDelete,
+	runHooks,
 ) where
 
 import Common
+import Utility.Types.DirWatcher
 
 import System.Posix.Types
 import Foreign.C.Types
@@ -187,3 +189,26 @@ handleChange (Kqueue h dirmap pruner) fd olddirinfo =
 			-- remove it from our map.
 			newmap <- removeSubDir dirmap (dirName olddirinfo)
 			return (Kqueue h newmap pruner, [])
+
+{- Processes changes on the Kqueue, calling the hooks as appropriate.
+ - Never returns. -}
+runHooks :: Kqueue -> WatchHooks -> IO ()
+runHooks kq hooks = do
+	(kq', changes) <- Kqueue.waitChange kq
+	forM_ changes $ dispatch kq'
+	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
+		dispatchadd q change s
+			| Files.isSymbolicLink = callhook addSymlinkHook change
+			| Files.isDirectory = print $ "TODO: recursive directory add: " ++ show change
+			| Files.isRegularFile = callhook addHook change
+			| otherwise = noop
+		callhook h change = hooks h $ changedFile change
+		withstatus change a = maybe noop (a change) =<<
+			(catchMaybeIO (getSymbolicLinkStatus (changedFile change)
diff --git a/Utility/Types/DirWatcher.hs b/Utility/Types/DirWatcher.hs
new file mode 100644
index 000000000..c828a0593
--- /dev/null
+++ b/Utility/Types/DirWatcher.hs
@@ -0,0 +1,22 @@
+{- generic directory watching types
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE CPP #-}
+
+module Utility.Types.DirWatcher where
+
+import Common
+
+type Hook a = Maybe (a -> Maybe FileStatus -> IO ())
+
+data WatchHooks = WatchHooks
+	{ addHook :: Hook FilePath
+	, addSymlinkHook :: Hook FilePath
+	, delHook :: Hook FilePath
+	, delDirHook :: Hook FilePath
+	, errHook :: Hook String -- error message
+	}