Add recursive directory tree events in Linux

src/Streamly/Internal/FileSystem/Event/Linux.hs

@@ -101,6 +101,8 @@ module Streamly.Internal.FileSystem.Event.Linux
     -- ** Watch APIs
     , watchPathsWith
     , watchPaths
+    , watchTreesWith
+    , watchTrees
     , addToWatch
     , removeFromWatch
 
@@ -140,15 +142,19 @@ module Streamly.Internal.FileSystem.Event.Linux
 
     -- * Debugging
     , showEvent
+    , showEventShort
     )
 where
 
 import Control.Monad (void, when)
-import Control.Monad.IO.Class (liftIO)
+import Control.Monad.IO.Class (MonadIO, liftIO)
+import Data.Bifunctor (bimap)
 import Data.Bits ((.|.), (.&.), complement)
 import Data.Foldable (foldlM)
 import Data.Functor.Identity (runIdentity)
 import Data.IntMap.Lazy (IntMap)
+import Data.IORef (IORef, newIORef, readIORef, writeIORef)
+import Data.Function ((&))
 import Data.List.NonEmpty (NonEmpty)
 import Data.Word (Word8, Word32)
 import Foreign.C.Error (throwErrnoIfMinus1)
@@ -162,6 +168,7 @@ import GHC.IO.Handle.FD (mkHandleFromFD)
 import Streamly.Prelude (SerialT)
 import Streamly.Internal.Data.Parser (Parser)
 import Streamly.Internal.Data.Array.Storable.Foreign.Types (Array(..))
+import System.FilePath ((</>))
 import System.IO (Handle, hClose, IOMode(ReadMode))
 #if !MIN_VERSION_base(4,10,0)
 import Control.Concurrent.MVar (readMVar)
@@ -175,12 +182,13 @@ import GHC.IO.Handle.FD (handleToFd)
 
 import qualified Data.IntMap.Lazy as Map
 import qualified Data.List.NonEmpty as NonEmpty
+import qualified Streamly.Internal.Data.Array.Storable.Foreign as A
 import qualified Streamly.Internal.Data.Fold as FL
 import qualified Streamly.Internal.Data.Parser as PR
 import qualified Streamly.Internal.Data.Stream.IsStream as S
-import qualified Streamly.Internal.Unicode.Stream as U
+import qualified Streamly.Internal.FileSystem.Dir as Dir
 import qualified Streamly.Internal.FileSystem.Handle as FH
-import qualified Streamly.Internal.Data.Array.Storable.Foreign as A
+import qualified Streamly.Internal.Unicode.Stream as U
 
 -------------------------------------------------------------------------------
 -- Subscription to events
@@ -192,7 +200,9 @@ import qualified Streamly.Internal.Data.Array.Storable.Foreign as A
 -- /Internal/
 --
 data Config = Config
-    { createFlags   :: Word32 }
+    { watchRec :: Bool
+    , createFlags :: Word32 
+    }
 
 -------------------------------------------------------------------------------
 -- Boolean settings
@@ -216,11 +226,71 @@ setFlag mask status cfg@Config{..} =
                 Off -> createFlags .&. complement mask
     in cfg {createFlags = flags}
 
+-------------------------------------------------------------------------------
+-- Utilities
+-------------------------------------------------------------------------------
+splitPath :: (MonadIO m) => FilePath -> FilePath -> m [FilePath]
+splitPath pat xs = S.toList
+    $ S.splitOnSeq (A.fromList pat) (FL.toList) (S.fromList xs)
+
+pathDiff :: (MonadIO m) => FilePath -> FilePath -> m FilePath
+pathDiff pat xs =  do
+    splits <- splitPath pat xs
+    let j = case length splits of
+                0 -> ""
+                _ -> last splits
+        t = case length j of
+                0 -> ""
+                _ -> tail j
+    return t
+
+dirListing :: String -> SerialT IO (Either String String)
+dirListing s = do
+    S.filter dirFilter
+        $ S.iterateMapLeftsWith S.ahead listDir (S.yield $ (Left s))
+
+    where
+
+    dirFilter x =
+        case x of
+            Left _ -> True
+            Right _ -> False
+
+    listDir dir =
+        Dir.toEither dir            -- SerialT IO (Either String String)
+        & S.map (bimap prefix prefix) -- SerialT IO (Either String String)
+        
+        where
+        
+        prefix x = dir ++ "/" ++ x
+
+toPathList :: String -> IO [String]
+toPathList root = do
+  S.toList $ S.map toStr $ dirListing root
+
+    where
+
+    toStr x =
+        case x of
+            Left d -> d
+            Right d -> d
+
+toUtf8 :: MonadIO m => String -> m (Array Word8)
+toUtf8 = A.fromStream . U.encodeUtf8 . S.fromList
+
+-- | Set watch event on directory recursively.
+--
+-- /default: Off/
+--
+-- /Internal/
+--
+setRecursiveMode :: Bool -> Config -> Config
+setRecursiveMode rec cfg@Config{} = cfg {watchRec = rec}
+
 -------------------------------------------------------------------------------
 -- Settings
 -------------------------------------------------------------------------------
 
-
 foreign import capi
     "sys/inotify.h value IN_DONT_FOLLOW" iN_DONT_FOLLOW :: Word32
 
@@ -501,14 +571,14 @@ defaultConfig :: Config
 defaultConfig =
       setWhenExists AddIfExists
     $ setAllEvents On
-    $ Config { createFlags = 0 }
+    $ Config {watchRec = False, createFlags = 0}
 
 -------------------------------------------------------------------------------
 -- Open an event stream
 -------------------------------------------------------------------------------
 
 -- | A handle for a watch.
-data Watch = Watch Handle (IntMap (Array Word8))
+data Watch = Watch Handle (IORef (IntMap (Array Word8, Array Word8)))
 
 -- Instead of using the watch descriptor we can provide APIs that use the path
 -- itself to identify the watch. That will require us to maintain a map from wd
