mirror of
https://github.com/composewell/streamly.git
synced 2024-09-11 11:37:22 +03:00
Update documentation, format, add copyright info
This commit is contained in:
parent
a608695f4a
commit
1fd498a537
@ -7,6 +7,14 @@ notices in the individual files.
|
||||
|
||||
* macOS FS Event handling C code adapted from hfsevents package:
|
||||
* Copyright (c) 2012, Luite Stegeman
|
||||
* http://hackage.haskell.org/package/hfsevents-0.1.6
|
||||
* See hfsevents-0.1.6.txt for the original license
|
||||
|
||||
* Some code snippets in Windows FS event handling module are taken from the
|
||||
fsnotify package.
|
||||
* Copyright (c) 2012, Mark Dittmer
|
||||
* http://hackage.haskell.org/package/fsnotify-0.3.0.1/
|
||||
* See fsnotify-0.3.0.1.txt for the original license
|
||||
|
||||
## 0.7.1
|
||||
|
||||
|
30
credits/fsnotify-0.3.0.1.txt
Normal file
30
credits/fsnotify-0.3.0.1.txt
Normal file
@ -0,0 +1,30 @@
|
||||
Copyright (c) 2012, Mark Dittmer
|
||||
|
||||
All rights reserved.
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are met:
|
||||
|
||||
* Redistributions of source code must retain the above copyright
|
||||
notice, this list of conditions and the following disclaimer.
|
||||
|
||||
* Redistributions in binary form must reproduce the above
|
||||
copyright notice, this list of conditions and the following
|
||||
disclaimer in the documentation and/or other materials provided
|
||||
with the distribution.
|
||||
|
||||
* Neither the name of Mark Dittmer nor the names of other
|
||||
contributors may be used to endorse or promote products derived
|
||||
from this software without specific prior written permission.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
||||
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
|
||||
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
|
||||
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
||||
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
|
||||
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
|
||||
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
|
||||
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
||||
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
30
credits/hfsevents-0.1.6.txt
Normal file
30
credits/hfsevents-0.1.6.txt
Normal file
@ -0,0 +1,30 @@
|
||||
Copyright (c) 2012, Luite Stegeman
|
||||
|
||||
All rights reserved.
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are met:
|
||||
|
||||
* Redistributions of source code must retain the above copyright
|
||||
notice, this list of conditions and the following disclaimer.
|
||||
|
||||
* Redistributions in binary form must reproduce the above
|
||||
copyright notice, this list of conditions and the following
|
||||
disclaimer in the documentation and/or other materials provided
|
||||
with the distribution.
|
||||
|
||||
* Neither the name of Luite Stegeman nor the names of other
|
||||
contributors may be used to endorse or promote products derived
|
||||
from this software without specific prior written permission.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
||||
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
|
||||
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
|
||||
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
||||
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
|
||||
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
|
||||
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
|
||||
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
||||
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
@ -1,25 +1,58 @@
|
||||
-- Some code snippets are adapted from the fsnotify package.
|
||||
-- http://hackage.haskell.org/package/fsnotify-0.3.0.1/
|
||||
--
|
||||
-- |
|
||||
-- Module : Streamly.Internal.FileSystem.Event.Windows
|
||||
-- Copyright : (c) 2020 Composewell Technologies
|
||||
--
|
||||
-- License : BSD3
|
||||
-- (c) 2012, Mark Dittmer
|
||||
-- License : BSD-3-Clause
|
||||
-- Maintainer : streamly@composewell.com
|
||||
-- Stability : experimental
|
||||
-- Portability : GHC
|
||||
--
|
||||
-- Just report all events under the paths provided as arguments
|
||||
-- =Overview
|
||||
--
|
||||
-- Use 'watchTrees'or 'watchPaths' with a list of file system paths you want to
|
||||
-- watch as argument. It returns a stream of 'Event' representing the file
|
||||
-- system events occurring under the watched paths.
|
||||
--
|
||||
-- @
|
||||
-- {-\# LANGUAGE MagicHash #-}
|
||||
-- Stream.mapM_ (putStrLn . 'showEvent') $ 'watchTrees' [Array.fromCString\# "path"#]
|
||||
-- @
|
||||
--
|
||||
-- 'Event' is an opaque type. Accessor functions (e.g. 'showEvent' above)
|
||||
-- provided in this module are used to determine the attributes of the event.
|
||||
--
|
||||
-- =Design notes
|
||||
--
|
||||
-- For Windows reference documentation see:
|
||||
--
|
||||
-- * <https://docs.microsoft.com/en-us/windows/win32/api/winnt/ns-winnt-file_notify_information file notify information>
|
||||
-- * <https://docs.microsoft.com/en-us/windows/win32/api/winbase/nf-winbase-readdirectorychangesw read directory changes>
|
||||
--
|
||||
-- We try to keep the macOS\/Linux/Windows event handling APIs and defaults
|
||||
-- semantically and syntactically as close as possible.
|
||||
--
|
||||
-- =Availability
|
||||
--
|
||||
-- As per the Windows reference docs, the fs event notification API is
|
||||
-- available in:
|
||||
--
|
||||
-- * Minimum supported client: Windows XP [desktop apps | UWP apps]
|
||||
-- * Minimum supported server: Windows Server 2003 [desktop apps | UWP apps
|
||||
|
||||
module Streamly.Internal.FileSystem.Event.Windows
|
||||
(
|
||||
(
|
||||
-- * Subscribing to events
|
||||
|
||||
-- ** Default configuration
|
||||
-- ** Default configuration
|
||||
Config
|
||||
, Event
|
||||
, Toggle (..)
|
||||
, setFlag
|
||||
, setFlag
|
||||
, defaultConfig
|
||||
, getConfigFlag
|
||||
, getConfigFlag
|
||||
, setAllEvents
|
||||
|
||||
-- ** Watch Behavior
|
||||
@ -32,44 +65,44 @@ module Streamly.Internal.FileSystem.Event.Windows
|
||||
, setModifiedAttribute
|
||||
, setModifiedSize
|
||||
, setModifiedLastWrite
|
||||
, setModifiedSecurity
|
||||
, setModifiedSecurity
|
||||
|
||||
-- ** Watch APIs
|
||||
, watchPaths
|
||||
, watchPathsWith
|
||||
, watchTrees
|
||||
, watchTreesWith
|
||||
|
||||
, watchTreesWith
|
||||
|
||||
-- * Handling Events
|
||||
, getRelPath
|
||||
, getRelPath
|
||||
, getRoot
|
||||
|
||||
-- ** Item CRUD events
|
||||
, isCreated
|
||||
, isDeleted
|
||||
, isDeleted
|
||||
, isMovedFrom
|
||||
, isMovedTo
|
||||
, isModified
|
||||
, isModified
|
||||
|
||||
-- ** Exception Conditions
|
||||
, isOverflow
|
||||
|
||||
-- * Debugging
|
||||
, showEvent
|
||||
)
|
||||
, showEvent
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Monad.IO.Class (MonadIO(liftIO))
|
||||
import Data.Bits ((.|.), (.&.), complement)
|
||||
import Data.Functor.Identity (runIdentity)
|
||||
import Data.Bits ((.|.), (.&.), complement)
|
||||
import Data.Functor.Identity (runIdentity)
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import Data.Word (Word8)
|
||||
import Foreign.C.String (peekCWStringLen)
|
||||
import Foreign.Marshal.Alloc (alloca, allocaBytes)
|
||||
import Foreign.Storable (peekByteOff)
|
||||
import Foreign.Ptr (Ptr, FunPtr, castPtr, nullPtr, nullFunPtr, plusPtr)
|
||||
import Foreign.Storable (peekByteOff)
|
||||
import Foreign.Ptr (Ptr, FunPtr, castPtr, nullPtr, nullFunPtr, plusPtr)
|
||||
import Streamly.Prelude (SerialT, parallel)
|
||||
import System.Win32.File
|
||||
import System.Win32.File
|
||||
( FileNotificationFlag
|
||||
, LPOVERLAPPED
|
||||
, closeHandle
|
||||
@ -81,10 +114,10 @@ import System.Win32.File
|
||||
, fILE_NOTIFY_CHANGE_ATTRIBUTES
|
||||
, fILE_NOTIFY_CHANGE_SIZE
|
||||
, fILE_NOTIFY_CHANGE_LAST_WRITE
|
||||
, fILE_NOTIFY_CHANGE_SECURITY
|
||||
, fILE_NOTIFY_CHANGE_SECURITY
|
||||
, fILE_SHARE_READ
|
||||
, fILE_SHARE_WRITE
|
||||
, oPEN_EXISTING
|
||||
, oPEN_EXISTING
|
||||
)
|
||||
import System.Win32.Types (BOOL, DWORD, HANDLE, LPVOID, LPDWORD, failIfFalse_)
|
||||
import qualified Data.List.NonEmpty as NonEmpty
|
||||
@ -100,7 +133,7 @@ import Streamly.Internal.Data.Array.Storable.Foreign (Array)
|
||||
--
|
||||
data Config = Config
|
||||
{ watchRec :: BOOL
|
||||
, createFlags :: DWORD
|
||||
, createFlags :: DWORD
|
||||
}
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
@ -164,7 +197,7 @@ setModifiedAttribute = setFlag fILE_NOTIFY_CHANGE_ATTRIBUTES
|
||||
-- /Internal/
|
||||
--
|
||||
setModifiedSize :: Toggle -> Config -> Config
|
||||
setModifiedSize = setFlag fILE_NOTIFY_CHANGE_SIZE
|
||||
setModifiedSize = setFlag fILE_NOTIFY_CHANGE_SIZE
|
||||
|
||||
-- | Report when a file last write time is changed.
|
||||
--
|
||||
@ -173,7 +206,7 @@ setModifiedSize = setFlag fILE_NOTIFY_CHANGE_SIZE
|
||||
-- /Internal/
|
||||
--
|
||||
setModifiedLastWrite :: Toggle -> Config -> Config
|
||||
setModifiedLastWrite = setFlag fILE_NOTIFY_CHANGE_LAST_WRITE
|
||||
setModifiedLastWrite = setFlag fILE_NOTIFY_CHANGE_LAST_WRITE
|
||||
|
||||
-- | Report when a file Security attributes is changed.
|
||||
--
|
||||
@ -182,7 +215,7 @@ setModifiedLastWrite = setFlag fILE_NOTIFY_CHANGE_LAST_WRITE
|
||||
-- /Internal/
|
||||
--
|
||||
setModifiedSecurity :: Toggle -> Config -> Config
|
||||
setModifiedSecurity = setFlag fILE_NOTIFY_CHANGE_SECURITY
|
||||
setModifiedSecurity = setFlag fILE_NOTIFY_CHANGE_SECURITY
|
||||
|
||||
-- | Set all events 'On' or 'Off'.
|
||||
--
|
||||
@ -197,7 +230,7 @@ setAllEvents s =
|
||||
. setModifiedAttribute s
|
||||
. setModifiedSize s
|
||||
. setModifiedLastWrite s
|
||||
. setModifiedSecurity s
|
||||
. setModifiedSecurity s
|
||||
|
||||
defaultConfig :: Config
|
||||
defaultConfig = setAllEvents On $ Config {watchRec = True, createFlags = 0}
|
||||
@ -209,22 +242,22 @@ getConfigRecMode :: Config -> BOOL
|
||||
getConfigRecMode Config{..} = watchRec
|
||||
|
||||
data Event = Event
|
||||
{ eventFlags :: DWORD
|
||||
, eventRelPath :: String
|
||||
, eventRootPath :: String
|
||||
{ eventFlags :: DWORD
|
||||
, eventRelPath :: String
|
||||
, eventRootPath :: String
|
||||
, totalBytes :: DWORD
|
||||
} deriving (Show, Ord, Eq)
|
||||
} deriving (Show, Ord, Eq)
|
||||
|
||||
-- For reference documentation see:
|
||||
--
|
||||
--
|
||||
-- See https://docs.microsoft.com/en-us/windows/win32/api/winnt/ns-winnt-file_notify_information
|
||||
data FILE_NOTIFY_INFORMATION = FILE_NOTIFY_INFORMATION
|
||||
{ fniNextEntryOffset :: DWORD
|
||||
, fniAction :: DWORD
|
||||
, fniFileName :: String
|
||||
} deriving Show
|
||||
} deriving Show
|
||||
|
||||
type LPOVERLAPPED_COMPLETION_ROUTINE =
|
||||
type LPOVERLAPPED_COMPLETION_ROUTINE =
|
||||
FunPtr ((DWORD, DWORD, LPOVERLAPPED) -> IO ())
|
||||
|
||||
-- | A handle for a watch.
|
||||
@ -232,64 +265,80 @@ getWatchHandle :: FilePath -> IO (HANDLE, FilePath)
|
||||
getWatchHandle dir = do
|
||||
h <- createFile dir
|
||||
-- Access mode
|
||||
fILE_LIST_DIRECTORY
|
||||
fILE_LIST_DIRECTORY
|
||||
-- Share mode
|
||||
(fILE_SHARE_READ .|. fILE_SHARE_WRITE)
|
||||
(fILE_SHARE_READ .|. fILE_SHARE_WRITE)
|
||||
-- Security attributes
|
||||
Nothing
|
||||
Nothing
|
||||
-- Create mode, we want to look at an existing directory
|
||||
oPEN_EXISTING
|
||||
oPEN_EXISTING
|
||||
-- File attribute, NOT using OVERLAPPED since we work synchronously
|
||||
fILE_FLAG_BACKUP_SEMANTICS
|
||||
fILE_FLAG_BACKUP_SEMANTICS
|
||||
-- No template file
|
||||
Nothing
|
||||
Nothing
|
||||
return (h, dir)
|
||||
|
||||
|
||||
-- For reference documentation see:
|
||||
--
|
||||
-- See https://docs.microsoft.com/en-us/windows/win32/api/winbase/nf-winbase-readdirectorychangesw
|
||||
-- Note that this API uses UTF-16 for file system paths:
|
||||
-- Note that this API uses UTF-16 for file system paths:
|
||||
-- 1. https://docs.microsoft.com/en-us/windows/win32/intl/unicode-in-the-windows-api
|
||||
-- 2. https://docs.microsoft.com/en-us/windows/win32/intl/unicode
|
||||
foreign import ccall safe
|
||||
foreign import ccall safe
|
||||
"windows.h ReadDirectoryChangesW" c_ReadDirectoryChangesW ::
|
||||
HANDLE -> LPVOID -> DWORD -> BOOL -> DWORD -> LPDWORD
|
||||
-> LPOVERLAPPED -> LPOVERLAPPED_COMPLETION_ROUTINE -> IO BOOL
|
||||
HANDLE
|
||||
-> LPVOID
|
||||
-> DWORD
|
||||
-> BOOL
|
||||
-> DWORD
|
||||
-> LPDWORD
|
||||
-> LPOVERLAPPED
|
||||
-> LPOVERLAPPED_COMPLETION_ROUTINE
|
||||
-> IO BOOL
|
||||
|
||||
readDirectoryChangesW ::
|
||||
HANDLE -> Ptr FILE_NOTIFY_INFORMATION -> DWORD
|
||||
-> BOOL -> FileNotificationFlag -> LPDWORD -> IO ()
|
||||
|
||||
HANDLE
|
||||
-> Ptr FILE_NOTIFY_INFORMATION
|
||||
-> DWORD
|
||||
-> BOOL
|
||||
-> FileNotificationFlag
|
||||
-> LPDWORD
|
||||
-> IO ()
|
||||
readDirectoryChangesW h buf bufSize wst f br =
|
||||
failIfFalse_ "ReadDirectoryChangesW" $ c_ReadDirectoryChangesW h (castPtr buf)
|
||||
bufSize wst f br nullPtr nullFunPtr
|
||||
let res = c_ReadDirectoryChangesW
|
||||
h (castPtr buf) bufSize wst f br nullPtr nullFunPtr
|
||||
in failIfFalse_ "ReadDirectoryChangesW" res
|
||||
|
||||
peekFNI :: Ptr FILE_NOTIFY_INFORMATION -> IO FILE_NOTIFY_INFORMATION
|
||||
peekFNI buf = do
|
||||
neof <- peekByteOff buf 0
|
||||
acti <- peekByteOff buf 4
|
||||
fnle <- peekByteOff buf 8
|
||||
-- Note: The path is UTF-16 encoded C WChars, peekCWStringLen converts
|
||||
-- UTF-16 to UTF-32 Char String
|
||||
fnam <- peekCWStringLen
|
||||
-- start of array
|
||||
(buf `plusPtr` 12,
|
||||
-- fnle is the length in *bytes*, and a WCHAR is 2 bytes
|
||||
fromEnum (fnle :: DWORD) `div` 2)
|
||||
fromEnum (fnle :: DWORD) `div` 2)
|
||||
return $ FILE_NOTIFY_INFORMATION neof acti fnam
|
||||
|
||||
readChangeEvents :: Ptr FILE_NOTIFY_INFORMATION -> String -> DWORD -> IO [Event]
|
||||
readChangeEvents pfni root bytesRet = do
|
||||
readChangeEvents ::
|
||||
Ptr FILE_NOTIFY_INFORMATION -> String -> DWORD -> IO [Event]
|
||||
readChangeEvents pfni root bytesRet = do
|
||||
fni <- peekFNI pfni
|
||||
let entry = Event
|
||||
{ eventFlags = fniAction fni
|
||||
, eventRelPath = fniFileName fni
|
||||
{ eventFlags = fniAction fni
|
||||
, eventRelPath = fniFileName fni
|
||||
, eventRootPath = root
|
||||
, totalBytes = bytesRet
|
||||
}
|
||||
nioff = fromEnum $ fniNextEntryOffset fni
|
||||
entries <- if nioff == 0
|
||||
then return []
|
||||
else readChangeEvents (pfni `plusPtr` nioff) root bytesRet
|
||||
return $ entry :entries
|
||||
}
|
||||
nioff = fromEnum $ fniNextEntryOffset fni
|
||||
entries <-
|
||||
if nioff == 0
|
||||
then return []
|
||||
else readChangeEvents (pfni `plusPtr` nioff) root bytesRet
|
||||
return $ entry : entries
|
||||
|
||||
readDirectoryChanges ::
|
||||
String -> HANDLE -> Bool -> FileNotificationFlag -> IO [Event]
|
||||
@ -300,7 +349,7 @@ readDirectoryChanges root h wst mask = do
|
||||
readDirectoryChangesW h buffer (toEnum maxBuf) wst mask bret
|
||||
bytesRet <- peekByteOff bret 0
|
||||
readChangeEvents buffer root bytesRet
|
||||
|
||||
|
||||
type FileAction = DWORD
|
||||
|
||||
fILE_ACTION_ADDED :: FileAction
|
||||
@ -322,19 +371,20 @@ eventStreamAggr :: (HANDLE, FilePath, Config) -> SerialT IO Event
|
||||
eventStreamAggr (handle, rootPath, cfg) = do
|
||||
let recMode = getConfigRecMode cfg
|
||||
flagMasks = getConfigFlag cfg
|
||||
S.concatMap S.fromList $ S.repeatM
|
||||
S.concatMap S.fromList $ S.repeatM
|
||||
$ readDirectoryChanges rootPath handle recMode flagMasks
|
||||
|
||||
pathsToHandles ::
|
||||
pathsToHandles ::
|
||||
NonEmpty FilePath -> Config -> SerialT IO (HANDLE, FilePath, Config)
|
||||
pathsToHandles paths cfg = do
|
||||
let pathStream = S.fromList (NonEmpty.toList paths)
|
||||
st2 = S.mapM getWatchHandle pathStream
|
||||
S.map (\(h, f) -> (h, f, cfg)) st2
|
||||
S.map (\(h, f) -> (h, f, cfg)) st2
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Utilities
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
utf8ToString :: Array Word8 -> FilePath
|
||||
utf8ToString = runIdentity . S.toList . U.decodeUtf8 . A.toStream
|
||||
|
||||
@ -357,17 +407,18 @@ closePathHandleStream = S.mapM_ (\(h, _, _) -> closeHandle h)
|
||||
--
|
||||
-- /Internal/
|
||||
--
|
||||
watchPathsWith ::
|
||||
(Config -> Config)
|
||||
-> NonEmpty (Array Word8)
|
||||
watchPathsWith ::
|
||||
(Config -> Config)
|
||||
-> NonEmpty (Array Word8)
|
||||
-> SerialT IO Event
|
||||
watchPathsWith f paths =
|
||||
S.bracket before after (S.concatMapWith parallel eventStreamAggr)
|
||||
|
||||
where
|
||||
|
||||
before = return $ pathsToHandles (utf8ToStringList paths)
|
||||
(f $ setRecursiveMode False defaultConfig)
|
||||
before =
|
||||
let cfg = f $ setRecursiveMode False defaultConfig
|
||||
in return $ pathsToHandles (utf8ToStringList paths) cfg
|
||||
after = liftIO . closePathHandleStream
|
||||
|
||||
-- | Like 'watchPathsWith' but uses the 'defaultConfig' options.
|
||||
@ -389,17 +440,18 @@ watchPaths = watchPathsWith id
|
||||
--
|
||||
-- /Internal/
|
||||
--
|
||||
watchTreesWith ::
|
||||
(Config -> Config)
|
||||
-> NonEmpty (Array Word8)
|
||||
-> SerialT IO Event
|
||||
watchTreesWith f paths =
|
||||
watchTreesWith ::
|
||||
(Config -> Config)
|
||||
-> NonEmpty (Array Word8)
|
||||
-> SerialT IO Event
|
||||
watchTreesWith f paths =
|
||||
S.bracket before after (S.concatMapWith parallel eventStreamAggr)
|
||||
|
||||
where
|
||||
|
||||
before = return $ pathsToHandles (utf8ToStringList paths)
|
||||
(f $ setRecursiveMode True defaultConfig)
|
||||
before =
|
||||
let cfg = f $ setRecursiveMode True defaultConfig
|
||||
in return $ pathsToHandles (utf8ToStringList paths) cfg
|
||||
after = liftIO . closePathHandleStream
|
||||
|
||||
-- | Like 'watchTreesWith' but uses the 'defaultConfig' options.
|
||||
@ -409,35 +461,78 @@ watchTreesWith f paths =
|
||||
-- @
|
||||
--
|
||||
watchTrees :: NonEmpty (Array Word8) -> SerialT IO Event
|
||||
watchTrees = watchTreesWith id
|
||||
|
||||
watchTrees = watchTreesWith id
|
||||
|
||||
getFlag :: DWORD -> Event -> Bool
|
||||
getFlag mask Event{..} = eventFlags == mask
|
||||
|
||||
-- XXX Change the type to Array Word8 to make it compatible with other APIs.
|
||||
--
|
||||
-- | Get the file system object path for which the event is generated, relative
|
||||
-- to the watched root. The path is a UTF-8 encoded array of bytes.
|
||||
--
|
||||
-- /Internal/
|
||||
--
|
||||
getRelPath :: Event -> String
|
||||
getRelPath Event{..} = eventRelPath
|
||||
|
||||
-- XXX Change the type to Array Word8 to make it compatible with other APIs.
|
||||
--
|
||||
-- | Get the watch root directory to which this event belongs.
|
||||
--
|
||||
-- /Internal/
|
||||
--
|
||||
getRoot :: Event -> String
|
||||
getRoot Event{..} = eventRootPath
|
||||
|
||||
-- XXX need to document the exact semantics of these.
|
||||
--
|
||||
-- | File/directory created in watched directory.
|
||||
--
|
||||
-- /Internal/
|
||||
--
|
||||
isCreated :: Event -> Bool
|
||||
isCreated = getFlag fILE_ACTION_ADDED
|
||||
|
||||
-- | File/directory deleted from watched directory.
|
||||
--
|
||||
-- /Internal/
|
||||
--
|
||||
isDeleted :: Event -> Bool
|
||||
isDeleted = getFlag fILE_ACTION_REMOVED
|
||||
|
||||
-- | Generated for the original path when an object is moved from under a
|
||||
-- monitored directory.
|
||||
--
|
||||
-- /Internal/
|
||||
--
|
||||
isMovedFrom :: Event -> Bool
|
||||
isMovedFrom = getFlag fILE_ACTION_RENAMED_OLD_NAME
|
||||
|
||||
-- | Generated for the new path when an object is moved under a monitored
|
||||
-- directory.
|
||||
--
|
||||
-- /Internal/
|
||||
--
|
||||
isMovedTo :: Event -> Bool
|
||||
isMovedTo = getFlag fILE_ACTION_RENAMED_NEW_NAME
|
||||
|
||||
-- XXX This event is generated only for files and not directories?
|
||||
--
|
||||
-- | Determine whether the event indicates modification of an object within the
|
||||
-- monitored path.
|
||||
--
|
||||
-- /Internal/
|
||||
--
|
||||
isModified :: Event -> Bool
|
||||
isModified = getFlag fILE_ACTION_MODIFIED
|
||||
|
||||
-- | If the buffer overflows, ReadDirectoryChangesW will still return true,
|
||||
-- but the entire contents of the buffer are discarded.
|
||||
-- | If the buffer overflows, entire contents of the buffer are discarded,
|
||||
-- therefore, events are lost. The user application must scan everything under
|
||||
-- the watched paths to know the current state.
|
||||
--
|
||||
-- /Internal/
|
||||
--
|
||||
isOverflow :: Event -> Bool
|
||||
isOverflow Event{..} = totalBytes == 0
|
||||
|
||||
@ -447,11 +542,11 @@ isOverflow Event{..} = totalBytes == 0
|
||||
|
||||
-- | Convert an 'Event' record to a String representation.
|
||||
showEvent :: Event -> String
|
||||
showEvent ev@Event{..} =
|
||||
showEvent ev@Event{..} =
|
||||
"--------------------------"
|
||||
++ "\nRoot = " ++ show (getRoot ev)
|
||||
++ "\nPath = " ++ show (getRelPath ev)
|
||||
++ "\nFlags " ++ show eventFlags
|
||||
++ "\nFlags " ++ show eventFlags
|
||||
++ showev isOverflow "Overflow"
|
||||
++ showev isCreated "Created"
|
||||
++ showev isDeleted "Deleted"
|
||||
@ -460,4 +555,4 @@ showEvent ev@Event{..} =
|
||||
++ showev isMovedTo "MovedTo"
|
||||
++ "\n"
|
||||
|
||||
where showev f str = if f ev then "\n" ++ str else ""
|
||||
where showev f str = if f ev then "\n" ++ str else ""
|
||||
|
@ -128,6 +128,8 @@ extra-source-files:
|
||||
credits/bjoern-2008-2009.txt
|
||||
credits/clock-0.7.2.txt
|
||||
credits/foldl-1.4.5.txt
|
||||
credits/fsnotify-0.3.0.1.txt
|
||||
credits/hfsevents-0.1.6.txt
|
||||
credits/pipes-concurrency-2.0.8.txt
|
||||
credits/primitive-0.7.0.0.txt
|
||||
credits/transient-0.5.5.txt
|
||||
@ -229,7 +231,7 @@ common compile-options
|
||||
cpp-options: -DCABAL_OS_LINUX
|
||||
|
||||
if os(windows)
|
||||
cpp-options: -DCABAL_OS_WINDOWS
|
||||
cpp-options: -DCABAL_OS_WINDOWS
|
||||
|
||||
if flag(streamk)
|
||||
cpp-options: -DUSE_STREAMK_ONLY
|
||||
@ -368,7 +370,7 @@ library
|
||||
if os(windows)
|
||||
c-sources: src/Streamly/Internal/Data/Time/Windows.c
|
||||
exposed-modules: Streamly.Internal.FileSystem.Event.Windows
|
||||
build-depends: Win32 >= 2.6 && < 2.9
|
||||
build-depends: Win32 >= 2.6 && < 2.10
|
||||
|
||||
if os(darwin)
|
||||
frameworks: Cocoa
|
||||
@ -467,7 +469,7 @@ library
|
||||
, Streamly.Internal.Data.Stream.StreamDK
|
||||
, Streamly.Internal.Data.Stream.Enumeration
|
||||
, Streamly.Internal.Data.Stream.Prelude
|
||||
|
||||
|
||||
-- Higher level streams
|
||||
, Streamly.Internal.Data.Stream.IsStream
|
||||
, Streamly.Internal.Data.Stream.SVar
|
||||
|
@ -9,13 +9,13 @@
|
||||
--
|
||||
-- Just report all events under the paths provided as arguments
|
||||
module Main (main) where
|
||||
|
||||
import Control.Monad.IO.Class (MonadIO)
|
||||
|
||||
import Control.Monad.IO.Class (MonadIO)
|
||||
import Data.Function ((&))
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import Data.Word (Word8)
|
||||
import System.Environment (getArgs)
|
||||
import Streamly.Prelude (SerialT)
|
||||
import Streamly.Prelude (SerialT)
|
||||
import Streamly.Internal.Data.Array.Storable.Foreign (Array)
|
||||
|
||||
import qualified Streamly.Unicode.Stream as Unicode
|
||||
@ -35,22 +35,25 @@ import qualified Streamly.Internal.FileSystem.Event.Windows as Event
|
||||
-------------------------------------------------------------------------------
|
||||
-- Utilities
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
toUtf8 :: MonadIO m => String -> m (Array Word8)
|
||||
toUtf8 = Array.fromStream . Unicode.encodeUtf8' . Stream.fromList
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Main
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
watchPaths :: NonEmpty (Array Word8) -> SerialT IO Event.Event
|
||||
#if defined(CABAL_OS_LINUX)
|
||||
#if defined(CABAL_OS_LINUX)
|
||||
watchPaths = Event.watchPaths
|
||||
#else
|
||||
#else
|
||||
watchPaths = Event.watchTrees
|
||||
#endif
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
args <- getArgs
|
||||
args <- getArgs
|
||||
paths <- mapM toUtf8 args
|
||||
|
||||
watchPaths (NonEmpty.fromList paths)
|
||||
& Stream.mapM_ (putStrLn . Event.showEvent)
|
||||
|
Loading…
Reference in New Issue
Block a user