-- | Api for watching and notifying file changes. -- Currently, this is based on inotify, but people may want to -- provide implementations of this module for non-inotify-supported -- platforms. module System.Plugins.Auto.FileSystemWatcher ( FSWatcher , FSWatchDescriptor , initFSWatcher , addWatch , removeWatch ) where import Control.Concurrent.MVar (MVar,readMVar,modifyMVar,modifyMVar_,newMVar) import System.INotify (INotify, WatchDescriptor, Event(..), EventVariety(..),initINotify) import qualified System.INotify as I(addWatch, removeWatch) import System.FilePath (splitFileName) import qualified Data.Map as Map import Data.Map (Map) -- | A FSWatcher watches several files for changes. If a file is deleted from the -- containing folder, it keeps watching the folder in case the file is added -- again. data FSWatcher = FSWatcher INotify -- INotify handle (MVar (Map FilePath -- Folder containing the file ( WatchDescriptor -- Watch descriptor of the folder , Map String -- File being observed (Event -> IO ()) -- Handler to run on file events ) ) ) -- | Identifier used to stop watching files. data FSWatchDescriptor = FSWatchDescriptor FSWatcher FilePath -- | Initializes a watcher. initFSWatcher :: IO FSWatcher initFSWatcher = do iN <- initINotify fmvar <- newMVar Map.empty return$ FSWatcher iN fmvar -- Replacement for splitFileName which returns "." instead of an empty folder. splitFileName' :: FilePath -> (FilePath,String) splitFileName' fp = let (d,f) = splitFileName fp in (if null d then "." else d,f) -- | Runs the callback IO action on modifications to the file at the given path. -- -- Each file can have only one callback IO action. Registering a new IO action -- discards any previously registered callback. -- -- The returned FSWatchDescriptor value can be used to stop watching the file. addWatch :: FSWatcher -> FilePath -> IO () -> IO FSWatchDescriptor addWatch piN@(FSWatcher iN fmvar) fp hdl = let (d,f) = splitFileName' fp in modifyMVar fmvar$ \fm -> case Map.lookup d fm of Nothing -> do wd <- I.addWatch iN [Modify, Move, Delete] d $ \e -> do case e of Ignored -> return () Deleted { filePath = f' } -> callHandler e d f' MovedIn { filePath = f' } -> callHandler e d f' Modified { maybeFilePath = Just f' } -> callHandler e d f' _ -> return () return ( Map.insert d (wd,Map.singleton f (const hdl)) fm , FSWatchDescriptor piN fp ) Just (wd,ffm) -> return ( Map.insert d (wd,Map.insert f (const hdl) ffm) fm , FSWatchDescriptor piN fp ) where callHandler e d f = do fm <- readMVar fmvar case Map.lookup d fm of Nothing -> return () Just (_,ffm) -> case Map.lookup f ffm of Nothing -> return () Just mhdl -> mhdl e -- | Stops watching the file associated to the given file descriptor. removeWatch :: FSWatchDescriptor -> IO () removeWatch (FSWatchDescriptor (FSWatcher _iN fmvar) fp) = let (d,f) = splitFileName' fp in modifyMVar_ fmvar$ \fm -> case Map.lookup d fm of Nothing -> error$ "removeWatchP: invalid handle for file "++fp Just (wd,ffm) -> let ffm' = Map.delete f ffm in if Map.null ffm' then I.removeWatch wd >> return (Map.delete d fm) else return (Map.insert d (wd,ffm') fm)