@@ -545,7 +615,8 @@ createWatch = do
            ReadMode
            True    -- use non-blocking IO
            Nothing -- TextEncoding (binary)
-    return $ Watch h Map.empty
+    emptyMapRef <- newIORef Map.empty       
+    return $ Watch h emptyMapRef
 
 foreign import ccall unsafe
     "sys/inotify.h inotify_add_watch" c_inotify_add_watch
@@ -580,13 +651,40 @@ handleToFd h = case h of
 --
 -- /Internal/
 --
-addToWatch :: Config -> Watch -> Array Word8 -> IO Watch
-addToWatch Config{..} (Watch handle wdMap) path = do
+addToWatchExecutor ::
+       Config
+    -> Watch
+    -> Array Word8
+    -> Array Word8
+    -> IO (Config, Watch)
+addToWatchExecutor cfg@Config{..} (Watch handle wdMap) pathArr root =  do
+    fd <- handleToFd handle
+    wd <- A.asCString pathArr $ \pathPtr ->
+            throwErrnoIfMinus1 ("addToWatch " ++ utf8ToString pathArr) $
+                c_inotify_add_watch (fdFD fd) pathPtr (CUInt createFlags)
+    km <- readIORef wdMap
+    let k = (Map.insert (fromIntegral wd) (root, pathArr) km)
+    writeIORef wdMap k
+    return $ (cfg, Watch handle wdMap) 
+
+addToWatch :: Config -> Watch -> Array Word8 -> IO (Config, Watch)
+addToWatch cfg@Config{..} (Watch handle wdMap) path = do
     fd <- handleToFd handle
     wd <- A.asCString path $ \pathPtr ->
             throwErrnoIfMinus1 ("addToWatch " ++ utf8ToString path) $
                 c_inotify_add_watch (fdFD fd) pathPtr (CUInt createFlags)
-    return $ Watch handle (Map.insert (fromIntegral wd) path wdMap)
+    km <- readIORef wdMap
+    let k = (Map.insert (fromIntegral wd) (path, path) km)
+    writeIORef wdMap k
+    return $ (cfg, Watch handle wdMap)
+
+addToWatchRec :: Config -> Watch -> FilePath -> FilePath -> IO (Config, Watch)
+addToWatchRec cfg watch path origRoot= do 
+    subdirs <- toPathList path
+    pathArrList <- mapM toUtf8 subdirs
+    rootArr <- toUtf8 origRoot
+    foldlM (\(cfg1, w1) pathArr -> addToWatchExecutor cfg1 w1 pathArr rootArr)
+        (cfg, watch) pathArrList
 
 foreign import ccall unsafe
     "sys/inotify.h inotify_rm_watch" c_inotify_rm_watch
@@ -600,13 +698,15 @@ foreign import ccall unsafe
 removeFromWatch :: Watch -> Array Word8 -> IO Watch
 removeFromWatch (Watch handle wdMap) path = do
     fd <- handleToFd handle
-    wdMap1 <- foldlM (step fd) Map.empty (Map.toList wdMap)
-    return $ Watch handle wdMap1
+    km <- readIORef wdMap
+    wdMap1 <- foldlM (step fd) Map.empty (Map.toList km)
+    writeIORef wdMap wdMap1
+    return $ Watch handle wdMap
 
     where
 
     step fd newMap (wd, v) = do
-        if v == path
+        if (fst v) == path
         then do
             let err = "removeFromWatch " ++ show (utf8ToString path)
                 rm = c_inotify_rm_watch (fdFD fd) (fromIntegral wd)
@@ -620,17 +720,32 @@ removeFromWatch (Watch handle wdMap) path = do
 --
 -- /Internal/
 --
-openWatch :: Config -> NonEmpty (Array Word8) -> IO Watch
+openWatch ::
+       Config
+    -> NonEmpty (Array Word8)
+    -> IO (Config, Watch)
 openWatch cfg paths = do
+    let pathList = NonEmpty.toList paths
     w <- createWatch
-    foldlM (\w1 pth -> addToWatch cfg w1 pth) w (NonEmpty.toList paths)
+    foldlM (\(cfg1, w1) path -> addToWatch cfg1 w1 path)
+        (cfg, w) pathList
+
+openWatchRec ::
+       Config
+    -> NonEmpty (Array Word8)
+    -> IO (Config, Watch)
+openWatchRec cfg paths = do
+    let pathList = map utf8ToString $ NonEmpty.toList paths
+    w <- createWatch
+    foldlM (\(cfg1, w1) path -> addToWatchRec cfg1 w1 path path)
+        (cfg, w) pathList
 
 -- | Close a 'Watch' handle.
 --
 -- /Internal/
 --
-closeWatch :: Watch -> IO ()
-closeWatch (Watch h _) = hClose h
+closeWatch :: (Config, Watch) -> IO ()
+closeWatch (_, Watch h _) = hClose h
 
 -------------------------------------------------------------------------------
 -- Raw events read from the watch file handle
@@ -648,7 +763,7 @@ data Event = Event
    , eventFlags :: Word32
    , eventCookie :: Word32
    , eventRelPath :: Array Word8
-   , eventMap :: IntMap (Array Word8)
+   , eventMap :: IntMap (Array Word8, Array Word8)
    } deriving (Show, Ord, Eq)
 
 -- The inotify event struct from the man page/header file:
@@ -665,14 +780,16 @@ data Event = Event
 -- XXX We can perhaps use parseD monad instance for fusing with parseMany? Need
 -- to measure the perf.
 --
