Skip to content
Permalink
master
Switch branches/tags
Go to file
 
 
Cannot retrieve contributors at this time
136 lines (116 sloc) 6.26 KB
--
-- Copyright (c) 2012 Mark Dittmer - http://www.markdittmer.org
-- Developed for a Google Summer of Code project - http://gsoc2012.markdittmer.org
--
{-# LANGUAGE MultiWayIf, OverloadedStrings, MultiParamTypeClasses #-}
module System.FSNotify.OSX
( FileListener(..)
, NativeManager
) where
import Control.Concurrent
import Control.Monad
import Data.Bits
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Time.Clock (UTCTime, getCurrentTime)
import Data.Unique
import Data.Word
import Prelude hiding (FilePath)
import System.Directory
import System.FSNotify.Listener
import System.FSNotify.Path (canonicalizeDirPath)
import System.FSNotify.Types
import System.FilePath
import qualified System.OSX.FSEvents as FSE
data WatchData = WatchData FSE.EventStream EventCallback
type WatchMap = Map Unique WatchData
data OSXManager = OSXManager (MVar WatchMap)
type NativeManager = OSXManager
nil :: Word64
nil = 0x00
-- OS X reports the absolute (canonical) path without a trailing slash. Add
-- the trailing slash when the path refers to a directory
canonicalEventPath :: FSE.Event -> FilePath
canonicalEventPath event =
if flags .&. dirFlag /= nil then addTrailingPathSeparator path else path
where
flags = FSE.eventFlags event
dirFlag = FSE.eventFlagItemIsDir
path = FSE.eventPath event
-- We have to be careful about interpreting the flags in a given event, because
-- "really it's an OR of all the changes made since the FSEventsListener is created"
-- See https://stackoverflow.com/questions/18415285/osx-fseventstreameventflags-not-working-correctly
-- Thus, we try to look at whether the path exists or not to determine whether it was created, modified, etc.
-- Note that there's still some bugs possible due to event coalescing, which the docs say is a possibility:
-- for example, a file could be created and modified within a short time interval, and then we'd only emit one
-- event (the "modified" one, given the logic below)
-- See https://developer.apple.com/library/content/documentation/Darwin/Conceptual/FSEvents_ProgGuide/UsingtheFSEventsFramework/UsingtheFSEventsFramework.html
fsnEvents :: UTCTime -> FSE.Event -> IO [Event]
fsnEvents timestamp e = do
-- Note: we *don't* want to use the canonical event path in the existence check, because of the aforementioned crazy event coalescing.
-- 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
-- still be turned on, which could lead us to construct a canonical event path with a trailing slash, which would then cause the existence
-- check to fail and make us think the file was removed.
-- 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
-- on the event is for :(
exists <- doesPathExist $ FSE.eventPath e
-- Uncomment for an easy way to see flag activity when testing manually
-- putStrLn $ show ["Event", show e, "isDirectory", show isDirectory, "isFile", show isFile, "isModified", show isModified, "isCreated", show isCreated, "path", path e, "exists", show exists]
return $ if | exists && isModified -> [Modified (path e) timestamp isDirectory]
| exists && isModifiedAttributes -> [ModifiedAttributes (path e) timestamp isDirectory]
| exists && isCreated -> [Added (path e) timestamp isDirectory]
| (not exists) && hasFlag e FSE.eventFlagItemRemoved -> [Removed (path e) timestamp isDirectory]
-- Rename stuff
| exists && isRenamed -> [Added (path e) timestamp isDirectory]
| (not exists) && isRenamed -> [Removed (path e) timestamp isDirectory]
| otherwise -> []
where
isDirectory = if hasFlag e FSE.eventFlagItemIsDir then IsDirectory else IsFile
isFile = hasFlag e FSE.eventFlagItemIsFile
isCreated = hasFlag e FSE.eventFlagItemCreated
isRenamed = hasFlag e FSE.eventFlagItemRenamed
isModified = hasFlag e FSE.eventFlagItemModified
isModifiedAttributes = hasFlag e FSE.eventFlagItemInodeMetaMod
path = canonicalEventPath
hasFlag event flag = FSE.eventFlags event .&. flag /= 0
handleFSEEvent :: Bool -> ActionPredicate -> EventCallback -> FilePath -> FSE.Event -> IO ()
handleFSEEvent isRecursive actPred callback dirPath fseEvent = do
currentTime <- getCurrentTime
events <- fsnEvents currentTime fseEvent
forM_ events $ \event ->
when (actPred event && (isRecursive || (isDirectlyInside dirPath event))) $
callback event
-- | For non-recursive monitoring, test if an event takes place directly inside the monitored folder
isDirectlyInside :: FilePath -> Event -> Bool
isDirectlyInside dirPath event = isRelevantFileEvent || isRelevantDirEvent
where
isRelevantFileEvent = (eventIsDirectory event == IsFile) && (takeDirectory dirPath == (takeDirectory $ eventPath event))
isRelevantDirEvent = (eventIsDirectory event == IsDirectory) && (takeDirectory dirPath == (takeDirectory $ takeDirectory $ eventPath event))
listenFn :: (ActionPredicate -> EventCallback -> FilePath -> FSE.Event -> IO a)
-> WatchConfig
-> OSXManager
-> FilePath
-> ActionPredicate
-> EventCallback
-> IO StopListening
listenFn handler conf (OSXManager mvarMap) path actPred callback = do
path' <- canonicalizeDirPath path
unique <- newUnique
eventStream <- FSE.eventStreamCreate [path'] 0.0 True False True (handler actPred callback path')
modifyMVar_ mvarMap $ \watchMap -> return (Map.insert unique (WatchData eventStream callback) watchMap)
return $ do
FSE.eventStreamDestroy eventStream
modifyMVar_ mvarMap $ \watchMap -> return $ Map.delete unique watchMap
instance FileListener OSXManager () where
initSession _ = do
(v1, v2, _) <- FSE.osVersion
if not $ v1 > 10 || (v1 == 10 && v2 > 6) then return $ Left "Unsupported OS version" else
(Right . OSXManager) <$> newMVar Map.empty
killSession (OSXManager mvarMap) = do
watchMap <- readMVar mvarMap
forM_ (Map.elems watchMap) eventStreamDestroy'
where
eventStreamDestroy' :: WatchData -> IO ()
eventStreamDestroy' (WatchData eventStream _) = FSE.eventStreamDestroy eventStream
listen = listenFn $ handleFSEEvent False
listenRecursive = listenFn $ handleFSEEvent True