git.iko.soy/streamly
on master help sign in
Implement common FS events
3b8932eRanjeet Kumar Ranjan
src/Streamly/Internal/FileSystem/Event.hsnew file+102
compare with master
unifiedsplit
@@ -0,0 +1,102 @@
1+-- |
2+-- Module : Streamly.FileSystem.Event
3+-- Copyright : (c) 2020 Composewell Technologies
4+--
5+-- License : BSD-3-Clause
6+-- Maintainer : streamly@composewell.com
7+-- Stability : experimental
8+-- Portability : GHC
9+
10+module Streamly.Internal.FileSystem.Event
11+ ( Config
12+ , Event
13+ , Toggle
14+ , defaultConfig
15+ , setAllEvents
16+
17+ -- ** Events of Interest
18+ , setRootMoved
19+
20+ -- * Handling Events
21+ , getAbsolutePath
22+
23+ -- ** Item CRUD events
24+ , isCreated
25+ , isDeleted
26+ , isMoved
27+ , isModified
28+
29+ -- ** Exception Conditions
30+ , isOverflow
31+
32+ -- * Debugging
33+ , showEvent
34+ )
35+where
36+
37+import Data.Word (Word8)
38+import Streamly.Internal.Data.Array.Foreign (Array)
39+
40+#if defined(CABAL_OS_DARWIN)
41+import qualified Streamly.Internal.FileSystem.Event.Darwin as Event
42+#elif defined(CABAL_OS_LINUX)
43+import qualified Streamly.Internal.FileSystem.Event.Linux as Event
44+#elif defined(CABAL_OS_WINDOWS)
45+import qualified Streamly.Internal.FileSystem.Event.Windows as Event
46+#else
47+#error "FS Events not supported on this platform"
48+#endif
49+
50+-------------------------------------------------------------------------------
51+-- Main
52+-------------------------------------------------------------------------------
53+
54+type Toggle = Event.Toggle
55+type Config = Event.Config
56+type Event = Event.Event
57+
58+setRootMoved :: Toggle -> Config -> Config
59+setRootMoved = Event.setRootMoved
60+
61+setAllEvents :: Toggle -> Config -> Config
62+#if defined(CABAL_OS_DARWIN)
63+setAllEvents s cfg = defaultConfig
64+#else
65+setAllEvents = Event.setAllEvents
66+#endif
67+
68+getAbsolutePath :: Event -> Array Word8
69+getAbsolutePath = Event.getAbsPath
70+
71+isCreated :: Event -> Bool
72+isCreated = Event.isCreated
73+
74+isDeleted :: Event -> Bool
75+isDeleted = Event.isDeleted
76+
77+isMoved :: Event -> Bool
78+#if defined(CABAL_OS_DARWIN)
79+isMoved = Event.isMoved
80+#else
81+isMoved ev = Event.isMovedFrom ev || Event.isMovedTo ev
82+#endif
83+
84+isModified :: Event -> Bool
85+isModified = Event.isModified
86+
87+isOverflow :: Event -> Bool
88+#if defined(CABAL_OS_DARWIN)
89+isOverflow = Event.isMustScanSubdirs
90+#else
91+isOverflow = Event.isOverflow
92+#endif
93+
94+showEvent :: Event -> String
95+showEvent = Event.showEvent
96+
97+defaultConfig :: Config
98+#if defined(CABAL_OS_DARWIN)
99+defaultConfig = Event.Config 0.0 0
100+#else
101+defaultConfig = Event.Config True 0
102+#endif
src/Streamly/Internal/FileSystem/Event/Darwin.hs+11−9
@@ -81,7 +81,7 @@ module Streamly.Internal.FileSystem.Event.Darwin
81 -- * Creating a Watch
81 -- * Creating a Watch
82
82
83 -- ** Default configuration
83 -- ** Default configuration
84− Config
84+ Config (..)
85 , Toggle (..)
85 , Toggle (..)
86 , defaultConfig
86 , defaultConfig
87
87
@@ -90,7 +90,7 @@ module Streamly.Internal.FileSystem.Event.Darwin
90 , setEventBatching
90 , setEventBatching
91
91
92 -- ** Events of Interest
92 -- ** Events of Interest
93− , setRootChanged
93+ , setRootMoved
94 , setFileEvents
94 , setFileEvents
95 , setIgnoreSelf
95 , setIgnoreSelf
96#if HAVE_DECL_KFSEVENTSTREAMCREATEFLAGFULLHISTORY
96#if HAVE_DECL_KFSEVENTSTREAMCREATEFLAGFULLHISTORY
@@ -214,7 +214,7 @@ data BatchInfo =
214-- /Pre-release/
214-- /Pre-release/
215--
215--
216setEventBatching :: BatchInfo -> Config -> Config
216setEventBatching :: BatchInfo -> Config -> Config
217−setEventBatching batchInfo cfg@Config{..} =
217+setEventBatching batchInfo cfg =
218 let (t, status) =
218 let (t, status) =
219 case batchInfo of
219 case batchInfo of
220 Throttle sec | sec < 0 -> (0, On)
220 Throttle sec | sec < 0 -> (0, On)
@@ -255,8 +255,8 @@ foreign import ccall safe
255--
255--
256-- /Pre-release/
256-- /Pre-release/
257--
257--
258−setRootChanged :: Toggle -> Config -> Config
258+setRootMoved :: Toggle -> Config -> Config
259−setRootChanged = setFlag kFSEventStreamCreateFlagWatchRoot
259+setRootMoved = setFlag kFSEventStreamCreateFlagWatchRoot
260
260
261foreign import ccall safe
261foreign import ccall safe
262 "FSEventStreamCreateFlagFileEvents"
262 "FSEventStreamCreateFlagFileEvents"
@@ -321,7 +321,7 @@ setFullHistory = setFlag kFSEventStreamCreateFlagFullHistory
321--
321--
322-- * 'setEventBatching' ('Batch' 0.0)
322-- * 'setEventBatching' ('Batch' 0.0)
323-- * 'setFileEvents' 'On'
323-- * 'setFileEvents' 'On'
324−-- * 'setRootChanged' 'Off'
324+-- * 'setRootMoved' 'Off'
325-- * 'setIgnoreSelf' 'Off'
325-- * 'setIgnoreSelf' 'Off'
326#if HAVE_DECL_KFSEVENTSTREAMCREATEFLAGFULLHISTORY
326#if HAVE_DECL_KFSEVENTSTREAMCREATEFLAGFULLHISTORY
327-- * 'setFullHistory' 'Off'
327-- * 'setFullHistory' 'Off'
@@ -498,14 +498,16 @@ watchToStream (Watch handle _ _) =
498--
498--
499-- BUGS: If a watch is started on a non-existing path then the path is not
499-- BUGS: If a watch is started on a non-existing path then the path is not
500-- watched even if it is created later. The macOS API does not fail for a
500-- watched even if it is created later. The macOS API does not fail for a
501−-- non-existing path. If a non-existing path is watched with 'setRootChanged'
501+-- non-existing path. If a non-existing path is watched with 'setRootMoved'
502-- then an 'isRootChanged' event is reported if the path is created later and
502-- then an 'isRootChanged' event is reported if the path is created later and
503-- the "path" field in the event is set to the dirname of the path rather than
503-- the "path" field in the event is set to the dirname of the path rather than
504-- the full absolute path. This is the observed behavior on macOS 10.15.1.
504-- the full absolute path. This is the observed behavior on macOS 10.15.1.
505--
505--
506-- @
506-- @
507-- {-\# LANGUAGE MagicHash #-}
507-- {-\# LANGUAGE MagicHash #-}
508+-- watchTreesWith
509+-- ('setIgnoreSelf' 'On' . 'setRootMoved' 'On')
508−-- watchTreesWith ('setIgnoreSelf' 'On' . 'setRootChanged' 'On') [Array.fromCString\# "path"#]
510+-- [Array.fromCString\# "path"#]
509-- @
511-- @
510--
512--
511-- /Pre-release/
513-- /Pre-release/
@@ -656,7 +658,7 @@ foreign import ccall safe
656-- object itself. Note that the object may become unreachable or deleted after
658-- object itself. Note that the object may become unreachable or deleted after
657-- a change of path.
659-- a change of path.
658--
660--
659−-- /Applicable only when 'setRootChanged' is 'On'/
661+-- /Applicable only when 'setRootMoved' is 'On'/
660--
662--
661-- /Occurs only for the watched path/
663-- /Occurs only for the watched path/
662--
664--
src/Streamly/Internal/FileSystem/Event/Linux.hs+25−37
@@ -3,7 +3,7 @@
3-- Copyright : (c) 2020 Composewell Technologies
3-- Copyright : (c) 2020 Composewell Technologies
4-- License : BSD-3-Clause
4-- License : BSD-3-Clause
5-- Maintainer : streamly@composewell.com
5-- Maintainer : streamly@composewell.com
6−-- Stability : pre-release
6+-- Stability : experimental
7-- Portability : GHC
7-- Portability : GHC
8--
8--
9-- =Overview
9-- =Overview
@@ -63,7 +63,7 @@ module Streamly.Internal.FileSystem.Event.Linux
63 -- * Subscribing to events
63 -- * Subscribing to events
64
64
65 -- ** Default configuration
65 -- ** Default configuration
66− Config
66+ Config (..)
67 , Toggle (..)
67 , Toggle (..)
68 , defaultConfig
68 , defaultConfig
69
69
@@ -101,8 +101,7 @@ module Streamly.Internal.FileSystem.Event.Linux
101 -- ** Watch APIs
101 -- ** Watch APIs
102 -- XXX watchPaths is redundant now because we can use watchTrees with
102 -- XXX watchPaths is redundant now because we can use watchTrees with
103 -- setRecursiveMode False. Perhaps we can use a common "watch" API.
103 -- setRecursiveMode False. Perhaps we can use a common "watch" API.
104− , watchPathsWith
104+ , watch
105− , watchPaths
106 , watchTreesWith
105 , watchTreesWith
107 , watchTrees
106 , watchTrees
108 , addToWatch
107 , addToWatch
@@ -157,7 +156,7 @@ import Data.Functor.Identity (runIdentity)
157import Data.IntMap.Lazy (IntMap)
156import Data.IntMap.Lazy (IntMap)
158import Data.IORef (IORef, newIORef, readIORef, writeIORef, modifyIORef)
157import Data.IORef (IORef, newIORef, readIORef, writeIORef, modifyIORef)
159import Data.List.NonEmpty (NonEmpty)
158import Data.List.NonEmpty (NonEmpty)
160−#if !(MIN_VERSION_base(4,11,0))
159+#if !(MIN_VERSION_base(4,13,0))
161import Data.Semigroup (Semigroup(..))
160import Data.Semigroup (Semigroup(..))
162#endif
161#endif
163import Data.Word (Word8, Word32)
162import Data.Word (Word8, Word32)
@@ -172,6 +171,7 @@ import GHC.IO.Handle.FD (mkHandleFromFD)
172import Streamly.Prelude (SerialT)
171import Streamly.Prelude (SerialT)
173import Streamly.Internal.Data.Parser (Parser)
172import Streamly.Internal.Data.Parser (Parser)
174import Streamly.Internal.Data.Array.Foreign.Type (Array(..))
173import Streamly.Internal.Data.Array.Foreign.Type (Array(..))
174+--import System.FilePath ((</>))
175import System.IO (Handle, hClose, IOMode(ReadMode))
175import System.IO (Handle, hClose, IOMode(ReadMode))
176#if !MIN_VERSION_base(4,10,0)
176#if !MIN_VERSION_base(4,10,0)
177import Control.Concurrent.MVar (readMVar)
177import Control.Concurrent.MVar (readMVar)
@@ -637,7 +637,7 @@ ensureTrailingSlash path =
637-- /Pre-release/
637-- /Pre-release/
638--
638--
639addToWatch :: Config -> Watch -> Array Word8 -> Array Word8 -> IO ()
639addToWatch :: Config -> Watch -> Array Word8 -> Array Word8 -> IO ()
640−addToWatch cfg@Config{..} watch@(Watch handle wdMap) root0 path0 = do
640+addToWatch cfg@Config{..} watch0@(Watch handle wdMap) root0 path0 = do
641 -- XXX do not add if the path is already added
641 -- XXX do not add if the path is already added
642 -- XXX if the watch is added by the scan and not via an event we can
642 -- XXX if the watch is added by the scan and not via an event we can
643 -- generate a create event assuming that the create may have been lost. We
643 -- generate a create event assuming that the create may have been lost. We
@@ -686,7 +686,7 @@ addToWatch cfg@Config{..} watch@(Watch handle wdMap) root0 path0 = do
686 -- XXX toDirs currently uses paths as String, we need to convert it
686 -- XXX toDirs currently uses paths as String, we need to convert it
687 -- to "/" separated by byte arrays.
687 -- to "/" separated by byte arrays.
688 when watchRec $ do
688 when watchRec $ do
689− S.mapM_ (\p -> addToWatch cfg watch root (path <> p))
689+ S.mapM_ (\p -> addToWatch cfg watch0 root (path <> p))
690 $ S.mapM toUtf8
690 $ S.mapM toUtf8
691 $ Dir.toDirs $ utf8ToString absPath
691 $ Dir.toDirs $ utf8ToString absPath
692
692
@@ -843,35 +843,30 @@ watchToStream cfg wt@(Watch handle _) = do
843 S.parseMany (readOneEvent cfg wt) $ S.unfold FH.read handle
843 S.parseMany (readOneEvent cfg wt) $ S.unfold FH.read handle
844
844
845-- | Start monitoring a list of file system paths for file system events with
845-- | Start monitoring a list of file system paths for file system events with
846−-- the supplied configuration operation over the 'defaultConfig'. The
846+-- the supplied recursive mode and configuration. The paths could be files or
847+-- directories. When recursive mode is True and the path is a directory, the
848+-- whole directory tree under it is watched recursively.
847−-- paths could be files or directories. When the path is a directory, only the
849+-- When recursive mode is False and the path is a directory, only the
848-- files and directories directly under the watched directory are monitored,
850-- files and directories directly under the watched directory are monitored,
849-- contents of subdirectories are not monitored. Monitoring starts from the
851-- contents of subdirectories are not monitored. Monitoring starts from the
850−-- current time onwards. The paths are specified as "/" separated 'Array' of
852+-- current time onwards. The paths are specified as UTF-8 encoded 'Array' of
851-- 'Word8'.
853-- 'Word8'.
852--
854--
853-- @
855-- @
854−-- watchPathsWith
856+-- watch
857+-- True
855−-- ('setFollowSymLinks' On . 'setUnwatchMoved' Off)
858+-- ('setFollowSymLinks' On . 'setUnwatchMoved' Off)
859+-- defaultConfig
856−-- [Array.fromCString\# "dir"#]
860+-- [Array.fromCString\# "dir"#]
857−-- @
858−--
859−-- /Pre-release/
860−--
861−watchPathsWith ::
862− (Config -> Config) -> NonEmpty (Array Word8) -> SerialT IO Event
863−watchPathsWith f = watchTreesWith (f . setRecursiveMode False)
864−
865−-- | Like 'watchPathsWith' but uses the 'defaultConfig' options.
866−--
867−-- @
868−-- watchPaths = watchPathsWith id
869-- @
861-- @
870--
862--
871-- /Pre-release/
863-- /Pre-release/
872--
864--
873−watchPaths :: NonEmpty (Array Word8) -> SerialT IO Event
865+watch :: Bool -> Config -> NonEmpty (Array Word8) -> SerialT IO Event
874−watchPaths = watchPathsWith id
866+watch rec cfg paths =
867+ case rec of
868+ True -> watchTreesWith (\_ -> cfg) paths
869+ False -> watchTreesWith (\_ -> setRecursiveMode False cfg) paths
875
870
876-- XXX We should not go across the mount points of network file systems or file
871-- XXX We should not go across the mount points of network file systems or file
877-- systems that are known to not generate any events.
872-- systems that are known to not generate any events.
@@ -951,14 +946,8 @@ getRoot Event{..} =
951getRelPath :: Event -> Array Word8
946getRelPath :: Event -> Array Word8
952getRelPath Event{..} = eventRelPath
947getRelPath Event{..} = eventRelPath
953
948
954−
955−-- | Get the absolute file system object path for which the event is generated.
956−-- The path is a "/" separated array of bytes.
957−--
958−-- /Pre-release/
959−--
960getAbsPath :: Event -> Array Word8
949getAbsPath :: Event -> Array Word8
961−getAbsPath ev = getRoot ev <> getRelPath ev
950+getAbsPath ev = getRoot ev <> A.fromCString# "/"# <> getRelPath ev
962
951
963-- XXX should we use a Maybe?
952-- XXX should we use a Maybe?
964-- | Cookie is set when a rename occurs. The cookie value can be used to
953-- | Cookie is set when a rename occurs. The cookie value can be used to
@@ -1199,8 +1188,7 @@ showEvent ev@Event{..} =
1199 "--------------------------"
1188 "--------------------------"
1200 ++ "\nWd = " ++ show eventWd
1189 ++ "\nWd = " ++ show eventWd
1201 ++ "\nRoot = " ++ show (utf8ToString $ getRoot ev)
1190 ++ "\nRoot = " ++ show (utf8ToString $ getRoot ev)
1202− ++ "\nRelative Path = " ++ show (utf8ToString $ getRelPath ev)
1191+ ++ "\nPath = " ++ show (utf8ToString $ getRelPath ev)
1203− ++ "\nAbsolute Path = " ++ show (utf8ToString $ getAbsPath ev)
1204 ++ "\nCookie = " ++ show (getCookie ev)
1192 ++ "\nCookie = " ++ show (getCookie ev)
1205 ++ "\nFlags " ++ show eventFlags
1193 ++ "\nFlags " ++ show eventFlags
1206
1194
@@ -1231,4 +1219,4 @@ showEvent ev@Event{..} =
1231#else
1219#else
1232#warning "Disabling module Streamly.Internal.FileSystem.Event.Linux. Does not support kernels older than 2.6.36."
1220#warning "Disabling module Streamly.Internal.FileSystem.Event.Linux. Does not support kernels older than 2.6.36."
1233module Streamly.Internal.FileSystem.Event.Linux () where
1221module Streamly.Internal.FileSystem.Event.Linux () where
1234−#endif
1222+#endif
src/Streamly/Internal/FileSystem/Event/Windows.hs+38−63
@@ -47,7 +47,7 @@ module Streamly.Internal.FileSystem.Event.Windows
47 -- * Subscribing to events
47 -- * Subscribing to events
48
48
49 -- ** Default configuration
49 -- ** Default configuration
50− Config
50+ Config (..)
51 , Event (..)
51 , Event (..)
52 , Toggle (..)
52 , Toggle (..)
53 , setFlag
53 , setFlag
@@ -61,22 +61,21 @@ module Streamly.Internal.FileSystem.Event.Windows
61 -- ** Events of Interest
61 -- ** Events of Interest
62 -- *** Root Level Events
62 -- *** Root Level Events
63 , setModifiedFileName
63 , setModifiedFileName
64− , setModifiedDirName
64+ , setRootMoved
65 , setModifiedAttribute
65 , setModifiedAttribute
66 , setModifiedSize
66 , setModifiedSize
67 , setModifiedLastWrite
67 , setModifiedLastWrite
68 , setModifiedSecurity
68 , setModifiedSecurity
69
69
70 -- ** Watch APIs
70 -- ** Watch APIs
71− , watchPaths
71+ , watch
72− , watchPathsWith
73 , watchTrees
72 , watchTrees
74 , watchTreesWith
73 , watchTreesWith
75
74
76 -- * Handling Events
75 -- * Handling Events
77− , getAbsPath
78 , getRelPath
76 , getRelPath
79 , getRoot
77 , getRoot
78+ , getAbsPath
80
79
81 -- ** Item CRUD events
80 -- ** Item CRUD events
82 , isCreated
81 , isCreated
@@ -124,6 +123,7 @@ import System.Win32.Types (BOOL, DWORD, HANDLE, LPVOID, LPDWORD, failIfFalse_)
124import qualified Data.List.NonEmpty as NonEmpty
123import qualified Data.List.NonEmpty as NonEmpty
125import qualified Streamly.Internal.Data.Stream.IsStream as S
124import qualified Streamly.Internal.Data.Stream.IsStream as S
126import qualified Streamly.Internal.Unicode.Stream as U
125import qualified Streamly.Internal.Unicode.Stream as U
126+import qualified Streamly.Internal.Unicode.Utf8 as UTF8
127import qualified Streamly.Internal.Data.Array.Foreign as A
127import qualified Streamly.Internal.Data.Array.Foreign as A
128import Streamly.Internal.Data.Array.Foreign (Array)
128import Streamly.Internal.Data.Array.Foreign (Array)
129
129
@@ -179,8 +179,8 @@ setModifiedFileName = setFlag fILE_NOTIFY_CHANGE_FILE_NAME
179--
179--
180-- /Pre-release/
180-- /Pre-release/
181--
181--
182−setModifiedDirName :: Toggle -> Config -> Config
182+setRootMoved :: Toggle -> Config -> Config
183−setModifiedDirName = setFlag fILE_NOTIFY_CHANGE_DIR_NAME
183+setRootMoved = setFlag fILE_NOTIFY_CHANGE_DIR_NAME
184
184
185-- | Report when a file attribute is modified.
185-- | Report when a file attribute is modified.
186--
186--
@@ -227,7 +227,7 @@ setModifiedSecurity = setFlag fILE_NOTIFY_CHANGE_SECURITY
227setAllEvents :: Toggle -> Config -> Config
227setAllEvents :: Toggle -> Config -> Config
228setAllEvents s =
228setAllEvents s =
229 setModifiedFileName s
229 setModifiedFileName s
230− . setModifiedDirName s
230+ . setRootMoved s
231 . setModifiedAttribute s
231 . setModifiedAttribute s
232 . setModifiedSize s
232 . setModifiedSize s
233 . setModifiedLastWrite s
233 . setModifiedLastWrite s
@@ -399,32 +399,6 @@ utf8ToStringList = NonEmpty.map utf8ToString
399closePathHandleStream :: SerialT IO (HANDLE, FilePath, Config) -> IO ()
399closePathHandleStream :: SerialT IO (HANDLE, FilePath, Config) -> IO ()
400closePathHandleStream = S.mapM_ (\(h, _, _) -> closeHandle h)
400closePathHandleStream = S.mapM_ (\(h, _, _) -> closeHandle h)
401
401
402−-- | Start monitoring a list of file system paths for file system events with
403−-- the supplied configuration operation over the 'defaultConfig'. The
404−-- paths could be files or directories. When the path is a directory, only the
405−-- files and directories directly under the watched directory are monitored,
406−-- contents of subdirectories are not monitored. Monitoring starts from the
407−-- current time onwards.
408−--
409−-- /Pre-release/
410−--
411−watchPathsWith ::
412− (Config -> Config)
413− -> NonEmpty (Array Word8)
414− -> SerialT IO Event
415−watchPathsWith f = watchTreesWith (f . setRecursiveMode False)
416−
417−-- | Like 'watchPathsWith' but uses the 'defaultConfig' options.
418−--
419−-- @
420−-- watchPaths = watchPathsWith id
421−-- @
422−--
423−-- /Pre-release/
424−--
425−watchPaths :: NonEmpty (Array Word8) -> SerialT IO Event
426−watchPaths = watchPathsWith id
427−
428-- XXX
402-- XXX
429-- Document the path treatment for Linux/Windows/macOS modules.
403-- Document the path treatment for Linux/Windows/macOS modules.
430-- Remove the utf-8 encoding requirement of paths? It can be encoding agnostic
404-- Remove the utf-8 encoding requirement of paths? It can be encoding agnostic
@@ -450,9 +424,7 @@ watchTreesWith f paths =
450
424
451 where
425 where
452
426
453− before =
454− let cfg = f $ setRecursiveMode True defaultConfig
455− in return $ pathsToHandles (utf8ToStringList paths) cfg
427+ before = return $ pathsToHandles (utf8ToStringList paths) $ f defaultConfig
456 after = liftIO . closePathHandleStream
428 after = liftIO . closePathHandleStream
457
429
458-- | Like 'watchTreesWith' but uses the 'defaultConfig' options.
430-- | Like 'watchTreesWith' but uses the 'defaultConfig' options.
@@ -464,18 +436,29 @@ watchTreesWith f paths =
464watchTrees :: NonEmpty (Array Word8) -> SerialT IO Event
436watchTrees :: NonEmpty (Array Word8) -> SerialT IO Event
465watchTrees = watchTreesWith id
437watchTrees = watchTreesWith id
466
438
467−-- | Add a trailing "\" at the end of the path if there is none. Do not add a
439+-- | Start monitoring a list of file system paths for file system events with
468−-- "\" if the path is empty.
440+-- the supplied recursive mode and configuration. The paths could be files or
441+-- directories. When recursive mode is True and the path is a directory, the
442+-- whole directory tree under it is watched recursively.
443+-- When recursive mode is False and the path is a directory, only the
444+-- files and directories directly under the watched directory are monitored,
445+-- contents of subdirectories are not monitored. Monitoring starts from the
446+-- current time onwards. The paths are specified as UTF-8 encoded 'Array' of
447+-- 'Word8'.
448+--
449+-- @
450+-- watch True
451+-- ('setModifiedAttribute' On . 'setModifiedLastWrite' Off) defaultConfig
452+-- [Array.fromCString\# "dir"#]
453+-- @
454+--
455+-- /Pre-release/
469--
456--
470−ensureTrailingSlash :: String -> String
457+watch :: Bool -> Config -> NonEmpty (Array Word8) -> SerialT IO Event
471−ensureTrailingSlash path =
458+watch rec cfg paths =
472− if null path
459+ case rec of
473− then path
460+ True -> watchTreesWith (\_ -> cfg) paths
474− else
461+ False -> watchTreesWith (\_ -> setRecursiveMode False cfg) paths
475− let x = last path
476− in if x /= '\\' && x /= '/'
477− then path ++ "\\"
478− else path
479
462
480getFlag :: DWORD -> Event -> Bool
463getFlag :: DWORD -> Event -> Bool
481getFlag mask Event{..} = eventFlags == mask
464getFlag mask Event{..} = eventFlags == mask
@@ -487,8 +470,8 @@ getFlag mask Event{..} = eventFlags == mask
487--
470--
488-- /Pre-release/
471-- /Pre-release/
489--
472--
490−getRelPath :: Event -> String
473+getRelPath :: Event -> Array Word8
491−getRelPath Event{..} = eventRelPath
474+getRelPath Event{..} = (UTF8.toArray . UTF8.pack) eventRelPath
492
475
493-- XXX Change the type to Array Word8 to make it compatible with other APIs.
476-- XXX Change the type to Array Word8 to make it compatible with other APIs.
494--
477--
@@ -496,17 +479,10 @@ getRelPath Event{..} = eventRelPath
496--
479--
497-- /Pre-release/
480-- /Pre-release/
498--
481--
499−getRoot :: Event -> String
482+getRoot :: Event -> Array Word8
500−getRoot Event{..} = ensureTrailingSlash eventRootPath
483+getRoot Event{..} = (UTF8.toArray . UTF8.pack) eventRootPath
501
484
502−-- XXX Change the type to Array Word8 to make it compatible with other APIs.
503−--
504−-- | Get the absolute file system object path for which the event is generated.
505−-- The path is a UTF-8 encoded array of bytes.
506−--
507−-- /Pre-release/
508−--
509−getAbsPath :: Event -> String
485+getAbsPath :: Event -> Array Word8
510getAbsPath ev = getRoot ev <> getRelPath ev
486getAbsPath ev = getRoot ev <> getRelPath ev
511
487
512-- XXX need to document the exact semantics of these.
488-- XXX need to document the exact semantics of these.
@@ -568,9 +544,8 @@ isOverflow Event{..} = totalBytes == 0
568showEvent :: Event -> String
544showEvent :: Event -> String
569showEvent ev@Event{..} =
545showEvent ev@Event{..} =
570 "--------------------------"
546 "--------------------------"
571− ++ "\nRoot = " ++ show (getRoot ev)
547+ ++ "\nRoot = " ++ utf8ToString (getRoot ev)
572− ++ "\nRelative Path = " ++ show (getRelPath ev)
548+ ++ "\nPath = " ++ utf8ToString (getRelPath ev)
573− ++ "\nAbsolute Path = " ++ show (getAbsPath ev)
574 ++ "\nFlags " ++ show eventFlags
549 ++ "\nFlags " ++ show eventFlags
575 ++ showev isOverflow "Overflow"
550 ++ showev isOverflow "Overflow"
576 ++ showev isCreated "Created"
551 ++ showev isCreated "Created"
streamly.cabal+2
@@ -499,6 +499,7 @@ library
499 , Streamly.Internal.FileSystem.File
499 , Streamly.Internal.FileSystem.File
500 , Streamly.Internal.FileSystem.FDIO
500 , Streamly.Internal.FileSystem.FDIO
501 , Streamly.Internal.FileSystem.FD
501 , Streamly.Internal.FileSystem.FD
502+ , Streamly.Internal.FileSystem.Event
502
503
503 -- streamly-console
504 -- streamly-console
504 , Streamly.Internal.Console.Stdio
505 , Streamly.Internal.Console.Stdio
@@ -528,6 +529,7 @@ library
528 , transformers >= 0.4 && < 0.6
529 , transformers >= 0.4 && < 0.6
529
530
530 , heaps >= 0.3 && < 0.5
531 , heaps >= 0.3 && < 0.5
532+ , filepath >= 1.2.0.0 && < 1.4.3.0
531
533
532 -- concurrency
534 -- concurrency
533 , atomic-primops >= 0.8 && < 0.9
535 , atomic-primops >= 0.8 && < 0.9
test/Streamly/Test/FileSystem/Event.hs+13−15
@@ -13,6 +13,7 @@ import Control.Monad.IO.Class (MonadIO)
13#if !defined(CABAL_OS_WINDOWS)
13#if !defined(CABAL_OS_WINDOWS)
14import Data.Char (ord)
14import Data.Char (ord)
15#endif
15#endif
16+import Data.Functor.Identity (runIdentity)
16import Data.Maybe (fromJust)
17import Data.Maybe (fromJust)
17import Data.Word (Word8)
18import Data.Word (Word8)
18import System.Directory
19import System.Directory
@@ -38,6 +39,7 @@ import qualified Streamly.Internal.Data.Array.Foreign as Array
38import qualified Streamly.Internal.Data.Fold as FL
39import qualified Streamly.Internal.Data.Fold as FL
39import qualified Streamly.Internal.Data.Parser as PR
40import qualified Streamly.Internal.Data.Parser as PR
40import qualified Streamly.Internal.Data.Stream.IsStream as S
41import qualified Streamly.Internal.Data.Stream.IsStream as S
42+import qualified Streamly.Internal.Unicode.Stream as U
41#if defined(CABAL_OS_DARWIN)
43#if defined(CABAL_OS_DARWIN)
42import qualified Streamly.Internal.FileSystem.Event.Darwin as Event
44import qualified Streamly.Internal.FileSystem.Event.Darwin as Event
43#elif defined(CABAL_OS_LINUX)
45#elif defined(CABAL_OS_LINUX)
@@ -45,12 +47,7 @@ import qualified Streamly.Internal.FileSystem.Event.Linux as Event
45#elif defined(CABAL_OS_WINDOWS)
47#elif defined(CABAL_OS_WINDOWS)
46import qualified Streamly.Internal.FileSystem.Event.Windows as Event
48import qualified Streamly.Internal.FileSystem.Event.Windows as Event
47#else
49#else
48−#error "FS Events not supported on this platform
50+#error "FS Events not supported on this platform"
49−#endif
50−
51−#if !defined(CABAL_OS_WINDOWS)
52−import Data.Functor.Identity (runIdentity)
53−import qualified Streamly.Internal.Unicode.Stream as U
54#endif
51#endif
55
52
56import Test.Hspec
53import Test.Hspec
@@ -62,10 +59,8 @@ import Test.Hspec
62toUtf8 :: MonadIO m => String -> m (Array Word8)
59toUtf8 :: MonadIO m => String -> m (Array Word8)
63toUtf8 = Array.fromStream . Unicode.encodeUtf8' . S.fromList
60toUtf8 = Array.fromStream . Unicode.encodeUtf8' . S.fromList
64
61
65−#if !defined(CABAL_OS_WINDOWS)
66utf8ToString :: Array Word8 -> String
62utf8ToString :: Array Word8 -> String
67utf8ToString = runIdentity . S.toList . U.decodeUtf8' . Array.toStream
63utf8ToString = runIdentity . S.toList . U.decodeUtf8' . Array.toStream
68−#endif
69
64
70timeout :: IO String
65timeout :: IO String
71timeout = threadDelay 5000000 >> return "Timeout"
66timeout = threadDelay 5000000 >> return "Timeout"
@@ -73,13 +68,16 @@ timeout = threadDelay 5000000 >> return "Timeout"
73fseventDir :: String
68fseventDir :: String
74fseventDir = "fsevent_dir"
69fseventDir = "fsevent_dir"
75
70
71+eoTask :: String
72+eoTask = "EOTask"
73+
76-- XXX Make the getRelPath type same on windows and other platforms
74-- XXX Make the getRelPath type same on windows and other platforms
77eventPredicate :: Event.Event -> Bool
75eventPredicate :: Event.Event -> Bool
78eventPredicate ev =
76eventPredicate ev =
79#if defined(CABAL_OS_WINDOWS)
77#if defined(CABAL_OS_WINDOWS)
80− if (Event.getRelPath ev) == "EOTask"
78+ if (utf8ToString $ Event.getRelPath ev) == eoTask
81#else
79#else
82− if (utf8ToString $ Event.getRelPath ev) == "EOTask"
80+ if (utf8ToString $ Event.getRelPath ev) == eoTask
83#endif
81#endif
84 then False
82 then False
85 else True
83 else True
@@ -112,16 +110,16 @@ showEventShort :: Event.Event -> String
112#if defined(CABAL_OS_WINDOWS)
110#if defined(CABAL_OS_WINDOWS)
113-- | Convert an 'Event' record to a short representation for unit test.
111-- | Convert an 'Event' record to a short representation for unit test.
114showEventShort ev@Event.Event{..} =
112showEventShort ev@Event.Event{..} =
115− Event.getRelPath ev ++ "_" ++ show eventFlags
113+ (utf8ToString $ Event.getRelPath ev) ++ "_" ++ show eventFlags
116#elif defined(CABAL_OS_LINUX)
114#elif defined(CABAL_OS_LINUX)
117showEventShort ev@Event.Event{..} =
115showEventShort ev@Event.Event{..} =
118− (utf8ToString $ removeTrailingSlash $ Event.getRelPath ev)
116+ utf8ToString (removeTrailingSlash $ Event.getRelPath ev)
119 ++ "_" ++ show eventFlags
117 ++ "_" ++ show eventFlags
120 ++ showev Event.isDir "Dir"
118 ++ showev Event.isDir "Dir"
121
119
122 where showev f str = if f ev then "_" ++ str else ""
120 where showev f str = if f ev then "_" ++ str else ""
123#else
121#else
124−#error "Unsupported OS
122+#error "Unsupported OS"
125#endif
123#endif
126
124
127-------------------------------------------------------------------------------
125-------------------------------------------------------------------------------
@@ -139,7 +137,7 @@ checkEvents rootPath m matchList = do
139 let eventStr = map showEventShort events
137 let eventStr = map showEventShort events
140 let baseSet = Set.fromList matchList
138 let baseSet = Set.fromList matchList
141 resultSet = Set.fromList eventStr
139 resultSet = Set.fromList eventStr
142− if (baseSet `Set.isSubsetOf` resultSet)
140+ if baseSet `Set.isSubsetOf` resultSet
143 then
141 then
144 return "PASS"
142 return "PASS"
145 else do
143 else do
@@ -399,4 +397,4 @@ moduleName = "FileSystem.Event"
399main :: IO ()
397main :: IO ()
400main = do
398main = do
401 hSetBuffering stdout NoBuffering
399 hSetBuffering stdout NoBuffering
402− hspec $ describe moduleName $ sequence_ $ map driver testDesc
400+ hspec $ describe moduleName $ mapM_ driver testDesc