-readOneEvent :: IntMap (Array Word8) -> Parser IO Word8 Event
-readOneEvent wdMap = do
+readOneEvent :: Config -> Watch -> Parser IO Word8 Event
+readOneEvent cfg  wt@(Watch _ wdMap) = do
     let headerLen = (sizeOf (undefined :: CInt)) + 12
     arr <- PR.takeEQ headerLen (A.writeN headerLen)
     (ewd, eflags, cookie, pathLen) <- PR.yieldM $ A.asPtr arr readHeader
     -- XXX need the "initial" in parsers to return a step type so that "take 0"
     -- can return without an input. otherwise if pathLen is 0 we will keep
     -- waiting to read one more char before we return this event.
+    -- PR.yieldM $ print ("Flag1 = " ++ show eflags)
+    -- PR.yieldM $ print ("pathLen = " ++ show pathLen)
     path <-
         if pathLen /= 0
         then do
@@ -681,15 +798,30 @@ readOneEvent wdMap = do
             -- takeP
             pth <- PR.sliceSepByMax (== 0) pathLen (A.writeN pathLen)
             let remaining = pathLen - A.length pth - 1
+            -- PR.yieldM $ print ("remaining = " ++ show remaining)
             when (remaining /= 0) $ PR.takeEQ remaining FL.drain
+            -- PR.yieldM $ print ("takeEQ = " ++ show remaining)
             return pth
         else return $ A.fromList []
+    -- PR.yieldM $ print ("Flag2 = " ++ show eflags)    
+    xm <- PR.yieldM $ readIORef wdMap           
+    let base = case Map.lookup (fromIntegral ewd) xm of
+                    Just path1 -> path1   
+                    Nothing -> (path, path)
+    let xpath = utf8ToString (snd base) </> utf8ToString  path
+    _ <- if eflags .&. iN_CREATE /= 0 && eflags .&. iN_ISDIR /= 0
+         then   
+             processEvent cfg wt xpath (utf8ToString $ fst base)  
+         else return (cfg, wt)
+    rm2 <- PR.yieldM $ readIORef wdMap
+    pdiff <- PR.yieldM $ pathDiff (utf8ToString $ fst base) xpath
+    relPath <- PR.yieldM $ toUtf8 (pdiff)
     return $ Event
         { eventWd = (fromIntegral ewd)
         , eventFlags = eflags
         , eventCookie = cookie
-        , eventRelPath = path
-        , eventMap = wdMap
+        , eventRelPath = relPath
+        , eventMap = rm2
         }
 
     where
@@ -702,8 +834,21 @@ readOneEvent wdMap = do
         pathLen :: Word32 <- peekByteOff ptr (len + 8)
         return (ewd, eflags, cookie, fromIntegral pathLen)
 
-watchToStream :: Watch -> SerialT IO Event
-watchToStream (Watch handle wdMap) =
+    processEvent ::
+           Config
+        -> Watch
+        -> FilePath
+        -> FilePath  
+        -> Parser IO Word8 (Config, Watch)
+    processEvent cfg1@Config{..} wt1 xpath root = do
+            if watchRec
+            then
+                PR.yieldM $ addToWatchRec cfg1 wt1 xpath root
+            else
+                PR.yieldM $ return (cfg1, wt1)       
+        
+watchToStream :: (Config, Watch) -> SerialT IO Event
+watchToStream (cfg, wt@(Watch handle _)) = do
     -- Do not use too small a buffer. As per inotify man page:
     --
     -- The behavior when the buffer given to read(2) is too small to return
@@ -714,7 +859,7 @@ watchToStream (Watch handle wdMap) =
     --          sizeof(struct inotify_event) + NAME_MAX + 1
     --
     -- will be sufficient to read at least one event.
-    S.parseMany (readOneEvent wdMap) $ S.unfold FH.read handle
+    S.parseMany (readOneEvent cfg wt) $ S.unfold FH.read handle
 
 -- | Start monitoring a list of file system paths for file system events with
 -- the supplied configuration operation over the 'defaultConfig'. The
@@ -752,6 +897,33 @@ watchPathsWith f paths = S.bracket before after watchToStream
 watchPaths :: NonEmpty (Array Word8) -> SerialT IO Event
 watchPaths = watchPathsWith id
 
+-- | Start monitoring a list of file system paths for file system events with
+-- the supplied configuration operation over the 'defaultConfig'. The
+-- paths could be files or directories.  When the path is a directory, the
+-- whole directory tree under it is watched recursively. Monitoring starts from
+-- the current time onwards.
+--
+-- /Internal/
+--
+watchTreesWith ::
+    (Config -> Config) -> NonEmpty (Array Word8) -> SerialT IO Event
+watchTreesWith f paths = S.bracket before after watchToStream
+
+    where
+
+    before = liftIO 
+        $ openWatchRec (f $ setRecursiveMode True defaultConfig) paths
+    after = liftIO . closeWatch
+
+-- | Like 'watchTreesWith' but uses the 'defaultConfig' options.
+--
+-- @
+-- watchTrees = watchTreesWith id
+-- @
+--
+watchTrees :: NonEmpty (Array Word8) -> SerialT IO Event
+watchTrees = watchTreesWith id
+
 -------------------------------------------------------------------------------
 -- Examine event stream
 -------------------------------------------------------------------------------
@@ -769,13 +941,12 @@ getRoot Event{..} =
     if (eventWd >= 1)
     then
         case Map.lookup (fromIntegral eventWd) eventMap of
-            Just path -> path
+            Just path -> fst path
             Nothing ->
                 error $ "Bug: getRoot: No path found corresponding to the "
                     ++ "watch descriptor " ++ show eventWd
     else A.fromList []
 
-
 -- XXX should we use a Maybe here?
 -- | Get the file system object path for which the event is generated, relative
 -- to the watched root. The path is a "/" separated array of bytes.
@@ -1017,6 +1188,12 @@ isDir = getFlag iN_ISDIR
 -------------------------------------------------------------------------------
 -- Debugging
 -------------------------------------------------------------------------------
