diff options
Diffstat (limited to 'Utility')
| -rw-r--r-- | Utility/Batch.hs | 2 | ||||
| -rw-r--r-- | Utility/Win32Notify.hs | 64 |
2 files changed, 66 insertions, 0 deletions
diff --git a/Utility/Batch.hs b/Utility/Batch.hs index 011d30c94..035a2eb04 100644 --- a/Utility/Batch.hs +++ b/Utility/Batch.hs @@ -10,7 +10,9 @@ module Utility.Batch where import Common +#ifndef mingw32_HOST_OS import qualified Build.SysConfig +#endif #if defined(linux_HOST_OS) || defined(__ANDROID__) import Control.Concurrent.Async diff --git a/Utility/Win32Notify.hs b/Utility/Win32Notify.hs new file mode 100644 index 000000000..3493b9e9a --- /dev/null +++ b/Utility/Win32Notify.hs @@ -0,0 +1,64 @@ +{- Win32-notify interface + - + - Copyright 2013 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Utility.Win32Notify where + +import Common hiding (isDirectory) +import Utility.DirWatcher.Types + +import System.Win32.Notify + +watchDir :: FilePath -> (FilePath -> Bool) -> WatchHooks -> IO WatchManager +watchDir dir ignored hooks = do + scan dir + wm <- initWatchManager + void $ watchDirectory wm dir True [Create, Delete, Modify, Move] handle + retufn wm + where + handle evt + | ignoredPath ignored (filePath evt) = noop + | otherwise = case eventToVariety evt of + Delete + | isDirectory evt -> runhook delDirHook Nothing + | otherwise -> runhook delHook Nothing + Create + | isDirectory evt -> noop + | otherwise -> runhook addHook Nothing + Modify + | isDirectory evt -> noop + {- Add hooks are run when a file is modified for + - compatability with INotify, which calls the add + - hook when a file is closed, and so tends to call + - both add and modify for file modifications. -} + | otherwise -> do + runHook addHook Nothing + runHook modifyHook Nothing + where + runhook h s = maybe noop (\a -> a (filePath evt) s) (h hooks) + + scan d = unless (ignoredPath ignored d) $ + mapM_ go =<< dirContentsRecursive d + where + go f + | ignoredPath ignored f = noop + | otherwise = do + ms <- getstatus f + case ms of + Nothing -> noop + Just s + | Files.isRegularFile s -> + runhook addHook ms + | otherwise -> + noop + where + runhook h s = maybe noop (\a -> a f s) (h hooks) + + getstatus = catchMaybeIO . getFileStatus + +{- Check each component of the path to see if it's ignored. -} +ignoredPath :: (FilePath -> Bool) -> FilePath -> Bool +ignoredPath ignored = any ignored . map dropTrailingPathSeparator . splitPath |