jbrechtel
77c6de303f
- Remove nonexistent confDebounce field from WatchConfig (fsnotify 0.4.4.0) - Remove unused Generic deriving and GHC.Generics import - Replace .!= with fromMaybe (not re-exported by Data.Yaml) - Add missing Data.Text import in Main.hs - Use git -C flag in runGitIn to run in the correct repo directory - Clean up unused imports
73 lines
3.2 KiB
Haskell
73 lines
3.2 KiB
Haskell
--
|
|
-- Copyright (c) 2012 Mark Dittmer - http://www.markdittmer.org
|
|
-- Developed for a Google Summer of Code project - http://gsoc2012.markdittmer.org
|
|
--
|
|
{-# 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
|
|
|
|
-- Win32-notify has (temporarily?) dropped support for Renamed events.
|
|
fsnEvent :: EventIsDirectory -> FilePath -> 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 -> FilePath -> 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 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 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
|