+showEventShort :: Event -> String
+showEventShort ev@Event{..} = (utf8ToString $ getRelPath ev) 
+    ++ "_" ++ show eventFlags
+    ++ showev isDir "Dir"
+
+    where showev f str = if f ev then "_" ++ str else ""
 
 -- | Convert an 'Event' record to a String representation.
 showEvent :: Event -> String
@@ -1055,4 +1232,4 @@ showEvent ev@Event{..} =
 #else
 #warning "Disabling module Streamly.Internal.FileSystem.Event.Linux. Does not support kernels older than 2.6.36."
 module Streamly.Internal.FileSystem.Event.Linux () where
-#endif
+#endif

src/Streamly/Internal/FileSystem/Event/Windows.hs

@@ -89,6 +89,7 @@ module Streamly.Internal.FileSystem.Event.Windows
 
     -- * Debugging
     , showEvent
+    , showEventShort
     )
 where
 
@@ -539,6 +540,9 @@ isOverflow Event{..} = totalBytes == 0
 -------------------------------------------------------------------------------
 -- Debugging
 -------------------------------------------------------------------------------
+-- | Convert an 'Event' record to a short representation for unit test.
+showEventShort :: Event -> String
+showEventShort ev@Event{..} = getRelPath ev ++ "_" ++ show eventFlags    
 
 -- | Convert an 'Event' record to a String representation.
 showEvent :: Event -> String

streamly.cabal

@@ -328,6 +328,9 @@ common test-dependencies
     , random            >= 1.0.0 && < 2
     , transformers      >= 0.4   && < 0.6
     , QuickCheck        >= 2.13  && < 2.15
+    , directory         >= 1.2.2 && < 1.4
+    , filepath          >= 1.4.1
+    , temporary         >= 1.3
 
 -- Compilation for coverage builds on CI machines takes too long without -O0
 -- XXX we should use coverage flag for that, -O0 may take too long to run tests
@@ -386,6 +389,7 @@ library
 
     if os(linux)
       exposed-modules: Streamly.Internal.FileSystem.Event.Linux
+      build-depends: unix >= 2.7.2, filepath  >= 1.4.1
 
     hs-source-dirs:    src
     other-modules:
@@ -733,8 +737,11 @@ test-suite version-bounds
   type: exitcode-stdio-1.0
   main-is: version-bounds.hs
 
-executable FileSystem.Event
+test-suite FileSystem.Event
   import: test-options
+  type: exitcode-stdio-1.0
   main-is: Streamly/Test/FileSystem/Event.hs
-  if !flag(manual-tests)
-    buildable: False
+  hs-source-dirs: test  
+  default-language: Haskell2010
+  if os(darwin)
+    buildable: False

test/Streamly/Test/FileSystem/Event.hs

@@ -1,27 +1,30 @@
--- |
--- Module      : Streamly.Test.FileSystem.Event
--- Copyright   : (c) 2020 Composewell Technologies
---
--- License     : BSD3
--- Maintainer  : streamly@composewell.com
--- Stability   : experimental
--- Portability : GHC
---
--- Just report all events under the paths provided as arguments
-module Main (main) where
-
+import Control.Concurrent (MVar, newEmptyMVar, putMVar, takeMVar, threadDelay)
 import Control.Monad.IO.Class (MonadIO)
-import Data.Function ((&))
 import Data.List.NonEmpty (NonEmpty)
+import Data.Maybe (fromJust)
 import Data.Word (Word8)
-import System.Environment (getArgs)
+import System.Directory ( createDirectoryIfMissing
+                        , removeFile
+                        , removeDirectory
+                        , removePathForcibly
+                        , renameDirectory
+                        , renamePath
+                        )
+import System.FilePath ((</>))
+import System.IO (BufferMode(..), hSetBuffering, stdout)
+import System.IO.Temp (withSystemTempDirectory)
 import Streamly.Prelude (SerialT)
 import Streamly.Internal.Data.Array.Storable.Foreign (Array)
+import Test.Hspec
+import Test.Hspec.QuickCheck
 
+import qualified Data.List.NonEmpty as NonEmpty
+import qualified Data.Set as Set
 import qualified Streamly.Unicode.Stream as Unicode
 import qualified Streamly.Internal.Data.Array.Storable.Foreign as Array
-import qualified Data.List.NonEmpty as NonEmpty
-import qualified Streamly.Internal.Data.Stream.IsStream as Stream
+import qualified Streamly.Internal.Data.Fold as FL
+import qualified Streamly.Internal.Data.Parser as PR
+import qualified Streamly.Internal.Data.Stream.IsStream as S
 #if defined(CABAL_OS_DARWIN)
 import qualified Streamly.Internal.FileSystem.Event.Darwin as Event
 #elif defined(CABAL_OS_LINUX)
@@ -32,28 +35,574 @@ import qualified Streamly.Internal.FileSystem.Event.Windows as Event
 #error "FS Events not supported on this platform
 #endif
 
+#if !defined(CABAL_OS_WINDOWS)
+import Data.Functor.Identity (runIdentity)
+import qualified Streamly.Internal.Unicode.Stream as U
+#endif
 -------------------------------------------------------------------------------
 -- Utilities
 -------------------------------------------------------------------------------
-
 toUtf8 :: MonadIO m => String -> m (Array Word8)
