@@ -165,7 +165,8 @@ renameFileNestedDirEvents =
165165
166166-- | Convert an 'Event' record to a short representation for unit test.
167167showEventShort :: Event.Event -> String
168−showEventShort ev@Event.Event{..} = Event.getRelPath ev ++ "_" ++ show eventFlags
168+showEventShort ev@Event.Event{..} =
169+ Event.getRelPath ev ++ "_" ++ show eventFlags
169170
170171#else
171172
@@ -297,127 +298,99 @@ checkEvents rootPath m matchList = do
297298-------------------------------------------------------------------------------
298299-- FS Event Generators
299300-------------------------------------------------------------------------------
301+fsOpsPreTask :: FilePath -> MVar () -> String -> IO ()
302+fsOpsPreTask fp m msg = do
303+ takeMVar m
304+ putStrLn (msg ++ fp)
305+ threadDelay 200000
306+
307+fsOpsPostTask :: FilePath -> IO ()
308+fsOpsPostTask fp =
309+ threadDelay 200000 >> createDirectoryIfMissing True (fp </> "EOTask")
300310
301311-- XXX Factor out common code from all these functions. The specific operation
302312-- can be passed to a common function.
303313
304314fsOpsCreateSingleDir :: FilePath -> MVar () -> IO ()
305315fsOpsCreateSingleDir fp m = do
306− takeMVar m
307− putStrLn ("Create Single Directory !!!!!!! on " ++ fp)
308− threadDelay 200000
316+ fsOpsPreTask fp m "Create a Single Dir on : "
309317 >> createDirectoryIfMissing True (fp </> "dir1Single")
310− >> threadDelay 200000
311− >> createDirectoryIfMissing True (fp </> "EOTask")
318+ >> fsOpsPostTask fp
312319
313320fsOpsRemoveSingleDir :: FilePath -> MVar () -> IO ()
314321fsOpsRemoveSingleDir fp m = do
315− takeMVar m
316− putStrLn ("Remove Single Directory !!!!!!! on " ++ fp)
317− threadDelay 200000
322+ fsOpsPreTask fp m "Remove Single Directory on : "
318323 >> removeDirectory (fp </> "dir1Single")
319− >> threadDelay 200000
320− >> createDirectoryIfMissing True (fp </> "EOTask")
324+ >> fsOpsPostTask fp
321325
322326fsOpsRenameSingleDir :: FilePath -> MVar () -> IO ()
323327fsOpsRenameSingleDir fp m = do
324− takeMVar m
325− putStrLn ("Rename a Single Directory !!!!!!! on " ++ fp)
326− threadDelay 200000
328+ fsOpsPreTask fp m "Rename a Single Directory on : "
327329 >> renameDirectory (fp </> "dir1Single") (fp </> "dir1SingleRenamed")
328− >> threadDelay 200000
329− >> createDirectoryIfMissing True (fp </> "EOTask")
330+ >> fsOpsPostTask fp
330331
331332fsOpsCreateNestedDir :: FilePath -> MVar () -> IO ()
332333fsOpsCreateNestedDir fp m = do
333− takeMVar m
334− putStrLn ("Create Nested Directory !!!!!!!!!!!!! on " ++ fp)
335− threadDelay 200000
334+ fsOpsPreTask fp m "Create Nested Directory on : "
336335 >> createDirectoryIfMissing True (fp </> "dir1" </> "dir2" </> "dir3")
337− >> threadDelay 200000
338− >> createDirectoryIfMissing True (fp </> "EOTask")
336+ >> fsOpsPostTask fp
339337
340338fsOpsRemoveNestedDir :: FilePath -> MVar () -> IO ()
341339fsOpsRemoveNestedDir fp m = do
342− takeMVar m
343− putStrLn ("Remove Nested Directory !!!!!!!!!!!!! on " ++ fp)
344− threadDelay 200000
340+ fsOpsPreTask fp m "Remove Nested Directory on : "
345341 >> removePathForcibly (fp </> "dir1")
346− >> threadDelay 200000
347− >> createDirectoryIfMissing True (fp </> "EOTask")
342+ >> fsOpsPostTask fp
348343
349344fsOpsRenameNestedDir :: FilePath -> MVar () -> IO ()
350345fsOpsRenameNestedDir fp m = do
351− takeMVar m
352− putStrLn ("Rename Nested Directory !!!!!!!!!!!!! on " ++ fp)
353− threadDelay 200000
346+ fsOpsPreTask fp m "Rename Nested Directory on : "
354347 >> renameDirectory
355348 (fp </> "dir1" </> "dir2" </> "dir3")
356349 (fp </> "dir1" </> "dir2" </> "dir3Renamed")
357− >> threadDelay 200000
358− >> createDirectoryIfMissing True (fp </> "EOTask")
350+ >> fsOpsPostTask fp
359351
360352fsOpsCreateFileInRootDir :: FilePath -> MVar () -> IO ()
361353fsOpsCreateFileInRootDir fp m = do
362− takeMVar m
363− let tpath = (fp </> "FileCreated.txt")
364− putStrLn ("create a File on " ++ fp)
365− threadDelay 200000
366− >> writeFile tpath "Test Data"
367− >> threadDelay 200000
368− >> createDirectoryIfMissing True (fp </> "EOTask")
354+ fsOpsPreTask fp m "Create a File on : "
355+ >> writeFile (fp </> "FileCreated.txt") "Test Data"
356+ >> fsOpsPostTask fp
369357
370358fsOpsRemoveFileInRootDir :: FilePath -> MVar () -> IO ()
371359fsOpsRemoveFileInRootDir fp m = do
372− takeMVar m
373360 let tpath = (fp </> "FileCreated.txt")
374− putStrLn ("Remove a File on " ++ fp)
375− threadDelay 200000
361+ fsOpsPreTask fp m "Remove a File on : "
376362 >> removeFile tpath
377− >> threadDelay 200000
378− >> createDirectoryIfMissing True (fp </> "EOTask")
363+ >> fsOpsPostTask fp
379364
380365fsOpsRenameFileInRootDir :: FilePath -> MVar () -> IO ()
381366fsOpsRenameFileInRootDir fp m = do
382− takeMVar m
383367 let spath = (fp </> "FileCreated.txt")
384368 tpath = (fp </> "FileRenamed.txt")
385− putStrLn ("Rename a File on " ++ fp)
386− threadDelay 200000
369+ fsOpsPreTask fp m "Rename a File on : "
387370 >> renamePath spath tpath
388− >> threadDelay 200000
389− >> createDirectoryIfMissing True (fp </> "EOTask")
371+ >> fsOpsPostTask fp
390372
391373fsOpsCreateFileInNestedDir :: FilePath -> MVar () -> IO ()
392374fsOpsCreateFileInNestedDir fp m = do
393− takeMVar m
394375 let tpath = (fp </> "dir1" </> "dir2" </> "dir3" </> "FileCreated.txt")
395− putStrLn ("create a File on nested dir " ++ fp)
396− threadDelay 200000
376+ fsOpsPreTask fp m "create a File in nested dir on : "
397377 >> writeFile tpath "Test Data"
398− >> threadDelay 200000
399− >> createDirectoryIfMissing True (fp </> "EOTask")
378+ >> fsOpsPostTask fp
400379
401380fsOpsRemoveFileInNestedDir :: FilePath -> MVar () -> IO ()
402381fsOpsRemoveFileInNestedDir fp m = do
403− takeMVar m
404382 let tpath = (fp </> "dir1" </> "dir2" </> "dir3" </> "FileCreated.txt")
405− putStrLn ("Remove a File on nested dir " ++ fp)
406− threadDelay 200000
407− >> threadDelay 200000 >> removeFile tpath
408− >> threadDelay 200000
409− >> createDirectoryIfMissing True (fp </> "EOTask")
383+ fsOpsPreTask fp m "Remove a File in nested dir on : "
384+ >> removeFile tpath
385+ >> fsOpsPostTask fp
410386
411387fsOpsRenameFileInNestedDir :: FilePath -> MVar () -> IO ()
412388fsOpsRenameFileInNestedDir fp m = do
413− takeMVar m
414389 let spath = (fp </> "dir1" </> "dir2" </> "dir3" </> "FileCreated.txt")
415390 tpath = (fp </> "dir1" </> "dir2" </> "dir3" </> "FileRenamed.txt")
416− putStrLn ("Rename a File on nested dir " ++ fp)
417− threadDelay 200000
391+ fsOpsPreTask fp m "Rename a File in nested on : "
418392 >> renamePath spath tpath
419− >> threadDelay 200000
420− >> createDirectoryIfMissing True (fp </> "EOTask")
393+ >> fsOpsPostTask fp
421394
422395checker :: S.IsStream t =>
423396 FilePath -> MVar () -> [String] -> t IO String
@@ -439,215 +412,118 @@ driverInit = do
439412-- XXX Factor out common code from all these. Pass a specific fsops function to
440413-- a common functions.
441414
415+eventProcessor
416+ :: FilePath
417+ -> MVar ()
418+ -> [String]
419+ -> (FilePath -> MVar () -> IO ())
420+ -> IO String
421+eventProcessor fp sync evts func = do
422+ res <- S.head
423+ $ (checker fp sync evts)
424+ `S.parallelFst`
425+ S.yieldM -- ^ this message should follow checker
426+ (func fp sync
427+ >> threadDelay 10000000
428+ >> return "fOps Done")
429+ return $ fromJust res
430+
442431driverCreateSingleDir :: IO String
443432driverCreateSingleDir = do
444433 sync <- driverInit
445− withSystemTempDirectory fseventDir $ \fp -> do
446− res <- S.head
447− $ (checker fp sync singleDirCreateEvents)
448− `S.parallelFst`
449− S.yieldM -- ^ this message should follow checker
450− (fsOpsCreateSingleDir fp sync
451− >> threadDelay 10000000
452− >> return "fOps Done")
453− return $ fromJust res
434+ withSystemTempDirectory fseventDir $ \fp ->
435+ eventProcessor
436+ fp sync singleDirCreateEvents fsOpsCreateSingleDir
454437
455438driverRemoveSingleDir :: IO String
456439driverRemoveSingleDir = do
457440 sync <- driverInit
458441 withSystemTempDirectory fseventDir $ \fp -> do
459442 createDirectoryIfMissing True (fp </> "dir1Single")
460− res <- S.head
461− $ (checker fp sync singleDirRemoveEvents)
462− `S.parallelFst`
463− S.yieldM -- ^ this message should follow checker
464− (fsOpsRemoveSingleDir fp sync
465− >> threadDelay 10000000
466− >> return "fOps Done")
467− return $ fromJust res
443+ eventProcessor
444+ fp sync singleDirRemoveEvents fsOpsRemoveSingleDir
468445
469446driverRenameSingleDir :: IO String
470447driverRenameSingleDir = do
471448 sync <- driverInit
472449 withSystemTempDirectory fseventDir $ \fp -> do
473450 createDirectoryIfMissing True (fp </> "dir1Single")
474− res <- S.head
475− $ (checker fp sync singleDirRenameEvents)
476− `S.parallelFst`
477− S.yieldM -- ^ this message should follow checker
478− (fsOpsRenameSingleDir fp sync
479− >> threadDelay 10000000
480− >> return "fOps Done")
481− return $ fromJust res
451+ eventProcessor
452+ fp sync singleDirRenameEvents fsOpsRenameSingleDir
482453
483454driverCreateNestedDir :: IO String
484455driverCreateNestedDir = do
485456 sync <- driverInit
486− withSystemTempDirectory fseventDir $ \fp -> do
487− res <- S.head
488− $ (checker fp sync nestedDirCreateEvents)
489− `S.parallelFst`
490− S.yieldM
491− (fsOpsCreateNestedDir fp sync
492− >> threadDelay 10000000
493− >> return "fOps Done")
494− return $ fromJust res
457+ withSystemTempDirectory fseventDir $ \fp ->
458+ eventProcessor
459+ fp sync nestedDirCreateEvents fsOpsCreateNestedDir
495460
496461driverRemoveNestedDir :: IO String
497462driverRemoveNestedDir = do
498463 sync <- driverInit
499464 withSystemTempDirectory fseventDir $ \fp -> do
500465 createDirectoryIfMissing True (fp </> "dir1" </> "dir2" </> "dir3")
501− res <- S.head
502− $ (checker fp sync nestedDirRemoveEvents)
503− `S.parallelFst`
504− S.yieldM
505− (fsOpsRemoveNestedDir fp sync
506− >> threadDelay 10000000
507− >> return "fOps Done")
508− return $ fromJust res
466+ eventProcessor
467+ fp sync nestedDirRemoveEvents fsOpsRemoveNestedDir
509468
510469driverRenameNestedDir :: IO String
511470driverRenameNestedDir = do
512471 sync <- driverInit
513472 withSystemTempDirectory fseventDir $ \fp -> do
514473 createDirectoryIfMissing True (fp </> "dir1" </> "dir2" </> "dir3")
515− res <- S.head
516− $ (checker fp sync nestedDirRenameEvents)
517− `S.parallelFst`
518− S.yieldM
519− (fsOpsRenameNestedDir fp sync
520− >> threadDelay 10000000
521− >> return "fOps Done")
522− return $ fromJust res
474+ eventProcessor
475+ fp sync nestedDirRenameEvents fsOpsRenameNestedDir
523476
524477driverCreateFileInRootDir :: IO String
525478driverCreateFileInRootDir = do
526479 sync <- driverInit
527480 withSystemTempDirectory fseventDir $ \fp -> do
528− res <- S.head
529− $ (checker fp sync createFileRootDirEvents)
530− `S.parallelFst`
531− S.yieldM
532− (fsOpsCreateFileInRootDir fp sync
533− >> threadDelay 10000000
534− >> return "fOps Done")
535− return $ fromJust res
481+ eventProcessor
482+ fp sync createFileRootDirEvents fsOpsCreateFileInRootDir
536483
537484driverRemoveFileInRootDir :: IO String
538485driverRemoveFileInRootDir = do
539486 sync <- driverInit
540487 withSystemTempDirectory fseventDir $ \fp -> do
541488 writeFile (fp </> "FileCreated.txt") "Test Data"
542− res <- S.head
543− $ (checker fp sync removeFileRootDirEvents)
544− `S.parallelFst`
545− S.yieldM
546− (fsOpsRemoveFileInRootDir fp sync
547− >> threadDelay 10000000
548− >> return "fOps Done")
549− return $ fromJust res
489+ eventProcessor
490+ fp sync removeFileRootDirEvents fsOpsRemoveFileInRootDir
550491
551492driverRenameFileInRootDir :: IO String
552493driverRenameFileInRootDir = do
553494 sync <- driverInit
554495 withSystemTempDirectory fseventDir $ \fp -> do
555496 writeFile (fp </> "FileCreated.txt") "Test Data"
556− res <- S.head
557− $ (checker fp sync renameFileRootDirEvents)
558− `S.parallelFst`
559− S.yieldM
560− (fsOpsRenameFileInRootDir fp sync
561− >> threadDelay 10000000
562− >> return "fOps Done")
563− return $ fromJust res
497+ eventProcessor
498+ fp sync renameFileRootDirEvents fsOpsRenameFileInRootDir
564499
565500driverCreateFileInNestedDir :: IO String
566501driverCreateFileInNestedDir = do
567502 sync <- driverInit
568503 withSystemTempDirectory fseventDir $ \fp -> do
569504 createDirectoryIfMissing True (fp </> "dir1" </> "dir2" </> "dir3")
570− res <- S.head
571− $ (checker fp sync createFileNestedDirEvents)
572− `S.parallelFst`
573− S.yieldM
574− (fsOpsCreateFileInNestedDir fp sync
575− >> threadDelay 10000000
576− >> return "fOps Done")
577− return $ fromJust res
505+ eventProcessor
506+ fp sync createFileNestedDirEvents fsOpsCreateFileInNestedDir
578507
579508driverRemoveFileInNestedDir :: IO String
580509driverRemoveFileInNestedDir = do
581510 sync <- driverInit
582511 withSystemTempDirectory fseventDir $ \fp -> do
583− createDirectoryIfMissing True (fp </> "dir1" </> "dir2" </> "dir3")
584− >> writeFile (fp </> "dir1" </> "dir2" </> "dir3" </> "FileCreated.txt") "Test Data"
585− res <- S.head
586− $ (checker fp sync removeFileNestedDirEvents)
587− `S.parallelFst`
588− S.yieldM
589− (fsOpsRemoveFileInNestedDir fp sync
590− >> threadDelay 10000000
591− >> return "fOps Done")
592− return $ fromJust res
512+ let nestedDir = fp </> "dir1" </> "dir2" </> "dir3"
513+ fpath = nestedDir </> "FileCreated.txt"
514+ createDirectoryIfMissing True nestedDir >> writeFile fpath "Test Data"
515+ eventProcessor
516+ fp sync removeFileNestedDirEvents fsOpsRemoveFileInNestedDir
593517
594518driverRenameFileInNestedDir :: IO String
595519driverRenameFileInNestedDir = do
596520 sync <- driverInit
597521 withSystemTempDirectory fseventDir $ \fp -> do
598− createDirectoryIfMissing True (fp </> "dir1" </> "dir2" </> "dir3")
599− >> writeFile (fp </> "dir1" </> "dir2" </> "dir3" </> "FileCreated.txt") "Test Data"
600− res <- S.head
601− $ (checker fp sync renameFileNestedDirEvents)
602− `S.parallelFst`
603− S.yieldM
604− (fsOpsRenameFileInNestedDir fp sync
605− >> threadDelay 10000000
606− >> return "fOps Done")
607− return $ fromJust res
608−
609−-------------------------------------------------------------------------------
610−-- Test Cases
611−-------------------------------------------------------------------------------
612−
613−-- XXX These can either be directly inlined instead of creating a wrapper
614−-- function or the wrapper could be common passing the function being checked.
615−
616−testCreateSingleDir :: Expectation
617−testCreateSingleDir = driverCreateSingleDir `shouldReturn` "PASS"
618−
619−testRemoveSingleDir :: Expectation
620−testRemoveSingleDir = driverRemoveSingleDir `shouldReturn` "PASS"
621−
622−testRenameSingleDir :: Expectation
623−testRenameSingleDir = driverRenameSingleDir `shouldReturn` "PASS"
624−
625−testCreateNestedDir :: Expectation
626−testCreateNestedDir = driverCreateNestedDir `shouldReturn` "PASS"
627−
628−testRemoveNestedDir :: Expectation
629−testRemoveNestedDir = driverRemoveNestedDir `shouldReturn` "PASS"
630−
631−testRenameNestedDir :: Expectation
632−testRenameNestedDir = driverRenameNestedDir `shouldReturn` "PASS"
633−
634−testCreateFileInRootDir :: Expectation
635−testCreateFileInRootDir = driverCreateFileInRootDir `shouldReturn` "PASS"
636−
637−testRemoveFileInRootDir :: Expectation
638−testRemoveFileInRootDir = driverRemoveFileInRootDir `shouldReturn` "PASS"
639−
640−testRenameFileInRootDir :: Expectation
641−testRenameFileInRootDir = driverRenameFileInRootDir `shouldReturn` "PASS"
642−
643−testCreateFileInNestedDir :: Expectation
644−testCreateFileInNestedDir = driverCreateFileInNestedDir `shouldReturn` "PASS"
645−
646−testRemoveFileInNestedDir :: Expectation
647−testRemoveFileInNestedDir = driverRemoveFileInNestedDir `shouldReturn` "PASS"
648−
649−testRenameFileInNestedDir :: Expectation
650−testRenameFileInNestedDir = driverRenameFileInNestedDir `shouldReturn` "PASS"
522+ let nestedDir = fp </> "dir1" </> "dir2" </> "dir3"
523+ fpath = nestedDir </> "FileCreated.txt"
524+ createDirectoryIfMissing True nestedDir >> writeFile fpath "Test Data"
525+ eventProcessor
526+ fp sync renameFileNestedDirEvents fsOpsRenameFileInNestedDir
651527
652528-------------------------------------------------------------------------------
653529-- Main
@@ -655,15 +531,27 @@ testRenameFileInNestedDir = driverRenameFileInNestedDir `shouldReturn` "PASS"
655531
656532main :: IO ()
657533main = hspec $ do
658− prop "Create a single directory" testCreateSingleDir
659− prop "Remove a single directory" testRemoveSingleDir
660− prop "Rename a single directory" testRenameSingleDir
661− prop "Create a nested directory" testCreateNestedDir
662− prop "Remove a nested directory" testRemoveNestedDir
663− prop "Rename a nested directory" testRenameNestedDir
664− prop "Create a file in root Dir" testCreateFileInRootDir
665− prop "Remove a file in root Dir" testRemoveFileInRootDir
666− prop "Rename a file in root Dir" testRenameFileInRootDir
667− prop "Create a file in a nested Dir" testCreateFileInNestedDir
668− prop "Remove a file in a nested Dir" testRemoveFileInNestedDir
669− prop "Rename a file in a nested Dir" testRenameFileInNestedDir
534+ prop "Create a single directory"
535+ $ driverCreateSingleDir `shouldReturn` "PASS"
536+ prop "Remove a single directory"
537+ $ driverRemoveSingleDir `shouldReturn` "PASS"
538+ prop "Rename a single directory"
539+ $ driverRenameSingleDir `shouldReturn` "PASS"
540+ prop "Create a nested directory"
541+ $ driverCreateNestedDir `shouldReturn` "PASS"
542+ prop "Remove a nested directory"
543+ $ driverRemoveNestedDir `shouldReturn` "PASS"
544+ prop "Rename a nested directory"
545+ $ driverRenameNestedDir `shouldReturn` "PASS"
546+ prop "Create a file in root Dir"
547+ $ driverCreateFileInRootDir `shouldReturn` "PASS"
548+ prop "Remove a file in root Dir"
549+ $ driverRemoveFileInRootDir `shouldReturn` "PASS"
550+ prop "Rename a file in root Dir"
551+ $ driverRenameFileInRootDir `shouldReturn` "PASS"
552+ prop "Create a file in a nested Dir"
553+ $ driverCreateFileInNestedDir `shouldReturn` "PASS"
554+ prop "Remove a file in a nested Dir"
555+ $ driverRemoveFileInNestedDir `shouldReturn` "PASS"
556+ prop "Rename a file in a nested Dir"
557+ $ driverRenameFileInNestedDir `shouldReturn` "PASS"