git.iko.soy/streamly
on fe28607 help sign in
streamly/test/Streamly/Test/FileSystem/Event/Linux.hs
150 lines 5.5 kB history raw
1-- |
2-- Module : Streamly.Test.FileSystem.Event.Linux
3-- Copyright : (c) 2020 Composewell Technologies
4-- License : BSD-3-Clause
5-- Maintainer : streamly@composewell.com
6-- Stability : experimental
7-- Portability : GHC
8--
9module Streamly.Test.FileSystem.Event.Linux (main) where
11import Streamly.Internal.FileSystem.Event.Linux (Event)
12import qualified Streamly.Internal.FileSystem.Event.Linux as Event
14import Streamly.Test.FileSystem.Event.Common
16moduleName :: String
17moduleName = "FileSystem.Event.Linux"
19dirTouchEvents :: String -> [([Char], Event -> Bool)]
20dirTouchEvents dir =
21 [ (dir, dirEvent Event.isOpened)
22 , (dir, dirEvent Event.isAccessed)
23 , (dir, dirEvent Event.isNonWriteClosed)
24 ]
26dirDelEvents :: String -> [([Char], Event -> Bool)]
27dirDelEvents dir =
28 (dir, dirEvent Event.isDeleted)
29 : (dir, dirEvent Event.isAttrsModified)
30 : dirTouchEvents dir
32rootDirDelEvents :: String -> [([Char], Event -> Bool)]
33rootDirDelEvents root =
34 (root, Event.isRootUnwatched)
35 : (root, Event.isRootDeleted)
36 : (root, dirEvent Event.isAttrsModified)
37 : dirTouchEvents root
39dirMoveEvents :: [Char] -> [Char] -> [([Char], Event -> Bool)]
40dirMoveEvents src dst =
41 [ (src, dirEvent Event.isMoved)
42 , (src, dirEvent Event.isMovedFrom)
43 , (dst, dirEvent Event.isMoved)
44 , (dst, dirEvent Event.isMovedTo)
45 ]
47-- In recursive mode all subdirectories are roots therefore they will generate
48-- isRootMoved.
49rootDirMoveEvents :: [Char] -> [Char] -> [([Char], Event -> Bool)]
50rootDirMoveEvents root _ =
51 (root, Event.isRootMoved)
52 : dirTouchEvents root
54recDirMoveEvents :: [Char] -> [Char] -> [([Char], Event -> Bool)]
55recDirMoveEvents src dst = dirMoveEvents src dst ++ rootDirMoveEvents src dst
57fileTouchEvents :: String -> [([Char], Event -> Bool)]
58fileTouchEvents file =
59 [ (file, fileEvent Event.isOpened)
60 , (file, fileEvent Event.isModified)
61 , (file, fileEvent Event.isWriteClosed)
62 ]
64fileMoveEvents :: [Char] -> [Char] -> [([Char], Event -> Bool)]
65fileMoveEvents src dst =
66 [ (src, fileEvent Event.isMoved)
67 , (src, fileEvent Event.isMovedFrom)
68 , (dst, fileEvent Event.isMoved)
69 , (dst, fileEvent Event.isMovedTo)
70 ]
72-- TODO: add fileRoot tests from macOS test suite
74main :: IO ()
75main = do
76 -- We ignore the events on root/parent dir during regular non-root dir/file
77 -- tests.
79 -- Tests common to regular root and symlink root cases
80 let regSymTests =
81 fileCreate "file" fileTouchEvents
82 : fileMove "file1" "file2" fileMoveEvents
83 : dirMove "dir1" "dir2" dirMoveEvents
84 : dirDelete "dir" dirDelEvents
85 : commonTests
87 let regTests =
88 dirDelete "" rootDirDelEvents
89 : rootDirMove "moved" (\src -> [(src, Event.isRootMoved)])
90 : regSymTests
92 let symTests =
93 -- when root is a symlinked dir, it does not recv touch, isDeleted
94 -- or rootDeleted, rootUnwatched events.
95 dirDelete "" (\dir -> [(dir, dirEvent Event.isAttrsModified)])
96 -- No events occur when a symlink root is moved
97 : regSymTests
99 let w = Event.watchWith (Event.setAllEvents True)
100 run = runTests moduleName "non-recursive" w
102 run DirType regTests
103 run SymLinkOrigPath symTests
105 let fileRootTests =
106 [ fileDelete "" (\path ->
107 [ (path, Event.isAttrsModified)
108 , (path, Event.isRootDeleted)
109 , (path, Event.isRootUnwatched)
110 ])
111 , rootFileMove "moved" (\path -> [(path, Event.isRootMoved)])
112 , fileModify "" (\path -> [(path, Event.isOpened)])
113 ]
115 run FileType fileRootTests
117 -- In recursive mode all subdirectories are roots therefore they will
118 -- generate isRootDeleted/isRootUnwatched. Also, for subdirectories
119 -- multiple events are generated, once in the parent watch and once in the
120 -- self watch as a root of the watch. Therefore, additional touchEvents are
121 -- generated in this case.
122 --
123 -- XXX We can possibly filter out the duplicate events either from the
124 -- parent or self.
125 let regSymRecTests =
126 -- XXX Nested file create misses the create event due to a race
127 -- : fileCreateWithParent "subdir/file" fileTouchEvents
128 fileCreate "subdir/file" fileTouchEvents
129 : fileMove "subdir/file1" "subdir/file2" fileMoveEvents
130 : dirMove "dir1" "dir2" recDirMoveEvents
131 : dirMove "subdir/dir1" "subdir/dir2" recDirMoveEvents
132 : dirDelete "dir" (\d -> rootDirDelEvents d ++ dirDelEvents d)
133 : dirDelete "subdir/dir" (\d -> rootDirDelEvents d ++ dirDelEvents d)
134 -- XXX Nested dir create misses the create event due to a race
135 -- : dirCreateWithParent "subdir/dir" dirTouchEvents
136 : dirCreate "subdir/dir"
137 (\dir -> (dir, dirEvent Event.isCreated) : dirTouchEvents dir)
138 : dirCreate "dir"
139 (\dir -> (dir, dirEvent Event.isCreated) : dirTouchEvents dir)
140 : commonRecTests
141 recRegTests = regTests ++ regSymRecTests
142 recSymTests = symTests ++ regSymRecTests
144 let recw = Event.watchWith
145 (Event.setAllEvents True . Event.setRecursiveMode True)
146 runRec = runTests moduleName "recursive" recw
148 runRec DirType recRegTests
149 runRec SymLinkOrigPath recSymTests
150 runRec FileType fileRootTests