From 4c6096e2f92db212c2172e5567e5eaa53629ab9a Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@oberon.tam-lin.net>
Date: Thu, 27 Dec 2012 14:19:12 -0500
Subject: OSX FSEvents support

Needs work to deal with directory renames better; otherwise seems to
basically work.
---
 Utility/FSEvents.hs | 65 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 65 insertions(+)
 create mode 100644 Utility/FSEvents.hs

(limited to 'Utility/FSEvents.hs')

diff --git a/Utility/FSEvents.hs b/Utility/FSEvents.hs
new file mode 100644
index 000000000..2f0ada955
--- /dev/null
+++ b/Utility/FSEvents.hs
@@ -0,0 +1,65 @@
+{- FSEvents interface
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Utility.FSEvents where
+
+import Common hiding (isDirectory)
+import Utility.Types.DirWatcher
+
+import System.OSX.FSEvents
+import qualified System.Posix.Files as Files
+import Data.Bits ((.&.))
+
+watchDir :: FilePath -> (FilePath -> Bool) -> WatchHooks -> IO EventStream
+watchDir dir ignored hooks = do
+	unlessM fileLevelEventsSupported $
+		error "Need at least OSX 10.7.0 for file-level FSEvents"
+	eventStreamCreate [dir] 1.0 True False True handle
+  where
+	handle evt
+		| not (hasflag eventFlagItemIsFile) = noop
+		| ignoredPath ignored (eventPath evt) = noop
+		| otherwise = do
+			{- More than one flag may be set, if events occurred
+			 - close together. 
+			 - 
+			 - Order is important..
+			 - If a file is added and then deleted, we'll see it's
+			 - not present, and addHook won't run.
+			 - OTOH, if a file is deleted and then re-added,
+			 - the delHook will run first, followed by the addHook.
+			 -}
+
+			{- Deletion events are received for both directories
+			 - and files, with no way to differentiate between
+			 - them. Deleting a directory always first yields
+			 - events deleting its contents though, so we
+			 - just always call delHook, and never delDirHook. -}
+			when (hasflag eventFlagItemRemoved) $
+				runhook delHook Nothing
+			{- TODO deal with moving whole directories -}
+			when (hasflag eventFlagItemCreated || hasflag eventFlagItemRenamed) $ do
+				ms <- getstatus $ eventPath evt
+				case ms of
+					Nothing -> noop
+					Just s
+						| Files.isSymbolicLink s -> 
+							runhook addSymlinkHook ms
+						| Files.isRegularFile s ->
+							runhook addHook ms
+						| otherwise -> noop
+			when (hasflag eventFlagItemModified) $ do
+				ms <- getstatus $ eventPath evt
+				runhook modifyHook ms
+	  where
+		getstatus = catchMaybeIO . getSymbolicLinkStatus
+		hasflag f = eventFlags evt .&. f /= 0
+		runhook h s = maybe noop (\a -> a (eventPath evt) s) (h hooks)
+
+{- Check each component of the path to see if it's ignored. -}
+ignoredPath :: (FilePath -> Bool) -> FilePath -> Bool
+ignoredPath ignored = any ignored . map dropTrailingPathSeparator . splitPath
-- 
cgit v1.2.3