Skip to content
Permalink
Branch: master
Find file Copy path
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
80 lines (63 sloc) 3.47 KB
--
-- Copyright (c) 2012 Mark Dittmer - http://www.markdittmer.org
-- Developed for a Google Summer of Code project - http://gsoc2012.markdittmer.org
--
{-# 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 -> EventChannel -> DebouncePayload -> WNo.Event -> IO ()
handleWNoEvent isDirectory basedir actPred chan dbp inoEvent = do
currentTime <- getCurrentTime
let event = fsnEvent isDirectory basedir currentTime inoEvent
when (actPred event) $ writeChan chan event
watchDirectory :: Bool -> WatchConfig -> WNo.WatchManager -> FilePath -> ActionPredicate -> EventChannel -> IO (IO ())
watchDirectory isRecursive conf watchManager@(WNo.WatchManager mvarMap) path actPred chan = do
path' <- canonicalizeDirPath path
dbp <- newDebouncePayload $ confDebounce conf
let fileFlags = foldl (.|.) 0 [WNo.fILE_NOTIFY_CHANGE_FILE_NAME, WNo.fILE_NOTIFY_CHANGE_SIZE, WNo.fILE_NOTIFY_CHANGE_ATTRIBUTES]
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 chan dbp)
wid2 <- WNo.watchDirectory watchManager path' isRecursive dirFlags (handleWNoEvent IsDirectory path' actPred chan dbp)
-- 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
usesPolling = const False
You can’t perform that action at this time.