1 files changed, 64 insertions, 0 deletions
diff --git a/Utility/Win32Notify.hs b/Utility/Win32Notify.hs
new file mode 100644
index 000000000..3493b9e9a
--- /dev/null
+++ b/Utility/Win32Notify.hs
@@ -0,0 +1,64 @@
+{- Win32-notify interface
+ -
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Utility.Win32Notify where
+
+import Common hiding (isDirectory)
+import Utility.DirWatcher.Types
+
+import System.Win32.Notify
+
+watchDir :: FilePath -> (FilePath -> Bool) -> WatchHooks -> IO WatchManager
+watchDir dir ignored hooks = do
+	scan dir
+	wm <- initWatchManager
+	void $ watchDirectory wm dir True [Create, Delete, Modify, Move] handle
+	retufn wm
+  where
+	handle evt
+		| ignoredPath ignored (filePath evt) = noop
+		| otherwise = case eventToVariety evt of
+			Delete
+				| isDirectory evt -> runhook delDirHook Nothing
+				| otherwise -> runhook delHook Nothing
+			Create
+				| isDirectory evt -> noop
+				| otherwise -> runhook addHook Nothing
+			Modify
+				| isDirectory evt -> noop
+				{- Add hooks are run when a file is modified for 
+				 - compatability with INotify, which calls the add
+				 - hook when a file is closed, and so tends to call
+				 - both add and modify for file modifications. -}
+				| otherwise -> do
+					runHook addHook Nothing
+					runHook modifyHook Nothing
+	  where
+		runhook h s = maybe noop (\a -> a (filePath evt) s) (h hooks)
+
+	scan d = unless (ignoredPath ignored d) $
+		mapM_ go =<< dirContentsRecursive d
+	  where		
+		go f
+			| ignoredPath ignored f = noop
+			| otherwise = do
+				ms <- getstatus f
+				case ms of
+					Nothing -> noop
+					Just s
+						| Files.isRegularFile s ->
+							runhook addHook ms
+						| otherwise ->
+							noop
+		  where
+			runhook h s = maybe noop (\a -> a f s) (h hooks)
+		
+	getstatus = catchMaybeIO . getFileStatus
+
+{- Check each component of the path to see if it's ignored. -}
+ignoredPath :: (FilePath -> Bool) -> FilePath -> Bool
+ignoredPath ignored = any ignored . map dropTrailingPathSeparator . splitPath