-toUtf8 = Array.fromStream . Unicode.encodeUtf8' . Stream.fromList
+toUtf8 = Array.fromStream . Unicode.encodeUtf8' . S.fromList
+
+#if !defined(CABAL_OS_WINDOWS)
+utf8ToString :: Array Word8 -> String
+utf8ToString = runIdentity . S.toList . U.decodeUtf8' . Array.toStream
+#endif
+
+watchPaths :: NonEmpty (Array Word8) -> SerialT IO Event.Event
+watchPaths = Event.watchTrees
+
+timeout :: IO String
+timeout = threadDelay 5000000 >> return "Timeout"
+
+fseventDir :: String
+fseventDir = "fsevent_dir"
+
+eventPredicate :: Event.Event -> Bool
+eventPredicate ev =
+#if defined(CABAL_OS_WINDOWS)
+    if (Event.getRelPath ev) == "EOTask"
+#else
+    if (utf8ToString $ Event.getRelPath ev) == "EOTask"
+#endif
+    then False
+    else True
+
+-------------------------------------------------------------------------------
+-- Event lists to be matched with
+-------------------------------------------------------------------------------
+#if defined(CABAL_OS_WINDOWS)
+
+singleDirCreateEvents :: [String]
+singleDirCreateEvents =
+    [ "dir1Single_1" ]
+
+singleDirRemoveEvents :: [String]
+singleDirRemoveEvents =
+    [ "dir1Single_2" ]
+
+singleDirRenameEvents :: [String]
+singleDirRenameEvents =
+    [ "dir1Single_4"
+    , "dir1SingleRenamed_5"
+    ]
+
+nestedDirCreateEvents :: [String]
+nestedDirCreateEvents =
+    [ "dir1_1"
+    , "dir1\\dir2_1"
+    , "dir1\\dir2\\dir3_1"
+    ]
+
+nestedDirRemoveEvents :: [String]
+nestedDirRemoveEvents =
+    [ "dir1_3"
+    , "dir1\\dir2_3"
+    , "dir1\\dir2\\dir3_2"
+    , "dir1\\dir2_2","dir1_2"
+    ]
+
+nestedDirRenameEvents :: [String]
+nestedDirRenameEvents =
+    [ "dir1\\dir2_3"
+    , "dir1\\dir2\\dir3_4"
+    , "dir1\\dir2\\dir3Renamed_5"
+    , "dir1\\dir2_3"
+    ]
+
+createFileRootDirEvents :: [String]
+createFileRootDirEvents =
+    [ "FileCreated.txt_1"
+    , "FileCreated.txt_3"
+    , "FileCreated.txt_3"
+    ]
+
+removeFileRootDirEvents :: [String]
+removeFileRootDirEvents =
+    [ "FileCreated.txt_2" ]
+
+renameFileRootDirEvents :: [String]
+renameFileRootDirEvents =
+    [ "FileCreated.txt_4"
+    , "FileRenamed.txt_5"
+    ]
+
+createFileNestedDirEvents :: [String]
+createFileNestedDirEvents =
+    [ "dir1\\dir2\\dir3\\FileCreated.txt_1"
+    , "dir1\\dir2\\dir3\\FileCreated.txt_3"
+    ]
+
+removeFileNestedDirEvents :: [String]
+removeFileNestedDirEvents =
+    ["dir1\\dir2\\dir3\\FileCreated.txt_2"]
+
+renameFileNestedDirEvents :: [String]
+renameFileNestedDirEvents =
+    [ "dir1\\dir2\\dir3_3"
+    , "dir1\\dir2\\dir3\\FileCreated.txt_4"
+    , "dir1\\dir2\\dir3\\FileRenamed.txt_5"
+    ]
+
+#else
+
+singleDirCreateEvents :: [String]
+singleDirCreateEvents =
+    [ "dir1Single_1073742080_Dir"
+    , "dir1Single_1073741856_Dir"
+    , "dir1Single_1073741825_Dir"
+    , "dir1Single_1073741840_Dir"
+    ]
+
+singleDirRemoveEvents :: [String]
+singleDirRemoveEvents =
+    [ "dir1Single_1024"
+    , "dir1Single_32768"
+    ]
+
+singleDirRenameEvents :: [String]
+singleDirRenameEvents =
+    [ "dir1Single_1073741888_Dir"
+    , "dir1SingleRenamed_1073741952_Dir"
+    ]
+
+nestedDirCreateEvents :: [String]
+nestedDirCreateEvents =
+    [ "dir1_1073742080_Dir"
+    , "dir1_1073741856_Dir"
+    , "dir1_1073741825_Dir"
+    , "dir1_1073741840_Dir"
+    ]
+
+nestedDirRemoveEvents :: [String]
+nestedDirRemoveEvents =
+    [ "dir1/dir2/dir3_1073742336_Dir"
+    , "dir1/dir2_1073742336_Dir"
+    , "dir1_1073742336_Dir"
+    ]
+
+nestedDirRenameEvents :: [String]
+nestedDirRenameEvents =
+    [ "dir1/dir2/dir3_1073741888_Dir"
+    , "dir1/dir2/dir3Renamed_1073741952_Dir"
+    ]
+
+createFileRootDirEvents :: [String]
+createFileRootDirEvents =
+    [ "FileCreated.txt_256"
+    , "FileCreated.txt_32"
+    , "FileCreated.txt_2"
+    ]
+
+removeFileRootDirEvents :: [String]
+removeFileRootDirEvents =
+    ["FileCreated.txt_512"]
+
+renameFileRootDirEvents :: [String]
+renameFileRootDirEvents =
+    [ "FileCreated.txt_64"
+    , "FileRenamed.txt_128"
+    ]
+
+createFileNestedDirEvents :: [String]
+createFileNestedDirEvents =
+    [ "dir1/dir2/dir3/FileCreated.txt_256"
+    , "dir1/dir2/dir3/FileCreated.txt_32"
+    , "dir1/dir2/dir3/FileCreated.txt_2"
+    , "dir1/dir2/dir3/FileCreated.txt_8"
+    ]
+
+removeFileNestedDirEvents :: [String]
+removeFileNestedDirEvents =
+    ["dir1/dir2/dir3/FileCreated.txt_512"]
+
+renameFileNestedDirEvents :: [String]
+renameFileNestedDirEvents =
+    [ "dir1/dir2/dir3/FileCreated.txt_64"
+    , "dir1/dir2/dir3/FileRenamed.txt_128"
+    ]
+#endif
+
+-------------------------------------------------------------------------------
+-- Event Watcher
+-------------------------------------------------------------------------------
+checkEvents :: FilePath -> MVar () -> [String] -> IO String
+checkEvents rootPath m matchList = do
+    let args = [rootPath]
+    paths <- mapM toUtf8 args
+    putStrLn ("Watch started !!!! on Path " ++ rootPath)
+    events <- S.parse (PR.takeWhile eventPredicate FL.toList)
+        $ S.before (putMVar m ())
+        $ watchPaths (NonEmpty.fromList paths)
+    let eventStr =  map Event.showEventShort events
+    putStrLn $ show (eventStr)
+    let baseSet = Set.fromList matchList
+        resultSet = Set.fromList eventStr
+    if (baseSet `Set.isSubsetOf` resultSet)
+    then
+        return "PASS"
+    else
+        return "Mismatch"
+
+-------------------------------------------------------------------------------
+-- FS Event Generators
+-------------------------------------------------------------------------------
+fsOpsCreateSingleDir :: FilePath -> MVar () -> IO ()
+fsOpsCreateSingleDir fp m = do
+    takeMVar m
+    putStrLn ("Create Single Directory !!!!!!! on " ++ fp)
+    threadDelay 200000
+        >> createDirectoryIfMissing True (fp </> "dir1Single")
+        >> threadDelay 200000
+        >> createDirectoryIfMissing True (fp </> "EOTask")
+
+fsOpsRemoveSingleDir :: FilePath -> MVar () -> IO ()
+fsOpsRemoveSingleDir fp m = do
+    takeMVar m
+    putStrLn ("Remove Single Directory !!!!!!! on " ++ fp)
+    threadDelay 200000
+        >> removeDirectory (fp </> "dir1Single")
+        >> threadDelay 200000
+        >> createDirectoryIfMissing True (fp </> "EOTask")
+
+fsOpsRenameSingleDir :: FilePath -> MVar () -> IO ()
+fsOpsRenameSingleDir fp m = do
+    takeMVar m
+    putStrLn ("Rename a Single Directory !!!!!!! on " ++ fp)
+    threadDelay 200000
+        >> renameDirectory (fp </> "dir1Single") (fp </> "dir1SingleRenamed")
+        >> threadDelay 200000
+        >> createDirectoryIfMissing True (fp </> "EOTask")
+
+fsOpsCreateNestedDir :: FilePath -> MVar () -> IO ()
+fsOpsCreateNestedDir fp m = do
+    takeMVar m
+    putStrLn ("Create Nested Directory !!!!!!!!!!!!! on " ++ fp)
+    threadDelay 200000
+        >> createDirectoryIfMissing True (fp </> "dir1" </> "dir2" </> "dir3")
+        >> threadDelay 200000
+        >> createDirectoryIfMissing True (fp </> "EOTask")
+
+fsOpsRemoveNestedDir :: FilePath -> MVar () -> IO ()
+fsOpsRemoveNestedDir fp m = do
+    takeMVar m
+    putStrLn ("Remove Nested Directory !!!!!!!!!!!!! on " ++ fp)
+    threadDelay 200000
+        >> removePathForcibly (fp </> "dir1")
+        >> threadDelay 200000
+        >> createDirectoryIfMissing True (fp </> "EOTask")
+
+fsOpsRenameNestedDir :: FilePath -> MVar () -> IO ()
+fsOpsRenameNestedDir fp m = do
+    takeMVar m
+    putStrLn ("Rename Nested Directory !!!!!!!!!!!!! on " ++ fp)
+    threadDelay 200000
+        >> renameDirectory
+            (fp </> "dir1" </> "dir2" </> "dir3")
+            (fp </> "dir1" </> "dir2" </> "dir3Renamed")
+        >> threadDelay 200000
+        >> createDirectoryIfMissing True (fp </> "EOTask")
+
+fsOpsCreateFileInRootDir :: FilePath -> MVar () -> IO ()
+fsOpsCreateFileInRootDir fp m = do
+    takeMVar m
+    let tpath = (fp </> "FileCreated.txt")
+    putStrLn ("create a File  on " ++ fp)
+    threadDelay 200000
+        >> writeFile tpath "Test Data"
+        >> threadDelay 200000
+        >> createDirectoryIfMissing True (fp </> "EOTask")
+
+fsOpsRemoveFileInRootDir :: FilePath -> MVar () -> IO ()
+fsOpsRemoveFileInRootDir fp m = do
+    takeMVar m
+    let tpath = (fp </> "FileCreated.txt")
+    putStrLn ("Remove a File  on " ++ fp)
+    threadDelay 200000 
+        >> removeFile tpath
+        >> threadDelay 200000
+        >> createDirectoryIfMissing True (fp </> "EOTask")
+
+fsOpsRenameFileInRootDir :: FilePath -> MVar () -> IO ()
+fsOpsRenameFileInRootDir fp m = do
+    takeMVar m
+    let spath = (fp </> "FileCreated.txt")
+        tpath = (fp </> "FileRenamed.txt")
+    putStrLn ("Rename a File  on " ++ fp)
+    threadDelay 200000
+        >> renamePath spath tpath
+        >> threadDelay 200000
+        >> createDirectoryIfMissing True (fp </> "EOTask")
+
+fsOpsCreateFileInNestedDir :: FilePath -> MVar () -> IO ()
+fsOpsCreateFileInNestedDir fp m = do
+    takeMVar m
+    let tpath = (fp </> "dir1" </> "dir2" </> "dir3" </> "FileCreated.txt")
+    putStrLn ("create a File  on nested dir " ++ fp)
+    threadDelay 200000
+        >> writeFile tpath "Test Data"
+        >> threadDelay 200000
+        >> createDirectoryIfMissing True (fp </> "EOTask")
+
+fsOpsRemoveFileInNestedDir :: FilePath -> MVar () -> IO ()
+fsOpsRemoveFileInNestedDir fp m = do
+    takeMVar m
+    let tpath = (fp </> "dir1" </> "dir2" </> "dir3" </> "FileCreated.txt")
+    putStrLn ("Remove a File  on nested dir " ++ fp)
+    threadDelay 200000
+        >> threadDelay 200000 >> removeFile tpath
+        >> threadDelay 200000
+        >> createDirectoryIfMissing True (fp </> "EOTask")
+
+fsOpsRenameFileInNestedDir :: FilePath -> MVar () -> IO ()
+fsOpsRenameFileInNestedDir fp m = do
+    takeMVar m
+    let spath = (fp </> "dir1" </> "dir2" </> "dir3" </> "FileCreated.txt")
+        tpath = (fp </> "dir1" </> "dir2" </> "dir3" </> "FileRenamed.txt")
+    putStrLn ("Rename a File  on nested dir " ++ fp)
+    threadDelay 200000
+        >> renamePath spath tpath
+        >> threadDelay 200000
+        >> createDirectoryIfMissing True (fp </> "EOTask")
+
+
+checker :: S.IsStream t =>
+                FilePath -> MVar () -> [String] -> t IO String
+checker rootPath synch matchList =
+    S.yieldM (checkEvents rootPath synch matchList)
+    `S.parallelFst`
+    S.yieldM timeout
+
+driverInit :: IO (MVar ())
+driverInit = do
+    hSetBuffering stdout NoBuffering
+    pre <- newEmptyMVar
+    return pre
+
+-------------------------------------------------------------------------------
+-- Test Drivers
+-------------------------------------------------------------------------------
+driverCreateSingleDir :: IO String
+driverCreateSingleDir = do
+    sync <- driverInit
+    withSystemTempDirectory fseventDir $ \fp -> do
+        res <- S.head
+            $ (checker fp sync singleDirCreateEvents)
+            `S.parallelFst`
+            S.yieldM  -- ^ this message should follow checker
+            (fsOpsCreateSingleDir fp sync
+                >> threadDelay 10000000
+                >> return "fOps Done")
+        return $ fromJust res
+
+driverRemoveSingleDir :: IO String
+driverRemoveSingleDir = do
+    sync <- driverInit
+    withSystemTempDirectory fseventDir $ \fp -> do
+        createDirectoryIfMissing True (fp </> "dir1Single")
+        res <- S.head
+            $ (checker fp sync singleDirRemoveEvents)
+            `S.parallelFst`
+            S.yieldM  -- ^ this message should follow checker
+            (fsOpsRemoveSingleDir fp sync
+                >> threadDelay 10000000
+                >> return "fOps Done")
+        return $ fromJust res
+
+driverRenameSingleDir :: IO String
+driverRenameSingleDir = do
+    sync <- driverInit
+    withSystemTempDirectory fseventDir $ \fp -> do
+        createDirectoryIfMissing True (fp </> "dir1Single")
+        res <- S.head
+            $ (checker fp sync singleDirRenameEvents)
+            `S.parallelFst`
+            S.yieldM  -- ^ this message should follow checker
+            (fsOpsRenameSingleDir fp sync
+                >> threadDelay 10000000
+                >> return "fOps Done")
+        return $ fromJust res
+
+driverCreateNestedDir :: IO String
+driverCreateNestedDir = do
+    sync <- driverInit
+    withSystemTempDirectory fseventDir $ \fp -> do
+        res <- S.head
+            $ (checker fp sync nestedDirCreateEvents)
+            `S.parallelFst`
+            S.yieldM
+            (fsOpsCreateNestedDir fp sync
+                >> threadDelay 10000000
+                >> return "fOps Done")
+        return $ fromJust res
+
+driverRemoveNestedDir :: IO String
+driverRemoveNestedDir = do
+    sync <- driverInit
+    withSystemTempDirectory fseventDir $ \fp -> do
+        createDirectoryIfMissing True (fp </> "dir1" </> "dir2" </> "dir3")
+        res <- S.head
+            $ (checker fp sync nestedDirRemoveEvents)
+            `S.parallelFst`
+            S.yieldM
+            (fsOpsRemoveNestedDir fp sync
+                >> threadDelay 10000000
+                >> return "fOps Done")
+        return $ fromJust res
+
+driverRenameNestedDir :: IO String
+driverRenameNestedDir = do
+    sync <- driverInit
+    withSystemTempDirectory fseventDir $ \fp -> do
+        createDirectoryIfMissing True (fp </> "dir1" </> "dir2" </> "dir3")
+        res <- S.head
+            $ (checker fp sync nestedDirRenameEvents)
+            `S.parallelFst`
+            S.yieldM
+            (fsOpsRenameNestedDir fp sync
+                >> threadDelay 10000000
+                >> return "fOps Done")
+        return $ fromJust res
+
+driverCreateFileInRootDir :: IO String
+driverCreateFileInRootDir = do
+    sync <- driverInit
+    withSystemTempDirectory fseventDir $ \fp -> do
+        res <- S.head
+            $ (checker fp sync createFileRootDirEvents)
+            `S.parallelFst`
+            S.yieldM
+            (fsOpsCreateFileInRootDir fp sync
+                >> threadDelay 10000000
+                >> return "fOps Done")
+        return $ fromJust res
+
+driverRemoveFileInRootDir :: IO String
+driverRemoveFileInRootDir = do
+    sync <- driverInit
+    withSystemTempDirectory fseventDir $ \fp -> do
+        writeFile (fp </> "FileCreated.txt") "Test Data"
+        res <- S.head
+            $ (checker fp sync removeFileRootDirEvents)
+            `S.parallelFst`
+            S.yieldM
+            (fsOpsRemoveFileInRootDir fp sync
+                >> threadDelay 10000000
+                >> return "fOps Done")
+        return $ fromJust res
+
+driverRenameFileInRootDir :: IO String
+driverRenameFileInRootDir = do
+    sync <- driverInit
+    withSystemTempDirectory fseventDir $ \fp -> do
+        writeFile (fp </> "FileCreated.txt") "Test Data"
+        res <- S.head
+            $ (checker fp sync renameFileRootDirEvents)
+            `S.parallelFst`
+            S.yieldM
+            (fsOpsRenameFileInRootDir fp sync
+                >> threadDelay 10000000
+                >> return "fOps Done")
+        return $ fromJust res
+
+driverCreateFileInNestedDir :: IO String
+driverCreateFileInNestedDir = do
+    sync <- driverInit
+    withSystemTempDirectory fseventDir $ \fp -> do
+        createDirectoryIfMissing True (fp </> "dir1" </> "dir2" </> "dir3")
+        res <- S.head
+            $ (checker fp sync createFileNestedDirEvents)
+            `S.parallelFst`
+            S.yieldM
+            (fsOpsCreateFileInNestedDir fp sync
+                >> threadDelay 10000000
+                >> return "fOps Done")
+        return $ fromJust res
+
+driverRemoveFileInNestedDir :: IO String
+driverRemoveFileInNestedDir = do
+    sync <- driverInit
+    withSystemTempDirectory fseventDir $ \fp -> do
+        createDirectoryIfMissing True (fp </> "dir1" </> "dir2" </> "dir3")
+            >> writeFile (fp </> "dir1" </> "dir2" </> "dir3" </> "FileCreated.txt") "Test Data"
+        res <- S.head
+            $ (checker fp sync removeFileNestedDirEvents)
+            `S.parallelFst`
+            S.yieldM
+            (fsOpsRemoveFileInNestedDir fp sync
+                >> threadDelay 10000000
+                >> return "fOps Done")
+        return $ fromJust res
+
+driverRenameFileInNestedDir :: IO String
+driverRenameFileInNestedDir = do
+    sync <- driverInit
+    withSystemTempDirectory fseventDir $ \fp -> do
+        createDirectoryIfMissing True (fp </> "dir1" </> "dir2" </> "dir3")
+            >> writeFile (fp </> "dir1" </> "dir2" </> "dir3" </> "FileCreated.txt") "Test Data"
+        res <- S.head
+            $ (checker fp sync renameFileNestedDirEvents)
+            `S.parallelFst`
+            S.yieldM
+            (fsOpsRenameFileInNestedDir fp sync
+                >> threadDelay 10000000
+                >> return "fOps Done")
+        return $ fromJust res
+
+-------------------------------------------------------------------------------
+-- Test Cases
+-------------------------------------------------------------------------------
+testCreateSingleDir :: Expectation
+testCreateSingleDir = driverCreateSingleDir `shouldReturn` "PASS"
+
+testRemoveSingleDir :: Expectation
+testRemoveSingleDir = driverRemoveSingleDir `shouldReturn` "PASS"
+
+testRenameSingleDir :: Expectation
+testRenameSingleDir = driverRenameSingleDir `shouldReturn` "PASS"
+
+testCreateNestedDir :: Expectation
+testCreateNestedDir = driverCreateNestedDir `shouldReturn` "PASS"
+
+testRemoveNestedDir :: Expectation
+testRemoveNestedDir = driverRemoveNestedDir `shouldReturn` "PASS"
+
+testRenameNestedDir :: Expectation
+testRenameNestedDir = driverRenameNestedDir `shouldReturn` "PASS"
+
+testCreateFileInRootDir :: Expectation
+testCreateFileInRootDir = driverCreateFileInRootDir `shouldReturn` "PASS"
+
+testRemoveFileInRootDir :: Expectation
+testRemoveFileInRootDir = driverRemoveFileInRootDir `shouldReturn` "PASS"
+
+testRenameFileInRootDir :: Expectation
+testRenameFileInRootDir = driverRenameFileInRootDir `shouldReturn` "PASS"
+
+testCreateFileInNestedDir :: Expectation
+testCreateFileInNestedDir = driverCreateFileInNestedDir `shouldReturn` "PASS"
+
+testRemoveFileInNestedDir :: Expectation
+testRemoveFileInNestedDir = driverRemoveFileInNestedDir `shouldReturn` "PASS"
+
+testRenameFileInNestedDir :: Expectation
+testRenameFileInNestedDir = driverRenameFileInNestedDir `shouldReturn` "PASS"
 
 -------------------------------------------------------------------------------
 -- Main
 -------------------------------------------------------------------------------
