module System.Win32.Notify
( Event(..)
, EventVariety(..)
, Handler
, WatchId(..)
, WatchManager(..)
, initWatchManager
, killWatch
, killWatchManager
, watch
, watchDirectory
) where
import Control.Concurrent
import Control.Concurrent.MVar
import Data.Bits
import Data.List (intersect)
import Data.Map (Map)
import System.Directory
import System.Win32 (closeHandle)
import System.Win32.File
import System.Win32.FileNotify
import qualified Data.Map as Map
data EventVariety
= Modify
| Move
| Create
| Delete
deriving Eq
data Event
= Modified
{ isDirectory :: Bool
, filePath :: FilePath
}
| Created
{ isDirectory :: Bool
, filePath :: FilePath
}
| Deleted
{ isDirectory :: Bool
, filePath :: FilePath
}
deriving (Eq, Show)
type Handler = Event -> IO ()
data WatchId = WatchId ThreadId ThreadId Handle deriving (Eq, Ord, Show)
type WatchMap = Map WatchId Handler
data WatchManager = WatchManager (MVar WatchMap)
void :: IO ()
void = return ()
initWatchManager :: IO WatchManager
initWatchManager = do
mvarMap <- newMVar Map.empty
return (WatchManager mvarMap)
killWatchManager :: WatchManager -> IO ()
killWatchManager (WatchManager mvarMap) = do
watchMap <- readMVar mvarMap
flip mapM_ (Map.keys watchMap) $ killWatch
varietiesToFnFlags :: [EventVariety] -> FileNotificationFlag
varietiesToFnFlags = foldl (.|.) 0 . map evToFnFlag'
where evToFnFlag' :: EventVariety -> FileNotificationFlag
evToFnFlag' ev = case ev of
Modify -> fILE_NOTIFY_CHANGE_LAST_WRITE
Move -> fILE_NOTIFY_CHANGE_FILE_NAME .|. fILE_NOTIFY_CHANGE_DIR_NAME
Create -> fILE_NOTIFY_CHANGE_FILE_NAME .|. fILE_NOTIFY_CHANGE_DIR_NAME
Delete -> fILE_NOTIFY_CHANGE_FILE_NAME .|. fILE_NOTIFY_CHANGE_DIR_NAME
watchDirectory :: WatchManager -> FilePath -> Bool -> [EventVariety] -> Handler -> IO WatchId
watchDirectory (WatchManager mvarMap) dir watchSubTree varieties handler = do
watchHandle <- getWatchHandle dir
chanEvents <- newChan
tid1 <- forkIO $ dispatcher chanEvents
tid2 <- forkIO $ osEventsReader watchHandle chanEvents
modifyMVar_ mvarMap $ \watchMap -> return (Map.insert (WatchId tid1 tid2 watchHandle) handler watchMap)
return (WatchId tid1 tid2 watchHandle)
where
dispatcher :: Chan [Event] -> IO ()
dispatcher chanEvents = do
events <- readChan chanEvents
mapM_ maybeHandle events
dispatcher chanEvents
osEventsReader :: Handle -> Chan [Event] -> IO ()
osEventsReader watchHandle chanEvents = do
events <- (readDirectoryChanges watchHandle watchSubTree (varietiesToFnFlags varieties) >>= actsToEvents)
writeChan chanEvents events
osEventsReader watchHandle chanEvents
maybeHandle :: Handler
maybeHandle event =
if (==) (eventToVariety event) `any` varieties then handler event else void
watch :: WatchManager -> FilePath -> Bool -> [EventVariety] -> IO (WatchId, Chan [Event])
watch (WatchManager mvarMap) dir watchSubTree varieties = do
watchHandle <- getWatchHandle dir
chanEvents <- newChan
tid <- forkIO $ osEventsReader watchHandle chanEvents
modifyMVar_ mvarMap $ \watchMap -> return (Map.insert (WatchId tid tid watchHandle) (\_ -> void) watchMap)
return ((WatchId tid tid watchHandle), chanEvents)
where
osEventsReader :: Handle -> Chan [Event] -> IO ()
osEventsReader watchHandle chanEvents = do
events <- (readDirectoryChanges watchHandle watchSubTree (varietiesToFnFlags varieties) >>= actsToEvents)
writeChan chanEvents events
osEventsReader watchHandle chanEvents
killWatch :: WatchId -> IO ()
killWatch (WatchId tid1 tid2 handle) = do
killThread tid1
if tid1 /= tid2 then killThread tid2 else void
closeHandle handle
eventToVariety :: Event -> EventVariety
eventToVariety event = case event of
Created _ _ -> Create
Deleted _ _ -> Delete
Modified _ _ -> Modify
actsToEvents :: [(Action, String)] -> IO [Event]
actsToEvents = mapM actToEvent
where
actToEvent (act, fn) = do
isDir <- doesDirectoryExist fn
case act of
FileModified -> return $ Modified isDir fn
FileAdded -> return $ Created isDir fn
FileRemoved -> return $ Deleted isDir fn
FileRenamedOld -> return $ Deleted isDir fn
FileRenamedNew -> return $ Created isDir fn