1-- 2-- Copyright (c) 2012 Mark Dittmer - http://www.markdittmer.org 3-- Developed for a Google Summer of Code project - http://gsoc2012.markdittmer.org 4-- 5 6{-# LANGUAGE MultiWayIf #-} 7 8module System.FSNotify.OSX 9 ( FileListener(..) 10 , NativeManager 11 ) where 12 13import Control.Concurrent.Chan 14import Control.Concurrent.MVar 15import Control.Monad 16import Data.Bits 17import Data.IORef (atomicModifyIORef, readIORef) 18import Data.Map (Map) 19import qualified Data.Map as Map 20import Data.Time.Clock (UTCTime, getCurrentTime) 21import Data.Unique 22import Data.Word 23import Prelude hiding (FilePath) 24import System.Directory 25import System.FSNotify.Listener 26import System.FSNotify.Path (canonicalizeDirPath) 27import System.FSNotify.Types 28import System.FilePath 29import qualified System.OSX.FSEvents as FSE 30 31 32data WatchData = WatchData FSE.EventStream EventChannel 33 34type WatchMap = Map Unique WatchData 35data OSXManager = OSXManager (MVar WatchMap) 36type NativeManager = OSXManager 37 38nil :: Word64 39nil = 0x00 40 41-- OS X reports the absolute (canonical) path without a trailing slash. Add 42-- the trailing slash when the path refers to a directory 43canonicalEventPath :: FSE.Event -> FilePath 44canonicalEventPath event = 45 if flags .&. dirFlag /= nil then addTrailingPathSeparator path else path 46 where 47 flags = FSE.eventFlags event 48 dirFlag = FSE.eventFlagItemIsDir 49 path = FSE.eventPath event 50 51-- We have to be careful about interpreting the flags in a given event, because 52-- "really it's an OR of all the changes made since the FSEventsListener is created" 53-- See https://stackoverflow.com/questions/18415285/osx-fseventstreameventflags-not-working-correctly 54-- Thus, we try to look at whether the path exists or not to determine whether it was created, modified, etc. 55 56-- Note that there's still some bugs possible due to event coalescing, which the docs say is a possibility: 57-- for example, a file could be created and modified within a short time interval, and then we'd only emit one 58-- event (the "modified" one, given the logic below) 59-- See https://developer.apple.com/library/content/documentation/Darwin/Conceptual/FSEvents_ProgGuide/UsingtheFSEventsFramework/UsingtheFSEventsFramework.html 60fsnEvents :: UTCTime -> FSE.Event -> IO [Event] 61fsnEvents timestamp e = do 62 -- Note: we *don't* want to use the canonical event path in the existence check, because of the aforementioned crazy event coalescing. 63 -- For example, suppose a directory is created and deleted, and then a file is created with the same name. This means the isDirectory flag might 64 -- still be turned on, which could lead us to construct a canonical event path with a trailing slash, which would then cause the existence 65 -- check to fail and make us think the file was removed. 66 -- The upshot of this is that the canonical event paths in the events we emit can't really be trusted, but hey, that's what the extra flag 67 -- on the event is for :( 68 exists <- doesPathExist $ FSE.eventPath e 69 70 -- Uncomment for an easy way to see flag activity when testing manually 71 -- putStrLn $ show ["Event", show e, "isDirectory", show isDirectory, "isFile", show isFile, "isModified", show isModified, "isCreated", show isCreated, "path", path e, "exists", show exists] 72 73 return $ if | exists && isModified -> [Modified (path e) timestamp isDirectory] 74 | exists && isCreated -> [Added (path e) timestamp isDirectory] 75 | (not exists) && hasFlag e FSE.eventFlagItemRemoved -> [Removed (path e) timestamp isDirectory] 76 77 -- Rename stuff 78 | exists && isRenamed -> [Added (path e) timestamp isDirectory] 79 | (not exists) && isRenamed -> [Removed (path e) timestamp isDirectory] 80 81 | otherwise -> [] 82 where 83 isDirectory = hasFlag e FSE.eventFlagItemIsDir 84 isFile = hasFlag e FSE.eventFlagItemIsFile 85 isCreated = hasFlag e FSE.eventFlagItemCreated 86 isRenamed = hasFlag e FSE.eventFlagItemRenamed 87 isModified = hasFlag e FSE.eventFlagItemModified || hasFlag e FSE.eventFlagItemInodeMetaMod 88 path = canonicalEventPath 89 hasFlag event flag = FSE.eventFlags event .&. flag /= 0 90 91handleEvent :: Bool -> ActionPredicate -> EventChannel -> FilePath -> DebouncePayload -> FSE.Event -> IO () 92handleEvent isRecursive actPred chan dirPath dbp fseEvent = do 93 currentTime <- getCurrentTime 94 events <- fsnEvents currentTime fseEvent 95 handleEvents isRecursive actPred chan dirPath dbp events 96 97-- | For non-recursive monitoring, test if an event takes place directly inside the monitored folder 98isDirectlyInside :: FilePath -> Event -> Bool 99isDirectlyInside dirPath event = isRelevantFileEvent || isRelevantDirEvent 100 where 101 isRelevantFileEvent = (not $ eventIsDirectory event) && (takeDirectory dirPath == (takeDirectory $ eventPath event)) 102 isRelevantDirEvent = eventIsDirectory event && (takeDirectory dirPath == (takeDirectory $ takeDirectory $ eventPath event)) 103 104handleEvents :: Bool -> ActionPredicate -> EventChannel -> FilePath -> DebouncePayload -> [Event] -> IO () 105handleEvents isRecursive actPred chan dirPath dbp (event:events) = do 106 when (actPred event && (isRecursive || (isDirectlyInside dirPath event))) $ case dbp of 107 (Just (DebounceData epsilon ior)) -> do 108 lastEvent <- readIORef ior 109 when (not $ debounce epsilon lastEvent event) (writeChan chan event) 110 atomicModifyIORef ior (\_ -> (event, ())) 111 Nothing -> writeChan chan event 112 handleEvents isRecursive actPred chan dirPath dbp events 113handleEvents _ _ _ _ _ [] = return () 114 115listenFn :: (ActionPredicate -> EventChannel -> FilePath -> DebouncePayload -> FSE.Event -> IO a) 116 -> WatchConfig 117 -> OSXManager 118 -> FilePath 119 -> ActionPredicate 120 -> EventChannel 121 -> IO StopListening 122listenFn handler conf (OSXManager mvarMap) path actPred chan = do 123 path' <- canonicalizeDirPath path 124 dbp <- newDebouncePayload $ confDebounce conf 125 unique <- newUnique 126 eventStream <- FSE.eventStreamCreate [path'] 0.0 True False True (handler actPred chan path' dbp) 127 modifyMVar_ mvarMap $ \watchMap -> return (Map.insert unique (WatchData eventStream chan) watchMap) 128 return $ do 129 FSE.eventStreamDestroy eventStream 130 modifyMVar_ mvarMap $ \watchMap -> return $ Map.delete unique watchMap 131 132instance FileListener OSXManager where 133 initSession = do 134 (v1, v2, _) <- FSE.osVersion 135 if not $ v1 > 10 || (v1 == 10 && v2 > 6) then return Nothing else 136 fmap (Just . OSXManager) $ newMVar Map.empty 137 138 killSession (OSXManager mvarMap) = do 139 watchMap <- readMVar mvarMap 140 forM_ (Map.elems watchMap) eventStreamDestroy' 141 where 142 eventStreamDestroy' :: WatchData -> IO () 143 eventStreamDestroy' (WatchData eventStream _) = FSE.eventStreamDestroy eventStream 144 145 listen = listenFn $ handleEvent False 146 listenRecursive = listenFn $ handleEvent True 147 148 usesPolling = const False 149