git.iko.soy/streamly
on master help sign in
Seperate platform specific Events
commit212559e9d5acfc63da494dc904c4b66dfe75c84a authorRanjeet Kumar Ranjan <ranjeetr@composewell.com> dateThu 30 Sep 2021, 19:58 (5 years ago) parent6b0b502
9 files changed+1236−522
compare with master
unifiedsplit
src/Streamly/Internal/FileSystem/Event.hs−28 src/Streamly/Internal/FileSystem/Event/Linux.hs+12−1 streamly.cabal+4 test/Streamly/Test/FileSystem/Event.hs+6−493 test/Streamly/Test/FileSystem/Event/Linux.hs+832 test/Streamly/Test/FileSystem/Event/LinuxTest.hs+9 test/Streamly/Test/FileSystem/Event/Windows.hs+346 test/Streamly/Test/FileSystem/Event/WindowsTest.hs+9 test/streamly-tests.cabal+18
src/Streamly/Internal/FileSystem/Event.hs−28
@@ -105,21 +105,7 @@ import qualified Streamly.Internal.FileSystem.Event.Windows as Event
105105-- /Pre-release/
106106--
107107watch :: NonEmpty (Array Word8) -> SerialT IO Event
108−#if defined(CABAL_OS_WINDOWS)
109108watch = Event.watch
110−#elif defined(CABAL_OS_LINUX)
111−watch = Event.watchWithFlags
112− [ 0x00000002 -- File was modified.
113− , 0x00000004 -- Metadata changed.
114− , 0x00000100 -- Subfile was created.
115− , 0x00000200 -- Subfile was deleted.
116− , 0x00000400 -- Root was deleted.
117− , 0x00000040 -- File was moved from X.
118− , 0x00000080 -- File was moved to Y.
119− ]
120−#elif defined(CABAL_OS_DARWIN)
121−watch = Event.watch
122−#endif
123109
124110-- | Like 'watch' except that if a watched path is a directory the whole
125111-- directory tree under it is watched recursively.
@@ -129,21 +115,7 @@ watch = Event.watch
129115-- /Pre-release/
130116--
131117watchRecursive :: NonEmpty (Array Word8) -> SerialT IO Event
132−#if defined(CABAL_OS_WINDOWS)
133118watchRecursive = Event.watchRecursive
134−#elif defined(CABAL_OS_LINUX)
135−watchRecursive = Event.watchRecursiveWithFlags
136− [ 0x00000002 -- File was modified.
137− , 0x00000004 -- Metadata changed.
138− , 0x00000100 -- Subfile was created.
139− , 0x00000200 -- Subfile was deleted.
140− , 0x00000400 -- Root was deleted.
141− , 0x00000040 -- File was moved from X.
142− , 0x00000080 -- File was moved to Y.
143− ]
144−#elif defined(CABAL_OS_DARWIN)
145−watchRecursive = Event.watchRecursive
146−#endif
147119
148120-------------------------------------------------------------------------------
149121-- Handling Events
src/Streamly/Internal/FileSystem/Event/Linux.hs+12−1
@@ -517,6 +517,17 @@ setAllEvents s cfg =
517517 . setModified s
518518 ) cfg
519519
520+setCommonEvents :: Toggle -> Config -> Config
521+setCommonEvents s cfg =
522+ ( setRootDeleted s
523+ . setRootMoved s
524+ . setMetadataChanged s
525+ . setCreated s
526+ . setDeleted s
527+ . setMovedFrom s
528+ . setMovedTo s
529+ . setModified s
530+ ) cfg
520531-------------------------------------------------------------------------------
521532-- Default config
522533-------------------------------------------------------------------------------
@@ -538,7 +549,7 @@ setAllEvents s cfg =
538549defaultConfig :: Config
539550defaultConfig =
540551 setWhenExists AddIfExists
541− $ setAllEvents On
552+ $ setCommonEvents On
542553 $ Config
543554 { watchRec = True
544555 , createFlags = 0
streamly.cabal+4
@@ -93,6 +93,10 @@ extra-source-files:
9393 test/Streamly/Test/Data/Array/Stream/Foreign.hs
9494 test/Streamly/Test/Data/Parser/ParserD.hs
9595 test/Streamly/Test/FileSystem/Event.hs
96+ test/Streamly/Test/FileSystem/Event/Windows.hs
97+ test/Streamly/Test/FileSystem/Event/Linux.hs
98+ test/Streamly/Test/FileSystem/Event/WindowsTest.hs
99+ test/Streamly/Test/FileSystem/Event/LinuxTest.hs
96100 test/Streamly/Test/FileSystem/Handle.hs
97101 test/Streamly/Test/Network/Socket.hs
98102 test/Streamly/Test/Network/Inet/TCP.hs
test/Streamly/Test/FileSystem/Event.hs+6−493
@@ -6,505 +6,18 @@
66-- Stability : experimental
77-- Portability : GHC
88--
9+
910module Main (main) where
1011
11−import Control.Concurrent (MVar, newEmptyMVar, putMVar, takeMVar, threadDelay)
12−import Control.Monad.IO.Class (MonadIO)
13−#if !defined(CABAL_OS_WINDOWS)
14−import Data.Char (ord)
15−#endif
16−import Data.Functor.Identity (runIdentity)
17−import Data.Maybe (fromJust)
18−import Data.Word (Word8)
19−import System.Directory
20− ( createDirectoryIfMissing
21− , createDirectoryLink
22− , removeFile
23− , removeDirectory
24− , removePathForcibly
25− , renameDirectory
26− , renamePath
27− )
28−import System.FilePath ((</>))
2912import System.IO (BufferMode(..), hSetBuffering, stdout)
30−import System.IO.Temp (withSystemTempDirectory)
31−#if !defined(CABAL_OS_WINDOWS)
32−import System.IO.Unsafe (unsafePerformIO)
33−#endif
34−import Streamly.Internal.Data.Array.Foreign (Array)
35−
36−import qualified Data.List.NonEmpty as NonEmpty
37−import Data.List.NonEmpty (NonEmpty)
38−import qualified Data.Set as Set
39−import qualified Streamly.Unicode.Stream as Unicode
40−import qualified Streamly.Internal.Data.Array.Foreign as Array
41−import qualified Streamly.Internal.Data.Fold as FL
42−import qualified Streamly.Internal.Data.Parser as PR
43−import qualified Streamly.Internal.Data.Stream.IsStream as S
44−import qualified Streamly.Internal.Unicode.Stream as U
45−import qualified Streamly.Internal.FileSystem.Event as CommonEvent
46−#if defined(CABAL_OS_DARWIN)
47−import qualified Streamly.Internal.FileSystem.Event.Darwin as Event
48−#elif defined(CABAL_OS_LINUX)
49−import qualified Streamly.Internal.FileSystem.Event.Linux as Event
50−#elif defined(CABAL_OS_WINDOWS)
51−import qualified Streamly.Internal.FileSystem.Event.Windows as Event
52−#else
53−#error "FS Events not supported on this platform"
54−#endif
55−
56−import Test.Hspec
57−
58−-------------------------------------------------------------------------------
59−-- Utilities
60−-------------------------------------------------------------------------------
61−
62−toUtf8 :: MonadIO m => String -> m (Array Word8)
63−toUtf8 = Array.fromStream . Unicode.encodeUtf8' . S.fromList
64−
65−utf8ToString :: Array Word8 -> String
66−utf8ToString = runIdentity . S.toList . U.decodeUtf8' . Array.toStream
67−
68−timeout :: IO String
69−timeout = threadDelay 5000000 >> return "Timeout"
70−
71−fseventDir :: String
72−fseventDir = "fsevent_dir"
73−
74−eoTask :: String
75−eoTask = "EOTask"
76−
77−-- XXX Make the getRelPath type same on windows and other platforms
78−eventPredicate :: Event.Event -> Bool
79−eventPredicate ev =
80− if (utf8ToString $ Event.getRelPath ev) == eoTask
81− then False
82− else True
83−
84−-------------------------------------------------------------------------------
85−-- Event matching utilities
86−-------------------------------------------------------------------------------
87−#if defined(CABAL_OS_LINUX)
88−removeTrailingSlash :: Array Word8 -> Array Word8
89−removeTrailingSlash path =
90− if Array.length path == 0
91− then path
92− else
93− let mx = Array.getIndex path (Array.length path - 1)
94− in case mx of
95− Nothing -> error "removeTrailingSlash: Bug: Invalid index"
96− Just x ->
97− if x == fromIntegral (ord '/')
98− -- XXX need array slicing
99− then unsafePerformIO
100− $ Array.fromStreamN (Array.length path - 1)
101− $ Array.toStream path
102− else path
103−#endif
104−
105−-- XXX Return a tuple (path, flags) instead of appending flags to path. And
106−-- then check the flags using an event mask.
107−
108−showEventShort :: Event.Event -> String
109−#if defined(CABAL_OS_WINDOWS)
110−-- | Convert an 'Event' record to a short representation for unit test.
111−showEventShort ev@Event.Event{..} =
112− (utf8ToString $ Event.getRelPath ev) ++ "_" ++ show eventFlags
113−#elif defined(CABAL_OS_LINUX)
114−showEventShort ev@Event.Event{..} =
115− utf8ToString (removeTrailingSlash $ Event.getRelPath ev)
116− ++ "_" ++ show eventFlags
117− ++ showev Event.isDir "Dir"
118−
119− where showev f str = if f ev then "_" ++ str else ""
120−#else
121−#error "Unsupported OS"
122−#endif
123−
124−rootPathRemovedEventCount :: Int
125−#if defined(CABAL_OS_WINDOWS)
126−rootPathRemovedEventCount = 3
127−#else
128−rootPathRemovedEventCount = 10
129−eventListWithFixLenSymLink :: ToEventList
130−eventListWithFixLenSymLink = S.toList . S.take 1
131−#endif
132−
133−-------------------------------------------------------------------------------
134−-- Event Watcher
135−-------------------------------------------------------------------------------
136−
137−type EventChecker = FilePath -> MVar () -> [String] -> IO String
138−type EventWatch = NonEmpty (Array Word8) -> S.SerialT IO Event.Event
139−type ToEventList = S.SerialT IO Event.Event -> IO [Event.Event]
140−
141−eventListWithFixLen :: ToEventList
142−eventListWithFixLen = S.toList . S.take rootPathRemovedEventCount
143−
144−eventListWithEOtask :: ToEventList
145−eventListWithEOtask = S.parse (PR.takeWhile eventPredicate FL.toList)
146−
147−checkEvents :: ToEventList -> EventWatch -> EventChecker
148−checkEvents toEL ew rootPath m matchList = do
149− let args = [rootPath]
150− paths <- mapM toUtf8 args
151− putStrLn ("Watch started !!!! on Path " ++ rootPath)
152− events <- toEL
153− $ S.before (putMVar m ())
154− $ ew (NonEmpty.fromList paths)
155− let eventStr = map showEventShort events
156− let baseSet = Set.fromList matchList
157− resultSet = Set.fromList eventStr
158− if baseSet `Set.isSubsetOf` resultSet
159− then
160− return "PASS"
161− else do
162− putStrLn $ "baseSet " ++ show matchList
163− putStrLn $ "resultSet " ++ show eventStr
164− return "Mismatch"
165−
166−-------------------------------------------------------------------------------
167−-- FS Event Generators
168−-------------------------------------------------------------------------------
169−
170−checker :: S.IsStream t =>
171− EventChecker -> FilePath -> MVar () -> [String] -> t IO String
172−checker ec rootPath synch matchList =
173− S.fromEffect (ec rootPath synch matchList)
174− `S.parallelFst`
175− S.fromEffect timeout
176−
177−-------------------------------------------------------------------------------
178−-- Test Drivers
179−-------------------------------------------------------------------------------
180−
181−driver ::
182− EventChecker
183− -> ( String
184− , FilePath -> IO ()
185− , FilePath -> IO ()
186− , [String]
187− , Bool
188− )
189− -> SpecWith ()
190−driver ec (desc, pre, ops, events, sym) = it desc $ runTest `shouldReturn` "PASS"
191−
192− where
193−
194− runTest = do
195− sync <- newEmptyMVar
196− withSystemTempDirectory fseventDir $ \fp ->
197− if sym
198− then do
199− createDirectoryLink fp (fp ++ "SymLink")
200− pre (fp ++ "SymLink")
201− let eventStream = checker ec (fp ++ "SymLink") sync events
202− fsOps = S.fromEffect $ runFSOps (fp ++ "SymLink") sync
203− fmap fromJust $ S.head $ eventStream `S.parallelFst` fsOps
204− else do
205− pre fp
206− let eventStream = checker ec fp sync events
207− fsOps = S.fromEffect $ runFSOps fp sync
208− fmap fromJust $ S.head $ eventStream `S.parallelFst` fsOps
209−
210− runFSOps fp sync = do
211− _ <- takeMVar sync
212− threadDelay 200000
213− ops fp
214− -- 'EOTask Created dir' event gets out of order so need to wait here
215− threadDelay 200000 -- Why this delay?
216− createDirectoryIfMissing True (fp </> eoTask)
217− threadDelay 10000000
218− error "fs ops timed out"
219−
220−-------------------------------------------------------------------------------
221−-- Main
222−-------------------------------------------------------------------------------
223−
224−testDesc, testDescRootDir ::
225− [ ( String -- test description
226− , FilePath -> IO () -- pre test operation
227− , FilePath -> IO () -- file system actions
228− , [String] -- expected events
229− , Bool ) -- SymLink
230− ]
231−testDesc =
232− [
233− ( "Create a single directory"
234− , const (return ())
235− , \fp -> createDirectoryIfMissing True (fp </> "dir1Single")
236−#if defined(CABAL_OS_WINDOWS)
237− , [ "dir1Single_1" ]
238−#elif defined(CABAL_OS_LINUX)
239− , ["dir1Single_1073742080_Dir"]
240−#endif
241− , False
242− )
243− , ( "Remove a single directory"
244− , \fp -> createDirectoryIfMissing True (fp </> "dir1Single")
245− , \fp -> removeDirectory (fp </> "dir1Single")
246−#if defined(CABAL_OS_WINDOWS)
247− , [ "dir1Single_2" ]
248−#elif defined(CABAL_OS_LINUX)
249− , [
250− "dir1Single_1073742336_Dir"
251− ]
252−#endif
253− , False
254− )
255− , ( "Rename a single directory"
256− , \fp -> createDirectoryIfMissing True (fp </> "dir1Single")
257− , \fp ->
258− let spath = fp </> "dir1Single"
259− tpath = fp </> "dir1SingleRenamed"
260− in renameDirectory spath tpath
261−#if defined(CABAL_OS_WINDOWS)
262− , [ "dir1Single_4"
263− , "dir1SingleRenamed_5"
264− ]
265−#elif defined(CABAL_OS_LINUX)
266− , [ "dir1Single_1073741888_Dir"
267− , "dir1SingleRenamed_1073741952_Dir"
268− ]
269−#endif
270− , False
271− )
272− , ( "Create a nested directory"
273− , const (return ())
274− , \fp ->
275− createDirectoryIfMissing True (fp </> "dir1" </> "dir2" </> "dir3")
276−#if defined(CABAL_OS_WINDOWS)
277− , [ "dir1_1"
278− , "dir1\\dir2_1"
279− , "dir1\\dir2\\dir3_1"
280− ]
281−#elif defined(CABAL_OS_LINUX)
282− , [ "dir1_1073742080_Dir"
283− ]
284−#endif
285− , False
286− )
287− , ( "Rename a nested directory"
288− , \fp -> createDirectoryIfMissing True
289− (fp </> "dir1" </> "dir2" </> "dir3")
290− , \fp ->
291− let spath = fp </> "dir1" </> "dir2" </> "dir3"
292− tpath = fp </> "dir1" </> "dir2" </> "dir3Renamed"
293− in renameDirectory spath tpath
294−#if defined(CABAL_OS_WINDOWS)
295− , [ "dir1\\dir2_3"
296− , "dir1\\dir2\\dir3_4"
297− , "dir1\\dir2\\dir3Renamed_5"
298− , "dir1\\dir2_3"
299− ]
300−#elif defined(CABAL_OS_LINUX)
301− , [ "dir1/dir2/dir3_1073741888_Dir"
302− , "dir1/dir2/dir3Renamed_1073741952_Dir"
303− ]
304−#endif
305− , False
306− )
307− , ( "Create a file in root Dir"
308− , const (return ())
309− , \fp -> writeFile (fp </> "FileCreated.txt") "Test Data"
310−#if defined(CABAL_OS_WINDOWS)
311− , [ "FileCreated.txt_1"
312− , "FileCreated.txt_3"
313− , "FileCreated.txt_3"
314− ]
315−#elif defined(CABAL_OS_LINUX)
316− , [ "FileCreated.txt_256"
317− , "FileCreated.txt_2"
318− ]
319−#endif
320− , False
321− )
322− , ( "Remove a file in root Dir"
323− , \fp -> writeFile (fp </> "FileCreated.txt") "Test Data"
324− , \fp -> removeFile (fp </> "FileCreated.txt")
325−#if defined(CABAL_OS_WINDOWS)
326− , [ "FileCreated.txt_2" ]
327−#elif defined(CABAL_OS_LINUX)
328− , [ "FileCreated.txt_512" ]
329−#endif
330− , False
331− )
332− , ( "Rename a file in root Dir"
333− , \fp -> writeFile (fp </> "FileCreated.txt") "Test Data"
334− , \fp ->
335− let spath = (fp </> "FileCreated.txt")
336− tpath = (fp </> "FileRenamed.txt")
337− in renamePath spath tpath
338−#if defined(CABAL_OS_WINDOWS)
339− , [ "FileCreated.txt_4"
340− , "FileRenamed.txt_5"
341− ]
342−#elif defined(CABAL_OS_LINUX)
343− , [ "FileCreated.txt_64"
344− , "FileRenamed.txt_128"
345− ]
346−#endif
347− , False
348− )
349− , ( "Create a file in a nested Dir"
350− , \fp ->
351− createDirectoryIfMissing True (fp </> "dir1" </> "dir2" </> "dir3")
352− , \fp ->
353− let p = fp </> "dir1" </> "dir2" </> "dir3" </> "FileCreated.txt"
354− in writeFile p "Test Data"
355−#if defined(CABAL_OS_WINDOWS)
356− , [ "dir1\\dir2\\dir3\\FileCreated.txt_1"
357− , "dir1\\dir2\\dir3\\FileCreated.txt_3"
358− ]
359−#elif defined(CABAL_OS_LINUX)
360− , [ "dir1/dir2/dir3/FileCreated.txt_256"
361− , "dir1/dir2/dir3/FileCreated.txt_2"
362− ]
363−#endif
364− , False
365− )
366− , ( "Remove a file in a nested Dir"
367− , \fp ->
368− let nestedDir = fp </> "dir1" </> "dir2" </> "dir3"
369− fpath = nestedDir </> "FileCreated.txt"
370− in do
371− createDirectoryIfMissing True nestedDir
372− writeFile fpath "Test Data"
373− , \fp ->
374− let p = fp </> "dir1" </> "dir2" </> "dir3" </> "FileCreated.txt"
375− in removeFile p
376−#if defined(CABAL_OS_WINDOWS)
377− , ["dir1\\dir2\\dir3\\FileCreated.txt_2"]
378−#elif defined(CABAL_OS_LINUX)
379− , ["dir1/dir2/dir3/FileCreated.txt_512"]
380−#endif
381− , False
382− )
383− , ( "Rename a file in a nested Dir"
384− , \fp ->
385− let nestedDir = fp </> "dir1" </> "dir2" </> "dir3"
386− fpath = nestedDir </> "FileCreated.txt"
387− in do
388− createDirectoryIfMissing True nestedDir
389− writeFile fpath "Test Data"
390− , \fp ->
391− let s = (fp </> "dir1" </> "dir2" </> "dir3" </> "FileCreated.txt")
392− t = (fp </> "dir1" </> "dir2" </> "dir3" </> "FileRenamed.txt")
393− in renamePath s t
394−#if defined(CABAL_OS_WINDOWS)
395− , [ "dir1\\dir2\\dir3_3"
396− , "dir1\\dir2\\dir3\\FileCreated.txt_4"
397− , "dir1\\dir2\\dir3\\FileRenamed.txt_5"
398− ]
399−#elif defined(CABAL_OS_LINUX)
400− , [ "dir1/dir2/dir3/FileCreated.txt_64"
401− , "dir1/dir2/dir3/FileRenamed.txt_128"
402− ]
403−#endif
404− , False
405− )
406− , ( "Remove the nested directory"
407− , \fp ->
408− createDirectoryIfMissing True (fp </> "dir1" </> "dir2" </> "dir3")
409− , \fp -> removePathForcibly (fp </> "dir1")
410−#if defined(CABAL_OS_WINDOWS)
411− , [ "dir1_3"
412− , "dir1\\dir2_3"
413− , "dir1\\dir2\\dir3_2"
414− , "dir1\\dir2_2","dir1_2"
415− ]
416−#elif defined(CABAL_OS_LINUX)
417− , [ "dir1_1073741828_Dir"
418− , "dir1_1073741828_Dir"
419− , "dir1/dir2_1073741828_Dir"
420− , "dir1/dir2_1073741828_Dir"
421− , "dir1/dir2/dir3_1073741828_Dir"
422− , "dir1/dir2/dir3_1073741828_Dir"
423− , "dir1/dir2/dir3_1024"
424− , "dir1/dir2/dir3_1073742336_Dir"
425− , "dir1/dir2_1024"
426− , "dir1/dir2_1073742336_Dir"
427− , "dir1_1024"
428− , "dir1_1073742336_Dir"
429− ]
430−#endif
431− , False
432− )
433− ]
434−
435−testDescRootDir =
436− [ ( "Remove the root directory"
437− , \fp ->
438− createDirectoryIfMissing True (fp </> "dir1" </> "dir2")
439− , \fp -> removePathForcibly fp
440−#if defined(CABAL_OS_WINDOWS)
441− , ["dir1_2", "dir1_3", "dir1\\dir2_2"]
442−#elif defined(CABAL_OS_LINUX)
443− , [ "_1073741828_Dir"
444− , "dir1_1073741828_Dir"
445− , "dir1_1073741828_Dir"
446− , "dir1/dir2_1073741828_Dir"
447− , "dir1/dir2_1073741828_Dir"
448− , "dir1/dir2_1024"
449− , "dir1/dir2_1073742336_Dir"
450− , "dir1_1024"
451− , "dir1_1073742336_Dir"
452− , "_1024"
453− ]
454−#endif
455− , False
456− )
457− ]
458−
45913#if defined(CABAL_OS_LINUX)
460−testDescRootDirSymLink ::
461− [ ( String -- test description
462− , FilePath -> IO () -- pre test operation
463− , FilePath -> IO () -- file system actions
464− , [String] -- expected events
465− , Bool ) -- SymLink
466− ]
467−testDescRootDirSymLink =
468− [ ( "Remove the root directory as SymLink"
469− , \fp ->
470− createDirectoryIfMissing True (fp </> "dir1" </> "dir2")
471− , \fp -> removePathForcibly fp
472− , ["_1073741828_Dir"]
473− , True
474− )
475− ]
14+import qualified Streamly.Test.FileSystem.Event.Linux as Event
15+#elif defined(CABAL_OS_WINDOWS)
16+import qualified Streamly.Test.FileSystem.Event.Windows as Event
47617#endif
47718
478−moduleName :: String
479−moduleName = "FileSystem.Event"
480−
48119main :: IO ()
48220main = do
48321 hSetBuffering stdout NoBuffering
484−#if defined(CABAL_OS_LINUX)
485− hspec
486− $ describe moduleName
487− $ mapM_
488− (driver $ checkEvents eventListWithEOtask Event.watchRecursive)
489− testDesc
490− hspec
491− $ describe moduleName
492− $ mapM_
493− (driver $ checkEvents eventListWithEOtask CommonEvent.watchRecursive)
494− (map (\(a, b, c, d, _) -> (a, b, c, d, True)) testDesc)
495− hspec
496− $ describe moduleName
497− $ mapM_
498− (driver $ checkEvents eventListWithFixLenSymLink CommonEvent.watchRecursive)
499− testDescRootDirSymLink
500−#endif
501− hspec
502− $ describe moduleName
503− $ mapM_
504− (driver $ checkEvents eventListWithEOtask CommonEvent.watchRecursive)
505− testDesc
506− hspec
507− $ describe moduleName
508− $ mapM_
509− (driver $ checkEvents eventListWithFixLen CommonEvent.watchRecursive)
510− testDescRootDir
22+ Event.testCommonEvents
23+
test/Streamly/Test/FileSystem/Event/Linux.hsnew file+832
@@ -0,0 +1,832 @@
1+-- |
2+-- Module : Streamly.Test.FileSystem.Event.Linux
3+-- Copyright : (c) 2020 Composewell Technologies
4+-- License : BSD-3-Clause
5+-- Maintainer : streamly@composewell.com
6+-- Stability : experimental
7+-- Portability : GHC
8+--
9+module Streamly.Test.FileSystem.Event.Linux (testAllEvents, testCommonEvents) where
10+
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
40+import qualified Streamly.Internal.FileSystem.Event.Linux as Event
41+
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
185+
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+-------------------------------------------------------------------------------
214+
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
228+ ]
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")
442+
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+ )
470+ ]
471+
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+ )
680+ ]
681+
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
826+
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
test/Streamly/Test/FileSystem/Event/LinuxTest.hsnew file+9
@@ -0,0 +1,9 @@
1+module Main (main) where
2+
3+import System.IO (BufferMode(..), hSetBuffering, stdout)
4+import qualified Streamly.Test.FileSystem.Event.Linux as Event
5+
6+main :: IO ()
7+main = do
8+ hSetBuffering stdout NoBuffering
9+ Event.testAllEvents
test/Streamly/Test/FileSystem/Event/Windows.hsnew file+346
@@ -0,0 +1,346 @@
1+-- |
2+-- Module : Streamly.Test.FileSystem.Event.Windows
3+-- Copyright : (c) 2020 Composewell Technologies
4+-- License : BSD-3-Clause
5+-- Maintainer : streamly@composewell.com
6+-- Stability : experimental
7+-- Portability : GHC
8+--
9+module Streamly.Test.FileSystem.Event.Windows (testCommonEvents) where
10+
11+import Control.Concurrent (MVar, newEmptyMVar, putMVar, takeMVar, threadDelay)
12+import Control.Monad.IO.Class (MonadIO)
13+
14+import Data.Functor.Identity (runIdentity)
15+import Data.Maybe (fromJust)
16+import Data.Word (Word8)
17+import System.Directory
18+ ( createDirectoryIfMissing
19+ , createDirectoryLink
20+ , removeFile
21+ , removeDirectory
22+ , removePathForcibly
23+ , renameDirectory
24+ , renamePath
25+ )
26+import System.FilePath ((</>))
27+import System.IO.Temp (withSystemTempDirectory)
28+
29+import Streamly.Internal.Data.Array.Foreign (Array)
30+
31+import qualified Data.List.NonEmpty as NonEmpty
32+import Data.List.NonEmpty (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
40+
41+import qualified Streamly.Internal.FileSystem.Event.Windows as Event
42+
43+
44+import Test.Hspec
45+
46+-------------------------------------------------------------------------------
47+-- Utilities
48+-------------------------------------------------------------------------------
49+
50+toUtf8 :: MonadIO m => String -> m (Array Word8)
51+toUtf8 = Array.fromStream . Unicode.encodeUtf8' . S.fromList
52+
53+utf8ToString :: Array Word8 -> String
54+utf8ToString = runIdentity . S.toList . U.decodeUtf8' . Array.toStream
55+
56+timeout :: IO String
57+timeout = threadDelay 5000000 >> return "Timeout"
58+
59+fseventDir :: String
60+fseventDir = "fsevent_dir"
61+
62+eoTask :: String
63+eoTask = "EOTask"
64+
65+-- XXX Make the getRelPath type same on windows and other platforms
66+eventPredicate :: Event.Event -> Bool
67+eventPredicate ev =
68+ if (utf8ToString $ Event.getRelPath ev) == eoTask
69+ then False
70+ else True
71+
72+-------------------------------------------------------------------------------
73+-- Event matching utilities
74+-------------------------------------------------------------------------------
75+
76+
77+-- XXX Return a tuple (path, flags) instead of appending flags to path. And
78+-- then check the flags using an event mask.
79+
80+showEventShort :: Event.Event -> String
81+-- | Convert an 'Event' record to a short representation for unit test.
82+showEventShort ev@Event.Event{..} =
83+ (utf8ToString $ Event.getRelPath ev) ++ "_" ++ show eventFlags
84+
85+-------------------------------------------------------------------------------
86+-- Event Watcher
87+-------------------------------------------------------------------------------
88+
89+type EventChecker = FilePath -> MVar () -> [String] -> IO String
90+type EventWatch = NonEmpty (Array Word8) -> S.SerialT IO Event.Event
91+type ToEventList = S.SerialT IO Event.Event -> IO [Event.Event]
92+
93+eventListWithFixLen :: Int -> ToEventList
94+eventListWithFixLen count = S.toList . S.take count
95+
96+eventListWithEOtask :: ToEventList
97+eventListWithEOtask = S.parse (PR.takeWhile eventPredicate FL.toList)
98+
99+checkEvents :: ToEventList -> EventWatch -> EventChecker
100+checkEvents toEL ew rootPath m matchList = do
101+ let args = [rootPath]
102+ paths <- mapM toUtf8 args
103+ putStrLn ("Watch started !!!! on Path " ++ rootPath)
104+ events <- toEL
105+ $ S.before (putMVar m ())
106+ $ ew (NonEmpty.fromList paths)
107+ let eventStr = map showEventShort events
108+ let baseSet = Set.fromList matchList
109+ resultSet = Set.fromList eventStr
110+ if baseSet `Set.isSubsetOf` resultSet
111+ then
112+ return "PASS"
113+ else do
114+ putStrLn $ "baseSet " ++ show matchList
115+ putStrLn $ "resultSet " ++ show eventStr
116+ return "Mismatch"
117+
118+-------------------------------------------------------------------------------
119+-- FS Event Generators
120+-------------------------------------------------------------------------------
121+
122+checker :: S.IsStream t =>
123+ EventChecker -> FilePath -> MVar () -> [String] -> t IO String
124+checker ec rootPath synch matchList =
125+ S.fromEffect (ec rootPath synch matchList)
126+ `S.parallelFst`
127+ S.fromEffect timeout
128+
129+-------------------------------------------------------------------------------
130+-- Test Drivers
131+-------------------------------------------------------------------------------
132+
133+driver ::
134+ EventChecker
135+ -> ( String
136+ , FilePath -> IO ()
137+ , FilePath -> IO ()
138+ , [String]
139+ , Bool
140+ )
141+ -> SpecWith ()
142+driver ec (desc, pre, ops, events, sym) = it desc $ runTest `shouldReturn` "PASS"
143+
144+ where
145+
146+ runTest = do
147+ sync <- newEmptyMVar
148+ withSystemTempDirectory fseventDir $ \fp ->
149+ if sym
150+ then do
151+ createDirectoryLink fp (fp ++ "SymLink")
152+ runTest0 (fp ++ "SymLink") sync
153+ else runTest0 fp sync
154+
155+ runTest0 fp sync = do
156+ pre fp
157+ let eventStream = checker ec fp sync events
158+ fsOps = S.fromEffect $ runFSOps fp sync
159+ fmap fromJust $ S.head $ eventStream `S.parallelFst` fsOps
160+
161+ runFSOps fp sync = do
162+ _ <- takeMVar sync
163+ threadDelay 200000
164+ ops fp
165+ -- 'EOTask Created dir' event gets out of order so need to wait here
166+ threadDelay 200000 -- Why this delay?
167+ createDirectoryIfMissing True (fp </> eoTask)
168+ threadDelay 10000000
169+ error "fs ops timed out"
170+
171+-------------------------------------------------------------------------------
172+-- Main
173+-------------------------------------------------------------------------------
174+
175+testDesc, testDescRootDir ::
176+ [ ( String -- test description
177+ , FilePath -> IO () -- pre test operation
178+ , FilePath -> IO () -- file system actions
179+ , [String] -- expected events
180+ , Bool ) -- SymLink
181+ ]
182+testDesc =
183+ [
184+ ( "Create a single directory"
185+ , const (return ())
186+ , \fp -> createDirectoryIfMissing True (fp </> "dir1Single")
187+ , [ "dir1Single_1" ]
188+ , False
189+ )
190+ , ( "Remove a single directory"
191+ , \fp -> createDirectoryIfMissing True (fp </> "dir1Single")
192+ , \fp -> removeDirectory (fp </> "dir1Single")
193+ , [ "dir1Single_2" ]
194+ , False
195+ )
196+ , ( "Rename a single directory"
197+ , \fp -> createDirectoryIfMissing True (fp </> "dir1Single")
198+ , \fp ->
199+ let spath = fp </> "dir1Single"
200+ tpath = fp </> "dir1SingleRenamed"
201+ in renameDirectory spath tpath
202+ , [ "dir1Single_4"
203+ , "dir1SingleRenamed_5"
204+ ]
205+ , False
206+ )
207+ , ( "Create a nested directory"
208+ , const (return ())
209+ , \fp ->
210+ createDirectoryIfMissing True (fp </> "dir1" </> "dir2" </> "dir3")
211+ , [ "dir1_1"
212+ , "dir1\\dir2_1"
213+ , "dir1\\dir2\\dir3_1"
214+ ]
215+ , False
216+ )
217+ , ( "Rename a nested directory"
218+ , \fp -> createDirectoryIfMissing True
219+ (fp </> "dir1" </> "dir2" </> "dir3")
220+ , \fp ->
221+ let spath = fp </> "dir1" </> "dir2" </> "dir3"
222+ tpath = fp </> "dir1" </> "dir2" </> "dir3Renamed"
223+ in renameDirectory spath tpath
224+ , [ "dir1\\dir2_3"
225+ , "dir1\\dir2\\dir3_4"
226+ , "dir1\\dir2\\dir3Renamed_5"
227+ , "dir1\\dir2_3"
228+ ]
229+ , False
230+ )
231+ , ( "Create a file in root Dir"
232+ , const (return ())
233+ , \fp -> writeFile (fp </> "FileCreated.txt") "Test Data"
234+ , [ "FileCreated.txt_1"
235+ , "FileCreated.txt_3"
236+ , "FileCreated.txt_3"
237+ ]
238+ , False
239+ )
240+ , ( "Remove a file in root Dir"
241+ , \fp -> writeFile (fp </> "FileCreated.txt") "Test Data"
242+ , \fp -> removeFile (fp </> "FileCreated.txt")
243+ , [ "FileCreated.txt_2" ]
244+ , False
245+ )
246+ , ( "Rename a file in root Dir"
247+ , \fp -> writeFile (fp </> "FileCreated.txt") "Test Data"
248+ , \fp ->
249+ let spath = (fp </> "FileCreated.txt")
250+ tpath = (fp </> "FileRenamed.txt")
251+ in renamePath spath tpath
252+ , [ "FileCreated.txt_4"
253+ , "FileRenamed.txt_5"
254+ ]
255+ , False
256+ )
257+ , ( "Create a file in a nested Dir"
258+ , \fp ->
259+ createDirectoryIfMissing True (fp </> "dir1" </> "dir2" </> "dir3")
260+ , \fp ->
261+ let p = fp </> "dir1" </> "dir2" </> "dir3" </> "FileCreated.txt"
262+ in writeFile p "Test Data"
263+
264+ , [ "dir1\\dir2\\dir3\\FileCreated.txt_1"
265+ , "dir1\\dir2\\dir3\\FileCreated.txt_3"
266+ ]
267+
268+ , False
269+ )
270+ , ( "Remove a file in a nested Dir"
271+ , \fp ->
272+ let nestedDir = fp </> "dir1" </> "dir2" </> "dir3"
273+ fpath = nestedDir </> "FileCreated.txt"
274+ in do
275+ createDirectoryIfMissing True nestedDir
276+ writeFile fpath "Test Data"
277+ , \fp ->
278+ let p = fp </> "dir1" </> "dir2" </> "dir3" </> "FileCreated.txt"
279+ in removeFile p
280+ , ["dir1\\dir2\\dir3\\FileCreated.txt_2"]
281+ , False
282+ )
283+ , ( "Rename a file in a nested Dir"
284+ , \fp ->
285+ let nestedDir = fp </> "dir1" </> "dir2" </> "dir3"
286+ fpath = nestedDir </> "FileCreated.txt"
287+ in do
288+ createDirectoryIfMissing True nestedDir
289+ writeFile fpath "Test Data"
290+ , \fp ->
291+ let s = (fp </> "dir1" </> "dir2" </> "dir3" </> "FileCreated.txt")
292+ t = (fp </> "dir1" </> "dir2" </> "dir3" </> "FileRenamed.txt")
293+ in renamePath s t
294+ , [ "dir1\\dir2\\dir3_3"
295+ , "dir1\\dir2\\dir3\\FileCreated.txt_4"
296+ , "dir1\\dir2\\dir3\\FileRenamed.txt_5"
297+ ]
298+ , False
299+ )
300+ , ( "Remove the nested directory"
301+ , \fp ->
302+ createDirectoryIfMissing True (fp </> "dir1" </> "dir2" </> "dir3")
303+ , \fp -> removePathForcibly (fp </> "dir1")
304+ , [ "dir1_3"
305+ , "dir1\\dir2_3"
306+ , "dir1\\dir2\\dir3_2"
307+ , "dir1\\dir2_2","dir1_2"
308+ ]
309+ , False
310+ )
311+ ]
312+
313+-- Since removel of root path as Symlink hangs for ever, testDescRootDir
314+-- is provided seperately.
315+testDescRootDir =
316+ [ ( "Remove the root directory"
317+ , \fp ->
318+ createDirectoryIfMissing True (fp </> "dir1" </> "dir2")
319+ , \fp -> removePathForcibly fp
320+ , ["dir1_2", "dir1_3", "dir1\\dir2_2"]
321+ , False
322+ )
323+ ]
324+
325+moduleName :: String
326+moduleName = "FileSystem.Event"
327+
328+testCommonEvents :: IO ()
329+testCommonEvents = do
330+ hspec
331+ $ describe moduleName
332+ $ mapM_
333+ (driver $ checkEvents eventListWithEOtask Event.watchRecursive)
334+ testDesc
335+ hspec
336+ $ describe moduleName
337+ $ mapM_
338+ (driver $ checkEvents (eventListWithFixLen 3) Event.watchRecursive)
339+ testDescRootDir
340+ -- Run test cases for SymLink
341+ -- Remove the root directory as SymLink is not allowed, it hangs and Timeout.
342+ hspec
343+ $ describe moduleName
344+ $ mapM_
345+ (driver $ checkEvents eventListWithEOtask Event.watchRecursive)
346+ (map (\(a, b, c, d, _) -> (a, b, c, d, True)) testDesc)
test/Streamly/Test/FileSystem/Event/WindowsTest.hsnew file+9
@@ -0,0 +1,9 @@
1+module Main (main) where
2+
3+import System.IO (BufferMode(..), hSetBuffering, stdout)
4+import qualified Streamly.Test.FileSystem.Event.Windows as Event
5+
6+main :: IO ()
7+main = do
8+ hSetBuffering stdout NoBuffering
9+ Event.testCommonEvents
test/streamly-tests.cabal+18
@@ -281,6 +281,24 @@ test-suite FileSystem.Event
281281 if os(darwin)
282282 buildable: False
283283
284+test-suite FileSystem.Event.Linux
285+ import: test-options
286+ type: exitcode-stdio-1.0
287+ main-is: Streamly/Test/FileSystem/Event/LinuxTest.hs
288+ if os(windows)
289+ buildable: False
290+ if os(darwin)
291+ buildable: False
292+
293+test-suite FileSystem.Event.Windows
294+ import: test-options
295+ type: exitcode-stdio-1.0
296+ main-is: Streamly/Test/FileSystem/Event/WindowsTest.hs
297+ if os(linux)
298+ buildable: False
299+ if os(darwin)
300+ buildable: False
301+
284302test-suite FileSystem.Handle
285303 import: test-options
286304 type: exitcode-stdio-1.0