Skip to content
Switch branches/tags
Go to file
Cannot retrieve contributors at this time
-- Copyright (c) 2012 Mark Dittmer -
-- Developed for a Google Summer of Code project -
{-# LANGUAGE MultiParamTypeClasses #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module System.FSNotify.Win32
( FileListener(..)
, NativeManager
) where
import Control.Concurrent
import Control.Monad (when)
import Data.Bits
import qualified Data.Map as Map
import Data.Time (getCurrentTime, UTCTime)
import Prelude
import System.FSNotify.Listener
import System.FSNotify.Path (canonicalizeDirPath)
import System.FSNotify.Types
import System.FilePath
import qualified System.Win32.Notify as WNo
type NativeManager = WNo.WatchManager
-- | Apparently Win32 gives back relative paths, so we pass around the base
-- directory to turn them into absolute ones
type BaseDir = FilePath
-- NEXT TODO: Need to ensure we use properly canonalized paths as
-- event paths. In Linux this required passing the base dir to
-- handle[native]Event.
-- Win32-notify has (temporarily?) dropped support for Renamed events.
fsnEvent :: EventIsDirectory -> BaseDir -> UTCTime -> WNo.Event -> Event
fsnEvent isDirectory basedir timestamp (WNo.Created name) = Added (normalise (basedir </> name)) timestamp isDirectory
fsnEvent isDirectory basedir timestamp (WNo.Modified name) = Modified (normalise (basedir </> name)) timestamp isDirectory
fsnEvent isDirectory basedir timestamp (WNo.Deleted name) = Removed (normalise (basedir </> name)) timestamp isDirectory
handleWNoEvent :: EventIsDirectory -> BaseDir -> ActionPredicate -> EventCallback -> WNo.Event -> IO ()
handleWNoEvent isDirectory basedir actPred callback inoEvent = do
currentTime <- getCurrentTime
let event = fsnEvent isDirectory basedir currentTime inoEvent
when (actPred event) $ callback event
watchDirectory :: Bool -> WatchConfig -> WNo.WatchManager -> FilePath -> ActionPredicate -> EventCallback -> IO (IO ())
watchDirectory isRecursive conf watchManager@(WNo.WatchManager mvarMap) path actPred callback = do
path' <- canonicalizeDirPath path
let dirFlags = foldl (.|.) 0 [WNo.fILE_NOTIFY_CHANGE_DIR_NAME]
-- Start one watch for file events and one for directory events
-- (There seems to be no other way to provide isDirectory information)
wid1 <- WNo.watchDirectory watchManager path' isRecursive fileFlags (handleWNoEvent IsFile path' actPred callback)
wid2 <- WNo.watchDirectory watchManager path' isRecursive dirFlags (handleWNoEvent IsDirectory path' actPred callback)
-- The StopListening action should make sure to remove the watches from the manager after they're killed.
-- Otherwise, a call to killSession would cause us to try to kill them again, resulting in an invalid handle error.
return $ do
WNo.killWatch wid1
modifyMVar_ mvarMap $ \watchMap -> return (Map.delete wid1 watchMap)
WNo.killWatch wid2
modifyMVar_ mvarMap $ \watchMap -> return (Map.delete wid2 watchMap)
instance FileListener WNo.WatchManager () where
-- TODO: This should actually lookup a Windows API version and possibly return
-- Nothing the calls we need are not available. This will require that API
-- version information be exposed by Win32-notify.
initSession _ = Right <$> WNo.initWatchManager
killSession = WNo.killWatchManager
listen = watchDirectory False
listenRecursive = watchDirectory True