git.iko.soy/streamly
on master help sign in
Add recursive directory tree events in Linux
f00008bRanjeet Ranjan
src/Streamly/Internal/FileSystem/Event/Linux.hs+206−29
compare with master
unifiedsplit
@@ -101,6 +101,8 @@ module Streamly.Internal.FileSystem.Event.Linux
101 -- ** Watch APIs
101 -- ** Watch APIs
102 , watchPathsWith
102 , watchPathsWith
103 , watchPaths
103 , watchPaths
104+ , watchTreesWith
105+ , watchTrees
104 , addToWatch
106 , addToWatch
105 , removeFromWatch
107 , removeFromWatch
106
108
@@ -140,15 +142,19 @@ module Streamly.Internal.FileSystem.Event.Linux
140
142
141 -- * Debugging
143 -- * Debugging
142 , showEvent
144 , showEvent
145+ , showEventShort
143 )
146 )
144where
147where
145
148
146import Control.Monad (void, when)
149import Control.Monad (void, when)
147−import Control.Monad.IO.Class (liftIO)
150+import Control.Monad.IO.Class (MonadIO, liftIO)
151+import Data.Bifunctor (bimap)
148import Data.Bits ((.|.), (.&.), complement)
152import Data.Bits ((.|.), (.&.), complement)
149import Data.Foldable (foldlM)
153import Data.Foldable (foldlM)
150import Data.Functor.Identity (runIdentity)
154import Data.Functor.Identity (runIdentity)
151import Data.IntMap.Lazy (IntMap)
155import Data.IntMap.Lazy (IntMap)
156+import Data.IORef (IORef, newIORef, readIORef, writeIORef)
157+import Data.Function ((&))
152import Data.List.NonEmpty (NonEmpty)
158import Data.List.NonEmpty (NonEmpty)
153import Data.Word (Word8, Word32)
159import Data.Word (Word8, Word32)
154import Foreign.C.Error (throwErrnoIfMinus1)
160import Foreign.C.Error (throwErrnoIfMinus1)
@@ -162,6 +168,7 @@ import GHC.IO.Handle.FD (mkHandleFromFD)
162import Streamly.Prelude (SerialT)
168import Streamly.Prelude (SerialT)
163import Streamly.Internal.Data.Parser (Parser)
169import Streamly.Internal.Data.Parser (Parser)
164import Streamly.Internal.Data.Array.Storable.Foreign.Types (Array(..))
170import Streamly.Internal.Data.Array.Storable.Foreign.Types (Array(..))
171+import System.FilePath ((</>))
165import System.IO (Handle, hClose, IOMode(ReadMode))
172import System.IO (Handle, hClose, IOMode(ReadMode))
166#if !MIN_VERSION_base(4,10,0)
173#if !MIN_VERSION_base(4,10,0)
167import Control.Concurrent.MVar (readMVar)
174import Control.Concurrent.MVar (readMVar)
@@ -175,12 +182,13 @@ import GHC.IO.Handle.FD (handleToFd)
175
182
176import qualified Data.IntMap.Lazy as Map
183import qualified Data.IntMap.Lazy as Map
177import qualified Data.List.NonEmpty as NonEmpty
184import qualified Data.List.NonEmpty as NonEmpty
185+import qualified Streamly.Internal.Data.Array.Storable.Foreign as A
178import qualified Streamly.Internal.Data.Fold as FL
186import qualified Streamly.Internal.Data.Fold as FL
179import qualified Streamly.Internal.Data.Parser as PR
187import qualified Streamly.Internal.Data.Parser as PR
180import qualified Streamly.Internal.Data.Stream.IsStream as S
188import qualified Streamly.Internal.Data.Stream.IsStream as S
181−import qualified Streamly.Internal.Unicode.Stream as U
189+import qualified Streamly.Internal.FileSystem.Dir as Dir
182import qualified Streamly.Internal.FileSystem.Handle as FH
190import qualified Streamly.Internal.FileSystem.Handle as FH
183−import qualified Streamly.Internal.Data.Array.Storable.Foreign as A
191+import qualified Streamly.Internal.Unicode.Stream as U
184
192
185-------------------------------------------------------------------------------
193-------------------------------------------------------------------------------
186-- Subscription to events
194-- Subscription to events
@@ -192,7 +200,9 @@ import qualified Streamly.Internal.Data.Array.Storable.Foreign as A
192-- /Internal/
200-- /Internal/
193--
201--
194data Config = Config
202data Config = Config
203+ { watchRec :: Bool
195− { createFlags :: Word32 }
204+ , createFlags :: Word32
205+ }
196
206
197-------------------------------------------------------------------------------
207-------------------------------------------------------------------------------
198-- Boolean settings
208-- Boolean settings
@@ -217,9 +227,69 @@ setFlag mask status cfg@Config{..} =
217 in cfg {createFlags = flags}
227 in cfg {createFlags = flags}
218
228
219-------------------------------------------------------------------------------
229-------------------------------------------------------------------------------
220−-- Settings
230+-- Utilities
221-------------------------------------------------------------------------------
231-------------------------------------------------------------------------------
232+splitPath :: (MonadIO m) => FilePath -> FilePath -> m [FilePath]
233+splitPath pat xs = S.toList
234+ $ S.splitOnSeq (A.fromList pat) (FL.toList) (S.fromList xs)
235+
236+pathDiff :: (MonadIO m) => FilePath -> FilePath -> m FilePath
237+pathDiff pat xs = do
238+ splits <- splitPath pat xs
239+ let j = case length splits of
240+ 0 -> ""
241+ _ -> last splits
242+ t = case length j of
243+ 0 -> ""
244+ _ -> tail j
245+ return t
246+
247+dirListing :: String -> SerialT IO (Either String String)
248+dirListing s = do
249+ S.filter dirFilter
250+ $ S.iterateMapLeftsWith S.ahead listDir (S.yield $ (Left s))
251+
252+ where
253+
254+ dirFilter x =
255+ case x of
256+ Left _ -> True
257+ Right _ -> False
258+
259+ listDir dir =
260+ Dir.toEither dir -- SerialT IO (Either String String)
261+ & S.map (bimap prefix prefix) -- SerialT IO (Either String String)
262+
263+ where
264+
265+ prefix x = dir ++ "/" ++ x
266+
267+toPathList :: String -> IO [String]
268+toPathList root = do
269+ S.toList $ S.map toStr $ dirListing root
270+
271+ where
222
272
273+ toStr x =
274+ case x of
275+ Left d -> d
276+ Right d -> d
277+
278+toUtf8 :: MonadIO m => String -> m (Array Word8)
279+toUtf8 = A.fromStream . U.encodeUtf8 . S.fromList
280+
281+-- | Set watch event on directory recursively.
282+--
283+-- /default: Off/
284+--
285+-- /Internal/
286+--
287+setRecursiveMode :: Bool -> Config -> Config
288+setRecursiveMode rec cfg@Config{} = cfg {watchRec = rec}
289+
290+-------------------------------------------------------------------------------
291+-- Settings
292+-------------------------------------------------------------------------------
223
293
224foreign import capi
294foreign import capi
225 "sys/inotify.h value IN_DONT_FOLLOW" iN_DONT_FOLLOW :: Word32
295 "sys/inotify.h value IN_DONT_FOLLOW" iN_DONT_FOLLOW :: Word32
@@ -501,14 +571,14 @@ defaultConfig :: Config
501defaultConfig =
571defaultConfig =
502 setWhenExists AddIfExists
572 setWhenExists AddIfExists
503 $ setAllEvents On
573 $ setAllEvents On
504− $ Config { createFlags = 0 }
574+ $ Config {watchRec = False, createFlags = 0}
505
575
506-------------------------------------------------------------------------------
576-------------------------------------------------------------------------------
507-- Open an event stream
577-- Open an event stream
508-------------------------------------------------------------------------------
578-------------------------------------------------------------------------------
509
579
510-- | A handle for a watch.
580-- | A handle for a watch.
511−data Watch = Watch Handle (IntMap (Array Word8))
581+data Watch = Watch Handle (IORef (IntMap (Array Word8, Array Word8)))
512
582
513-- Instead of using the watch descriptor we can provide APIs that use the path
583-- Instead of using the watch descriptor we can provide APIs that use the path
514-- itself to identify the watch. That will require us to maintain a map from wd
584-- itself to identify the watch. That will require us to maintain a map from wd
@@ -545,7 +615,8 @@ createWatch = do
545 ReadMode
615 ReadMode
546 True -- use non-blocking IO
616 True -- use non-blocking IO
547 Nothing -- TextEncoding (binary)
617 Nothing -- TextEncoding (binary)
618+ emptyMapRef <- newIORef Map.empty
548− return $ Watch h Map.empty
619+ return $ Watch h emptyMapRef
549
620
550foreign import ccall unsafe
621foreign import ccall unsafe
551 "sys/inotify.h inotify_add_watch" c_inotify_add_watch
622 "sys/inotify.h inotify_add_watch" c_inotify_add_watch
@@ -580,13 +651,40 @@ handleToFd h = case h of
580--
651--
581-- /Internal/
652-- /Internal/
582--
653--
654+addToWatchExecutor ::
655+ Config
656+ -> Watch
657+ -> Array Word8
658+ -> Array Word8
659+ -> IO (Config, Watch)
660+addToWatchExecutor cfg@Config{..} (Watch handle wdMap) pathArr root = do
661+ fd <- handleToFd handle
662+ wd <- A.asCString pathArr $ \pathPtr ->
663+ throwErrnoIfMinus1 ("addToWatch " ++ utf8ToString pathArr) $
664+ c_inotify_add_watch (fdFD fd) pathPtr (CUInt createFlags)
665+ km <- readIORef wdMap
666+ let k = (Map.insert (fromIntegral wd) (root, pathArr) km)
667+ writeIORef wdMap k
668+ return $ (cfg, Watch handle wdMap)
669+
583−addToWatch :: Config -> Watch -> Array Word8 -> IO Watch
670+addToWatch :: Config -> Watch -> Array Word8 -> IO (Config, Watch)
584−addToWatch Config{..} (Watch handle wdMap) path = do
671+addToWatch cfg@Config{..} (Watch handle wdMap) path = do
585 fd <- handleToFd handle
672 fd <- handleToFd handle
586 wd <- A.asCString path $ \pathPtr ->
673 wd <- A.asCString path $ \pathPtr ->
587 throwErrnoIfMinus1 ("addToWatch " ++ utf8ToString path) $
674 throwErrnoIfMinus1 ("addToWatch " ++ utf8ToString path) $
588 c_inotify_add_watch (fdFD fd) pathPtr (CUInt createFlags)
675 c_inotify_add_watch (fdFD fd) pathPtr (CUInt createFlags)
676+ km <- readIORef wdMap
589− return $ Watch handle (Map.insert (fromIntegral wd) path wdMap)
677+ let k = (Map.insert (fromIntegral wd) (path, path) km)
678+ writeIORef wdMap k
679+ return $ (cfg, Watch handle wdMap)
680+
681+addToWatchRec :: Config -> Watch -> FilePath -> FilePath -> IO (Config, Watch)
682+addToWatchRec cfg watch path origRoot= do
683+ subdirs <- toPathList path
684+ pathArrList <- mapM toUtf8 subdirs
685+ rootArr <- toUtf8 origRoot
686+ foldlM (\(cfg1, w1) pathArr -> addToWatchExecutor cfg1 w1 pathArr rootArr)
687+ (cfg, watch) pathArrList
590
688
591foreign import ccall unsafe
689foreign import ccall unsafe
592 "sys/inotify.h inotify_rm_watch" c_inotify_rm_watch
690 "sys/inotify.h inotify_rm_watch" c_inotify_rm_watch
@@ -600,13 +698,15 @@ foreign import ccall unsafe
600removeFromWatch :: Watch -> Array Word8 -> IO Watch
698removeFromWatch :: Watch -> Array Word8 -> IO Watch
601removeFromWatch (Watch handle wdMap) path = do
699removeFromWatch (Watch handle wdMap) path = do
602 fd <- handleToFd handle
700 fd <- handleToFd handle
701+ km <- readIORef wdMap
603− wdMap1 <- foldlM (step fd) Map.empty (Map.toList wdMap)
702+ wdMap1 <- foldlM (step fd) Map.empty (Map.toList km)
703+ writeIORef wdMap wdMap1
604− return $ Watch handle wdMap1
704+ return $ Watch handle wdMap
605
705
606 where
706 where
607
707
608 step fd newMap (wd, v) = do
708 step fd newMap (wd, v) = do
609− if v == path
709+ if (fst v) == path
610 then do
710 then do
611 let err = "removeFromWatch " ++ show (utf8ToString path)
711 let err = "removeFromWatch " ++ show (utf8ToString path)
612 rm = c_inotify_rm_watch (fdFD fd) (fromIntegral wd)
712 rm = c_inotify_rm_watch (fdFD fd) (fromIntegral wd)
@@ -620,17 +720,32 @@ removeFromWatch (Watch handle wdMap) path = do
620--
720--
621-- /Internal/
721-- /Internal/
622--
722--
723+openWatch ::
724+ Config
623−openWatch :: Config -> NonEmpty (Array Word8) -> IO Watch
725+ -> NonEmpty (Array Word8)
726+ -> IO (Config, Watch)
624openWatch cfg paths = do
727openWatch cfg paths = do
728+ let pathList = NonEmpty.toList paths
729+ w <- createWatch
730+ foldlM (\(cfg1, w1) path -> addToWatch cfg1 w1 path)
731+ (cfg, w) pathList
732+
733+openWatchRec ::
734+ Config
735+ -> NonEmpty (Array Word8)
736+ -> IO (Config, Watch)
737+openWatchRec cfg paths = do
738+ let pathList = map utf8ToString $ NonEmpty.toList paths
625 w <- createWatch
739 w <- createWatch
626− foldlM (\w1 pth -> addToWatch cfg w1 pth) w (NonEmpty.toList paths)
740+ foldlM (\(cfg1, w1) path -> addToWatchRec cfg1 w1 path path)
741+ (cfg, w) pathList
627
742
628-- | Close a 'Watch' handle.
743-- | Close a 'Watch' handle.
629--
744--
630-- /Internal/
745-- /Internal/
631--
746--
632−closeWatch :: Watch -> IO ()
747+closeWatch :: (Config, Watch) -> IO ()
633−closeWatch (Watch h _) = hClose h
748+closeWatch (_, Watch h _) = hClose h
634
749
635-------------------------------------------------------------------------------
750-------------------------------------------------------------------------------
636-- Raw events read from the watch file handle
751-- Raw events read from the watch file handle
@@ -648,7 +763,7 @@ data Event = Event
648 , eventFlags :: Word32
763 , eventFlags :: Word32
649 , eventCookie :: Word32
764 , eventCookie :: Word32
650 , eventRelPath :: Array Word8
765 , eventRelPath :: Array Word8
651− , eventMap :: IntMap (Array Word8)
766+ , eventMap :: IntMap (Array Word8, Array Word8)
652 } deriving (Show, Ord, Eq)
767 } deriving (Show, Ord, Eq)
653
768
654-- The inotify event struct from the man page/header file:
769-- The inotify event struct from the man page/header file:
@@ -665,14 +780,16 @@ data Event = Event
665-- XXX We can perhaps use parseD monad instance for fusing with parseMany? Need
780-- XXX We can perhaps use parseD monad instance for fusing with parseMany? Need
666-- to measure the perf.
781-- to measure the perf.
667--
782--
668−readOneEvent :: IntMap (Array Word8) -> Parser IO Word8 Event
783+readOneEvent :: Config -> Watch -> Parser IO Word8 Event
669−readOneEvent wdMap = do
784+readOneEvent cfg wt@(Watch _ wdMap) = do
670 let headerLen = (sizeOf (undefined :: CInt)) + 12
785 let headerLen = (sizeOf (undefined :: CInt)) + 12
671 arr <- PR.takeEQ headerLen (A.writeN headerLen)
786 arr <- PR.takeEQ headerLen (A.writeN headerLen)
672 (ewd, eflags, cookie, pathLen) <- PR.yieldM $ A.asPtr arr readHeader
787 (ewd, eflags, cookie, pathLen) <- PR.yieldM $ A.asPtr arr readHeader
673 -- XXX need the "initial" in parsers to return a step type so that "take 0"
788 -- XXX need the "initial" in parsers to return a step type so that "take 0"
674 -- can return without an input. otherwise if pathLen is 0 we will keep
789 -- can return without an input. otherwise if pathLen is 0 we will keep
675 -- waiting to read one more char before we return this event.
790 -- waiting to read one more char before we return this event.
791+ -- PR.yieldM $ print ("Flag1 = " ++ show eflags)
792+ -- PR.yieldM $ print ("pathLen = " ++ show pathLen)
676 path <-
793 path <-
677 if pathLen /= 0
794 if pathLen /= 0
678 then do
795 then do
@@ -681,15 +798,30 @@ readOneEvent wdMap = do
681 -- takeP
798 -- takeP
682 pth <- PR.sliceSepByMax (== 0) pathLen (A.writeN pathLen)
799 pth <- PR.sliceSepByMax (== 0) pathLen (A.writeN pathLen)
683 let remaining = pathLen - A.length pth - 1
800 let remaining = pathLen - A.length pth - 1
801+ -- PR.yieldM $ print ("remaining = " ++ show remaining)
684 when (remaining /= 0) $ PR.takeEQ remaining FL.drain
802 when (remaining /= 0) $ PR.takeEQ remaining FL.drain
803+ -- PR.yieldM $ print ("takeEQ = " ++ show remaining)
685 return pth
804 return pth
686 else return $ A.fromList []
805 else return $ A.fromList []
806+ -- PR.yieldM $ print ("Flag2 = " ++ show eflags)
807+ xm <- PR.yieldM $ readIORef wdMap
808+ let base = case Map.lookup (fromIntegral ewd) xm of
809+ Just path1 -> path1
810+ Nothing -> (path, path)
811+ let xpath = utf8ToString (snd base) </> utf8ToString path
812+ _ <- if eflags .&. iN_CREATE /= 0 && eflags .&. iN_ISDIR /= 0
813+ then
814+ processEvent cfg wt xpath (utf8ToString $ fst base)
815+ else return (cfg, wt)
816+ rm2 <- PR.yieldM $ readIORef wdMap
817+ pdiff <- PR.yieldM $ pathDiff (utf8ToString $ fst base) xpath
818+ relPath <- PR.yieldM $ toUtf8 (pdiff)
687 return $ Event
819 return $ Event
688 { eventWd = (fromIntegral ewd)
820 { eventWd = (fromIntegral ewd)
689 , eventFlags = eflags
821 , eventFlags = eflags
690 , eventCookie = cookie
822 , eventCookie = cookie
691− , eventRelPath = path
823+ , eventRelPath = relPath
692− , eventMap = wdMap
824+ , eventMap = rm2
693 }
825 }
694
826
695 where
827 where
@@ -702,8 +834,21 @@ readOneEvent wdMap = do
702 pathLen :: Word32 <- peekByteOff ptr (len + 8)
834 pathLen :: Word32 <- peekByteOff ptr (len + 8)
703 return (ewd, eflags, cookie, fromIntegral pathLen)
835 return (ewd, eflags, cookie, fromIntegral pathLen)
704
836
837+ processEvent ::
838+ Config
839+ -> Watch
840+ -> FilePath
841+ -> FilePath
842+ -> Parser IO Word8 (Config, Watch)
843+ processEvent cfg1@Config{..} wt1 xpath root = do
844+ if watchRec
845+ then
846+ PR.yieldM $ addToWatchRec cfg1 wt1 xpath root
847+ else
848+ PR.yieldM $ return (cfg1, wt1)
849+
705−watchToStream :: Watch -> SerialT IO Event
850+watchToStream :: (Config, Watch) -> SerialT IO Event
706−watchToStream (Watch handle wdMap) =
851+watchToStream (cfg, wt@(Watch handle _)) = do
707 -- Do not use too small a buffer. As per inotify man page:
852 -- Do not use too small a buffer. As per inotify man page:
708 --
853 --
709 -- The behavior when the buffer given to read(2) is too small to return
854 -- The behavior when the buffer given to read(2) is too small to return
@@ -714,7 +859,7 @@ watchToStream (Watch handle wdMap) =
714 -- sizeof(struct inotify_event) + NAME_MAX + 1
859 -- sizeof(struct inotify_event) + NAME_MAX + 1
715 --
860 --
716 -- will be sufficient to read at least one event.
861 -- will be sufficient to read at least one event.
717− S.parseMany (readOneEvent wdMap) $ S.unfold FH.read handle
862+ S.parseMany (readOneEvent cfg wt) $ S.unfold FH.read handle
718
863
719-- | Start monitoring a list of file system paths for file system events with
864-- | Start monitoring a list of file system paths for file system events with
720-- the supplied configuration operation over the 'defaultConfig'. The
865-- the supplied configuration operation over the 'defaultConfig'. The
@@ -752,6 +897,33 @@ watchPathsWith f paths = S.bracket before after watchToStream
752watchPaths :: NonEmpty (Array Word8) -> SerialT IO Event
897watchPaths :: NonEmpty (Array Word8) -> SerialT IO Event
753watchPaths = watchPathsWith id
898watchPaths = watchPathsWith id
754
899
900+-- | Start monitoring a list of file system paths for file system events with
901+-- the supplied configuration operation over the 'defaultConfig'. The
902+-- paths could be files or directories. When the path is a directory, the
903+-- whole directory tree under it is watched recursively. Monitoring starts from
904+-- the current time onwards.
905+--
906+-- /Internal/
907+--
908+watchTreesWith ::
909+ (Config -> Config) -> NonEmpty (Array Word8) -> SerialT IO Event
910+watchTreesWith f paths = S.bracket before after watchToStream
911+
912+ where
913+
914+ before = liftIO
915+ $ openWatchRec (f $ setRecursiveMode True defaultConfig) paths
916+ after = liftIO . closeWatch
917+
918+-- | Like 'watchTreesWith' but uses the 'defaultConfig' options.
919+--
920+-- @
921+-- watchTrees = watchTreesWith id
922+-- @
923+--
924+watchTrees :: NonEmpty (Array Word8) -> SerialT IO Event
925+watchTrees = watchTreesWith id
926+
755-------------------------------------------------------------------------------
927-------------------------------------------------------------------------------
756-- Examine event stream
928-- Examine event stream
757-------------------------------------------------------------------------------
929-------------------------------------------------------------------------------
@@ -769,13 +941,12 @@ getRoot Event{..} =
769 if (eventWd >= 1)
941 if (eventWd >= 1)
770 then
942 then
771 case Map.lookup (fromIntegral eventWd) eventMap of
943 case Map.lookup (fromIntegral eventWd) eventMap of
772− Just path -> path
944+ Just path -> fst path
773 Nothing ->
945 Nothing ->
774 error $ "Bug: getRoot: No path found corresponding to the "
946 error $ "Bug: getRoot: No path found corresponding to the "
775 ++ "watch descriptor " ++ show eventWd
947 ++ "watch descriptor " ++ show eventWd
776 else A.fromList []
948 else A.fromList []
777
949
778−
779-- XXX should we use a Maybe here?
950-- XXX should we use a Maybe here?
780-- | Get the file system object path for which the event is generated, relative
951-- | Get the file system object path for which the event is generated, relative
781-- to the watched root. The path is a "/" separated array of bytes.
952-- to the watched root. The path is a "/" separated array of bytes.
@@ -1017,6 +1188,12 @@ isDir = getFlag iN_ISDIR
1017-------------------------------------------------------------------------------
1188-------------------------------------------------------------------------------
1018-- Debugging
1189-- Debugging
1019-------------------------------------------------------------------------------
1190-------------------------------------------------------------------------------
1191+showEventShort :: Event -> String
1192+showEventShort ev@Event{..} = (utf8ToString $ getRelPath ev)
1193+ ++ "_" ++ show eventFlags
1194+ ++ showev isDir "Dir"
1195+
1196+ where showev f str = if f ev then "_" ++ str else ""
1020
1197
1021-- | Convert an 'Event' record to a String representation.
1198-- | Convert an 'Event' record to a String representation.
1022showEvent :: Event -> String
1199showEvent :: Event -> String
@@ -1055,4 +1232,4 @@ showEvent ev@Event{..} =
1055#else
1232#else
1056#warning "Disabling module Streamly.Internal.FileSystem.Event.Linux. Does not support kernels older than 2.6.36."
1233#warning "Disabling module Streamly.Internal.FileSystem.Event.Linux. Does not support kernels older than 2.6.36."
1057module Streamly.Internal.FileSystem.Event.Linux () where
1234module Streamly.Internal.FileSystem.Event.Linux () where
1058−#endif
1235+#endif
src/Streamly/Internal/FileSystem/Event/Windows.hs+4
@@ -89,6 +89,7 @@ module Streamly.Internal.FileSystem.Event.Windows
89
89
90 -- * Debugging
90 -- * Debugging
91 , showEvent
91 , showEvent
92+ , showEventShort
92 )
93 )
93where
94where
94
95
@@ -539,6 +540,9 @@ isOverflow Event{..} = totalBytes == 0
539-------------------------------------------------------------------------------
540-------------------------------------------------------------------------------
540-- Debugging
541-- Debugging
541-------------------------------------------------------------------------------
542-------------------------------------------------------------------------------
543+-- | Convert an 'Event' record to a short representation for unit test.
544+showEventShort :: Event -> String
545+showEventShort ev@Event{..} = getRelPath ev ++ "_" ++ show eventFlags
542
546
543-- | Convert an 'Event' record to a String representation.
547-- | Convert an 'Event' record to a String representation.
544showEvent :: Event -> String
548showEvent :: Event -> String
streamly.cabal+10−3
@@ -328,6 +328,9 @@ common test-dependencies
328 , random >= 1.0.0 && < 2
328 , random >= 1.0.0 && < 2
329 , transformers >= 0.4 && < 0.6
329 , transformers >= 0.4 && < 0.6
330 , QuickCheck >= 2.13 && < 2.15
330 , QuickCheck >= 2.13 && < 2.15
331+ , directory >= 1.2.2 && < 1.4
332+ , filepath >= 1.4.1
333+ , temporary >= 1.3
331
334
332-- Compilation for coverage builds on CI machines takes too long without -O0
335-- Compilation for coverage builds on CI machines takes too long without -O0
333-- XXX we should use coverage flag for that, -O0 may take too long to run tests
336-- XXX we should use coverage flag for that, -O0 may take too long to run tests
@@ -386,6 +389,7 @@ library
386
389
387 if os(linux)
390 if os(linux)
388 exposed-modules: Streamly.Internal.FileSystem.Event.Linux
391 exposed-modules: Streamly.Internal.FileSystem.Event.Linux
392+ build-depends: unix >= 2.7.2, filepath >= 1.4.1
389
393
390 hs-source-dirs: src
394 hs-source-dirs: src
391 other-modules:
395 other-modules:
@@ -733,8 +737,11 @@ test-suite version-bounds
733 type: exitcode-stdio-1.0
737 type: exitcode-stdio-1.0
734 main-is: version-bounds.hs
738 main-is: version-bounds.hs
735
739
736−executable FileSystem.Event
740+test-suite FileSystem.Event
737 import: test-options
741 import: test-options
742+ type: exitcode-stdio-1.0
738 main-is: Streamly/Test/FileSystem/Event.hs
743 main-is: Streamly/Test/FileSystem/Event.hs
739− if !flag(manual-tests)
744+ hs-source-dirs: test
745+ default-language: Haskell2010
746+ if os(darwin)
740− buildable: False
747+ buildable: False
test/Streamly/Test/FileSystem/Event.hs+577−28
@@ -1,27 +1,30 @@
1−-- |
1+import Control.Concurrent (MVar, newEmptyMVar, putMVar, takeMVar, threadDelay)
2−-- Module : Streamly.Test.FileSystem.Event
3−-- Copyright : (c) 2020 Composewell Technologies
4−--
5−-- License : BSD3
6−-- Maintainer : streamly@composewell.com
7−-- Stability : experimental
8−-- Portability : GHC
9−--
10−-- Just report all events under the paths provided as arguments
11−module Main (main) where
12−
13import Control.Monad.IO.Class (MonadIO)
2import Control.Monad.IO.Class (MonadIO)
14−import Data.Function ((&))
15import Data.List.NonEmpty (NonEmpty)
3import Data.List.NonEmpty (NonEmpty)
4+import Data.Maybe (fromJust)
16import Data.Word (Word8)
5import Data.Word (Word8)
17−import System.Environment (getArgs)
6+import System.Directory ( createDirectoryIfMissing
7+ , removeFile
8+ , removeDirectory
9+ , removePathForcibly
10+ , renameDirectory
11+ , renamePath
12+ )
13+import System.FilePath ((</>))
14+import System.IO (BufferMode(..), hSetBuffering, stdout)
15+import System.IO.Temp (withSystemTempDirectory)
18import Streamly.Prelude (SerialT)
16import Streamly.Prelude (SerialT)
19import Streamly.Internal.Data.Array.Storable.Foreign (Array)
17import Streamly.Internal.Data.Array.Storable.Foreign (Array)
18+import Test.Hspec
19+import Test.Hspec.QuickCheck
20
20
21+import qualified Data.List.NonEmpty as NonEmpty
22+import qualified Data.Set as Set
21import qualified Streamly.Unicode.Stream as Unicode
23import qualified Streamly.Unicode.Stream as Unicode
22import qualified Streamly.Internal.Data.Array.Storable.Foreign as Array
24import qualified Streamly.Internal.Data.Array.Storable.Foreign as Array
23−import qualified Data.List.NonEmpty as NonEmpty
25+import qualified Streamly.Internal.Data.Fold as FL
26+import qualified Streamly.Internal.Data.Parser as PR
24−import qualified Streamly.Internal.Data.Stream.IsStream as Stream
27+import qualified Streamly.Internal.Data.Stream.IsStream as S
25#if defined(CABAL_OS_DARWIN)
28#if defined(CABAL_OS_DARWIN)
26import qualified Streamly.Internal.FileSystem.Event.Darwin as Event
29import qualified Streamly.Internal.FileSystem.Event.Darwin as Event
27#elif defined(CABAL_OS_LINUX)
30#elif defined(CABAL_OS_LINUX)
@@ -32,28 +35,574 @@ import qualified Streamly.Internal.FileSystem.Event.Windows as Event
32#error "FS Events not supported on this platform
35#error "FS Events not supported on this platform
33#endif
36#endif
34
37
38+#if !defined(CABAL_OS_WINDOWS)
39+import Data.Functor.Identity (runIdentity)
40+import qualified Streamly.Internal.Unicode.Stream as U
41+#endif
35-------------------------------------------------------------------------------
42-------------------------------------------------------------------------------
36-- Utilities
43-- Utilities
37-------------------------------------------------------------------------------
44-------------------------------------------------------------------------------
38−
39toUtf8 :: MonadIO m => String -> m (Array Word8)
45toUtf8 :: MonadIO m => String -> m (Array Word8)
40−toUtf8 = Array.fromStream . Unicode.encodeUtf8' . Stream.fromList
46+toUtf8 = Array.fromStream . Unicode.encodeUtf8' . S.fromList
47+
48+#if !defined(CABAL_OS_WINDOWS)
49+utf8ToString :: Array Word8 -> String
50+utf8ToString = runIdentity . S.toList . U.decodeUtf8' . Array.toStream
51+#endif
52+
53+watchPaths :: NonEmpty (Array Word8) -> SerialT IO Event.Event
54+watchPaths = Event.watchTrees
55+
56+timeout :: IO String
57+timeout = threadDelay 5000000 >> return "Timeout"
58+
59+fseventDir :: String
60+fseventDir = "fsevent_dir"
61+
62+eventPredicate :: Event.Event -> Bool
63+eventPredicate ev =
64+#if defined(CABAL_OS_WINDOWS)
65+ if (Event.getRelPath ev) == "EOTask"
66+#else
67+ if (utf8ToString $ Event.getRelPath ev) == "EOTask"
68+#endif
69+ then False
70+ else True
41
71
42-------------------------------------------------------------------------------
72-------------------------------------------------------------------------------
43−-- Main
73+-- Event lists to be matched with
44-------------------------------------------------------------------------------
74-------------------------------------------------------------------------------
75+#if defined(CABAL_OS_WINDOWS)
76+
77+singleDirCreateEvents :: [String]
78+singleDirCreateEvents =
79+ [ "dir1Single_1" ]
80+
81+singleDirRemoveEvents :: [String]
82+singleDirRemoveEvents =
83+ [ "dir1Single_2" ]
84+
85+singleDirRenameEvents :: [String]
86+singleDirRenameEvents =
87+ [ "dir1Single_4"
88+ , "dir1SingleRenamed_5"
89+ ]
90+
91+nestedDirCreateEvents :: [String]
92+nestedDirCreateEvents =
93+ [ "dir1_1"
94+ , "dir1\\dir2_1"
95+ , "dir1\\dir2\\dir3_1"
96+ ]
97+
98+nestedDirRemoveEvents :: [String]
99+nestedDirRemoveEvents =
100+ [ "dir1_3"
101+ , "dir1\\dir2_3"
102+ , "dir1\\dir2\\dir3_2"
103+ , "dir1\\dir2_2","dir1_2"
104+ ]
105+
106+nestedDirRenameEvents :: [String]
107+nestedDirRenameEvents =
108+ [ "dir1\\dir2_3"
109+ , "dir1\\dir2\\dir3_4"
110+ , "dir1\\dir2\\dir3Renamed_5"
111+ , "dir1\\dir2_3"
112+ ]
113+
114+createFileRootDirEvents :: [String]
115+createFileRootDirEvents =
116+ [ "FileCreated.txt_1"
117+ , "FileCreated.txt_3"
118+ , "FileCreated.txt_3"
119+ ]
120+
121+removeFileRootDirEvents :: [String]
122+removeFileRootDirEvents =
123+ [ "FileCreated.txt_2" ]
124+
125+renameFileRootDirEvents :: [String]
126+renameFileRootDirEvents =
127+ [ "FileCreated.txt_4"
128+ , "FileRenamed.txt_5"
129+ ]
130+
131+createFileNestedDirEvents :: [String]
132+createFileNestedDirEvents =
133+ [ "dir1\\dir2\\dir3\\FileCreated.txt_1"
134+ , "dir1\\dir2\\dir3\\FileCreated.txt_3"
135+ ]
136+
137+removeFileNestedDirEvents :: [String]
138+removeFileNestedDirEvents =
139+ ["dir1\\dir2\\dir3\\FileCreated.txt_2"]
140+
141+renameFileNestedDirEvents :: [String]
142+renameFileNestedDirEvents =
143+ [ "dir1\\dir2\\dir3_3"
144+ , "dir1\\dir2\\dir3\\FileCreated.txt_4"
145+ , "dir1\\dir2\\dir3\\FileRenamed.txt_5"
146+ ]
45
147
46−watchPaths :: NonEmpty (Array Word8) -> SerialT IO Event.Event
47−#if defined(CABAL_OS_LINUX)
48−watchPaths = Event.watchPaths
49#else
148#else
50−watchPaths = Event.watchTrees
149+
150+singleDirCreateEvents :: [String]
151+singleDirCreateEvents =
152+ [ "dir1Single_1073742080_Dir"
153+ , "dir1Single_1073741856_Dir"
154+ , "dir1Single_1073741825_Dir"
155+ , "dir1Single_1073741840_Dir"
156+ ]
157+
158+singleDirRemoveEvents :: [String]
159+singleDirRemoveEvents =
160+ [ "dir1Single_1024"
161+ , "dir1Single_32768"
162+ ]
163+
164+singleDirRenameEvents :: [String]
165+singleDirRenameEvents =
166+ [ "dir1Single_1073741888_Dir"
167+ , "dir1SingleRenamed_1073741952_Dir"
168+ ]
169+
170+nestedDirCreateEvents :: [String]
171+nestedDirCreateEvents =
172+ [ "dir1_1073742080_Dir"
173+ , "dir1_1073741856_Dir"
174+ , "dir1_1073741825_Dir"
175+ , "dir1_1073741840_Dir"
176+ ]
177+
178+nestedDirRemoveEvents :: [String]
179+nestedDirRemoveEvents =
180+ [ "dir1/dir2/dir3_1073742336_Dir"
181+ , "dir1/dir2_1073742336_Dir"
182+ , "dir1_1073742336_Dir"
183+ ]
184+
185+nestedDirRenameEvents :: [String]
186+nestedDirRenameEvents =
187+ [ "dir1/dir2/dir3_1073741888_Dir"
188+ , "dir1/dir2/dir3Renamed_1073741952_Dir"
189+ ]
190+
191+createFileRootDirEvents :: [String]
192+createFileRootDirEvents =
193+ [ "FileCreated.txt_256"
194+ , "FileCreated.txt_32"
195+ , "FileCreated.txt_2"
196+ ]
197+
198+removeFileRootDirEvents :: [String]
199+removeFileRootDirEvents =
200+ ["FileCreated.txt_512"]
201+
202+renameFileRootDirEvents :: [String]
203+renameFileRootDirEvents =
204+ [ "FileCreated.txt_64"
205+ , "FileRenamed.txt_128"
206+ ]
207+
208+createFileNestedDirEvents :: [String]
209+createFileNestedDirEvents =
210+ [ "dir1/dir2/dir3/FileCreated.txt_256"
211+ , "dir1/dir2/dir3/FileCreated.txt_32"
212+ , "dir1/dir2/dir3/FileCreated.txt_2"
213+ , "dir1/dir2/dir3/FileCreated.txt_8"
214+ ]
215+
216+removeFileNestedDirEvents :: [String]
217+removeFileNestedDirEvents =
218+ ["dir1/dir2/dir3/FileCreated.txt_512"]
219+
220+renameFileNestedDirEvents :: [String]
221+renameFileNestedDirEvents =
222+ [ "dir1/dir2/dir3/FileCreated.txt_64"
223+ , "dir1/dir2/dir3/FileRenamed.txt_128"
224+ ]
51#endif
225#endif
52
226
53−main :: IO ()
227+-------------------------------------------------------------------------------
54−main = do
228+-- Event Watcher
55− args <- getArgs
229+-------------------------------------------------------------------------------
230+checkEvents :: FilePath -> MVar () -> [String] -> IO String
231+checkEvents rootPath m matchList = do
232+ let args = [rootPath]
56 paths <- mapM toUtf8 args
233 paths <- mapM toUtf8 args
234+ putStrLn ("Watch started !!!! on Path " ++ rootPath)
235+ events <- S.parse (PR.takeWhile eventPredicate FL.toList)
236+ $ S.before (putMVar m ())
237+ $ watchPaths (NonEmpty.fromList paths)
238+ let eventStr = map Event.showEventShort events
239+ putStrLn $ show (eventStr)
240+ let baseSet = Set.fromList matchList
241+ resultSet = Set.fromList eventStr
242+ if (baseSet `Set.isSubsetOf` resultSet)
243+ then
244+ return "PASS"
245+ else
246+ return "Mismatch"
247+
248+-------------------------------------------------------------------------------
249+-- FS Event Generators
250+-------------------------------------------------------------------------------
251+fsOpsCreateSingleDir :: FilePath -> MVar () -> IO ()
252+fsOpsCreateSingleDir fp m = do
253+ takeMVar m
254+ putStrLn ("Create Single Directory !!!!!!! on " ++ fp)
255+ threadDelay 200000
256+ >> createDirectoryIfMissing True (fp </> "dir1Single")
257+ >> threadDelay 200000
258+ >> createDirectoryIfMissing True (fp </> "EOTask")
259+
260+fsOpsRemoveSingleDir :: FilePath -> MVar () -> IO ()
261+fsOpsRemoveSingleDir fp m = do
262+ takeMVar m
263+ putStrLn ("Remove Single Directory !!!!!!! on " ++ fp)
264+ threadDelay 200000
265+ >> removeDirectory (fp </> "dir1Single")
266+ >> threadDelay 200000
267+ >> createDirectoryIfMissing True (fp </> "EOTask")
268+
269+fsOpsRenameSingleDir :: FilePath -> MVar () -> IO ()
270+fsOpsRenameSingleDir fp m = do
271+ takeMVar m
272+ putStrLn ("Rename a Single Directory !!!!!!! on " ++ fp)
273+ threadDelay 200000
274+ >> renameDirectory (fp </> "dir1Single") (fp </> "dir1SingleRenamed")
275+ >> threadDelay 200000
276+ >> createDirectoryIfMissing True (fp </> "EOTask")
277+
278+fsOpsCreateNestedDir :: FilePath -> MVar () -> IO ()
279+fsOpsCreateNestedDir fp m = do
280+ takeMVar m
281+ putStrLn ("Create Nested Directory !!!!!!!!!!!!! on " ++ fp)
282+ threadDelay 200000
283+ >> createDirectoryIfMissing True (fp </> "dir1" </> "dir2" </> "dir3")
284+ >> threadDelay 200000
285+ >> createDirectoryIfMissing True (fp </> "EOTask")
286+
287+fsOpsRemoveNestedDir :: FilePath -> MVar () -> IO ()
288+fsOpsRemoveNestedDir fp m = do
289+ takeMVar m
290+ putStrLn ("Remove Nested Directory !!!!!!!!!!!!! on " ++ fp)
291+ threadDelay 200000
292+ >> removePathForcibly (fp </> "dir1")
293+ >> threadDelay 200000
294+ >> createDirectoryIfMissing True (fp </> "EOTask")
295+
296+fsOpsRenameNestedDir :: FilePath -> MVar () -> IO ()
297+fsOpsRenameNestedDir fp m = do
298+ takeMVar m
299+ putStrLn ("Rename Nested Directory !!!!!!!!!!!!! on " ++ fp)
300+ threadDelay 200000
301+ >> renameDirectory
302+ (fp </> "dir1" </> "dir2" </> "dir3")
303+ (fp </> "dir1" </> "dir2" </> "dir3Renamed")
304+ >> threadDelay 200000
305+ >> createDirectoryIfMissing True (fp </> "EOTask")
306+
307+fsOpsCreateFileInRootDir :: FilePath -> MVar () -> IO ()
308+fsOpsCreateFileInRootDir fp m = do
309+ takeMVar m
310+ let tpath = (fp </> "FileCreated.txt")
311+ putStrLn ("create a File on " ++ fp)
312+ threadDelay 200000
313+ >> writeFile tpath "Test Data"
314+ >> threadDelay 200000
315+ >> createDirectoryIfMissing True (fp </> "EOTask")
316+
317+fsOpsRemoveFileInRootDir :: FilePath -> MVar () -> IO ()
318+fsOpsRemoveFileInRootDir fp m = do
319+ takeMVar m
320+ let tpath = (fp </> "FileCreated.txt")
321+ putStrLn ("Remove a File on " ++ fp)
322+ threadDelay 200000
323+ >> removeFile tpath
324+ >> threadDelay 200000
325+ >> createDirectoryIfMissing True (fp </> "EOTask")
326+
327+fsOpsRenameFileInRootDir :: FilePath -> MVar () -> IO ()
328+fsOpsRenameFileInRootDir fp m = do
329+ takeMVar m
330+ let spath = (fp </> "FileCreated.txt")
331+ tpath = (fp </> "FileRenamed.txt")
332+ putStrLn ("Rename a File on " ++ fp)
333+ threadDelay 200000
334+ >> renamePath spath tpath
335+ >> threadDelay 200000
336+ >> createDirectoryIfMissing True (fp </> "EOTask")
337+
338+fsOpsCreateFileInNestedDir :: FilePath -> MVar () -> IO ()
339+fsOpsCreateFileInNestedDir fp m = do
340+ takeMVar m
341+ let tpath = (fp </> "dir1" </> "dir2" </> "dir3" </> "FileCreated.txt")
342+ putStrLn ("create a File on nested dir " ++ fp)
343+ threadDelay 200000
344+ >> writeFile tpath "Test Data"
345+ >> threadDelay 200000
346+ >> createDirectoryIfMissing True (fp </> "EOTask")
347+
348+fsOpsRemoveFileInNestedDir :: FilePath -> MVar () -> IO ()
349+fsOpsRemoveFileInNestedDir fp m = do
350+ takeMVar m
351+ let tpath = (fp </> "dir1" </> "dir2" </> "dir3" </> "FileCreated.txt")
352+ putStrLn ("Remove a File on nested dir " ++ fp)
353+ threadDelay 200000
354+ >> threadDelay 200000 >> removeFile tpath
355+ >> threadDelay 200000
356+ >> createDirectoryIfMissing True (fp </> "EOTask")
357+
358+fsOpsRenameFileInNestedDir :: FilePath -> MVar () -> IO ()
359+fsOpsRenameFileInNestedDir fp m = do
360+ takeMVar m
361+ let spath = (fp </> "dir1" </> "dir2" </> "dir3" </> "FileCreated.txt")
362+ tpath = (fp </> "dir1" </> "dir2" </> "dir3" </> "FileRenamed.txt")
363+ putStrLn ("Rename a File on nested dir " ++ fp)
364+ threadDelay 200000
365+ >> renamePath spath tpath
366+ >> threadDelay 200000
367+ >> createDirectoryIfMissing True (fp </> "EOTask")
368+
369+
370+checker :: S.IsStream t =>
371+ FilePath -> MVar () -> [String] -> t IO String
372+checker rootPath synch matchList =
373+ S.yieldM (checkEvents rootPath synch matchList)
374+ `S.parallelFst`
375+ S.yieldM timeout
376+
377+driverInit :: IO (MVar ())
378+driverInit = do
379+ hSetBuffering stdout NoBuffering
380+ pre <- newEmptyMVar
381+ return pre
382+
383+-------------------------------------------------------------------------------
384+-- Test Drivers
385+-------------------------------------------------------------------------------
386+driverCreateSingleDir :: IO String
387+driverCreateSingleDir = do
388+ sync <- driverInit
389+ withSystemTempDirectory fseventDir $ \fp -> do
390+ res <- S.head
391+ $ (checker fp sync singleDirCreateEvents)
392+ `S.parallelFst`
393+ S.yieldM -- ^ this message should follow checker
394+ (fsOpsCreateSingleDir fp sync
395+ >> threadDelay 10000000
396+ >> return "fOps Done")
397+ return $ fromJust res
398+
399+driverRemoveSingleDir :: IO String
400+driverRemoveSingleDir = do
401+ sync <- driverInit
402+ withSystemTempDirectory fseventDir $ \fp -> do
403+ createDirectoryIfMissing True (fp </> "dir1Single")
404+ res <- S.head
405+ $ (checker fp sync singleDirRemoveEvents)
406+ `S.parallelFst`
407+ S.yieldM -- ^ this message should follow checker
408+ (fsOpsRemoveSingleDir fp sync
409+ >> threadDelay 10000000
410+ >> return "fOps Done")
411+ return $ fromJust res
412+
413+driverRenameSingleDir :: IO String
414+driverRenameSingleDir = do
415+ sync <- driverInit
416+ withSystemTempDirectory fseventDir $ \fp -> do
417+ createDirectoryIfMissing True (fp </> "dir1Single")
418+ res <- S.head
419+ $ (checker fp sync singleDirRenameEvents)
420+ `S.parallelFst`
421+ S.yieldM -- ^ this message should follow checker
422+ (fsOpsRenameSingleDir fp sync
423+ >> threadDelay 10000000
424+ >> return "fOps Done")
425+ return $ fromJust res
426+
427+driverCreateNestedDir :: IO String
428+driverCreateNestedDir = do
429+ sync <- driverInit
430+ withSystemTempDirectory fseventDir $ \fp -> do
431+ res <- S.head
432+ $ (checker fp sync nestedDirCreateEvents)
433+ `S.parallelFst`
434+ S.yieldM
435+ (fsOpsCreateNestedDir fp sync
436+ >> threadDelay 10000000
437+ >> return "fOps Done")
438+ return $ fromJust res
439+
440+driverRemoveNestedDir :: IO String
441+driverRemoveNestedDir = do
442+ sync <- driverInit
443+ withSystemTempDirectory fseventDir $ \fp -> do
444+ createDirectoryIfMissing True (fp </> "dir1" </> "dir2" </> "dir3")
445+ res <- S.head
446+ $ (checker fp sync nestedDirRemoveEvents)
447+ `S.parallelFst`
448+ S.yieldM
449+ (fsOpsRemoveNestedDir fp sync
450+ >> threadDelay 10000000
451+ >> return "fOps Done")
452+ return $ fromJust res
453+
454+driverRenameNestedDir :: IO String
455+driverRenameNestedDir = do
456+ sync <- driverInit
457+ withSystemTempDirectory fseventDir $ \fp -> do
458+ createDirectoryIfMissing True (fp </> "dir1" </> "dir2" </> "dir3")
459+ res <- S.head
460+ $ (checker fp sync nestedDirRenameEvents)
461+ `S.parallelFst`
462+ S.yieldM
463+ (fsOpsRenameNestedDir fp sync
464+ >> threadDelay 10000000
465+ >> return "fOps Done")
466+ return $ fromJust res
467+
468+driverCreateFileInRootDir :: IO String
469+driverCreateFileInRootDir = do
470+ sync <- driverInit
471+ withSystemTempDirectory fseventDir $ \fp -> do
472+ res <- S.head
473+ $ (checker fp sync createFileRootDirEvents)
474+ `S.parallelFst`
475+ S.yieldM
476+ (fsOpsCreateFileInRootDir fp sync
477+ >> threadDelay 10000000
478+ >> return "fOps Done")
479+ return $ fromJust res
57
480
58− watchPaths (NonEmpty.fromList paths)
481+driverRemoveFileInRootDir :: IO String
59− & Stream.mapM_ (putStrLn . Event.showEvent)
482+driverRemoveFileInRootDir = do
483+ sync <- driverInit
484+ withSystemTempDirectory fseventDir $ \fp -> do
485+ writeFile (fp </> "FileCreated.txt") "Test Data"
486+ res <- S.head
487+ $ (checker fp sync removeFileRootDirEvents)
488+ `S.parallelFst`
489+ S.yieldM
490+ (fsOpsRemoveFileInRootDir fp sync
491+ >> threadDelay 10000000
492+ >> return "fOps Done")
493+ return $ fromJust res
494+
495+driverRenameFileInRootDir :: IO String
496+driverRenameFileInRootDir = do
497+ sync <- driverInit
498+ withSystemTempDirectory fseventDir $ \fp -> do
499+ writeFile (fp </> "FileCreated.txt") "Test Data"
500+ res <- S.head
501+ $ (checker fp sync renameFileRootDirEvents)
502+ `S.parallelFst`
503+ S.yieldM
504+ (fsOpsRenameFileInRootDir fp sync
505+ >> threadDelay 10000000
506+ >> return "fOps Done")
507+ return $ fromJust res
508+
509+driverCreateFileInNestedDir :: IO String
510+driverCreateFileInNestedDir = do
511+ sync <- driverInit
512+ withSystemTempDirectory fseventDir $ \fp -> do
513+ createDirectoryIfMissing True (fp </> "dir1" </> "dir2" </> "dir3")
514+ res <- S.head
515+ $ (checker fp sync createFileNestedDirEvents)
516+ `S.parallelFst`
517+ S.yieldM
518+ (fsOpsCreateFileInNestedDir fp sync
519+ >> threadDelay 10000000
520+ >> return "fOps Done")
521+ return $ fromJust res
522+
523+driverRemoveFileInNestedDir :: IO String
524+driverRemoveFileInNestedDir = do
525+ sync <- driverInit
526+ withSystemTempDirectory fseventDir $ \fp -> do
527+ createDirectoryIfMissing True (fp </> "dir1" </> "dir2" </> "dir3")
528+ >> writeFile (fp </> "dir1" </> "dir2" </> "dir3" </> "FileCreated.txt") "Test Data"
529+ res <- S.head
530+ $ (checker fp sync removeFileNestedDirEvents)
531+ `S.parallelFst`
532+ S.yieldM
533+ (fsOpsRemoveFileInNestedDir fp sync
534+ >> threadDelay 10000000
535+ >> return "fOps Done")
536+ return $ fromJust res
537+
538+driverRenameFileInNestedDir :: IO String
539+driverRenameFileInNestedDir = do
540+ sync <- driverInit
541+ withSystemTempDirectory fseventDir $ \fp -> do
542+ createDirectoryIfMissing True (fp </> "dir1" </> "dir2" </> "dir3")
543+ >> writeFile (fp </> "dir1" </> "dir2" </> "dir3" </> "FileCreated.txt") "Test Data"
544+ res <- S.head
545+ $ (checker fp sync renameFileNestedDirEvents)
546+ `S.parallelFst`
547+ S.yieldM
548+ (fsOpsRenameFileInNestedDir fp sync
549+ >> threadDelay 10000000
550+ >> return "fOps Done")
551+ return $ fromJust res
552+
553+-------------------------------------------------------------------------------
554+-- Test Cases
555+-------------------------------------------------------------------------------
556+testCreateSingleDir :: Expectation
557+testCreateSingleDir = driverCreateSingleDir `shouldReturn` "PASS"
558+
559+testRemoveSingleDir :: Expectation
560+testRemoveSingleDir = driverRemoveSingleDir `shouldReturn` "PASS"
561+
562+testRenameSingleDir :: Expectation
563+testRenameSingleDir = driverRenameSingleDir `shouldReturn` "PASS"
564+
565+testCreateNestedDir :: Expectation
566+testCreateNestedDir = driverCreateNestedDir `shouldReturn` "PASS"
567+
568+testRemoveNestedDir :: Expectation
569+testRemoveNestedDir = driverRemoveNestedDir `shouldReturn` "PASS"
570+
571+testRenameNestedDir :: Expectation
572+testRenameNestedDir = driverRenameNestedDir `shouldReturn` "PASS"
573+
574+testCreateFileInRootDir :: Expectation
575+testCreateFileInRootDir = driverCreateFileInRootDir `shouldReturn` "PASS"
576+
577+testRemoveFileInRootDir :: Expectation
578+testRemoveFileInRootDir = driverRemoveFileInRootDir `shouldReturn` "PASS"
579+
580+testRenameFileInRootDir :: Expectation
581+testRenameFileInRootDir = driverRenameFileInRootDir `shouldReturn` "PASS"
582+
583+testCreateFileInNestedDir :: Expectation
584+testCreateFileInNestedDir = driverCreateFileInNestedDir `shouldReturn` "PASS"
585+
586+testRemoveFileInNestedDir :: Expectation
587+testRemoveFileInNestedDir = driverRemoveFileInNestedDir `shouldReturn` "PASS"
588+
589+testRenameFileInNestedDir :: Expectation
590+testRenameFileInNestedDir = driverRenameFileInNestedDir `shouldReturn` "PASS"
591+
592+-------------------------------------------------------------------------------
593+-- Main
594+-------------------------------------------------------------------------------
595+main :: IO ()
596+main = hspec $ do
597+ prop "Create a single directory" testCreateSingleDir
598+ prop "Remove a single directory" testRemoveSingleDir
599+ prop "Rename a single directory" testRenameSingleDir
600+ prop "Create a nested directory" testCreateNestedDir
601+ prop "Remove a nested directory" testRemoveNestedDir
602+ prop "Rename a nested directory" testRenameNestedDir
603+ prop "Create a file in root Dir" testCreateFileInRootDir
604+ prop "Remove a file in root Dir" testRemoveFileInRootDir
605+ prop "Rename a file in root Dir" testRenameFileInRootDir
606+ prop "Create a file in a nested Dir" testCreateFileInNestedDir
607+ prop "Remove a file in a nested Dir" testRemoveFileInNestedDir
608+ prop "Rename a file in a nested Dir" testRenameFileInNestedDir