-
-watchPaths :: NonEmpty (Array Word8) -> SerialT IO Event.Event
-#if defined(CABAL_OS_LINUX)
-watchPaths = Event.watchPaths
-#else
-watchPaths = Event.watchTrees
-#endif
-
 main :: IO ()
-main = do
-    args <- getArgs
-    paths <- mapM toUtf8 args
-
-    watchPaths (NonEmpty.fromList paths)
-        & Stream.mapM_ (putStrLn . Event.showEvent)
+main = hspec $ do
+    prop "Create a single directory" testCreateSingleDir
+    prop "Remove a single directory" testRemoveSingleDir
+    prop "Rename a single directory" testRenameSingleDir
+    prop "Create a nested directory" testCreateNestedDir
+    prop "Remove a nested directory" testRemoveNestedDir
+    prop "Rename a nested directory" testRenameNestedDir
+    prop "Create a file in root Dir" testCreateFileInRootDir
+    prop "Remove a file in root Dir" testRemoveFileInRootDir
+    prop "Rename a file in root Dir" testRenameFileInRootDir
+    prop "Create a file in a nested Dir" testCreateFileInNestedDir
+    prop "Remove a file in a nested Dir" testRemoveFileInNestedDir
+    prop "Rename a file in a nested Dir" testRenameFileInNestedDir