module System.Directory.Watcher (
EventType(..), Event(..), eventType, eventPath, eventTime,
Watcher(..),
withWatcher,
watchDir, watchDir_, unwatchDir, isWatchingDir,
watchTree, watchTree_, unwatchTree, isWatchingTree,
readEvent, events, onEvent
) where
import Control.Lens (makeLenses)
import Control.Arrow
import Control.Concurrent.MVar
import Control.Concurrent.Chan
import Control.Monad
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe (isJust)
import Data.String (fromString)
import Data.Time.Clock.POSIX
import System.FilePath (takeDirectory, isDrive)
import System.Directory
import qualified System.FSNotify as FS
data EventType = Added | Modified | Removed deriving (Eq, Ord, Enum, Bounded, Read, Show)
data Event = Event {
_eventType :: EventType,
_eventPath :: FilePath,
_eventTime :: POSIXTime }
makeLenses ''Event
data Watcher a = Watcher {
watcherDirs :: MVar (Map FilePath (Bool, IO ())),
watcherMan :: FS.WatchManager,
watcherChan :: Chan (a, Event) }
withWatcher :: (Watcher a -> IO b) -> IO b
withWatcher act = FS.withManager $ \man -> do
ch <- newChan
dirs <- newMVar M.empty
act $ Watcher dirs man ch
watchDir :: Watcher a -> FilePath -> (Event -> Bool) -> a -> IO ()
watchDir w f p v = do
e <- doesDirectoryExist f
when e $ do
f' <- canonicalizePath f
watching <- isWatchingDir w f'
unless watching $ do
stop <- FS.watchDir
(watcherMan w)
(fromString f')
(p . fromEvent)
(writeChan (watcherChan w) . (,) v . fromEvent)
modifyMVar_ (watcherDirs w) $ return . M.insert f' (False, stop)
watchDir_ :: Watcher () -> FilePath -> (Event -> Bool) -> IO ()
watchDir_ w f p = watchDir w f p ()
unwatchDir :: Watcher a -> FilePath -> IO Bool
unwatchDir w f = do
f' <- canonicalizePath f
stop <- modifyMVar (watcherDirs w) $ return . (M.delete f' &&& M.lookup f')
maybe (return ()) snd stop
return $ isJust stop
isWatchingDir :: Watcher a -> FilePath -> IO Bool
isWatchingDir w f = do
f' <- canonicalizePath f
dirs <- readMVar (watcherDirs w)
return $ isWatchingDir' dirs f'
where
isWatchingDir' :: Map FilePath (Bool, IO ()) -> FilePath -> Bool
isWatchingDir' m dir
| Just (_, _) <- M.lookup dir m = True
| isDrive dir = False
| otherwise = isWatchingDir' m (takeDirectory dir)
watchTree :: Watcher a -> FilePath -> (Event -> Bool) -> a -> IO ()
watchTree w f p v = do
e <- doesDirectoryExist f
when e $ do
f' <- canonicalizePath f
watching <- isWatchingTree w f'
unless watching $ do
stop <- FS.watchTree
(watcherMan w)
(fromString f')
(p . fromEvent)
(writeChan (watcherChan w) . (,) v . fromEvent)
modifyMVar_ (watcherDirs w) $ return . M.insert f' (True, stop)
watchTree_ :: Watcher () -> FilePath -> (Event -> Bool) -> IO ()
watchTree_ w f p = watchTree w f p ()
unwatchTree :: Watcher a -> FilePath -> IO Bool
unwatchTree w f = do
f' <- canonicalizePath f
stop <- modifyMVar (watcherDirs w) $ return . (M.delete f' &&& M.lookup f')
maybe (return ()) snd stop
return $ isJust stop
isWatchingTree :: Watcher a -> FilePath -> IO Bool
isWatchingTree w f = do
f' <- canonicalizePath f
dirs <- readMVar (watcherDirs w)
return $ isWatchingTree' dirs f'
where
isWatchingTree' :: Map FilePath (Bool, IO ()) -> FilePath -> Bool
isWatchingTree' m dir
| Just (True, _) <- M.lookup dir m = True
| isDrive dir = False
| otherwise = isWatchingTree' m (takeDirectory dir)
readEvent :: Watcher a -> IO (a, Event)
readEvent = readChan . watcherChan
events :: Watcher a -> IO [(a, Event)]
events = getChanContents . watcherChan
onEvent :: Watcher a -> (a -> Event -> IO ()) -> IO ()
onEvent w act = events w >>= mapM_ (uncurry act)
fromEvent :: FS.Event -> Event
fromEvent e = Event t (FS.eventPath e) (utcTimeToPOSIXSeconds $ FS.eventTime e) where
t = case e of
FS.Added _ _ -> Added
FS.Modified _ _ -> Modified
FS.Removed _ _ -> Removed