git.iko.soy/streamly
on master help sign in
Fix docs and enable test cases for common FS Event module
6b0b502Ranjeet Kumar Ranjan
src/Streamly/Internal/FileSystem/Event.hs+49−4
compare with master
unifiedsplit
@@ -104,8 +104,22 @@ import qualified Streamly.Internal.FileSystem.Event.Windows as Event
104--
104--
105-- /Pre-release/
105-- /Pre-release/
106--
106--
107−watch :: NonEmpty (Array Word8) -> SerialT IO Event.Event
107+watch :: NonEmpty (Array Word8) -> SerialT IO Event
108+#if defined(CABAL_OS_WINDOWS)
108watch = Event.watch
109watch = 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
109
123
110-- | Like 'watch' except that if a watched path is a directory the whole
124-- | Like 'watch' except that if a watched path is a directory the whole
111-- directory tree under it is watched recursively.
125-- directory tree under it is watched recursively.
@@ -115,7 +129,21 @@ watch = Event.watch
115-- /Pre-release/
129-- /Pre-release/
116--
130--
117watchRecursive :: NonEmpty (Array Word8) -> SerialT IO Event
131watchRecursive :: NonEmpty (Array Word8) -> SerialT IO Event
132+#if defined(CABAL_OS_WINDOWS)
133+watchRecursive = 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)
118watchRecursive = Event.watchRecursive
145watchRecursive = Event.watchRecursive
146+#endif
119
147
120-------------------------------------------------------------------------------
148-------------------------------------------------------------------------------
121-- Handling Events
149-- Handling Events
@@ -134,7 +162,8 @@ getAbsPath = Event.getAbsPath
134-- | Determine whether the event indicates creation of an object within the
162-- | Determine whether the event indicates creation of an object within the
135-- monitored path. This event is generated when any file system object other
163-- monitored path. This event is generated when any file system object other
136-- than a hard link is created.
164-- than a hard link is created.
137−--
165+-- Hard link behaviours:
166+-- On Linux and Windows hard lnik creation generates 'Created' event.
138-- /Pre-release/
167-- /Pre-release/
139--
168--
140isCreated :: Event -> Bool
169isCreated :: Event -> Bool
@@ -143,8 +172,20 @@ isCreated = Event.isCreated
143-- XXX Test and document the hard link deletion on each platform.
172-- XXX Test and document the hard link deletion on each platform.
144--
173--
145-- | Determine whether the event indicates deletion of an object within the
174-- | Determine whether the event indicates deletion of an object within the
146−-- monitored path. This is true when a file or a hardlink is deleted.
175+-- monitored path. This is true when a file or a hardlink is deleted.--
176+-- Hard link behaviours:
177+-- On Linux and Windows hard lnik deletion generates 'Deleted' event
178+-- @
179+-- Deletion of Root path:
180+--
181+-- In 'Linux' the deletion of root path only generates 'RootDeleted' event for
182+-- the root path, whereas the nested directory inside the root path gets
183+-- 'Deleted' and 'RootDeleted' events.
147−--
184+--
185+-- In Windows from GUI the deletion of root path is not allowed , from CLI the
186+-- content inside the root path is deleted and 'Deleted' event is generated
187+-- for each nested paths.There is no event generated for root path itself.
188+-- @
148-- /Pre-release/
189-- /Pre-release/
149--
190--
150isDeleted :: Event -> Bool
191isDeleted :: Event -> Bool
@@ -156,6 +197,8 @@ isDeleted = Event.isDeleted
156-- monitored path. This event is generated when an object is renamed within the
197-- monitored path. This event is generated when an object is renamed within the
157-- watched directory or if it is moved out of or in the watched directory.
198-- watched directory or if it is moved out of or in the watched directory.
158--
199--
200+-- Hard link behaviours:
201+-- On Linux and Windows hard lnik move generates 'MovedFrom' and ' MovedTo' events
159-- /Pre-release/
202-- /Pre-release/
160--
203--
161isMoved :: Event -> Bool
204isMoved :: Event -> Bool
@@ -163,6 +206,8 @@ isMoved = Event.isMoved
163
206
164-- | Determine whether the event indicates modification of an object within the
207-- | Determine whether the event indicates modification of an object within the
165-- monitored path. This event is generated only for files and not directories.
208-- monitored path. This event is generated only for files and not directories.
209+-- Unlike Linux in Windows in recursive mode when a file is created or deleted the Modified
210+-- event is generated for the parent directory as well.
166--
211--
167-- /Pre-release/
212-- /Pre-release/
168--
213--
src/Streamly/Internal/FileSystem/Event/Linux.hs+51−1
@@ -66,6 +66,7 @@ module Streamly.Internal.FileSystem.Event.Linux
66 Config (..)
66 Config (..)
67 , Toggle (..)
67 , Toggle (..)
68 , defaultConfig
68 , defaultConfig
69+ , setRecursiveMode
69
70
70 -- ** Watch Behavior
71 -- ** Watch Behavior
71 , setFollowSymLinks
72 , setFollowSymLinks
@@ -80,6 +81,7 @@ module Streamly.Internal.FileSystem.Event.Linux
80 , setRootDeleted
81 , setRootDeleted
81 , setRootMoved
82 , setRootMoved
82 -- XXX make a setRootPathEvents to include all root events
83 -- XXX make a setRootPathEvents to include all root events
84+ , setRootPathEvents
83
85
84 -- *** Item Level Metadata change
86 -- *** Item Level Metadata change
85 , setMetadataChanged
87 , setMetadataChanged
@@ -103,6 +105,8 @@ module Streamly.Internal.FileSystem.Event.Linux
103 , watch
105 , watch
104 , watchRecursive
106 , watchRecursive
105 , watchWith
107 , watchWith
108+ , watchWithFlags
109+ , watchRecursiveWithFlags
106
110
107 -- Low level watch APIs
111 -- Low level watch APIs
108 , addToWatch
112 , addToWatch
@@ -117,6 +121,7 @@ module Streamly.Internal.FileSystem.Event.Linux
117
121
118 -- ** Root Level Events
122 -- ** Root Level Events
119 -- XXX create a isRootPathEvent similar to macOS.
123 -- XXX create a isRootPathEvent similar to macOS.
124+ , isRootPathEvent
120 , isRootUnwatched
125 , isRootUnwatched
121 , isRootDeleted
126 , isRootDeleted
122 , isRootMoved
127 , isRootMoved
@@ -360,6 +365,15 @@ foreign import capi
360setRootMoved :: Toggle -> Config -> Config
365setRootMoved :: Toggle -> Config -> Config
361setRootMoved = setFlag iN_MOVE_SELF
366setRootMoved = setFlag iN_MOVE_SELF
362
367
368+-- | Report when the watched root path itself gets deleted or renamed.
369+--
370+-- /default: On/
371+--
372+-- /Pre-release/
373+--
374+setRootPathEvents :: Toggle -> Config -> Config
375+setRootPathEvents = setFlag (iN_DELETE_SELF .|. iN_MOVE_SELF)
376+
363foreign import capi
377foreign import capi
364 "sys/inotify.h value IN_ATTRIB" iN_ATTRIB :: Word32
378 "sys/inotify.h value IN_ATTRIB" iN_ATTRIB :: Word32
365
379
@@ -904,6 +918,31 @@ watchRecursive = watchWith id
904watch :: NonEmpty (Array Word8) -> SerialT IO Event
918watch :: NonEmpty (Array Word8) -> SerialT IO Event
905watch = watchWith (setRecursiveMode False)
919watch = watchWith (setRecursiveMode False)
906
920
921+-- | In recursive mode when a nested directory is created,
922+-- 'Created' event is generated only for the top directory.
923+-- No recursive Created events are generated for nested contents.
924+-- When a nested directory is deleted 'Deleted' events are generated
925+-- for the nested content recursively.
926+-- The nested directories are added into watch list for future events.
927+-- [flags] are used to filter the events with specific event flag.
928+--
929+-- /Pre-release/
930+--
931+watchRecursiveWithFlags ::
932+ [Word32] -> NonEmpty (Array Word8) -> SerialT IO Event
933+watchRecursiveWithFlags flags =
934+ S.filter (\ev -> any (flip getFlag ev) flags) . watchRecursive
935+
936+-- | When a nested directory is created,
937+-- Created event is generated only for the top directory.
938+-- [flags] are used to filter the events with specific event flag.
939+--
940+-- /Pre-release/
941+--
942+watchWithFlags :: [Word32] -> NonEmpty (Array Word8) -> SerialT IO Event
943+watchWithFlags flags =
944+ S.filter (\ev -> any (flip getFlag ev) flags) . watch
945+
907-------------------------------------------------------------------------------
946-------------------------------------------------------------------------------
908-- Examine event stream
947-- Examine event stream
909-------------------------------------------------------------------------------
948-------------------------------------------------------------------------------
@@ -942,7 +981,7 @@ getRelPath Event{..} = eventRelPath
942-- /Pre-release/
981-- /Pre-release/
943--
982--
944getAbsPath :: Event -> Array Word8
983getAbsPath :: Event -> Array Word8
945−getAbsPath ev = getRoot ev <> A.fromCString# "/"# <> getRelPath ev
984+getAbsPath ev = ensureTrailingSlash (getRoot ev) <> getRelPath ev
946
985
947-- XXX should we use a Maybe?
986-- XXX should we use a Maybe?
948-- | Cookie is set when a rename occurs. The cookie value can be used to
987-- | Cookie is set when a rename occurs. The cookie value can be used to
@@ -1037,6 +1076,17 @@ foreign import capi
1037isRootUnmounted :: Event -> Bool
1076isRootUnmounted :: Event -> Bool
1038isRootUnmounted = getFlag iN_UNMOUNT
1077isRootUnmounted = getFlag iN_UNMOUNT
1039
1078
1079+-- | Determine whether the event indicates a change of path of the monitored
1080+-- object itself. Note that the object may become unreachable or deleted after
1081+-- a change of path.
1082+--
1083+-- /Occurs only for a watched path/
1084+--
1085+-- /Pre-release/
1086+--
1087+isRootPathEvent :: Event -> Bool
1088+isRootPathEvent = getFlag (iN_DELETE_SELF .|. iN_MOVE_SELF .|. iN_UNMOUNT)
1089+
1040-------------------------------------------------------------------------------
1090-------------------------------------------------------------------------------
1041-- Metadata change Events
1091-- Metadata change Events
1042-------------------------------------------------------------------------------
1092-------------------------------------------------------------------------------
src/Streamly/Internal/FileSystem/Event/Windows.hs+66−7
@@ -64,11 +64,11 @@ module Streamly.Internal.FileSystem.Event.Windows
64
64
65 -- ** Watch APIs
65 -- ** Watch APIs
66 , watch
66 , watch
67− , watchTrees
67+ , watchRecursive
68− , watchTreesWith
68+ , watchWith
69
69
70 -- * Handling Events
70 -- * Handling Events
71− , Event
71+ , Event(..)
72 , getRoot
72 , getRoot
73 , getRelPath
73 , getRelPath
74 , getAbsPath
74 , getAbsPath
@@ -76,9 +76,10 @@ module Streamly.Internal.FileSystem.Event.Windows
76 -- ** Item CRUD events
76 -- ** Item CRUD events
77 , isCreated
77 , isCreated
78 , isDeleted
78 , isDeleted
79+ , isModified
80+ , isMoved
79 , isMovedFrom
81 , isMovedFrom
80 , isMovedTo
82 , isMovedTo
81− , isModified
82
83
83 -- ** Exception Conditions
84 -- ** Exception Conditions
84 , isEventsLost
85 , isEventsLost
@@ -410,7 +411,7 @@ closePathHandleStream = S.mapM_ (\(h, _, _) -> closeHandle h)
410-- path is a directory, only the files and directories directly under the
411-- path is a directory, only the files and directories directly under the
411-- watched directory are monitored, contents of subdirectories are not
412-- watched directory are monitored, contents of subdirectories are not
412-- monitored. Monitoring starts from the current time onwards. The paths are
413-- monitored. Monitoring starts from the current time onwards. The paths are
413−-- specified as UTF-8 encoded 'Array' of 'Word8'.
414+-- specified as encoded 'Array' of 'Word8'.
414--
415--
415-- @
416-- @
416-- watchWith
417-- watchWith
@@ -468,11 +469,46 @@ getRoot :: Event -> Array Word8
468getRoot Event{..} = (UTF8.toArray . UTF8.pack) eventRootPath
469getRoot Event{..} = (UTF8.toArray . UTF8.pack) eventRootPath
469
470
470getAbsPath :: Event -> Array Word8
471getAbsPath :: Event -> Array Word8
471−getAbsPath ev = getRoot ev <> getRelPath ev
472+getAbsPath ev = getRoot ev <> A.fromCString# "\\"# <> (getRelPath ev)
472
473
473-- XXX need to document the exact semantics of these.
474-- XXX need to document the exact semantics of these.
474--
475--
475-- | File/directory created in watched directory.
476-- | File/directory created in watched directory.
477+-- ** In non-recursive mode
478+-- @
479+-- When a file or directory is created, Created and Modified events are
480+-- generated for corresponding file or directory. Parent directory will not
481+-- generate any events.
482+--
483+-- When a nested directory is created following events are generated:
484+-- Created event for the directory created.
485+-- Modified event for the directory created.
486+-- Modified event for each entry inside it.
487+-- If a nested directory contains 5 entries on top level then we will get
488+-- one Created and six Modified events for the created top directory path.
489+-- @
490+--
491+-- ** In recursive mode
492+-- @
493+-- When a file is created we get following events:
494+-- Created event for the file got created.
495+-- Modified event for the file got created.
496+-- Modified event for the parent directory.
497+-- @
498+--
499+-- @
500+-- When an empty directory is created we get following events:
501+-- Created event for the directory got created.
502+-- Modified event for the parent directory.
503+-- @
504+--
505+-- @
506+-- When a nested directory is created we get
507+-- following events:
508+-- Created and Modified events for all the files and subdirectories
509+-- recursively inside the given directory.
510+-- Modified event for the parent directory.
511+-- @
476--
512--
477-- /Pre-release/
513-- /Pre-release/
478--
514--
@@ -480,7 +516,13 @@ isCreated :: Event -> Bool
480isCreated = getFlag fILE_ACTION_ADDED
516isCreated = getFlag fILE_ACTION_ADDED
481
517
482-- | File/directory deleted from watched directory.
518-- | File/directory deleted from watched directory.
519+-- ** In non-recursive mode:
520+-- Deleted event is generated for object deleted from watched directory.
521+-- No events are generated for nested objects.
483--
522--
523+-- ** In recursive mode:
524+-- If a nested directory is deleted Modified events are received for nested
525+-- sub-directories recursively. No events are generated for nested files.
484-- /Pre-release/
526-- /Pre-release/
485--
527--
486isDeleted :: Event -> Bool
528isDeleted :: Event -> Bool
@@ -488,6 +530,7 @@ isDeleted = getFlag fILE_ACTION_REMOVED
488
530
489-- | Generated for the original path when an object is moved from under a
531-- | Generated for the original path when an object is moved from under a
490-- monitored directory.
532-- monitored directory.
533+-- In recursive mode Modified events is generated for parent directory.
491--
534--
492-- /Pre-release/
535-- /Pre-release/
493--
536--
@@ -496,17 +539,32 @@ isMovedFrom = getFlag fILE_ACTION_RENAMED_OLD_NAME
496
539
497-- | Generated for the new path when an object is moved under a monitored
540-- | Generated for the new path when an object is moved under a monitored
498-- directory.
541-- directory.
542+-- In recursive mode Modified events is generated for parent directory.
499--
543--
500-- /Pre-release/
544-- /Pre-release/
501--
545--
502isMovedTo :: Event -> Bool
546isMovedTo :: Event -> Bool
503isMovedTo = getFlag fILE_ACTION_RENAMED_NEW_NAME
547isMovedTo = getFlag fILE_ACTION_RENAMED_NEW_NAME
504
548
549+-- | Generated for a path that is moved from or moved to the monitored
550+-- directory.
551+--
552+-- >>> isMoved ev = isMovedFrom ev || isMovedTo ev
553+--
554+-- /Occurs only for an object inside the watched directory/
555+--
556+-- /Pre-release/
557+--
558+isMoved :: Event -> Bool
559+isMoved ev = isMovedFrom ev || isMovedTo ev
560+
505-- XXX This event is generated only for files and not directories?
561-- XXX This event is generated only for files and not directories?
506--
562--
507-- | Determine whether the event indicates modification of an object within the
563-- | Determine whether the event indicates modification of an object within the
508-- monitored path.
564-- monitored path.
509−--
565+-- In non-recursive mode Modified event is not generated for a directory.
566+-- In recursive mode Modified event is generated for parent directory if a file
567+-- or directory is created or renamed.
510-- /Pre-release/
568-- /Pre-release/
511--
569--
512isModified :: Event -> Bool
570isModified :: Event -> Bool
@@ -531,6 +589,7 @@ showEvent ev@Event{..} =
531 "--------------------------"
589 "--------------------------"
532 ++ "\nRoot = " ++ utf8ToString (getRoot ev)
590 ++ "\nRoot = " ++ utf8ToString (getRoot ev)
533 ++ "\nPath = " ++ utf8ToString (getRelPath ev)
591 ++ "\nPath = " ++ utf8ToString (getRelPath ev)
592+ ++ "\ngetAbsPath = " ++ utf8ToString (getAbsPath ev)
534 ++ "\nFlags " ++ show eventFlags
593 ++ "\nFlags " ++ show eventFlags
535 ++ showev isEventsLost "Overflow"
594 ++ showev isEventsLost "Overflow"
536 ++ showev isCreated "Created"
595 ++ showev isCreated "Created"
test/Streamly/Test/FileSystem/Event.hs+162−52
@@ -18,6 +18,7 @@ import Data.Maybe (fromJust)
18import Data.Word (Word8)
18import Data.Word (Word8)
19import System.Directory
19import System.Directory
20 ( createDirectoryIfMissing
20 ( createDirectoryIfMissing
21+ , createDirectoryLink
21 , removeFile
22 , removeFile
22 , removeDirectory
23 , removeDirectory
23 , removePathForcibly
24 , removePathForcibly
@@ -33,6 +34,7 @@ import System.IO.Unsafe (unsafePerformIO)
33import Streamly.Internal.Data.Array.Foreign (Array)
34import Streamly.Internal.Data.Array.Foreign (Array)
34
35
35import qualified Data.List.NonEmpty as NonEmpty
36import qualified Data.List.NonEmpty as NonEmpty
37+import Data.List.NonEmpty (NonEmpty)
36import qualified Data.Set as Set
38import qualified Data.Set as Set
37import qualified Streamly.Unicode.Stream as Unicode
39import qualified Streamly.Unicode.Stream as Unicode
38import qualified Streamly.Internal.Data.Array.Foreign as Array
40import qualified Streamly.Internal.Data.Array.Foreign as Array
@@ -40,6 +42,7 @@ import qualified Streamly.Internal.Data.Fold as FL
40import qualified Streamly.Internal.Data.Parser as PR
42import qualified Streamly.Internal.Data.Parser as PR
41import qualified Streamly.Internal.Data.Stream.IsStream as S
43import qualified Streamly.Internal.Data.Stream.IsStream as S
42import qualified Streamly.Internal.Unicode.Stream as U
44import qualified Streamly.Internal.Unicode.Stream as U
45+import qualified Streamly.Internal.FileSystem.Event as CommonEvent
43#if defined(CABAL_OS_DARWIN)
46#if defined(CABAL_OS_DARWIN)
44import qualified Streamly.Internal.FileSystem.Event.Darwin as Event
47import qualified Streamly.Internal.FileSystem.Event.Darwin as Event
45#elif defined(CABAL_OS_LINUX)
48#elif defined(CABAL_OS_LINUX)
@@ -74,11 +77,7 @@ eoTask = "EOTask"
74-- XXX Make the getRelPath type same on windows and other platforms
77-- XXX Make the getRelPath type same on windows and other platforms
75eventPredicate :: Event.Event -> Bool
78eventPredicate :: Event.Event -> Bool
76eventPredicate ev =
79eventPredicate ev =
77−#if defined(CABAL_OS_WINDOWS)
78− if (utf8ToString $ Event.getRelPath ev) == eoTask
79−#else
80 if (utf8ToString $ Event.getRelPath ev) == eoTask
80 if (utf8ToString $ Event.getRelPath ev) == eoTask
81−#endif
82 then False
81 then False
83 else True
82 else True
84
83
@@ -122,18 +121,37 @@ showEventShort ev@Event.Event{..} =
122#error "Unsupported OS"
121#error "Unsupported OS"
123#endif
122#endif
124
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+
125-------------------------------------------------------------------------------
133-------------------------------------------------------------------------------
126-- Event Watcher
134-- Event Watcher
127-------------------------------------------------------------------------------
135-------------------------------------------------------------------------------
128
136
129−checkEvents :: FilePath -> MVar () -> [String] -> IO String
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
130−checkEvents rootPath m matchList = do
148+checkEvents toEL ew rootPath m matchList = do
131 let args = [rootPath]
149 let args = [rootPath]
132 paths <- mapM toUtf8 args
150 paths <- mapM toUtf8 args
133 putStrLn ("Watch started !!!! on Path " ++ rootPath)
151 putStrLn ("Watch started !!!! on Path " ++ rootPath)
134− events <- S.parse (PR.takeWhile eventPredicate FL.toList)
152+ events <- toEL
135 $ S.before (putMVar m ())
153 $ S.before (putMVar m ())
136− $ Event.watchTrees (NonEmpty.fromList paths)
154+ $ ew (NonEmpty.fromList paths)
137 let eventStr = map showEventShort events
155 let eventStr = map showEventShort events
138 let baseSet = Set.fromList matchList
156 let baseSet = Set.fromList matchList
139 resultSet = Set.fromList eventStr
157 resultSet = Set.fromList eventStr
@@ -150,9 +168,9 @@ checkEvents rootPath m matchList = do
150-------------------------------------------------------------------------------
168-------------------------------------------------------------------------------
151
169
152checker :: S.IsStream t =>
170checker :: S.IsStream t =>
153− FilePath -> MVar () -> [String] -> t IO String
171+ EventChecker -> FilePath -> MVar () -> [String] -> t IO String
154−checker rootPath synch matchList =
172+checker ec rootPath synch matchList =
155− S.fromEffect (checkEvents rootPath synch matchList)
173+ S.fromEffect (ec rootPath synch matchList)
156 `S.parallelFst`
174 `S.parallelFst`
157 S.fromEffect timeout
175 S.fromEffect timeout
158
176
@@ -161,30 +179,41 @@ checker rootPath synch matchList =
161-------------------------------------------------------------------------------
179-------------------------------------------------------------------------------
162
180
163driver ::
181driver ::
182+ EventChecker
164− ( String
183+ -> ( String
165 , FilePath -> IO ()
184 , FilePath -> IO ()
166 , FilePath -> IO ()
185 , FilePath -> IO ()
167 , [String]
186 , [String]
187+ , Bool
168 )
188 )
169 -> SpecWith ()
189 -> SpecWith ()
170−driver (desc, pre, ops, events) = it desc $ runTest `shouldReturn` "PASS"
190+driver ec (desc, pre, ops, events, sym) = it desc $ runTest `shouldReturn` "PASS"
171
191
172 where
192 where
173
193
174 runTest = do
194 runTest = do
175 sync <- newEmptyMVar
195 sync <- newEmptyMVar
176− withSystemTempDirectory fseventDir $ \fp -> do
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
177− pre fp
205+ pre fp
178− let eventStream = checker fp sync events
206+ let eventStream = checker ec fp sync events
179− fsOps = S.fromEffect $ runFSOps fp sync
207+ fsOps = S.fromEffect $ runFSOps fp sync
180− fmap fromJust $ S.head $ eventStream `S.parallelFst` fsOps
208+ fmap fromJust $ S.head $ eventStream `S.parallelFst` fsOps
181
209
182 runFSOps fp sync = do
210 runFSOps fp sync = do
183 _ <- takeMVar sync
211 _ <- takeMVar sync
184 threadDelay 200000
212 threadDelay 200000
185 ops fp
213 ops fp
214+ -- 'EOTask Created dir' event gets out of order so need to wait here
186 threadDelay 200000 -- Why this delay?
215 threadDelay 200000 -- Why this delay?
187− createDirectoryIfMissing True (fp </> "EOTask")
216+ createDirectoryIfMissing True (fp </> eoTask)
188 threadDelay 10000000
217 threadDelay 10000000
189 error "fs ops timed out"
218 error "fs ops timed out"
190
219
@@ -192,11 +221,12 @@ driver (desc, pre, ops, events) = it desc $ runTest `shouldReturn` "PASS"
192-- Main
221-- Main
193-------------------------------------------------------------------------------
222-------------------------------------------------------------------------------
194
223
195−testDesc ::
224+testDesc, testDescRootDir ::
196 [ ( String -- test description
225 [ ( String -- test description
197 , FilePath -> IO () -- pre test operation
226 , FilePath -> IO () -- pre test operation
198 , FilePath -> IO () -- file system actions
227 , FilePath -> IO () -- file system actions
199− , [String]) -- expected events
228+ , [String] -- expected events
229+ , Bool ) -- SymLink
200 ]
230 ]
201testDesc =
231testDesc =
202 [
232 [
@@ -206,12 +236,9 @@ testDesc =
206#if defined(CABAL_OS_WINDOWS)
236#if defined(CABAL_OS_WINDOWS)
207 , [ "dir1Single_1" ]
237 , [ "dir1Single_1" ]
208#elif defined(CABAL_OS_LINUX)
238#elif defined(CABAL_OS_LINUX)
209− , [ "dir1Single_1073742080_Dir"
239+ , ["dir1Single_1073742080_Dir"]
210− , "dir1Single_1073741856_Dir"
211− , "dir1Single_1073741825_Dir"
212− , "dir1Single_1073741840_Dir"
213− ]
214#endif
240#endif
241+ , False
215 )
242 )
216 , ( "Remove a single directory"
243 , ( "Remove a single directory"
217 , \fp -> createDirectoryIfMissing True (fp </> "dir1Single")
244 , \fp -> createDirectoryIfMissing True (fp </> "dir1Single")
@@ -219,10 +246,11 @@ testDesc =
219#if defined(CABAL_OS_WINDOWS)
246#if defined(CABAL_OS_WINDOWS)
220 , [ "dir1Single_2" ]
247 , [ "dir1Single_2" ]
221#elif defined(CABAL_OS_LINUX)
248#elif defined(CABAL_OS_LINUX)
222− , [ "dir1Single_1024"
249+ , [
223− , "dir1Single_32768"
250+ "dir1Single_1073742336_Dir"
224 ]
251 ]
225#endif
252#endif
253+ , False
226 )
254 )
227 , ( "Rename a single directory"
255 , ( "Rename a single directory"
228 , \fp -> createDirectoryIfMissing True (fp </> "dir1Single")
256 , \fp -> createDirectoryIfMissing True (fp </> "dir1Single")
@@ -239,6 +267,7 @@ testDesc =
239 , "dir1SingleRenamed_1073741952_Dir"
267 , "dir1SingleRenamed_1073741952_Dir"
240 ]
268 ]
241#endif
269#endif
270+ , False
242 )
271 )
243 , ( "Create a nested directory"
272 , ( "Create a nested directory"
244 , const (return ())
273 , const (return ())
@@ -251,28 +280,9 @@ testDesc =
251 ]
280 ]
252#elif defined(CABAL_OS_LINUX)
281#elif defined(CABAL_OS_LINUX)
253 , [ "dir1_1073742080_Dir"
282 , [ "dir1_1073742080_Dir"
254− , "dir1_1073741856_Dir"
255− , "dir1_1073741825_Dir"
256− , "dir1_1073741840_Dir"
257− ]
258−#endif
259− )
260− , ( "Remove a nested directory"
261− , \fp ->
262− createDirectoryIfMissing True (fp </> "dir1" </> "dir2" </> "dir3")
263− , \fp -> removePathForcibly (fp </> "dir1")
264−#if defined(CABAL_OS_WINDOWS)
265− , [ "dir1_3"
266− , "dir1\\dir2_3"
267− , "dir1\\dir2\\dir3_2"
268− , "dir1\\dir2_2","dir1_2"
269− ]
270−#elif defined(CABAL_OS_LINUX)
271− , [ "dir1/dir2/dir3_1073742336_Dir"
272− , "dir1/dir2_1073742336_Dir"
273− , "dir1_1073742336_Dir"
274 ]
283 ]
275#endif
284#endif
285+ , False
276 )
286 )
277 , ( "Rename a nested directory"
287 , ( "Rename a nested directory"
278 , \fp -> createDirectoryIfMissing True
288 , \fp -> createDirectoryIfMissing True
@@ -292,6 +302,7 @@ testDesc =
292 , "dir1/dir2/dir3Renamed_1073741952_Dir"
302 , "dir1/dir2/dir3Renamed_1073741952_Dir"
293 ]
303 ]
294#endif
304#endif
305+ , False
295 )
306 )
296 , ( "Create a file in root Dir"
307 , ( "Create a file in root Dir"
297 , const (return ())
308 , const (return ())
@@ -303,10 +314,10 @@ testDesc =
303 ]
314 ]
304#elif defined(CABAL_OS_LINUX)
315#elif defined(CABAL_OS_LINUX)
305 , [ "FileCreated.txt_256"
316 , [ "FileCreated.txt_256"
306− , "FileCreated.txt_32"
307 , "FileCreated.txt_2"
317 , "FileCreated.txt_2"
308 ]
318 ]
309#endif
319#endif
320+ , False
310 )
321 )
311 , ( "Remove a file in root Dir"
322 , ( "Remove a file in root Dir"
312 , \fp -> writeFile (fp </> "FileCreated.txt") "Test Data"
323 , \fp -> writeFile (fp </> "FileCreated.txt") "Test Data"
@@ -316,6 +327,7 @@ testDesc =
316#elif defined(CABAL_OS_LINUX)
327#elif defined(CABAL_OS_LINUX)
317 , [ "FileCreated.txt_512" ]
328 , [ "FileCreated.txt_512" ]
318#endif
329#endif
330+ , False
319 )
331 )
320 , ( "Rename a file in root Dir"
332 , ( "Rename a file in root Dir"
321 , \fp -> writeFile (fp </> "FileCreated.txt") "Test Data"
333 , \fp -> writeFile (fp </> "FileCreated.txt") "Test Data"
@@ -332,6 +344,7 @@ testDesc =
332 , "FileRenamed.txt_128"
344 , "FileRenamed.txt_128"
333 ]
345 ]
334#endif
346#endif
347+ , False
335 )
348 )
336 , ( "Create a file in a nested Dir"
349 , ( "Create a file in a nested Dir"
337 , \fp ->
350 , \fp ->
@@ -345,11 +358,10 @@ testDesc =
345 ]
358 ]
346#elif defined(CABAL_OS_LINUX)
359#elif defined(CABAL_OS_LINUX)
347 , [ "dir1/dir2/dir3/FileCreated.txt_256"
360 , [ "dir1/dir2/dir3/FileCreated.txt_256"
348− , "dir1/dir2/dir3/FileCreated.txt_32"
349 , "dir1/dir2/dir3/FileCreated.txt_2"
361 , "dir1/dir2/dir3/FileCreated.txt_2"
350− , "dir1/dir2/dir3/FileCreated.txt_8"
351 ]
362 ]
352#endif
363#endif
364+ , False
353 )
365 )
354 , ( "Remove a file in a nested Dir"
366 , ( "Remove a file in a nested Dir"
355 , \fp ->
367 , \fp ->
@@ -366,6 +378,7 @@ testDesc =
366#elif defined(CABAL_OS_LINUX)
378#elif defined(CABAL_OS_LINUX)
367 , ["dir1/dir2/dir3/FileCreated.txt_512"]
379 , ["dir1/dir2/dir3/FileCreated.txt_512"]
368#endif
380#endif
381+ , False
369 )
382 )
370 , ( "Rename a file in a nested Dir"
383 , ( "Rename a file in a nested Dir"
371 , \fp ->
384 , \fp ->
@@ -388,13 +401,110 @@ testDesc =
388 , "dir1/dir2/dir3/FileRenamed.txt_128"
401 , "dir1/dir2/dir3/FileRenamed.txt_128"
389 ]
402 ]
390#endif
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
391 )
432 )
392 ]
433 ]
393
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+
459+#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+ ]
476+#endif
477+
394moduleName :: String
478moduleName :: String
395moduleName = "FileSystem.Event"
479moduleName = "FileSystem.Event"
396
480
397main :: IO ()
481main :: IO ()
398main = do
482main = do
399 hSetBuffering stdout NoBuffering
483 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
400− hspec $ describe moduleName $ mapM_ driver testDesc
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