mirror of
https://github.com/composewell/streamly.git
synced 2024-09-11 11:37:22 +03:00
Add recursive directory tree events in Linux
This commit is contained in:
parent
8625ea5c3c
commit
f00008b321
@ -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
|
@ -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
|
||||
|
@ -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
|
@ -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
|
Loading…
Reference in New Issue
Block a user