summaryrefslogtreecommitdiff
path: root/Utility
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-11-12 14:54:02 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-11-12 17:22:34 -0400
commitd03bfb7355d11e271664d4dea51449f8f5059780 (patch)
tree638b735821c6074f31e8556f71d7f6b1f04eb1dd /Utility
parentf869020577d759313494828d1973adcf2916b392 (diff)
build assistant and watcher on windows (doesn't work yet)
Diffstat (limited to 'Utility')
-rw-r--r--Utility/Batch.hs2
-rw-r--r--Utility/Win32Notify.hs64
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