blob: 8fd676d9ef560ec345bb8d3512fc3a1be6e8987b (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
|
{- FSEvents interface
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Utility.FSEvents where
import Common hiding (isDirectory)
import Utility.Types.DirWatcher
import System.OSX.FSEvents
import qualified System.Posix.Files as Files
import Data.Bits ((.&.))
watchDir :: FilePath -> (FilePath -> Bool) -> WatchHooks -> IO EventStream
watchDir dir ignored hooks = do
unlessM fileLevelEventsSupported $
error "Need at least OSX 10.7.0 for file-level FSEvents"
scan dir
eventStreamCreate [dir] 1.0 True False True handle
where
handle evt
| ignoredPath ignored (eventPath evt) = noop
| otherwise = do
{- More than one flag may be set, if events occurred
- close together.
-
- Order is important..
- If a file is added and then deleted, we'll see it's
- not present, and addHook won't run.
- OTOH, if a file is deleted and then re-added,
- the delHook will run first, followed by the addHook.
-}
when (hasflag eventFlagItemRemoved) $
if hasflag eventFlagItemIsDir
then runhook delDirHook Nothing
else runhook delHook Nothing
{- TODO deal with moving whole directories -}
when (hasflag eventFlagItemCreated || (hasflag eventFlagItemRenamed && not (hasflag eventFlagItemRemoved))) $ do
ms <- getstatus $ eventPath evt
case ms of
Nothing -> noop
Just s
| Files.isSymbolicLink s ->
runhook addSymlinkHook ms
| Files.isRegularFile s ->
runhook addHook ms
| otherwise -> noop
when (hasflag eventFlagItemModified && not (hasflag eventFlagItemIsDir)) $ do
ms <- getstatus $ eventPath evt
runhook modifyHook ms
where
hasflag f = eventFlags evt .&. f /= 0
runhook h s = maybe noop (\a -> a (eventPath 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.isSymbolicLink s ->
runhook addSymlinkHook ms
| Files.isRegularFile s ->
runhook addHook ms
| otherwise ->
noop
where
runhook h s = maybe noop (\a -> a f s) (h hooks)
getstatus = catchMaybeIO . getSymbolicLinkStatus
{- Check each component of the path to see if it's ignored. -}
ignoredPath :: (FilePath -> Bool) -> FilePath -> Bool
ignoredPath ignored = any ignored . map dropTrailingPathSeparator . splitPath
|
