git.iko.soy/streamly
on master help sign in
Update documentation, format, add copyright info
1fd498aHarendra Kumar
credits/COPYRIGHTS.md+8
compare with master
unifiedsplit
@@ -7,6 +7,14 @@ notices in the individual files.
7
7
8* macOS FS Event handling C code adapted from hfsevents package:
8* macOS FS Event handling C code adapted from hfsevents package:
9 * Copyright (c) 2012, Luite Stegeman
9 * Copyright (c) 2012, Luite Stegeman
10+ * http://hackage.haskell.org/package/hfsevents-0.1.6
11+ * See hfsevents-0.1.6.txt for the original license
12+
13+* Some code snippets in Windows FS event handling module are taken from the
14+ fsnotify package.
15+ * Copyright (c) 2012, Mark Dittmer
16+ * http://hackage.haskell.org/package/fsnotify-0.3.0.1/
17+ * See fsnotify-0.3.0.1.txt for the original license
10
18
11## 0.7.1
19## 0.7.1
12
20
credits/fsnotify-0.3.0.1.txtnew file+30
@@ -0,0 +1,30 @@
1+Copyright (c) 2012, Mark Dittmer
2+
3+All rights reserved.
4+
5+Redistribution and use in source and binary forms, with or without
6+modification, are permitted provided that the following conditions are met:
7+
8+ * Redistributions of source code must retain the above copyright
9+ notice, this list of conditions and the following disclaimer.
10+
11+ * Redistributions in binary form must reproduce the above
12+ copyright notice, this list of conditions and the following
13+ disclaimer in the documentation and/or other materials provided
14+ with the distribution.
15+
16+ * Neither the name of Mark Dittmer nor the names of other
17+ contributors may be used to endorse or promote products derived
18+ from this software without specific prior written permission.
19+
20+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
credits/hfsevents-0.1.6.txtnew file+30
@@ -0,0 +1,30 @@
1+Copyright (c) 2012, Luite Stegeman
2+
3+All rights reserved.
4+
5+Redistribution and use in source and binary forms, with or without
6+modification, are permitted provided that the following conditions are met:
7+
8+ * Redistributions of source code must retain the above copyright
9+ notice, this list of conditions and the following disclaimer.
10+
11+ * Redistributions in binary form must reproduce the above
12+ copyright notice, this list of conditions and the following
13+ disclaimer in the documentation and/or other materials provided
14+ with the distribution.
15+
16+ * Neither the name of Luite Stegeman nor the names of other
17+ contributors may be used to endorse or promote products derived
18+ from this software without specific prior written permission.
19+
20+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
src/Streamly/Internal/FileSystem/Event/Windows.hs+179−84
@@ -1,25 +1,58 @@
1+-- Some code snippets are adapted from the fsnotify package.
2+-- http://hackage.haskell.org/package/fsnotify-0.3.0.1/
3+--
1-- |
4-- |
2-- Module : Streamly.Internal.FileSystem.Event.Windows
5-- Module : Streamly.Internal.FileSystem.Event.Windows
3-- Copyright : (c) 2020 Composewell Technologies
6-- Copyright : (c) 2020 Composewell Technologies
4−--
7+-- (c) 2012, Mark Dittmer
5−-- License : BSD3
8+-- License : BSD-3-Clause
6-- Maintainer : streamly@composewell.com
9-- Maintainer : streamly@composewell.com
7-- Stability : experimental
10-- Stability : experimental
8-- Portability : GHC
11-- Portability : GHC
9--
12--
13+-- =Overview
14+--
15+-- Use 'watchTrees'or 'watchPaths' with a list of file system paths you want to
16+-- watch as argument. It returns a stream of 'Event' representing the file
10−-- Just report all events under the paths provided as arguments
17+-- system events occurring under the watched paths.
18+--
19+-- @
20+-- {-\# LANGUAGE MagicHash #-}
21+-- Stream.mapM_ (putStrLn . 'showEvent') $ 'watchTrees' [Array.fromCString\# "path"#]
22+-- @
23+--
24+-- 'Event' is an opaque type. Accessor functions (e.g. 'showEvent' above)
25+-- provided in this module are used to determine the attributes of the event.
26+--
27+-- =Design notes
28+--
29+-- For Windows reference documentation see:
30+--
31+-- * <https://docs.microsoft.com/en-us/windows/win32/api/winnt/ns-winnt-file_notify_information file notify information>
32+-- * <https://docs.microsoft.com/en-us/windows/win32/api/winbase/nf-winbase-readdirectorychangesw read directory changes>
33+--
34+-- We try to keep the macOS\/Linux/Windows event handling APIs and defaults
35+-- semantically and syntactically as close as possible.
36+--
37+-- =Availability
38+--
39+-- As per the Windows reference docs, the fs event notification API is
40+-- available in:
41+--
42+-- * Minimum supported client: Windows XP [desktop apps | UWP apps]
43+-- * Minimum supported server: Windows Server 2003 [desktop apps | UWP apps
11
44
12module Streamly.Internal.FileSystem.Event.Windows
45module Streamly.Internal.FileSystem.Event.Windows
13− (
46+ (
14 -- * Subscribing to events
47 -- * Subscribing to events
15
48
16− -- ** Default configuration
49+ -- ** Default configuration
17 Config
50 Config
18 , Event
51 , Event
19 , Toggle (..)
52 , Toggle (..)
20− , setFlag
53+ , setFlag
21 , defaultConfig
54 , defaultConfig
22− , getConfigFlag
55+ , getConfigFlag
23 , setAllEvents
56 , setAllEvents
24
57
25 -- ** Watch Behavior
58 -- ** Watch Behavior
@@ -32,44 +65,44 @@ module Streamly.Internal.FileSystem.Event.Windows
32 , setModifiedAttribute
65 , setModifiedAttribute
33 , setModifiedSize
66 , setModifiedSize
34 , setModifiedLastWrite
67 , setModifiedLastWrite
35− , setModifiedSecurity
68+ , setModifiedSecurity
36
69
37 -- ** Watch APIs
70 -- ** Watch APIs
38 , watchPaths
71 , watchPaths
39 , watchPathsWith
72 , watchPathsWith
40 , watchTrees
73 , watchTrees
41− , watchTreesWith
74+ , watchTreesWith
42−
75+
43 -- * Handling Events
76 -- * Handling Events
44− , getRelPath
77+ , getRelPath
45 , getRoot
78 , getRoot
46
79
47 -- ** Item CRUD events
80 -- ** Item CRUD events
48 , isCreated
81 , isCreated
49− , isDeleted
82+ , isDeleted
50 , isMovedFrom
83 , isMovedFrom
51 , isMovedTo
84 , isMovedTo
52− , isModified
85+ , isModified
53
86
54 -- ** Exception Conditions
87 -- ** Exception Conditions
55 , isOverflow
88 , isOverflow
56
89
57 -- * Debugging
90 -- * Debugging
58− , showEvent
91+ , showEvent
59− )
92+ )
60where
93where
61
94
62import Control.Monad.IO.Class (MonadIO(liftIO))
95import Control.Monad.IO.Class (MonadIO(liftIO))
63−import Data.Bits ((.|.), (.&.), complement)
96+import Data.Bits ((.|.), (.&.), complement)
64−import Data.Functor.Identity (runIdentity)
97+import Data.Functor.Identity (runIdentity)
65import Data.List.NonEmpty (NonEmpty)
98import Data.List.NonEmpty (NonEmpty)
66import Data.Word (Word8)
99import Data.Word (Word8)
67import Foreign.C.String (peekCWStringLen)
100import Foreign.C.String (peekCWStringLen)
68import Foreign.Marshal.Alloc (alloca, allocaBytes)
101import Foreign.Marshal.Alloc (alloca, allocaBytes)
69−import Foreign.Storable (peekByteOff)
102+import Foreign.Storable (peekByteOff)
70−import Foreign.Ptr (Ptr, FunPtr, castPtr, nullPtr, nullFunPtr, plusPtr)
103+import Foreign.Ptr (Ptr, FunPtr, castPtr, nullPtr, nullFunPtr, plusPtr)
71import Streamly.Prelude (SerialT, parallel)
104import Streamly.Prelude (SerialT, parallel)
72−import System.Win32.File
105+import System.Win32.File
73 ( FileNotificationFlag
106 ( FileNotificationFlag
74 , LPOVERLAPPED
107 , LPOVERLAPPED
75 , closeHandle
108 , closeHandle
@@ -81,10 +114,10 @@ import System.Win32.File
81 , fILE_NOTIFY_CHANGE_ATTRIBUTES
114 , fILE_NOTIFY_CHANGE_ATTRIBUTES
82 , fILE_NOTIFY_CHANGE_SIZE
115 , fILE_NOTIFY_CHANGE_SIZE
83 , fILE_NOTIFY_CHANGE_LAST_WRITE
116 , fILE_NOTIFY_CHANGE_LAST_WRITE
84− , fILE_NOTIFY_CHANGE_SECURITY
117+ , fILE_NOTIFY_CHANGE_SECURITY
85 , fILE_SHARE_READ
118 , fILE_SHARE_READ
86 , fILE_SHARE_WRITE
119 , fILE_SHARE_WRITE
87− , oPEN_EXISTING
120+ , oPEN_EXISTING
88 )
121 )
89import System.Win32.Types (BOOL, DWORD, HANDLE, LPVOID, LPDWORD, failIfFalse_)
122import System.Win32.Types (BOOL, DWORD, HANDLE, LPVOID, LPDWORD, failIfFalse_)
90import qualified Data.List.NonEmpty as NonEmpty
123import qualified Data.List.NonEmpty as NonEmpty
@@ -100,7 +133,7 @@ import Streamly.Internal.Data.Array.Storable.Foreign (Array)
100--
133--
101data Config = Config
134data Config = Config
102 { watchRec :: BOOL
135 { watchRec :: BOOL
103− , createFlags :: DWORD
136+ , createFlags :: DWORD
104 }
137 }
105
138
106-------------------------------------------------------------------------------
139-------------------------------------------------------------------------------
@@ -164,7 +197,7 @@ setModifiedAttribute = setFlag fILE_NOTIFY_CHANGE_ATTRIBUTES
164-- /Internal/
197-- /Internal/
165--
198--
166setModifiedSize :: Toggle -> Config -> Config
199setModifiedSize :: Toggle -> Config -> Config
167−setModifiedSize = setFlag fILE_NOTIFY_CHANGE_SIZE
200+setModifiedSize = setFlag fILE_NOTIFY_CHANGE_SIZE
168
201
169-- | Report when a file last write time is changed.
202-- | Report when a file last write time is changed.
170--
203--
@@ -173,7 +206,7 @@ setModifiedSize = setFlag fILE_NOTIFY_CHANGE_SIZE
173-- /Internal/
206-- /Internal/
174--
207--
175setModifiedLastWrite :: Toggle -> Config -> Config
208setModifiedLastWrite :: Toggle -> Config -> Config
176−setModifiedLastWrite = setFlag fILE_NOTIFY_CHANGE_LAST_WRITE
209+setModifiedLastWrite = setFlag fILE_NOTIFY_CHANGE_LAST_WRITE
177
210
178-- | Report when a file Security attributes is changed.
211-- | Report when a file Security attributes is changed.
179--
212--
@@ -182,7 +215,7 @@ setModifiedLastWrite = setFlag fILE_NOTIFY_CHANGE_LAST_WRITE
182-- /Internal/
215-- /Internal/
183--
216--
184setModifiedSecurity :: Toggle -> Config -> Config
217setModifiedSecurity :: Toggle -> Config -> Config
185−setModifiedSecurity = setFlag fILE_NOTIFY_CHANGE_SECURITY
218+setModifiedSecurity = setFlag fILE_NOTIFY_CHANGE_SECURITY
186
219
187-- | Set all events 'On' or 'Off'.
220-- | Set all events 'On' or 'Off'.
188--
221--
@@ -197,7 +230,7 @@ setAllEvents s =
197 . setModifiedAttribute s
230 . setModifiedAttribute s
198 . setModifiedSize s
231 . setModifiedSize s
199 . setModifiedLastWrite s
232 . setModifiedLastWrite s
200− . setModifiedSecurity s
233+ . setModifiedSecurity s
201
234
202defaultConfig :: Config
235defaultConfig :: Config
203defaultConfig = setAllEvents On $ Config {watchRec = True, createFlags = 0}
236defaultConfig = setAllEvents On $ Config {watchRec = True, createFlags = 0}
@@ -209,22 +242,22 @@ getConfigRecMode :: Config -> BOOL
209getConfigRecMode Config{..} = watchRec
242getConfigRecMode Config{..} = watchRec
210
243
211data Event = Event
244data Event = Event
212− { eventFlags :: DWORD
245+ { eventFlags :: DWORD
213− , eventRelPath :: String
246+ , eventRelPath :: String
214− , eventRootPath :: String
247+ , eventRootPath :: String
215 , totalBytes :: DWORD
248 , totalBytes :: DWORD
216− } deriving (Show, Ord, Eq)
249+ } deriving (Show, Ord, Eq)
217
250
218-- For reference documentation see:
251-- For reference documentation see:
219−--
252+--
220-- See https://docs.microsoft.com/en-us/windows/win32/api/winnt/ns-winnt-file_notify_information
253-- See https://docs.microsoft.com/en-us/windows/win32/api/winnt/ns-winnt-file_notify_information
221data FILE_NOTIFY_INFORMATION = FILE_NOTIFY_INFORMATION
254data FILE_NOTIFY_INFORMATION = FILE_NOTIFY_INFORMATION
222 { fniNextEntryOffset :: DWORD
255 { fniNextEntryOffset :: DWORD
223 , fniAction :: DWORD
256 , fniAction :: DWORD
224 , fniFileName :: String
257 , fniFileName :: String
225− } deriving Show
258+ } deriving Show
226
259
227−type LPOVERLAPPED_COMPLETION_ROUTINE =
260+type LPOVERLAPPED_COMPLETION_ROUTINE =
228 FunPtr ((DWORD, DWORD, LPOVERLAPPED) -> IO ())
261 FunPtr ((DWORD, DWORD, LPOVERLAPPED) -> IO ())
229
262
230-- | A handle for a watch.
263-- | A handle for a watch.
@@ -232,64 +265,80 @@ getWatchHandle :: FilePath -> IO (HANDLE, FilePath)
232getWatchHandle dir = do
265getWatchHandle dir = do
233 h <- createFile dir
266 h <- createFile dir
234 -- Access mode
267 -- Access mode
235− fILE_LIST_DIRECTORY
268+ fILE_LIST_DIRECTORY
236 -- Share mode
269 -- Share mode
237− (fILE_SHARE_READ .|. fILE_SHARE_WRITE)
270+ (fILE_SHARE_READ .|. fILE_SHARE_WRITE)
238 -- Security attributes
271 -- Security attributes
239− Nothing
272+ Nothing
240 -- Create mode, we want to look at an existing directory
273 -- Create mode, we want to look at an existing directory
241− oPEN_EXISTING
274+ oPEN_EXISTING
242 -- File attribute, NOT using OVERLAPPED since we work synchronously
275 -- File attribute, NOT using OVERLAPPED since we work synchronously
243− fILE_FLAG_BACKUP_SEMANTICS
276+ fILE_FLAG_BACKUP_SEMANTICS
244 -- No template file
277 -- No template file
245− Nothing
278+ Nothing
246 return (h, dir)
279 return (h, dir)
247−
280+
248-- For reference documentation see:
281-- For reference documentation see:
249--
282--
250-- See https://docs.microsoft.com/en-us/windows/win32/api/winbase/nf-winbase-readdirectorychangesw
283-- See https://docs.microsoft.com/en-us/windows/win32/api/winbase/nf-winbase-readdirectorychangesw
251−-- Note that this API uses UTF-16 for file system paths:
284+-- Note that this API uses UTF-16 for file system paths:
252-- 1. https://docs.microsoft.com/en-us/windows/win32/intl/unicode-in-the-windows-api
285-- 1. https://docs.microsoft.com/en-us/windows/win32/intl/unicode-in-the-windows-api
253-- 2. https://docs.microsoft.com/en-us/windows/win32/intl/unicode
286-- 2. https://docs.microsoft.com/en-us/windows/win32/intl/unicode
254−foreign import ccall safe
287+foreign import ccall safe
255 "windows.h ReadDirectoryChangesW" c_ReadDirectoryChangesW ::
288 "windows.h ReadDirectoryChangesW" c_ReadDirectoryChangesW ::
256− HANDLE -> LPVOID -> DWORD -> BOOL -> DWORD -> LPDWORD
289+ HANDLE
290+ -> LPVOID
291+ -> DWORD
292+ -> BOOL
293+ -> DWORD
294+ -> LPDWORD
295+ -> LPOVERLAPPED
257− -> LPOVERLAPPED -> LPOVERLAPPED_COMPLETION_ROUTINE -> IO BOOL
296+ -> LPOVERLAPPED_COMPLETION_ROUTINE
297+ -> IO BOOL
258
298
259readDirectoryChangesW ::
299readDirectoryChangesW ::
300+ HANDLE
260− HANDLE -> Ptr FILE_NOTIFY_INFORMATION -> DWORD
301+ -> Ptr FILE_NOTIFY_INFORMATION
302+ -> DWORD
303+ -> BOOL
261− -> BOOL -> FileNotificationFlag -> LPDWORD -> IO ()
304+ -> FileNotificationFlag
262−
305+ -> LPDWORD
306+ -> IO ()
263readDirectoryChangesW h buf bufSize wst f br =
307readDirectoryChangesW h buf bufSize wst f br =
264− failIfFalse_ "ReadDirectoryChangesW" $ c_ReadDirectoryChangesW h (castPtr buf)
308+ let res = c_ReadDirectoryChangesW
265− bufSize wst f br nullPtr nullFunPtr
309+ h (castPtr buf) bufSize wst f br nullPtr nullFunPtr
310+ in failIfFalse_ "ReadDirectoryChangesW" res
266
311
267peekFNI :: Ptr FILE_NOTIFY_INFORMATION -> IO FILE_NOTIFY_INFORMATION
312peekFNI :: Ptr FILE_NOTIFY_INFORMATION -> IO FILE_NOTIFY_INFORMATION
268peekFNI buf = do
313peekFNI buf = do
269 neof <- peekByteOff buf 0
314 neof <- peekByteOff buf 0
270 acti <- peekByteOff buf 4
315 acti <- peekByteOff buf 4
271 fnle <- peekByteOff buf 8
316 fnle <- peekByteOff buf 8
317+ -- Note: The path is UTF-16 encoded C WChars, peekCWStringLen converts
318+ -- UTF-16 to UTF-32 Char String
272 fnam <- peekCWStringLen
319 fnam <- peekCWStringLen
273 -- start of array
320 -- start of array
274 (buf `plusPtr` 12,
321 (buf `plusPtr` 12,
275 -- fnle is the length in *bytes*, and a WCHAR is 2 bytes
322 -- fnle is the length in *bytes*, and a WCHAR is 2 bytes
276− fromEnum (fnle :: DWORD) `div` 2)
323+ fromEnum (fnle :: DWORD) `div` 2)
277 return $ FILE_NOTIFY_INFORMATION neof acti fnam
324 return $ FILE_NOTIFY_INFORMATION neof acti fnam
278
325
326+readChangeEvents ::
279−readChangeEvents :: Ptr FILE_NOTIFY_INFORMATION -> String -> DWORD -> IO [Event]
327+ Ptr FILE_NOTIFY_INFORMATION -> String -> DWORD -> IO [Event]
280−readChangeEvents pfni root bytesRet = do
328+readChangeEvents pfni root bytesRet = do
281 fni <- peekFNI pfni
329 fni <- peekFNI pfni
282 let entry = Event
330 let entry = Event
283− { eventFlags = fniAction fni
331+ { eventFlags = fniAction fni
284− , eventRelPath = fniFileName fni
332+ , eventRelPath = fniFileName fni
285 , eventRootPath = root
333 , eventRootPath = root
286 , totalBytes = bytesRet
334 , totalBytes = bytesRet
287− }
335+ }
288− nioff = fromEnum $ fniNextEntryOffset fni
336+ nioff = fromEnum $ fniNextEntryOffset fni
337+ entries <-
289− entries <- if nioff == 0
338+ if nioff == 0
290− then return []
339+ then return []
291− else readChangeEvents (pfni `plusPtr` nioff) root bytesRet
340+ else readChangeEvents (pfni `plusPtr` nioff) root bytesRet
292− return $ entry :entries
341+ return $ entry : entries
293
342
294readDirectoryChanges ::
343readDirectoryChanges ::
295 String -> HANDLE -> Bool -> FileNotificationFlag -> IO [Event]
344 String -> HANDLE -> Bool -> FileNotificationFlag -> IO [Event]
@@ -300,7 +349,7 @@ readDirectoryChanges root h wst mask = do
300 readDirectoryChangesW h buffer (toEnum maxBuf) wst mask bret
349 readDirectoryChangesW h buffer (toEnum maxBuf) wst mask bret
301 bytesRet <- peekByteOff bret 0
350 bytesRet <- peekByteOff bret 0
302 readChangeEvents buffer root bytesRet
351 readChangeEvents buffer root bytesRet
303−
352+
304type FileAction = DWORD
353type FileAction = DWORD
305
354
306fILE_ACTION_ADDED :: FileAction
355fILE_ACTION_ADDED :: FileAction
@@ -322,19 +371,20 @@ eventStreamAggr :: (HANDLE, FilePath, Config) -> SerialT IO Event
322eventStreamAggr (handle, rootPath, cfg) = do
371eventStreamAggr (handle, rootPath, cfg) = do
323 let recMode = getConfigRecMode cfg
372 let recMode = getConfigRecMode cfg
324 flagMasks = getConfigFlag cfg
373 flagMasks = getConfigFlag cfg
325− S.concatMap S.fromList $ S.repeatM
374+ S.concatMap S.fromList $ S.repeatM
326 $ readDirectoryChanges rootPath handle recMode flagMasks
375 $ readDirectoryChanges rootPath handle recMode flagMasks
327
376
328−pathsToHandles ::
377+pathsToHandles ::
329 NonEmpty FilePath -> Config -> SerialT IO (HANDLE, FilePath, Config)
378 NonEmpty FilePath -> Config -> SerialT IO (HANDLE, FilePath, Config)
330pathsToHandles paths cfg = do
379pathsToHandles paths cfg = do
331 let pathStream = S.fromList (NonEmpty.toList paths)
380 let pathStream = S.fromList (NonEmpty.toList paths)
332 st2 = S.mapM getWatchHandle pathStream
381 st2 = S.mapM getWatchHandle pathStream
333− S.map (\(h, f) -> (h, f, cfg)) st2
382+ S.map (\(h, f) -> (h, f, cfg)) st2
334
383
335-------------------------------------------------------------------------------
384-------------------------------------------------------------------------------
336-- Utilities
385-- Utilities
337-------------------------------------------------------------------------------
386-------------------------------------------------------------------------------
387+
338utf8ToString :: Array Word8 -> FilePath
388utf8ToString :: Array Word8 -> FilePath
339utf8ToString = runIdentity . S.toList . U.decodeUtf8 . A.toStream
389utf8ToString = runIdentity . S.toList . U.decodeUtf8 . A.toStream
340
390
@@ -357,17 +407,18 @@ closePathHandleStream = S.mapM_ (\(h, _, _) -> closeHandle h)
357--
407--
358-- /Internal/
408-- /Internal/
359--
409--
360−watchPathsWith ::
410+watchPathsWith ::
361− (Config -> Config)
411+ (Config -> Config)
362− -> NonEmpty (Array Word8)
412+ -> NonEmpty (Array Word8)
363 -> SerialT IO Event
413 -> SerialT IO Event
364watchPathsWith f paths =
414watchPathsWith f paths =
365 S.bracket before after (S.concatMapWith parallel eventStreamAggr)
415 S.bracket before after (S.concatMapWith parallel eventStreamAggr)
366
416
367 where
417 where
368
418
369− before = return $ pathsToHandles (utf8ToStringList paths)
419+ before =
370− (f $ setRecursiveMode False defaultConfig)
420+ let cfg = f $ setRecursiveMode False defaultConfig
421+ in return $ pathsToHandles (utf8ToStringList paths) cfg
371 after = liftIO . closePathHandleStream
422 after = liftIO . closePathHandleStream
372
423
373-- | Like 'watchPathsWith' but uses the 'defaultConfig' options.
424-- | Like 'watchPathsWith' but uses the 'defaultConfig' options.
@@ -389,17 +440,18 @@ watchPaths = watchPathsWith id
389--
440--
390-- /Internal/
441-- /Internal/
391--
442--
392−watchTreesWith ::
443+watchTreesWith ::
393− (Config -> Config)
444+ (Config -> Config)
394− -> NonEmpty (Array Word8)
445+ -> NonEmpty (Array Word8)
395− -> SerialT IO Event
446+ -> SerialT IO Event
396−watchTreesWith f paths =
447+watchTreesWith f paths =
397 S.bracket before after (S.concatMapWith parallel eventStreamAggr)
448 S.bracket before after (S.concatMapWith parallel eventStreamAggr)
398
449
399 where
450 where
400
451
401− before = return $ pathsToHandles (utf8ToStringList paths)
452+ before =
402− (f $ setRecursiveMode True defaultConfig)
453+ let cfg = f $ setRecursiveMode True defaultConfig
454+ in return $ pathsToHandles (utf8ToStringList paths) cfg
403 after = liftIO . closePathHandleStream
455 after = liftIO . closePathHandleStream
404
456
405-- | Like 'watchTreesWith' but uses the 'defaultConfig' options.
457-- | Like 'watchTreesWith' but uses the 'defaultConfig' options.
@@ -409,35 +461,78 @@ watchTreesWith f paths =
409-- @
461-- @
410--
462--
411watchTrees :: NonEmpty (Array Word8) -> SerialT IO Event
463watchTrees :: NonEmpty (Array Word8) -> SerialT IO Event
412−watchTrees = watchTreesWith id
464+watchTrees = watchTreesWith id
413−
414
465
415getFlag :: DWORD -> Event -> Bool
466getFlag :: DWORD -> Event -> Bool
416getFlag mask Event{..} = eventFlags == mask
467getFlag mask Event{..} = eventFlags == mask
417
468
469+-- XXX Change the type to Array Word8 to make it compatible with other APIs.
470+--
471+-- | Get the file system object path for which the event is generated, relative
472+-- to the watched root. The path is a UTF-8 encoded array of bytes.
473+--
474+-- /Internal/
475+--
418getRelPath :: Event -> String
476getRelPath :: Event -> String
419getRelPath Event{..} = eventRelPath
477getRelPath Event{..} = eventRelPath
420
478
479+-- XXX Change the type to Array Word8 to make it compatible with other APIs.
480+--
481+-- | Get the watch root directory to which this event belongs.
482+--
483+-- /Internal/
484+--
421getRoot :: Event -> String
485getRoot :: Event -> String
422getRoot Event{..} = eventRootPath
486getRoot Event{..} = eventRootPath
423
487
488+-- XXX need to document the exact semantics of these.
489+--
490+-- | File/directory created in watched directory.
491+--
492+-- /Internal/
493+--
424isCreated :: Event -> Bool
494isCreated :: Event -> Bool
425isCreated = getFlag fILE_ACTION_ADDED
495isCreated = getFlag fILE_ACTION_ADDED
426
496
497+-- | File/directory deleted from watched directory.
498+--
499+-- /Internal/
500+--
427isDeleted :: Event -> Bool
501isDeleted :: Event -> Bool
428isDeleted = getFlag fILE_ACTION_REMOVED
502isDeleted = getFlag fILE_ACTION_REMOVED
429
503
504+-- | Generated for the original path when an object is moved from under a
505+-- monitored directory.
506+--
507+-- /Internal/
508+--
430isMovedFrom :: Event -> Bool
509isMovedFrom :: Event -> Bool
431isMovedFrom = getFlag fILE_ACTION_RENAMED_OLD_NAME
510isMovedFrom = getFlag fILE_ACTION_RENAMED_OLD_NAME
432
511
512+-- | Generated for the new path when an object is moved under a monitored
513+-- directory.
514+--
515+-- /Internal/
516+--
433isMovedTo :: Event -> Bool
517isMovedTo :: Event -> Bool
434isMovedTo = getFlag fILE_ACTION_RENAMED_NEW_NAME
518isMovedTo = getFlag fILE_ACTION_RENAMED_NEW_NAME
435
519
520+-- XXX This event is generated only for files and not directories?
521+--
522+-- | Determine whether the event indicates modification of an object within the
523+-- monitored path.
524+--
525+-- /Internal/
526+--
436isModified :: Event -> Bool
527isModified :: Event -> Bool
437isModified = getFlag fILE_ACTION_MODIFIED
528isModified = getFlag fILE_ACTION_MODIFIED
438
529
439−-- | If the buffer overflows, ReadDirectoryChangesW will still return true,
440−-- but the entire contents of the buffer are discarded.
530+-- | If the buffer overflows, entire contents of the buffer are discarded,
531+-- therefore, events are lost. The user application must scan everything under
532+-- the watched paths to know the current state.
533+--
534+-- /Internal/
535+--
441isOverflow :: Event -> Bool
536isOverflow :: Event -> Bool
442isOverflow Event{..} = totalBytes == 0
537isOverflow Event{..} = totalBytes == 0
443
538
@@ -447,11 +542,11 @@ isOverflow Event{..} = totalBytes == 0
447
542
448-- | Convert an 'Event' record to a String representation.
543-- | Convert an 'Event' record to a String representation.
449showEvent :: Event -> String
544showEvent :: Event -> String
450−showEvent ev@Event{..} =
545+showEvent ev@Event{..} =
451 "--------------------------"
546 "--------------------------"
452 ++ "\nRoot = " ++ show (getRoot ev)
547 ++ "\nRoot = " ++ show (getRoot ev)
453 ++ "\nPath = " ++ show (getRelPath ev)
548 ++ "\nPath = " ++ show (getRelPath ev)
454− ++ "\nFlags " ++ show eventFlags
549+ ++ "\nFlags " ++ show eventFlags
455 ++ showev isOverflow "Overflow"
550 ++ showev isOverflow "Overflow"
456 ++ showev isCreated "Created"
551 ++ showev isCreated "Created"
457 ++ showev isDeleted "Deleted"
552 ++ showev isDeleted "Deleted"
@@ -460,4 +555,4 @@ showEvent ev@Event{..} =
460 ++ showev isMovedTo "MovedTo"
555 ++ showev isMovedTo "MovedTo"
461 ++ "\n"
556 ++ "\n"
462
557
463− where showev f str = if f ev then "\n" ++ str else ""
558+ where showev f str = if f ev then "\n" ++ str else ""
streamly.cabal+5−3
@@ -128,6 +128,8 @@ extra-source-files:
128 credits/bjoern-2008-2009.txt
128 credits/bjoern-2008-2009.txt
129 credits/clock-0.7.2.txt
129 credits/clock-0.7.2.txt
130 credits/foldl-1.4.5.txt
130 credits/foldl-1.4.5.txt
131+ credits/fsnotify-0.3.0.1.txt
132+ credits/hfsevents-0.1.6.txt
131 credits/pipes-concurrency-2.0.8.txt
133 credits/pipes-concurrency-2.0.8.txt
132 credits/primitive-0.7.0.0.txt
134 credits/primitive-0.7.0.0.txt
133 credits/transient-0.5.5.txt
135 credits/transient-0.5.5.txt
@@ -229,7 +231,7 @@ common compile-options
229 cpp-options: -DCABAL_OS_LINUX
231 cpp-options: -DCABAL_OS_LINUX
230
232
231 if os(windows)
233 if os(windows)
232− cpp-options: -DCABAL_OS_WINDOWS
234+ cpp-options: -DCABAL_OS_WINDOWS
233
235
234 if flag(streamk)
236 if flag(streamk)
235 cpp-options: -DUSE_STREAMK_ONLY
237 cpp-options: -DUSE_STREAMK_ONLY
@@ -368,7 +370,7 @@ library
368 if os(windows)
370 if os(windows)
369 c-sources: src/Streamly/Internal/Data/Time/Windows.c
371 c-sources: src/Streamly/Internal/Data/Time/Windows.c
370 exposed-modules: Streamly.Internal.FileSystem.Event.Windows
372 exposed-modules: Streamly.Internal.FileSystem.Event.Windows
371− build-depends: Win32 >= 2.6 && < 2.9
373+ build-depends: Win32 >= 2.6 && < 2.10
372
374
373 if os(darwin)
375 if os(darwin)
374 frameworks: Cocoa
376 frameworks: Cocoa
@@ -467,7 +469,7 @@ library
467 , Streamly.Internal.Data.Stream.StreamDK
469 , Streamly.Internal.Data.Stream.StreamDK
468 , Streamly.Internal.Data.Stream.Enumeration
470 , Streamly.Internal.Data.Stream.Enumeration
469 , Streamly.Internal.Data.Stream.Prelude
471 , Streamly.Internal.Data.Stream.Prelude
470−
472+
471 -- Higher level streams
473 -- Higher level streams
472 , Streamly.Internal.Data.Stream.IsStream
474 , Streamly.Internal.Data.Stream.IsStream
473 , Streamly.Internal.Data.Stream.SVar
475 , Streamly.Internal.Data.Stream.SVar
test/Streamly/Test/FileSystem/Event.hs+9−6
@@ -9,13 +9,13 @@
9--
9--
10-- Just report all events under the paths provided as arguments
10-- Just report all events under the paths provided as arguments
11module Main (main) where
11module Main (main) where
12−
12+
13−import Control.Monad.IO.Class (MonadIO)
13+import Control.Monad.IO.Class (MonadIO)
14import Data.Function ((&))
14import Data.Function ((&))
15import Data.List.NonEmpty (NonEmpty)
15import Data.List.NonEmpty (NonEmpty)
16import Data.Word (Word8)
16import Data.Word (Word8)
17import System.Environment (getArgs)
17import System.Environment (getArgs)
18−import Streamly.Prelude (SerialT)
18+import Streamly.Prelude (SerialT)
19import Streamly.Internal.Data.Array.Storable.Foreign (Array)
19import Streamly.Internal.Data.Array.Storable.Foreign (Array)
20
20
21import qualified Streamly.Unicode.Stream as Unicode
21import qualified Streamly.Unicode.Stream as Unicode
@@ -35,22 +35,25 @@ import qualified Streamly.Internal.FileSystem.Event.Windows as Event
35-------------------------------------------------------------------------------
35-------------------------------------------------------------------------------
36-- Utilities
36-- Utilities
37-------------------------------------------------------------------------------
37-------------------------------------------------------------------------------
38+
38toUtf8 :: MonadIO m => String -> m (Array Word8)
39toUtf8 :: MonadIO m => String -> m (Array Word8)
39toUtf8 = Array.fromStream . Unicode.encodeUtf8' . Stream.fromList
40toUtf8 = Array.fromStream . Unicode.encodeUtf8' . Stream.fromList
40
41
41-------------------------------------------------------------------------------
42-------------------------------------------------------------------------------
42-- Main
43-- Main
43-------------------------------------------------------------------------------
44-------------------------------------------------------------------------------
45+
44watchPaths :: NonEmpty (Array Word8) -> SerialT IO Event.Event
46watchPaths :: NonEmpty (Array Word8) -> SerialT IO Event.Event
45−#if defined(CABAL_OS_LINUX)
47+#if defined(CABAL_OS_LINUX)
46watchPaths = Event.watchPaths
48watchPaths = Event.watchPaths
47−#else
49+#else
48watchPaths = Event.watchTrees
50watchPaths = Event.watchTrees
49#endif
51#endif
50
52
51main :: IO ()
53main :: IO ()
52main = do
54main = do
53− args <- getArgs
55+ args <- getArgs
54 paths <- mapM toUtf8 args
56 paths <- mapM toUtf8 args
57+
55 watchPaths (NonEmpty.fromList paths)
58 watchPaths (NonEmpty.fromList paths)
56 & Stream.mapM_ (putStrLn . Event.showEvent)
59 & Stream.mapM_ (putStrLn . Event.showEvent)