@@ -6,827 +6,147 @@
66-- Stability : experimental
77-- Portability : GHC
88--
9−module Streamly.Test.FileSystem.Event.Linux (testAllEvents, testCommonEvents) where
9+module Streamly.Test.FileSystem.Event.Linux (main) where
1010
11−import Control.Concurrent (MVar, newEmptyMVar, putMVar, takeMVar, threadDelay)
12−import Control.Monad.IO.Class (MonadIO)
13−import Data.Char (ord)
14−import Data.Functor.Identity (runIdentity)
15−import Data.List.NonEmpty (NonEmpty)
16−import Data.Maybe (fromJust)
17−import Data.Word (Word8)
18−import System.Directory
19− ( createDirectoryIfMissing
20− , createDirectoryLink
21− , removeFile
22− , removeDirectory
23− , removePathForcibly
24− , renameDirectory
25− , renamePath
26− )
27−import System.FilePath ((</>))
28−import System.IO.Temp (withSystemTempDirectory)
29−import System.IO.Unsafe (unsafePerformIO)
30−import Streamly.Internal.Data.Array.Foreign (Array)
31−
32−import qualified Data.List.NonEmpty as NonEmpty
33−import qualified Data.Set as Set
34−import qualified Streamly.Unicode.Stream as Unicode
35−import qualified Streamly.Internal.Data.Array.Foreign as Array
36−import qualified Streamly.Internal.Data.Fold as FL
37−import qualified Streamly.Internal.Data.Parser as PR
38−import qualified Streamly.Internal.Data.Stream.IsStream as S
39−import qualified Streamly.Internal.Unicode.Stream as U
11+import Streamly.Internal.FileSystem.Event.Linux (Event)
4012import qualified Streamly.Internal.FileSystem.Event.Linux as Event
4113
42−import Test.Hspec
43−
44−-------------------------------------------------------------------------------
45−-- Utilities
46−-------------------------------------------------------------------------------
47−
48−toUtf8 :: MonadIO m => String -> m (Array Word8)
49−toUtf8 = Array.fromStream . Unicode.encodeUtf8' . S.fromList
50−
51−utf8ToString :: Array Word8 -> String
52−utf8ToString = runIdentity . S.toList . U.decodeUtf8' . Array.toStream
53−
54−timeout :: IO String
55−timeout = threadDelay 5000000 >> return "Timeout"
56−
57−fseventDir :: String
58−fseventDir = "fsevent_dir"
59−
60−eoTask :: String
61−eoTask = "EOTask"
62−
63−-- XXX Make the getRelPath type same on windows and other platforms
64−eventPredicate :: Event.Event -> Bool
65−eventPredicate ev =
66− if (utf8ToString $ Event.getRelPath ev) == eoTask
67− then False
68− else True
69−
70−-------------------------------------------------------------------------------
71−-- Event matching utilities
72−-------------------------------------------------------------------------------
73−
74−removeTrailingSlash :: Array Word8 -> Array Word8
75−removeTrailingSlash path =
76− if Array.length path == 0
77− then path
78− else
79− let mx = Array.getIndex path (Array.length path - 1)
80− in case mx of
81− Nothing -> error "removeTrailingSlash: Bug: Invalid index"
82− Just x ->
83− if x == fromIntegral (ord '/')
84− -- XXX need array slicing
85− then unsafePerformIO
86− $ Array.fromStreamN (Array.length path - 1)
87− $ Array.toStream path
88− else path
89−
90−
91−-- XXX Return a tuple (path, flags) instead of appending flags to path. And
92−-- then check the flags using an event mask.
93−
94−showEventShort :: Event.Event -> String
95−showEventShort ev@Event.Event{..} =
96− utf8ToString (removeTrailingSlash $ Event.getRelPath ev)
97− ++ "_" ++ show eventFlags
98− -- ++ showev Event.isDir "DirX"
99− ++ showev Event.isEventsLost "Overflow"
100−
101− ++ showev Event.isRootUnwatched "RootUnwatched"
102− ++ showev Event.isRootDeleted "RootDeleted"
103− ++ showev Event.isRootMoved "RootMoved"
104− ++ showev Event.isRootUnmounted "RootUnmounted"
105−
106− ++ showev Event.isMetadataChanged "MetadataChanged"
107−
108− ++ showev Event.isAccessed "Accessed"
109− ++ showev Event.isOpened "Opened"
110− ++ showev Event.isWriteClosed "WriteClosed"
111− ++ showev Event.isNonWriteClosed "NonWriteClosed"
112−
113− ++ showev Event.isCreated "Created"
114− ++ showev Event.isDeleted "Deleted"
115− ++ showev Event.isModified "Modified"
116− ++ showev Event.isMovedFrom "MovedFrom"
117− ++ showev Event.isMovedTo "MovedTo"
118− ++ showev Event.isDir "Dir"
119−
120− where showev f str = if f ev then "_" ++ str else ""
121−
122−type EventChecker = FilePath -> MVar () -> [String] -> IO String
123−type EventWatch = NonEmpty (Array Word8) -> S.SerialT IO Event.Event
124−type ToEventList = S.SerialT IO Event.Event -> IO [Event.Event]
125−
126−
127−
128−
129−-------------------------------------------------------------------------------
130−-- Event Watcher
131−-------------------------------------------------------------------------------
132−
133−eventListWithFixLen :: Int -> ToEventList
134−eventListWithFixLen count = S.toList . S.take count --51/20
135−
136−eventListWithEOtask :: ToEventList
137−eventListWithEOtask = S.parse (PR.takeWhile eventPredicate FL.toList)
138−
139−checkEvents :: ToEventList -> EventWatch -> EventChecker
140−checkEvents toEL ew rootPath m matchList = do
141− let args = [rootPath]
142− paths <- mapM toUtf8 args
143− putStrLn ("Watch started !!!! on Path " ++ rootPath)
144− events <- toEL
145− $ S.before (putMVar m ())
146− $ ew (NonEmpty.fromList paths)
147− let eventStr = map showEventShort events
148− let baseSet = Set.fromList matchList
149− resultSet = Set.fromList eventStr
150− if baseSet `Set.isSubsetOf` resultSet
151− then
152− return "PASS"
153− else do
154− putStrLn $ "baseSet " ++ show matchList
155− putStrLn $ "resultSet " ++ show eventStr
156− return "Mismatch"
157−
158−-------------------------------------------------------------------------------
159−-- FS Event Generators
160−-------------------------------------------------------------------------------
161−
162−checker :: S.IsStream t =>
163− EventChecker -> FilePath -> MVar () -> [String] -> t IO String
164−checker ec rootPath synch matchList =
165− S.fromEffect (ec rootPath synch matchList)
166− `S.parallelFst`
167− S.fromEffect timeout
168−
169−-------------------------------------------------------------------------------
170−-- Test Drivers
171−-------------------------------------------------------------------------------
172−
173−driver ::
174− EventChecker
175− -> ( String
176− , FilePath -> IO ()
177− , FilePath -> IO ()
178− , [String]
179− , Bool
180− )
181− -> SpecWith ()
182−driver ec (desc, pre, ops, events, sym) = it desc $ runTest `shouldReturn` "PASS"
183−
184− where
14+import Streamly.Test.FileSystem.Event.Common
18515
186− runTest = do
187− sync <- newEmptyMVar
188− withSystemTempDirectory fseventDir $ \fp ->
189− if sym
190− then do
191− createDirectoryLink fp (fp ++ "SymLink")
192− runTest0 (fp ++ "SymLink") sync
193− else runTest0 fp sync
194−
195− runTest0 fp sync = do
196− pre fp
197− let eventStream = checker ec fp sync events
198− fsOps = S.fromEffect $ runFSOps fp sync
199− fmap fromJust $ S.head $ eventStream `S.parallelFst` fsOps
200−
201− runFSOps fp sync = do
202− _ <- takeMVar sync
203− threadDelay 200000
204− ops fp
205− -- 'EOTask Created dir' event gets out of order so need to wait here
206− threadDelay 200000 -- Why this delay?
207− createDirectoryIfMissing True (fp </> eoTask)
208− threadDelay 10000000
209− error "fs ops timed out"
210−
211−-------------------------------------------------------------------------------
212−-- Main
213−-------------------------------------------------------------------------------
16+moduleName :: String
17+moduleName = "FileSystem.Event.Linux"
21418
215−testDesc,
216− testDescRemoveRootDir,
217− testDescRemoveRootDirSymLink,
218− testDescMoveRootDir,
219− testDescCommon,
220− testDescMoveRootDirCommon,
221− testDescRemoveRootDirCommon,
222− testDescRemoveRootDirSymLinkCommon ::
223− [ ( String -- test description
224− , FilePath -> IO () -- pre test operation
225− , FilePath -> IO () -- file system actions
226− , [String] -- expected events
227− , Bool ) -- SymLink
19+dirTouchEvents :: String -> [([Char], Event -> Bool)]
20+dirTouchEvents dir =
21+ [ (dir, dirEvent Event.isOpened)
22+ , (dir, dirEvent Event.isAccessed)
23+ , (dir, dirEvent Event.isNonWriteClosed)
22824 ]
229−testDesc =
230− [
231− ( "Create a single directory"
232− , const (return ())
233− , \fp -> createDirectoryIfMissing True (fp </> "dir1Single")
234− , [ "_1073741856_Opened_Dir"
235− , "_1073741825_Accessed_Dir"
236− , "_1073741840_NonWriteClosed_Dir"
237− , "dir1Single_1073742080_Created_Dir"
238− , "dir1Single_1073741856_Opened_Dir"
239− , "dir1Single_1073741825_Accessed_Dir"
240− , "dir1Single_1073741840_NonWriteClosed_Dir"
241− ]
242− , False
243− )
244− , ( "Remove a single directory"
245− , \fp -> createDirectoryIfMissing True (fp </> "dir1Single")
246− , \fp -> removeDirectory (fp </> "dir1Single")
247− , [ "_1073741856_Opened_Dir"
248− , "_1073741825_Accessed_Dir"
249− , "_1073741840_NonWriteClosed_Dir"
250− , "dir1Single_1073741856_Opened_Dir"
251− , "dir1Single_1073741825_Accessed_Dir"
252− , "dir1Single_1073741840_NonWriteClosed_Dir"
253− , "dir1Single_1024_RootDeleted"
254− , "dir1Single_32768_RootUnwatched"
255− , "dir1Single_1073742336_Deleted_Dir"
256− ]
257− , False
258− )
259− , ( "Rename a single directory"
260− , \fp -> createDirectoryIfMissing True (fp </> "dir1Single")
261− , \fp ->
262− let spath = fp </> "dir1Single"
263− tpath = fp </> "dir1SingleRenamed"
264− in renameDirectory spath tpath
265− , [ "_1073741856_Opened_Dir"
266− , "_1073741825_Accessed_Dir"
267− , "_1073741840_NonWriteClosed_Dir"
268− , "dir1Single_1073741856_Opened_Dir"
269− , "dir1Single_1073741825_Accessed_Dir"
270− , "dir1Single_1073741840_NonWriteClosed_Dir"
271− , "dir1Single_1073741888_MovedFrom_Dir"
272− , "dir1SingleRenamed_1073741952_MovedTo_Dir"
273− , "dir1Single_2048_RootMoved"
274− ]
275− , False
276− )
277− , ( "Create a nested directory"
278− , const (return ())
279− , \fp ->
280− createDirectoryIfMissing True (fp </> "dir1" </> "dir2" </> "dir3")
281− , [ "_1073741856_Opened_Dir"
282− , "_1073741825_Accessed_Dir"
283− , "_1073741840_NonWriteClosed_Dir"
284− , "dir1_1073742080_Created_Dir"
285− , "dir1_1073741856_Opened_Dir"
286− , "dir1_1073741825_Accessed_Dir"
287− , "dir1_1073741840_NonWriteClosed_Dir"
288− , "dir1/dir2_1073741856_Opened_Dir"
289− , "dir1/dir2_1073741825_Accessed_Dir"
290− , "dir1/dir2_1073741840_NonWriteClosed_Dir"
291− , "dir1/dir2/dir3_1073741856_Opened_Dir"
292− , "dir1/dir2/dir3_1073741825_Accessed_Dir"
293− , "dir1/dir2/dir3_1073741840_NonWriteClosed_Dir"
294− ]
295− , False
296− )
297− , ( "Rename a nested directory"
298− , \fp -> createDirectoryIfMissing True
299− (fp </> "dir1" </> "dir2" </> "dir3")
300− , \fp ->
301− let spath = fp </> "dir1" </> "dir2" </> "dir3"
302− tpath = fp </> "dir1" </> "dir2" </> "dir3Renamed"
303− in renameDirectory spath tpath
304− , [ "_1073741856_Opened_Dir"
305− , "_1073741825_Accessed_Dir"
306− , "_1073741840_NonWriteClosed_Dir"
307− , "dir1_1073741856_Opened_Dir"
308− , "dir1_1073741825_Accessed_Dir"
309− , "dir1_1073741840_NonWriteClosed_Dir"
310− , "dir1/dir2_1073741856_Opened_Dir"
311− , "dir1/dir2_1073741825_Accessed_Dir"
312− , "dir1/dir2_1073741840_NonWriteClosed_Dir"
313− , "dir1/dir2/dir3_1073741856_Opened_Dir"
314− , "dir1/dir2/dir3_1073741825_Accessed_Dir"
315− , "dir1/dir2/dir3_1073741840_NonWriteClosed_Dir"
316− , "dir1/dir2/dir3_1073741888_MovedFrom_Dir"
317− , "dir1/dir2/dir3Renamed_1073741952_MovedTo_Dir"
318− , "dir1/dir2/dir3_2048_RootMoved"
319− ]
320− , False
321− )
322− , ( "Create a file in root Dir"
323− , const (return ())
324− , \fp -> writeFile (fp </> "FileCreated.txt") "Test Data"
325− , [ "_1073741856_Opened_Dir"
326− , "_1073741825_Accessed_Dir"
327− , "_1073741840_NonWriteClosed_Dir"
328− , "FileCreated.txt_256_Created"
329− , "FileCreated.txt_32_Opened"
330− , "FileCreated.txt_2_Modified"
331− , "FileCreated.txt_8_WriteClosed"
332− ]
333− , False
334− )
335− , ( "Remove a file in root Dir"
336− , \fp -> writeFile (fp </> "FileCreated.txt") "Test Data"
337− , \fp -> removeFile (fp </> "FileCreated.txt")
338− , [ "_1073741856_Opened_Dir"
339− , "_1073741825_Accessed_Dir"
340− , "_1073741840_NonWriteClosed_Dir"
341− , "FileCreated.txt_512_Deleted"
342− ]
343− , False
344− )
345− , ( "Rename a file in root Dir"
346− , \fp -> writeFile (fp </> "FileCreated.txt") "Test Data"
347− , \fp ->
348− let spath = (fp </> "FileCreated.txt")
349− tpath = (fp </> "FileRenamed.txt")
350− in renamePath spath tpath
351− , [ "_1073741856_Opened_Dir"
352− , "_1073741825_Accessed_Dir"
353− , "_1073741840_NonWriteClosed_Dir"
354− , "FileCreated.txt_64_MovedFrom"
355− , "FileRenamed.txt_128_MovedTo"
356− ]
357− , False
358− )
359− , ( "Create a file in a nested Dir"
360− , \fp ->
361− createDirectoryIfMissing True (fp </> "dir1" </> "dir2" </> "dir3")
362− , \fp ->
363− let p = fp </> "dir1" </> "dir2" </> "dir3" </> "FileCreated.txt"
364− in writeFile p "Test Data"
365− , [ "_1073741856_Opened_Dir"
366− , "_1073741825_Accessed_Dir"
367− , "_1073741840_NonWriteClosed_Dir"
368− , "dir1_1073741856_Opened_Dir"
369− , "dir1_1073741825_Accessed_Dir"
370− , "dir1_1073741840_NonWriteClosed_Dir"
371− , "dir1/dir2_1073741856_Opened_Dir"
372− , "dir1/dir2_1073741825_Accessed_Dir"
373− , "dir1/dir2_1073741840_NonWriteClosed_Dir"
374− , "dir1/dir2/dir3_1073741856_Opened_Dir"
375− , "dir1/dir2/dir3_1073741825_Accessed_Dir"
376− , "dir1/dir2/dir3_1073741840_NonWriteClosed_Dir"
377− , "dir1/dir2/dir3/FileCreated.txt_256_Created"
378− , "dir1/dir2/dir3/FileCreated.txt_32_Opened"
379− , "dir1/dir2/dir3/FileCreated.txt_2_Modified"
380− , "dir1/dir2/dir3/FileCreated.txt_8_WriteClosed"
381− ]
382− , False
383− )
384− , ( "Remove a file in a nested Dir"
385− , \fp ->
386− let nestedDir = fp </> "dir1" </> "dir2" </> "dir3"
387− fpath = nestedDir </> "FileCreated.txt"
388− in do
389− createDirectoryIfMissing True nestedDir
390− writeFile fpath "Test Data"
391− , \fp ->
392− let p = fp </> "dir1" </> "dir2" </> "dir3" </> "FileCreated.txt"
393− in removeFile p
394− , [ "_1073741856_Opened_Dir"
395− , "_1073741825_Accessed_Dir"
396− , "_1073741840_NonWriteClosed_Dir"
397− , "dir1_1073741856_Opened_Dir"
398− , "dir1_1073741825_Accessed_Dir"
399− , "dir1_1073741840_NonWriteClosed_Dir"
400− , "dir1/dir2_1073741856_Opened_Dir"
401− , "dir1/dir2_1073741825_Accessed_Dir"
402− , "dir1/dir2_1073741840_NonWriteClosed_Dir"
403− , "dir1/dir2/dir3_1073741856_Opened_Dir"
404− , "dir1/dir2/dir3_1073741825_Accessed_Dir"
405− , "dir1/dir2/dir3_1073741840_NonWriteClosed_Dir"
406− , "dir1/dir2/dir3/FileCreated.txt_512_Deleted"
407− ]
408− , False
409− )
410− , ( "Rename a file in a nested Dir"
411− , \fp ->
412− let nestedDir = fp </> "dir1" </> "dir2" </> "dir3"
413− fpath = nestedDir </> "FileCreated.txt"
414− in do
415− createDirectoryIfMissing True nestedDir
416− writeFile fpath "Test Data"
417− , \fp ->
418− let s = (fp </> "dir1" </> "dir2" </> "dir3" </> "FileCreated.txt")
419− t = (fp </> "dir1" </> "dir2" </> "dir3" </> "FileRenamed.txt")
420− in renamePath s t
421− , [ "_1073741856_Opened_Dir"
422− , "_1073741825_Accessed_Dir"
423− , "_1073741840_NonWriteClosed_Dir"
424− , "dir1_1073741856_Opened_Dir"
425− , "dir1_1073741825_Accessed_Dir"
426− , "dir1_1073741840_NonWriteClosed_Dir"
427− , "dir1/dir2_1073741856_Opened_Dir"
428− , "dir1/dir2_1073741825_Accessed_Dir"
429− , "dir1/dir2_1073741840_NonWriteClosed_Dir"
430− , "dir1/dir2/dir3_1073741856_Opened_Dir"
431− , "dir1/dir2/dir3_1073741825_Accessed_Dir"
432− , "dir1/dir2/dir3_1073741840_NonWriteClosed_Dir"
433− , "dir1/dir2/dir3/FileCreated.txt_64_MovedFrom"
434− , "dir1/dir2/dir3/FileRenamed.txt_128_MovedTo"
435− ]
436− , False
437− )
438− , ( "Remove the nested directory"
439− , \fp ->
440− createDirectoryIfMissing True (fp </> "dir1" </> "dir2" </> "dir3")
441− , \fp -> removePathForcibly (fp </> "dir1")
44225
443− , [ "_1073741856_Opened_Dir"
444− , "_1073741825_Accessed_Dir"
445− , "_1073741840_NonWriteClosed_Dir"
446− , "dir1_1073741856_Opened_Dir"
447− , "dir1_1073741825_Accessed_Dir"
448− , "dir1_1073741840_NonWriteClosed_Dir"
449− , "dir1/dir2_1073741856_Opened_Dir"
450− , "dir1/dir2_1073741825_Accessed_Dir"
451− , "dir1/dir2_1073741840_NonWriteClosed_Dir"
452− , "dir1/dir2/dir3_1073741856_Opened_Dir"
453− , "dir1/dir2/dir3_1073741825_Accessed_Dir"
454− , "dir1/dir2/dir3_1073741840_NonWriteClosed_Dir"
455− , "dir1_1073741828_MetadataChanged_Dir"
456− , "dir1/dir2_1073741828_MetadataChanged_Dir"
457− , "dir1/dir2/dir3_1073741828_MetadataChanged_Dir"
458− , "dir1/dir2/dir3_1024_RootDeleted"
459− , "dir1/dir2/dir3_32768_RootUnwatched"
460− , "dir1/dir2/dir3_1073742336_Deleted_Dir"
461− , "dir1/dir2_1024_RootDeleted"
462− , "dir1/dir2_32768_RootUnwatched"
463− , "dir1/dir2_1073742336_Deleted_Dir"
464− , "dir1_1024_RootDeleted"
465− , "dir1_32768_RootUnwatched"
466− , "dir1_1073742336_Deleted_Dir"
467− ]
468− , False
469− )
26+dirDelEvents :: String -> [([Char], Event -> Bool)]
27+dirDelEvents dir =
28+ (dir, dirEvent Event.isDeleted)
29+ : (dir, dirEvent Event.isAttrsModified)
30+ : dirTouchEvents dir
31+
32+rootDirDelEvents :: String -> [([Char], Event -> Bool)]
33+rootDirDelEvents root =
34+ (root, Event.isRootUnwatched)
35+ : (root, Event.isRootDeleted)
36+ : (root, dirEvent Event.isAttrsModified)
37+ : dirTouchEvents root
38+
39+dirMoveEvents :: [Char] -> [Char] -> [([Char], Event -> Bool)]
40+dirMoveEvents src dst =
41+ [ (src, dirEvent Event.isMoved)
42+ , (src, dirEvent Event.isMovedFrom)
43+ , (dst, dirEvent Event.isMoved)
44+ , (dst, dirEvent Event.isMovedTo)
47045 ]
47146
472−testDescRemoveRootDir =
473− [ ( "Remove the root directory"
474− , \fp ->
475− createDirectoryIfMissing True (fp </> "dir1" </> "dir2")
476− , \fp -> removePathForcibly fp
477− , [ "_1073741856_Opened_Dir"
478− , "_1073741825_Accessed_Dir"
479− , "_1073741840_NonWriteClosed_Dir"
480− , "dir1_1073741856_Opened_Dir"
481− , "dir1_1073741825_Accessed_Dir"
482− , "dir1_1073741840_NonWriteClosed_Dir"
483− , "dir1/dir2_1073741856_Opened_Dir"
484− , "dir1/dir2_1073741825_Accessed_Dir"
485− , "dir1/dir2_1073741840_NonWriteClosed_Dir"
486− , "_1073741828_MetadataChanged_Dir"
487− , "dir1_1073741828_MetadataChanged_Dir"
488− , "dir1/dir2_1073741828_MetadataChanged_Dir"
489− , "dir1/dir2_1024_RootDeleted"
490− , "dir1/dir2_32768_RootUnwatched"
491− , "dir1/dir2_1073742336_Deleted_Dir"
492− , "dir1_1024_RootDeleted"
493− , "dir1_32768_RootUnwatched"
494− , "dir1_1073742336_Deleted_Dir"
495− , "_1024_RootDeleted"
496− ]
497− , False
498− )
499− ]
500−
501−testDescMoveRootDir =
502− [
503− ( "Moved the root directory"
504− , \fp ->
505− createDirectoryIfMissing True (fp </> "dir1" </> "dir2")
506− , \fp -> renameDirectory (fp </> "dir1" </> "dir2") (fp </> "dir1" </> "dir2_Moved")
507− , [ "_1073741856_Opened_Dir"
508− ,"_1073741825_Accessed_Dir"
509− ,"_1073741840_NonWriteClosed_Dir"
510− ,"dir1_1073741856_Opened_Dir"
511− ,"dir1_1073741825_Accessed_Dir"
512− ,"dir1_1073741840_NonWriteClosed_Dir"
513− ,"dir1/dir2_1073741856_Opened_Dir"
514− ,"dir1/dir2_1073741825_Accessed_Dir"
515− ,"dir1/dir2_1073741840_NonWriteClosed_Dir"
516− ,"dir1/dir2_1073741888_MovedFrom_Dir"
517− ,"dir1/dir2_Moved_1073741952_MovedTo_Dir"
518− ,"dir1/dir2_2048_RootMoved"
519− ]
520− , False
521− )
522− ]
523−
524−testDescRemoveRootDirSymLink =
525− [ ( "Remove the root directory as SymLink"
526− , \fp ->
527− createDirectoryIfMissing True (fp </> "dir1" </> "dir2")
528− , \fp -> removePathForcibly fp
529− , [ "_1073741856_Opened_Dir"
530− , "_1073741825_Accessed_Dir"
531− , "_1073741840_NonWriteClosed_Dir"
532− , "dir1_1073741856_Opened_Dir"
533− , "dir1_1073741825_Accessed_Dir"
534− , "dir1_1073741840_NonWriteClosed_Dir"
535− , "dir1/dir2_1073741856_Opened_Dir"
536− , "dir1/dir2_1073741825_Accessed_Dir"
537− , "dir1/dir2_1073741840_NonWriteClosed_Dir"
538− , "_1073741828_MetadataChanged_Dir"
539− ]
540− , True
541− )
542− ]
543−
544−-------------------------Test Descriptor for common Event Types ---------------
545−
546−testDescCommon =
547− [
548− ( "Create a single directory"
549− , const (return ())
550− , \fp -> createDirectoryIfMissing True (fp </> "dir1Single")
551− , ["dir1Single_1073742080_Created_Dir"]
552− , False
553− )
554− , ( "Remove a single directory"
555− , \fp -> createDirectoryIfMissing True (fp </> "dir1Single")
556− , \fp -> removeDirectory (fp </> "dir1Single")
557− , [ "dir1Single_1024_RootDeleted"
558− , "dir1Single_32768_RootUnwatched"
559− , "dir1Single_1073742336_Deleted_Dir"
560− ]
561− , False
562− )
563− , ( "Rename a single directory"
564− , \fp -> createDirectoryIfMissing True (fp </> "dir1Single")
565− , \fp ->
566− let spath = fp </> "dir1Single"
567− tpath = fp </> "dir1SingleRenamed"
568− in renameDirectory spath tpath
569− , [ "dir1Single_1073741888_MovedFrom_Dir"
570− , "dir1SingleRenamed_1073741952_MovedTo_Dir"
571− , "dir1Single_2048_RootMoved"
572− ]
573− , False
574− )
575− , ( "Create a nested directory"
576− , const (return ())
577− , \fp ->
578− createDirectoryIfMissing True (fp </> "dir1" </> "dir2" </> "dir3")
579− , ["dir1_1073742080_Created_Dir"]
580− , False
581− )
582− , ( "Rename a nested directory"
583− , \fp -> createDirectoryIfMissing True
584− (fp </> "dir1" </> "dir2" </> "dir3")
585− , \fp ->
586− let spath = fp </> "dir1" </> "dir2" </> "dir3"
587− tpath = fp </> "dir1" </> "dir2" </> "dir3Renamed"
588− in renameDirectory spath tpath
589− , [ "dir1/dir2/dir3_1073741888_MovedFrom_Dir"
590− , "dir1/dir2/dir3Renamed_1073741952_MovedTo_Dir"
591− , "dir1/dir2/dir3_2048_RootMoved"
592− ]
593− , False
594− )
595− , ( "Create a file in root Dir"
596− , const (return ())
597− , \fp -> writeFile (fp </> "FileCreated.txt") "Test Data"
598− , [ "FileCreated.txt_256_Created"
599− , "FileCreated.txt_2_Modified"
600− ]
601− , False
602− )
603− , ( "Remove a file in root Dir"
604− , \fp -> writeFile (fp </> "FileCreated.txt") "Test Data"
605− , \fp -> removeFile (fp </> "FileCreated.txt")
606− , ["FileCreated.txt_512_Deleted"]
607− , False
608− )
609− , ( "Rename a file in root Dir"
610− , \fp -> writeFile (fp </> "FileCreated.txt") "Test Data"
611− , \fp ->
612− let spath = (fp </> "FileCreated.txt")
613− tpath = (fp </> "FileRenamed.txt")
614− in renamePath spath tpath
615− , [ "FileCreated.txt_64_MovedFrom"
616− , "FileRenamed.txt_128_MovedTo"
617− ]
618− , False
619− )
620− , ( "Create a file in a nested Dir"
621− , \fp ->
622− createDirectoryIfMissing True (fp </> "dir1" </> "dir2" </> "dir3")
623− , \fp ->
624− let p = fp </> "dir1" </> "dir2" </> "dir3" </> "FileCreated.txt"
625− in writeFile p "Test Data"
626− , [ "dir1/dir2/dir3/FileCreated.txt_256_Created"
627− , "dir1/dir2/dir3/FileCreated.txt_2_Modified"
628− ]
629− , False
630− )
631− , ( "Remove a file in a nested Dir"
632− , \fp ->
633− let nestedDir = fp </> "dir1" </> "dir2" </> "dir3"
634− fpath = nestedDir </> "FileCreated.txt"
635− in do
636− createDirectoryIfMissing True nestedDir
637− writeFile fpath "Test Data"
638− , \fp ->
639− let p = fp </> "dir1" </> "dir2" </> "dir3" </> "FileCreated.txt"
640− in removeFile p
641− , ["dir1/dir2/dir3/FileCreated.txt_512_Deleted"]
642− , False
643− )
644− , ( "Rename a file in a nested Dir"
645− , \fp ->
646− let nestedDir = fp </> "dir1" </> "dir2" </> "dir3"
647− fpath = nestedDir </> "FileCreated.txt"
648− in do
649− createDirectoryIfMissing True nestedDir
650− writeFile fpath "Test Data"
651− , \fp ->
652− let s = (fp </> "dir1" </> "dir2" </> "dir3" </> "FileCreated.txt")
653− t = (fp </> "dir1" </> "dir2" </> "dir3" </> "FileRenamed.txt")
654− in renamePath s t
655− , [ "dir1/dir2/dir3/FileCreated.txt_64_MovedFrom"
656− , "dir1/dir2/dir3/FileRenamed.txt_128_MovedTo"
657− ]
658− , False
659− )
660− , ( "Remove the nested directory"
661− , \fp ->
662− createDirectoryIfMissing True (fp </> "dir1" </> "dir2" </> "dir3")
663− , \fp -> removePathForcibly (fp </> "dir1")
664−
665− , [ "dir1_1073741828_MetadataChanged_Dir"
666− , "dir1/dir2_1073741828_MetadataChanged_Dir"
667− , "dir1/dir2/dir3_1073741828_MetadataChanged_Dir"
668− , "dir1/dir2/dir3_1024_RootDeleted"
669− , "dir1/dir2/dir3_32768_RootUnwatched"
670− , "dir1/dir2/dir3_1073742336_Deleted_Dir"
671− , "dir1/dir2_1024_RootDeleted"
672− , "dir1/dir2_32768_RootUnwatched"
673− , "dir1/dir2_1073742336_Deleted_Dir"
674− , "dir1_1024_RootDeleted"
675− , "dir1_32768_RootUnwatched"
676− , "dir1_1073742336_Deleted_Dir"
677− ]
678− , False
679− )
47+-- In recursive mode all subdirectories are roots therefore they will generate
48+-- isRootMoved.
49+rootDirMoveEvents :: [Char] -> [Char] -> [([Char], Event -> Bool)]
50+rootDirMoveEvents root _ =
51+ (root, Event.isRootMoved)
52+ : dirTouchEvents root
53+
54+recDirMoveEvents :: [Char] -> [Char] -> [([Char], Event -> Bool)]
55+recDirMoveEvents src dst = dirMoveEvents src dst ++ rootDirMoveEvents src dst
56+
57+fileTouchEvents :: String -> [([Char], Event -> Bool)]
58+fileTouchEvents file =
59+ [ (file, fileEvent Event.isOpened)
60+ , (file, fileEvent Event.isModified)
61+ , (file, fileEvent Event.isWriteClosed)
68062 ]
68163
682−testDescRemoveRootDirCommon =
683− [ ( "Remove the root directory"
684− , \fp ->
685− createDirectoryIfMissing True (fp </> "dir1" </> "dir2")
686− , \fp -> removePathForcibly fp
687− , [ "_1073741828_MetadataChanged_Dir"
688− , "dir1_1073741828_MetadataChanged_Dir"
689− , "dir1/dir2_1073741828_MetadataChanged_Dir"
690− , "dir1/dir2_1024_RootDeleted"
691− , "dir1/dir2_32768_RootUnwatched"
692− , "dir1/dir2_1073742336_Deleted_Dir"
693− , "dir1_1024_RootDeleted"
694− , "dir1_32768_RootUnwatched"
695− , "dir1_1073742336_Deleted_Dir"
696− , "_1024_RootDeleted"
697− ]
698− , False
699− )
700− ]
701−
702−testDescMoveRootDirCommon =
703− [
704− ( "Moved the root directory"
705− , \fp ->
706− createDirectoryIfMissing True (fp </> "dir1" </> "dir2")
707− , \fp ->
708− renameDirectory
709− (fp </> "dir1" </> "dir2")
710− (fp </> "dir1" </> "dir2_Moved")
711− , [ "dir1/dir2_1073741888_MovedFrom_Dir"
712− , "dir1/dir2_Moved_1073741952_MovedTo_Dir"
713− , "dir1/dir2_2048_RootMoved"
714− ]
715− , False
716− )
717− ]
718−
719−testDescRemoveRootDirSymLinkCommon =
720− [ ( "Remove the root directory as SymLink"
721− , \fp ->
722− createDirectoryIfMissing True (fp </> "dir1" </> "dir2")
723− , \fp -> removePathForcibly fp
724− , ["_1073741828_MetadataChanged_Dir"]
725− , True
726− )
727− ]
728−-------------------------------------------------------------------------------
729−moduleName :: String
730−moduleName = "FileSystem.Event.Linux"
731−
732−setAllEvents :: Event.Config -> Event.Config
733−setAllEvents cfg = ( Event.setAccessed Event.On
734− . Event.setOpened Event.On
735− . Event.setWriteClosed Event.On
736− . Event.setNonWriteClosed Event.On
737− )cfg
738−
739−allEvents :: NonEmpty (Array Word8) -> S.SerialT IO Event.Event
740−allEvents = Event.watchWith setAllEvents
741−
742−-- Test cases for Linux platform
743−--
744−testAllEvents :: IO ()
745−testAllEvents = do
746− -- Test cases for regular path
747− hspec
748− $ describe moduleName
749− $ mapM_
750− (driver $ checkEvents eventListWithEOtask allEvents)
751− testDesc
752−
753− -- Test cases for SymLink path
754− hspec
755− $ describe moduleName
756− $ mapM_
757− (driver $ checkEvents eventListWithEOtask allEvents)
758− (map (\(a, b, c, d, _) -> (a, b, c, d, True)) testDesc)
759−
760− -- Test cases for moving root path
761− hspec
762− $ describe moduleName
763− $ mapM_
764− (driver $ checkEvents eventListWithEOtask allEvents)
765− testDescMoveRootDir
766−
767− -- Test cases for moving root path as SymLink
768− hspec
769− $ describe moduleName
770− $ mapM_
771− (driver $ checkEvents eventListWithEOtask allEvents)
772− (map (\(a, b, c, d, _) -> (a, b, c, d, True)) testDescMoveRootDir)
773−
774− -- Test cases for removing root path
775− hspec
776− $ describe moduleName
777− $ mapM_
778− (driver $ checkEvents (eventListWithFixLen 51) allEvents)
779− testDescRemoveRootDir
780−
781− -- Test cases for removing root path as Symlink
782− hspec
783− $ describe moduleName
784− $ mapM_
785− (driver $ checkEvents (eventListWithFixLen 20) allEvents)
786− testDescRemoveRootDirSymLink
787−
788−-- Test cases for Events which are common across the platforms
789−--
790−testCommonEvents :: IO ()
791−testCommonEvents = do
792− -- Test cases for regular path
793− hspec
794− $ describe moduleName
795− $ mapM_
796− (driver $ checkEvents eventListWithEOtask $ Event.watchRecursive)
797− testDescCommon
798−
799− -- Test cases for SymLink path
800− hspec
801− $ describe moduleName
802− $ mapM_
803− (driver $ checkEvents eventListWithEOtask Event.watchRecursive)
804− (map (\(a, b, c, d, _) -> (a, b, c, d, True)) testDescCommon)
805−
806− -- Test cases for moving root path
807− hspec
808− $ describe moduleName
809− $ mapM_
810− (driver $ checkEvents eventListWithEOtask Event.watchRecursive)
811− testDescMoveRootDirCommon
812−
813− -- Test cases for moving root path as SymLink
814− hspec
815− $ describe moduleName
816− $ mapM_
817− (driver $ checkEvents eventListWithEOtask Event.watchRecursive)
818− (map (\(a, b, c, d, _) -> (a, b, c, d, True)) testDescMoveRootDirCommon)
819−
820− -- Test cases for removing root path
821− hspec
822− $ describe moduleName
823− $ mapM_
824− (driver $ checkEvents (eventListWithFixLen 12) Event.watchRecursive)
825− testDescRemoveRootDirCommon
64+fileMoveEvents :: [Char] -> [Char] -> [([Char], Event -> Bool)]
65+fileMoveEvents src dst =
66+ [ (src, fileEvent Event.isMoved)
67+ , (src, fileEvent Event.isMovedFrom)
68+ , (dst, fileEvent Event.isMoved)
69+ , (dst, fileEvent Event.isMovedTo)
70+ ]
82671
827− -- Test cases for removing root path as Symlink
828− hspec
829− $ describe moduleName
830− $ mapM_
831− (driver $ checkEvents (eventListWithFixLen 1) Event.watchRecursive)
832− testDescRemoveRootDirSymLinkCommon
72+-- TODO: add fileRoot tests from macOS test suite
73+
74+main :: IO ()
75+main = do
76+ -- We ignore the events on root/parent dir during regular non-root dir/file
77+ -- tests.
78+
79+ -- Tests common to regular root and symlink root cases
80+ let regSymTests =
81+ fileCreate "file" fileTouchEvents
82+ : fileMove "file1" "file2" fileMoveEvents
83+ : dirMove "dir1" "dir2" dirMoveEvents
84+ : dirDelete "dir" dirDelEvents
85+ : commonTests
86+
87+ let regTests =
88+ dirDelete "" rootDirDelEvents
89+ : rootDirMove "moved" (\src -> [(src, Event.isRootMoved)])
90+ : regSymTests
91+
92+ let symTests =
93+ -- when root is a symlinked dir, it does not recv touch, isDeleted
94+ -- or rootDeleted, rootUnwatched events.
95+ dirDelete "" (\dir -> [(dir, dirEvent Event.isAttrsModified)])
96+ -- No events occur when a symlink root is moved
97+ : regSymTests
98+
99+ let w = Event.watchWith (Event.setAllEvents Event.On)
100+ run = runTests moduleName "non-recursive" w
101+
102+ run DirType regTests
103+ run SymLinkOrigPath symTests
104+
105+ let fileRootTests =
106+ [ fileDelete "" (\path ->
107+ [ (path, Event.isAttrsModified)
108+ , (path, Event.isRootDeleted)
109+ , (path, Event.isRootUnwatched)
110+ ])
111+ , rootFileMove "moved" (\path -> [(path, Event.isRootMoved)])
112+ , fileModify "" (\path -> [(path, Event.isOpened)])
113+ ]
114+
115+ run FileType fileRootTests
116+
117+ -- In recursive mode all subdirectories are roots therefore they will
118+ -- generate isRootDeleted/isRootUnwatched. Also, for subdirectories
119+ -- multiple events are generated, once in the parent watch and once in the
120+ -- self watch as a root of the watch. Therefore, additional touchEvents are
121+ -- generated in this case.
122+ --
123+ -- XXX We can possibly filter out the duplicate events either from the
124+ -- parent or self.
125+ let regSymRecTests =
126+ -- XXX Nested file create misses the create event due to a race
127+ -- : fileCreateWithParent "subdir/file" fileTouchEvents
128+ fileCreate "subdir/file" fileTouchEvents
129+ : fileMove "subdir/file1" "subdir/file2" fileMoveEvents
130+ : dirMove "dir1" "dir2" recDirMoveEvents
131+ : dirMove "subdir/dir1" "subdir/dir2" recDirMoveEvents
132+ : dirDelete "dir" (\d -> rootDirDelEvents d ++ dirDelEvents d)
133+ : dirDelete "subdir/dir" (\d -> rootDirDelEvents d ++ dirDelEvents d)
134+ -- XXX Nested dir create misses the create event due to a race
135+ -- : dirCreateWithParent "subdir/dir" dirTouchEvents
136+ : dirCreate "subdir/dir"
137+ (\dir -> (dir, dirEvent Event.isCreated) : dirTouchEvents dir)
138+ : dirCreate "dir"
139+ (\dir -> (dir, dirEvent Event.isCreated) : dirTouchEvents dir)
140+ : commonRecTests
141+ recRegTests = regTests ++ regSymRecTests
142+ recSymTests = symTests ++ regSymRecTests
143+
144+ let recw = Event.watchWith
145+ (Event.setAllEvents Event.On . Event.setRecursiveMode Event.On)
146+ runRec = runTests moduleName "recursive" recw
147+
148+ runRec DirType recRegTests
149+ runRec SymLinkOrigPath recSymTests
150+ -- XXX This fails with exceptions, ideally it should work the same as in
151+ -- non-recursive mode
152+ -- runRec FileType fileRootTests