@@ -47,7 +47,7 @@ module Streamly.Internal.FileSystem.Event.Windows
4747 -- * Subscribing to events
4848
4949 -- ** Default configuration
50− Config
50+ Config (..)
5151 , Event (..)
5252 , Toggle (..)
5353 , setFlag
@@ -61,22 +61,21 @@ module Streamly.Internal.FileSystem.Event.Windows
6161 -- ** Events of Interest
6262 -- *** Root Level Events
6363 , setModifiedFileName
64− , setModifiedDirName
64+ , setRootMoved
6565 , setModifiedAttribute
6666 , setModifiedSize
6767 , setModifiedLastWrite
6868 , setModifiedSecurity
6969
7070 -- ** Watch APIs
71− , watchPaths
72− , watchPathsWith
71+ , watch
7372 , watchTrees
7473 , watchTreesWith
7574
7675 -- * Handling Events
77− , getAbsPath
7876 , getRelPath
7977 , getRoot
78+ , getAbsPath
8079
8180 -- ** Item CRUD events
8281 , isCreated
@@ -124,6 +123,7 @@ import System.Win32.Types (BOOL, DWORD, HANDLE, LPVOID, LPDWORD, failIfFalse_)
124123import qualified Data.List.NonEmpty as NonEmpty
125124import qualified Streamly.Internal.Data.Stream.IsStream as S
126125import qualified Streamly.Internal.Unicode.Stream as U
126+import qualified Streamly.Internal.Unicode.Utf8 as UTF8
127127import qualified Streamly.Internal.Data.Array.Foreign as A
128128import Streamly.Internal.Data.Array.Foreign (Array)
129129
@@ -179,8 +179,8 @@ setModifiedFileName = setFlag fILE_NOTIFY_CHANGE_FILE_NAME
179179--
180180-- /Pre-release/
181181--
182−setModifiedDirName :: Toggle -> Config -> Config
183−setModifiedDirName = setFlag fILE_NOTIFY_CHANGE_DIR_NAME
182+setRootMoved :: Toggle -> Config -> Config
183+setRootMoved = setFlag fILE_NOTIFY_CHANGE_DIR_NAME
184184
185185-- | Report when a file attribute is modified.
186186--
@@ -227,7 +227,7 @@ setModifiedSecurity = setFlag fILE_NOTIFY_CHANGE_SECURITY
227227setAllEvents :: Toggle -> Config -> Config
228228setAllEvents s =
229229 setModifiedFileName s
230− . setModifiedDirName s
230+ . setRootMoved s
231231 . setModifiedAttribute s
232232 . setModifiedSize s
233233 . setModifiedLastWrite s
@@ -399,32 +399,6 @@ utf8ToStringList = NonEmpty.map utf8ToString
399399closePathHandleStream :: SerialT IO (HANDLE, FilePath, Config) -> IO ()
400400closePathHandleStream = S.mapM_ (\(h, _, _) -> closeHandle h)
401401
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−
428402-- XXX
429403-- Document the path treatment for Linux/Windows/macOS modules.
430404-- Remove the utf-8 encoding requirement of paths? It can be encoding agnostic
@@ -450,9 +424,7 @@ watchTreesWith f paths =
450424
451425 where
452426
453− before =
454− let cfg = f $ setRecursiveMode True defaultConfig
455− in return $ pathsToHandles (utf8ToStringList paths) cfg
427+ before = return $ pathsToHandles (utf8ToStringList paths) $ f defaultConfig
456428 after = liftIO . closePathHandleStream
457429
458430-- | Like 'watchTreesWith' but uses the 'defaultConfig' options.
@@ -464,18 +436,29 @@ watchTreesWith f paths =
464436watchTrees :: NonEmpty (Array Word8) -> SerialT IO Event
465437watchTrees = watchTreesWith id
466438
467−-- | Add a trailing "\" at the end of the path if there is none. Do not add a
468−-- "\" if the path is empty.
439+-- | Start monitoring a list of file system paths for file system events with
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/
469456--
470−ensureTrailingSlash :: String -> String
471−ensureTrailingSlash path =
472− if null path
473− then path
474− else
475− let x = last path
476− in if x /= '\\' && x /= '/'
477− then path ++ "\\"
478− else path
457+watch :: Bool -> Config -> NonEmpty (Array Word8) -> SerialT IO Event
458+watch rec cfg paths =
459+ case rec of
460+ True -> watchTreesWith (\_ -> cfg) paths
461+ False -> watchTreesWith (\_ -> setRecursiveMode False cfg) paths
479462
480463getFlag :: DWORD -> Event -> Bool
481464getFlag mask Event{..} = eventFlags == mask
@@ -487,8 +470,8 @@ getFlag mask Event{..} = eventFlags == mask
487470--
488471-- /Pre-release/
489472--
490−getRelPath :: Event -> String
491−getRelPath Event{..} = eventRelPath
473+getRelPath :: Event -> Array Word8
474+getRelPath Event{..} = (UTF8.toArray . UTF8.pack) eventRelPath
492475
493476-- XXX Change the type to Array Word8 to make it compatible with other APIs.
494477--
@@ -496,17 +479,10 @@ getRelPath Event{..} = eventRelPath
496479--
497480-- /Pre-release/
498481--
499−getRoot :: Event -> String
500−getRoot Event{..} = ensureTrailingSlash eventRootPath
482+getRoot :: Event -> Array Word8
483+getRoot Event{..} = (UTF8.toArray . UTF8.pack) eventRootPath
501484
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
510486getAbsPath ev = getRoot ev <> getRelPath ev
511487
512488-- XXX need to document the exact semantics of these.
@@ -568,9 +544,8 @@ isOverflow Event{..} = totalBytes == 0
568544showEvent :: Event -> String
569545showEvent ev@Event{..} =
570546 "--------------------------"
571− ++ "\nRoot = " ++ show (getRoot ev)
572− ++ "\nRelative Path = " ++ show (getRelPath ev)
573− ++ "\nAbsolute Path = " ++ show (getAbsPath ev)
547+ ++ "\nRoot = " ++ utf8ToString (getRoot ev)
548+ ++ "\nPath = " ++ utf8ToString (getRelPath ev)
574549 ++ "\nFlags " ++ show eventFlags
575550 ++ showev isOverflow "Overflow"
576551 ++ showev isCreated "Created"