#include "config.h"
#if HAVE_DECL_IN_EXCL_UNLINK
module Streamly.Internal.FileSystem.Event.Linux
(
Config (..)
, Switch (..)
, defaultConfig
, setRecursiveMode
, setFollowSymLinks
, setUnwatchMoved
, setOneShot
, setOnlyDir
, WhenExists (..)
, setWhenExists
, setRootDeleted
, setRootMoved
, setRootPathEvents
, setAttrsModified
, setAccessed
, setOpened
, setWriteClosed
, setNonWriteClosed
, setCreated
, setDeleted
, setMovedFrom
, setMovedTo
, setModified
, setAllEvents
, watch
, watchRecursive
, watchWith
, addToWatch
, removeFromWatch
, Event(..)
, getRoot
, getRelPath
, getAbsPath
, getCookie
, isRootPathEvent
, isRootUnwatched
, isRootDeleted
, isRootMoved
, isRootUnmounted
, isAttrsModified
, isAccessed
, isOpened
, isWriteClosed
, isNonWriteClosed
, isCreated
, isDeleted
, isMovedFrom
, isMovedTo
, isMoved
, isModified
, isDir
, isEventsLost
, showEvent
)
where
import Control.Monad (void, when)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Bits ((.|.), (.&.), complement)
import Data.Char (ord)
import Data.Foldable (foldlM)
import Data.Functor.Identity (runIdentity)
import Data.IntMap.Lazy (IntMap)
import Data.IORef (IORef, newIORef, readIORef, writeIORef, modifyIORef)
import Data.List.NonEmpty (NonEmpty)
#if !(MIN_VERSION_base(4,13,0))
import Data.Semigroup (Semigroup(..))
#endif
import Data.Word (Word8, Word32)
import Foreign.C.Error (throwErrnoIfMinus1)
import Foreign.C.String (CString)
import Foreign.C.Types (CInt(..), CUInt(..))
import Foreign.Ptr (Ptr)
import Foreign.Storable (peek, peekByteOff, sizeOf)
import GHC.IO.Device (IODeviceType(Stream))
import GHC.IO.FD (fdFD, mkFD)
import GHC.IO.Handle.FD (mkHandleFromFD)
import Streamly.Prelude (SerialT)
import Streamly.Internal.Data.Parser (Parser)
import Streamly.Internal.Data.Array.Foreign.Type (Array(..), byteLength)
import System.Directory (doesDirectoryExist)
import System.IO (Handle, hClose, IOMode(ReadMode))
#if !MIN_VERSION_base(4,10,0)
import Control.Concurrent.MVar (readMVar)
import Data.Typeable (cast)
import GHC.IO.Exception (IOException(..), IOErrorType(..), ioException)
import GHC.IO.FD (FD)
import GHC.IO.Handle.Types (Handle__(..), Handle(FileHandle, DuplexHandle))
#else
import GHC.IO.Handle.FD (handleToFd)
#endif
import qualified Data.IntMap.Lazy as Map
import qualified Data.List.NonEmpty as NonEmpty
import qualified Streamly.Internal.Data.Array.Foreign as A
import qualified Streamly.Internal.Data.Fold as FL
import qualified Streamly.Internal.Data.Parser as PR
import qualified Streamly.Internal.Data.Stream.IsStream as S
import qualified Streamly.Internal.FileSystem.Dir as Dir
import qualified Streamly.Internal.FileSystem.Handle as FH
import qualified Streamly.Internal.Unicode.Stream as U
data Config = Config
{ Config -> Bool
watchRec :: Bool
, Config -> Word32
createFlags :: Word32
}
data Switch = On | Off deriving (Key -> Switch -> ShowS
[Switch] -> ShowS
Switch -> String
forall a.
(Key -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Switch] -> ShowS
$cshowList :: [Switch] -> ShowS
show :: Switch -> String
$cshow :: Switch -> String
showsPrec :: Key -> Switch -> ShowS
$cshowsPrec :: Key -> Switch -> ShowS
Show, Switch -> Switch -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Switch -> Switch -> Bool
$c/= :: Switch -> Switch -> Bool
== :: Switch -> Switch -> Bool
$c== :: Switch -> Switch -> Bool
Eq)
toggle :: Switch -> Switch
toggle :: Switch -> Switch
toggle Switch
On = Switch
Off
toggle Switch
Off = Switch
On
setFlag :: Word32 -> Switch -> Config -> Config
setFlag :: Word32 -> Switch -> Config -> Config
setFlag Word32
mask Switch
status cfg :: Config
cfg@Config{Bool
Word32
createFlags :: Word32
watchRec :: Bool
createFlags :: Config -> Word32
watchRec :: Config -> Bool
..} =
let flags :: Word32
flags =
case Switch
status of
Switch
On -> Word32
createFlags forall a. Bits a => a -> a -> a
.|. Word32
mask
Switch
Off -> Word32
createFlags forall a. Bits a => a -> a -> a
.&. forall a. Bits a => a -> a
complement Word32
mask
in Config
cfg {createFlags :: Word32
createFlags = Word32
flags}
setRecursiveMode :: Switch -> Config -> Config
setRecursiveMode :: Switch -> Config -> Config
setRecursiveMode Switch
rec cfg :: Config
cfg@Config{} = Config
cfg {watchRec :: Bool
watchRec = Switch
rec forall a. Eq a => a -> a -> Bool
== Switch
On}
foreign import capi
"sys/inotify.h value IN_DONT_FOLLOW" iN_DONT_FOLLOW :: Word32
setFollowSymLinks :: Switch -> Config -> Config
setFollowSymLinks :: Switch -> Config -> Config
setFollowSymLinks Switch
s = Word32 -> Switch -> Config -> Config
setFlag Word32
iN_DONT_FOLLOW (Switch -> Switch
toggle Switch
s)
foreign import capi
"sys/inotify.h value IN_EXCL_UNLINK" iN_EXCL_UNLINK :: Word32
setUnwatchMoved :: Switch -> Config -> Config
setUnwatchMoved :: Switch -> Config -> Config
setUnwatchMoved = Word32 -> Switch -> Config -> Config
setFlag Word32
iN_EXCL_UNLINK
#if HAVE_DECL_IN_MASK_CREATE
foreign import capi
"sys/inotify.h value IN_MASK_CREATE" iN_MASK_CREATE :: Word32
#endif
foreign import capi
"sys/inotify.h value IN_MASK_ADD" iN_MASK_ADD :: Word32
data WhenExists =
AddIfExists
| ReplaceIfExists
#if HAVE_DECL_IN_MASK_CREATE
| FailIfExists
#endif
setWhenExists :: WhenExists -> Config -> Config
setWhenExists :: WhenExists -> Config -> Config
setWhenExists WhenExists
val Config
cfg =
case WhenExists
val of
WhenExists
AddIfExists -> Word32 -> Switch -> Config -> Config
setFlag Word32
iN_MASK_ADD Switch
On Config
cfg
WhenExists
ReplaceIfExists -> Word32 -> Switch -> Config -> Config
setFlag Word32
iN_MASK_ADD Switch
Off Config
cfg
#if HAVE_DECL_IN_MASK_CREATE
FailIfExists -> setFlag iN_MASK_CREATE On cfg
#endif
foreign import capi
"sys/inotify.h value IN_ONESHOT" iN_ONESHOT :: Word32
setOneShot :: Switch -> Config -> Config
setOneShot :: Switch -> Config -> Config
setOneShot = Word32 -> Switch -> Config -> Config
setFlag Word32
iN_ONESHOT
foreign import capi
"sys/inotify.h value IN_ONLYDIR" iN_ONLYDIR :: Word32
setOnlyDir :: Switch -> Config -> Config
setOnlyDir :: Switch -> Config -> Config
setOnlyDir = Word32 -> Switch -> Config -> Config
setFlag Word32
iN_ONLYDIR
foreign import capi
"sys/inotify.h value IN_DELETE_SELF" iN_DELETE_SELF :: Word32
setRootDeleted :: Switch -> Config -> Config
setRootDeleted :: Switch -> Config -> Config
setRootDeleted = Word32 -> Switch -> Config -> Config
setFlag Word32
iN_DELETE_SELF
foreign import capi
"sys/inotify.h value IN_MOVE_SELF" iN_MOVE_SELF :: Word32
setRootMoved :: Switch -> Config -> Config
setRootMoved :: Switch -> Config -> Config
setRootMoved = Word32 -> Switch -> Config -> Config
setFlag Word32
iN_MOVE_SELF
setRootPathEvents :: Switch -> Config -> Config
setRootPathEvents :: Switch -> Config -> Config
setRootPathEvents = Word32 -> Switch -> Config -> Config
setFlag (Word32
iN_DELETE_SELF forall a. Bits a => a -> a -> a
.|. Word32
iN_MOVE_SELF)
foreign import capi
"sys/inotify.h value IN_ATTRIB" iN_ATTRIB :: Word32
setAttrsModified :: Switch -> Config -> Config
setAttrsModified :: Switch -> Config -> Config
setAttrsModified = Word32 -> Switch -> Config -> Config
setFlag Word32
iN_ATTRIB
foreign import capi
"sys/inotify.h value IN_ACCESS" iN_ACCESS :: Word32
setAccessed :: Switch -> Config -> Config
setAccessed :: Switch -> Config -> Config
setAccessed = Word32 -> Switch -> Config -> Config
setFlag Word32
iN_ACCESS
foreign import capi
"sys/inotify.h value IN_OPEN" iN_OPEN :: Word32
setOpened :: Switch -> Config -> Config
setOpened :: Switch -> Config -> Config
setOpened = Word32 -> Switch -> Config -> Config
setFlag Word32
iN_OPEN
foreign import capi
"sys/inotify.h value IN_CLOSE_WRITE" iN_CLOSE_WRITE :: Word32
setWriteClosed :: Switch -> Config -> Config
setWriteClosed :: Switch -> Config -> Config
setWriteClosed = Word32 -> Switch -> Config -> Config
setFlag Word32
iN_CLOSE_WRITE
foreign import capi
"sys/inotify.h value IN_CLOSE_NOWRITE" iN_CLOSE_NOWRITE :: Word32
setNonWriteClosed :: Switch -> Config -> Config
setNonWriteClosed :: Switch -> Config -> Config
setNonWriteClosed = Word32 -> Switch -> Config -> Config
setFlag Word32
iN_CLOSE_NOWRITE
foreign import capi
"sys/inotify.h value IN_CREATE" iN_CREATE :: Word32
setCreated :: Switch -> Config -> Config
setCreated :: Switch -> Config -> Config
setCreated = Word32 -> Switch -> Config -> Config
setFlag Word32
iN_CREATE
foreign import capi
"sys/inotify.h value IN_DELETE" iN_DELETE :: Word32
setDeleted :: Switch -> Config -> Config
setDeleted :: Switch -> Config -> Config
setDeleted = Word32 -> Switch -> Config -> Config
setFlag Word32
iN_DELETE
foreign import capi
"sys/inotify.h value IN_MOVED_FROM" iN_MOVED_FROM :: Word32
setMovedFrom :: Switch -> Config -> Config
setMovedFrom :: Switch -> Config -> Config
setMovedFrom = Word32 -> Switch -> Config -> Config
setFlag Word32
iN_MOVED_FROM
foreign import capi
"sys/inotify.h value IN_MOVED_TO" iN_MOVED_TO :: Word32
setMovedTo :: Switch -> Config -> Config
setMovedTo :: Switch -> Config -> Config
setMovedTo = Word32 -> Switch -> Config -> Config
setFlag Word32
iN_MOVED_TO
foreign import capi
"sys/inotify.h value IN_MODIFY" iN_MODIFY :: Word32
setModified :: Switch -> Config -> Config
setModified :: Switch -> Config -> Config
setModified = Word32 -> Switch -> Config -> Config
setFlag Word32
iN_MODIFY
setAllEvents :: Switch -> Config -> Config
setAllEvents :: Switch -> Config -> Config
setAllEvents Switch
s =
Switch -> Config -> Config
setRootDeleted Switch
s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Switch -> Config -> Config
setRootMoved Switch
s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Switch -> Config -> Config
setAttrsModified Switch
s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Switch -> Config -> Config
setAccessed Switch
s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Switch -> Config -> Config
setOpened Switch
s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Switch -> Config -> Config
setWriteClosed Switch
s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Switch -> Config -> Config
setNonWriteClosed Switch
s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Switch -> Config -> Config
setCreated Switch
s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Switch -> Config -> Config
setDeleted Switch
s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Switch -> Config -> Config
setMovedFrom Switch
s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Switch -> Config -> Config
setMovedTo Switch
s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Switch -> Config -> Config
setModified Switch
s
defaultConfig :: Config
defaultConfig :: Config
defaultConfig =
WhenExists -> Config -> Config
setWhenExists WhenExists
AddIfExists
forall a b. (a -> b) -> a -> b
$ Switch -> Config -> Config
setCreated Switch
On
forall a b. (a -> b) -> a -> b
$ Switch -> Config -> Config
setDeleted Switch
On
forall a b. (a -> b) -> a -> b
$ Switch -> Config -> Config
setMovedFrom Switch
On
forall a b. (a -> b) -> a -> b
$ Switch -> Config -> Config
setMovedTo Switch
On
forall a b. (a -> b) -> a -> b
$ Switch -> Config -> Config
setModified Switch
On
forall a b. (a -> b) -> a -> b
$ Config
{ watchRec :: Bool
watchRec = Bool
False
, createFlags :: Word32
createFlags = Word32
0
}
data Watch =
Watch
Handle
(IORef
(IntMap
( Array Word8
, Array Word8
)
)
)
newtype WD = WD CInt deriving Key -> WD -> ShowS
[WD] -> ShowS
WD -> String
forall a.
(Key -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WD] -> ShowS
$cshowList :: [WD] -> ShowS
show :: WD -> String
$cshow :: WD -> String
showsPrec :: Key -> WD -> ShowS
$cshowsPrec :: Key -> WD -> ShowS
Show
foreign import ccall unsafe
"sys/inotify.h inotify_init" c_inotify_init :: IO CInt
createWatch :: IO Watch
createWatch :: IO Watch
createWatch = do
CInt
rawfd <- forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 String
"createWatch" IO CInt
c_inotify_init
(FD
fd, IODeviceType
fdType) <-
CInt
-> IOMode
-> Maybe (IODeviceType, CDev, CIno)
-> Bool
-> Bool
-> IO (FD, IODeviceType)
mkFD
CInt
rawfd
IOMode
ReadMode
(forall a. a -> Maybe a
Just (IODeviceType
Stream, CDev
0, CIno
0))
Bool
False
Bool
False
let fdString :: String
fdString = String
"<createWatch file descriptor: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show FD
fd forall a. [a] -> [a] -> [a]
++ String
">"
Handle
h <-
FD
-> IODeviceType
-> String
-> IOMode
-> Bool
-> Maybe TextEncoding
-> IO Handle
mkHandleFromFD
FD
fd
IODeviceType
fdType
String
fdString
IOMode
ReadMode
Bool
True
forall a. Maybe a
Nothing
IORef (IntMap (Array Word8, Array Word8))
emptyMapRef <- forall a. a -> IO (IORef a)
newIORef forall a. IntMap a
Map.empty
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Handle -> IORef (IntMap (Array Word8, Array Word8)) -> Watch
Watch Handle
h IORef (IntMap (Array Word8, Array Word8))
emptyMapRef
foreign import ccall unsafe
"sys/inotify.h inotify_add_watch" c_inotify_add_watch
:: CInt -> CString -> CUInt -> IO CInt
toUtf8 :: MonadIO m => String -> m (Array Word8)
toUtf8 :: forall (m :: * -> *). MonadIO m => String -> m (Array Word8)
toUtf8 = forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
SerialT m a -> m (Array a)
A.fromStream forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (t :: (* -> *) -> * -> *).
(Monad m, IsStream t) =>
t m Char -> t m Word8
U.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad m, IsStream t) =>
[a] -> t m a
S.fromList
utf8ToString :: Array Word8 -> String
utf8ToString :: Array Word8 -> String
utf8ToString = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => SerialT m a -> m [a]
S.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (t :: (* -> *) -> * -> *).
(Monad m, IsStream t) =>
t m Word8 -> t m Char
U.decodeUtf8' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
(Monad m, Storable a) =>
Array a -> SerialT m a
A.toStream
#if !MIN_VERSION_base(4,10,0)
handleToFd :: Handle -> IO FD
handleToFd h = case h of
FileHandle _ mv -> do
Handle__{haDevice = dev} <- readMVar mv
case cast dev of
Just fd -> return fd
Nothing -> throwErr "not a file descriptor"
DuplexHandle{} -> throwErr "not a file handle"
where
throwErr msg = ioException $ IOError (Just h)
InappropriateType "handleToFd" msg Nothing Nothing
#endif
ensureTrailingSlash :: Array Word8 -> Array Word8
ensureTrailingSlash :: Array Word8 -> Array Word8
ensureTrailingSlash Array Word8
path =
if forall a. Array a -> Key
byteLength Array Word8
path forall a. Eq a => a -> a -> Bool
/= Key
0
then
let mx :: Maybe Word8
mx = forall a. Storable a => Array a -> Key -> Maybe a
A.getIndex Array Word8
path (forall a. Array a -> Key
byteLength Array Word8
path forall a. Num a => a -> a -> a
- Key
1)
in case Maybe Word8
mx of
Maybe Word8
Nothing -> forall a. HasCallStack => String -> a
error String
"ensureTrailingSlash: Bug: Invalid index"
Just Word8
x ->
if Word8
x forall a. Eq a => a -> a -> Bool
/= forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Key
ord Char
'/')
then Array Word8
path forall a. Semigroup a => a -> a -> a
<> Addr# -> Array Word8
A.fromCString# Addr#
"/"#
else Array Word8
path
else Array Word8
path
removeTrailingSlash :: Array Word8 -> Array Word8
removeTrailingSlash :: Array Word8 -> Array Word8
removeTrailingSlash Array Word8
path =
if forall a. Array a -> Key
byteLength Array Word8
path forall a. Eq a => a -> a -> Bool
/= Key
0
then
let n :: Key
n = forall a. Array a -> Key
byteLength Array Word8
path forall a. Num a => a -> a -> a
- Key
1
mx :: Maybe Word8
mx = forall a. Storable a => Array a -> Key -> Maybe a
A.getIndex Array Word8
path Key
n
in case Maybe Word8
mx of
Maybe Word8
Nothing -> forall a. HasCallStack => String -> a
error String
"removeTrailingSlash: Bug: Invalid index"
Just Word8
x ->
if Word8
x forall a. Eq a => a -> a -> Bool
== forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Key
ord Char
'/')
then forall a. Storable a => Key -> Key -> Array a -> Array a
A.getSliceUnsafe Key
0 Key
n Array Word8
path
else Array Word8
path
else Array Word8
path
appendPaths :: Array Word8 -> Array Word8 -> Array Word8
appendPaths :: Array Word8 -> Array Word8 -> Array Word8
appendPaths Array Word8
a Array Word8
b
| forall a. Array a -> Key
byteLength Array Word8
a forall a. Eq a => a -> a -> Bool
== Key
0 = Array Word8
b
| forall a. Array a -> Key
byteLength Array Word8
b forall a. Eq a => a -> a -> Bool
== Key
0 = Array Word8
a
| Bool
otherwise = Array Word8 -> Array Word8
ensureTrailingSlash Array Word8
a forall a. Semigroup a => a -> a -> a
<> Array Word8
b
addToWatch :: Config -> Watch -> Array Word8 -> Array Word8 -> IO ()
addToWatch :: Config -> Watch -> Array Word8 -> Array Word8 -> IO ()
addToWatch cfg :: Config
cfg@Config{Bool
Word32
createFlags :: Word32
watchRec :: Bool
createFlags :: Config -> Word32
watchRec :: Config -> Bool
..} watch0 :: Watch
watch0@(Watch Handle
handle IORef (IntMap (Array Word8, Array Word8))
wdMap) Array Word8
root0 Array Word8
path0 = do
let root :: Array Word8
root = Array Word8 -> Array Word8
removeTrailingSlash Array Word8
root0
path :: Array Word8
path = Array Word8 -> Array Word8
removeTrailingSlash Array Word8
path0
absPath :: Array Word8
absPath = Array Word8 -> Array Word8 -> Array Word8
appendPaths Array Word8
root Array Word8
path
String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"root = " forall a. [a] -> [a] -> [a]
++ Array Word8 -> String
utf8ToString Array Word8
root forall a. [a] -> [a] -> [a]
++ String
" path = " forall a. [a] -> [a] -> [a]
++ Array Word8 -> String
utf8ToString Array Word8
path forall a. [a] -> [a] -> [a]
++ String
" absPath = " forall a. [a] -> [a] -> [a]
++ Array Word8 -> String
utf8ToString Array Word8
absPath
FD
fd <- Handle -> IO FD
handleToFd Handle
handle
CInt
wd <- forall a b. Array a -> (CString -> IO b) -> IO b
A.unsafeAsCString Array Word8
absPath forall a b. (a -> b) -> a -> b
$ \CString
pathPtr ->
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 (String
"addToWatch: " forall a. [a] -> [a] -> [a]
++ Array Word8 -> String
utf8ToString Array Word8
absPath) forall a b. (a -> b) -> a -> b
$
CInt -> CString -> CUInt -> IO CInt
c_inotify_add_watch (FD -> CInt
fdFD FD
fd) CString
pathPtr (Word32 -> CUInt
CUInt Word32
createFlags)
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef (IntMap (Array Word8, Array Word8))
wdMap (forall a. Key -> a -> IntMap a -> IntMap a
Map.insert (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
wd) (Array Word8
root, Array Word8
path))
Bool
pathIsDir <- String -> IO Bool
doesDirectoryExist forall a b. (a -> b) -> a -> b
$ Array Word8 -> String
utf8ToString Array Word8
absPath
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
watchRec Bool -> Bool -> Bool
&& Bool
pathIsDir) forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SerialT m a -> m ()
S.mapM_ (\Array Word8
p -> Config -> Watch -> Array Word8 -> Array Word8 -> IO ()
addToWatch Config
cfg Watch
watch0 Array Word8
root (Array Word8 -> Array Word8 -> Array Word8
appendPaths Array Word8
path Array Word8
p))
forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(IsStream t, MonadAsync m) =>
(a -> m b) -> t m a -> t m b
S.mapM forall (m :: * -> *). MonadIO m => String -> m (Array Word8)
toUtf8
forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(IsStream t, MonadIO m) =>
String -> t m String
Dir.toDirs forall a b. (a -> b) -> a -> b
$ Array Word8 -> String
utf8ToString Array Word8
absPath
foreign import ccall unsafe
"sys/inotify.h inotify_rm_watch" c_inotify_rm_watch
:: CInt -> CInt -> IO CInt
removeFromWatch :: Watch -> Array Word8 -> IO ()
removeFromWatch :: Watch -> Array Word8 -> IO ()
removeFromWatch (Watch Handle
handle IORef (IntMap (Array Word8, Array Word8))
wdMap) Array Word8
path = do
FD
fd <- Handle -> IO FD
handleToFd Handle
handle
IntMap (Array Word8, Array Word8)
km <- forall a. IORef a -> IO a
readIORef IORef (IntMap (Array Word8, Array Word8))
wdMap
IntMap (Array Word8, Array Word8)
wdMap1 <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM (forall {b}.
FD
-> IntMap (Array Word8, b)
-> (Key, (Array Word8, b))
-> IO (IntMap (Array Word8, b))
step FD
fd) forall a. IntMap a
Map.empty (forall a. IntMap a -> [(Key, a)]
Map.toList IntMap (Array Word8, Array Word8)
km)
forall a. IORef a -> a -> IO ()
writeIORef IORef (IntMap (Array Word8, Array Word8))
wdMap IntMap (Array Word8, Array Word8)
wdMap1
where
step :: FD
-> IntMap (Array Word8, b)
-> (Key, (Array Word8, b))
-> IO (IntMap (Array Word8, b))
step FD
fd IntMap (Array Word8, b)
newMap (Key
wd, (Array Word8, b)
v) = do
if forall a b. (a, b) -> a
fst (Array Word8, b)
v forall a. Eq a => a -> a -> Bool
== Array Word8
path
then do
let err :: String
err = String
"removeFromWatch: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Array Word8 -> String
utf8ToString Array Word8
path)
rm :: IO CInt
rm = CInt -> CInt -> IO CInt
c_inotify_rm_watch (FD -> CInt
fdFD FD
fd) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Key
wd)
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 String
err IO CInt
rm
forall (m :: * -> *) a. Monad m => a -> m a
return IntMap (Array Word8, b)
newMap
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Key -> a -> IntMap a -> IntMap a
Map.insert Key
wd (Array Word8, b)
v IntMap (Array Word8, b)
newMap
openWatch :: Config -> NonEmpty (Array Word8) -> IO Watch
openWatch :: Config -> NonEmpty (Array Word8) -> IO Watch
openWatch Config
cfg NonEmpty (Array Word8)
paths = do
Watch
w <- IO Watch
createWatch
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
(\Array Word8
root -> Config -> Watch -> Array Word8 -> Array Word8 -> IO ()
addToWatch Config
cfg Watch
w Array Word8
root (forall a. Storable a => [a] -> Array a
A.fromList []))
forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty (Array Word8)
paths
forall (m :: * -> *) a. Monad m => a -> m a
return Watch
w
closeWatch :: Watch -> IO ()
closeWatch :: Watch -> IO ()
closeWatch (Watch Handle
h IORef (IntMap (Array Word8, Array Word8))
_) = Handle -> IO ()
hClose Handle
h
newtype Cookie = Cookie Word32 deriving (Key -> Cookie -> ShowS
[Cookie] -> ShowS
Cookie -> String
forall a.
(Key -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cookie] -> ShowS
$cshowList :: [Cookie] -> ShowS
show :: Cookie -> String
$cshow :: Cookie -> String
showsPrec :: Key -> Cookie -> ShowS
$cshowsPrec :: Key -> Cookie -> ShowS
Show, Cookie -> Cookie -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cookie -> Cookie -> Bool
$c/= :: Cookie -> Cookie -> Bool
== :: Cookie -> Cookie -> Bool
$c== :: Cookie -> Cookie -> Bool
Eq)
data Event = Event
{ Event -> CInt
eventWd :: CInt
, Event -> Word32
eventFlags :: Word32
, Event -> Word32
eventCookie :: Word32
, Event -> Array Word8
eventRelPath :: Array Word8
, Event -> IntMap (Array Word8, Array Word8)
eventMap :: IntMap (Array Word8, Array Word8)
} deriving (Key -> Event -> ShowS
[Event] -> ShowS
Event -> String
forall a.
(Key -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Key -> Event -> ShowS
$cshowsPrec :: Key -> Event -> ShowS
Show, Eq Event
Event -> Event -> Bool
Event -> Event -> Ordering
Event -> Event -> Event
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Event -> Event -> Event
$cmin :: Event -> Event -> Event
max :: Event -> Event -> Event
$cmax :: Event -> Event -> Event
>= :: Event -> Event -> Bool
$c>= :: Event -> Event -> Bool
> :: Event -> Event -> Bool
$c> :: Event -> Event -> Bool
<= :: Event -> Event -> Bool
$c<= :: Event -> Event -> Bool
< :: Event -> Event -> Bool
$c< :: Event -> Event -> Bool
compare :: Event -> Event -> Ordering
$ccompare :: Event -> Event -> Ordering
Ord, Event -> Event -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c== :: Event -> Event -> Bool
Eq)
readOneEvent :: Config -> Watch -> Parser IO Word8 Event
readOneEvent :: Config -> Watch -> Parser IO Word8 Event
readOneEvent Config
cfg wt :: Watch
wt@(Watch Handle
_ IORef (IntMap (Array Word8, Array Word8))
wdMap) = do
let headerLen :: Key
headerLen = forall a. Storable a => a -> Key
sizeOf (forall a. HasCallStack => a
undefined :: CInt) forall a. Num a => a -> a -> a
+ Key
12
Array Word8
arr <- forall (m :: * -> *) a b.
MonadCatch m =>
Key -> Fold m a b -> Parser m a b
PR.takeEQ Key
headerLen (forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Key -> Fold m a (Array a)
A.writeN Key
headerLen)
(Word8
ewd, Word32
eflags, Word32
cookie, Key
pathLen) <- forall (m :: * -> *) b a. MonadCatch m => m b -> Parser m a b
PR.fromEffect forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
MonadIO m =>
Array a -> (Ptr a -> m b) -> m b
A.asPtrUnsafe Array Word8
arr forall {b} {c} {d}.
(Storable b, Storable c, Num d) =>
Ptr Word8 -> IO (Word8, b, c, d)
readHeader
Array Word8
path <-
if Key
pathLen forall a. Eq a => a -> a -> Bool
/= Key
0
then do
Array Word8
pth <-
forall (m :: * -> *) a b.
MonadCatch m =>
Fold m a b -> Parser m a b
PR.fromFold
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Monad m =>
(a -> Bool) -> Fold m a b -> Fold m a b
FL.takeEndBy_ (forall a. Eq a => a -> a -> Bool
== Word8
0)
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Monad m =>
Key -> Fold m a b -> Fold m a b
FL.take Key
pathLen (forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Key -> Fold m a (Array a)
A.writeN Key
pathLen)
let remaining :: Key
remaining = Key
pathLen forall a. Num a => a -> a -> a
- forall a. Array a -> Key
byteLength Array Word8
pth forall a. Num a => a -> a -> a
- Key
1
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Key
remaining forall a. Eq a => a -> a -> Bool
/= Key
0) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
MonadCatch m =>
Key -> Fold m a b -> Parser m a b
PR.takeEQ Key
remaining forall (m :: * -> *) a. Monad m => Fold m a ()
FL.drain
forall (m :: * -> *) a. Monad m => a -> m a
return Array Word8
pth
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Storable a => [a] -> Array a
A.fromList []
IntMap (Array Word8, Array Word8)
wdm <- forall (m :: * -> *) b a. MonadCatch m => m b -> Parser m a b
PR.fromEffect forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef (IntMap (Array Word8, Array Word8))
wdMap
let (Array Word8
root, Array Word8
sub) =
case forall a. Key -> IntMap a -> Maybe a
Map.lookup (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
ewd) IntMap (Array Word8, Array Word8)
wdm of
Just (Array Word8, Array Word8)
pair -> (Array Word8, Array Word8)
pair
Maybe (Array Word8, Array Word8)
Nothing ->
forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"readOneEvent: "
forall a. Semigroup a => a -> a -> a
<> String
"Unknown watch descriptor: "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Word8
ewd
let sub1 :: Array Word8
sub1 = Array Word8 -> Array Word8 -> Array Word8
appendPaths Array Word8
sub Array Word8
path
isDirCreate :: Bool
isDirCreate = Word32
eflags forall a. Bits a => a -> a -> a
.&. Word32
iN_ISDIR forall a. Eq a => a -> a -> Bool
/= Word32
0 Bool -> Bool -> Bool
&& Word32
eflags forall a. Bits a => a -> a -> a
.&. Word32
iN_CREATE forall a. Eq a => a -> a -> Bool
/= Word32
0
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Config -> Bool
watchRec Config
cfg Bool -> Bool -> Bool
&& Bool
isDirCreate)
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b a. MonadCatch m => m b -> Parser m a b
PR.fromEffect forall a b. (a -> b) -> a -> b
$ Config -> Watch -> Array Word8 -> Array Word8 -> IO ()
addToWatch Config
cfg Watch
wt Array Word8
root Array Word8
sub1
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Event
{ eventWd :: CInt
eventWd = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
ewd
, eventFlags :: Word32
eventFlags = Word32
eflags
, eventCookie :: Word32
eventCookie = Word32
cookie
, eventRelPath :: Array Word8
eventRelPath = Array Word8
sub1
, eventMap :: IntMap (Array Word8, Array Word8)
eventMap = IntMap (Array Word8, Array Word8)
wdm
}
where
readHeader :: Ptr Word8 -> IO (Word8, b, c, d)
readHeader (Ptr Word8
ptr :: Ptr Word8) = do
let len :: Key
len = forall a. Storable a => a -> Key
sizeOf (forall a. HasCallStack => a
undefined :: CInt)
Word8
ewd <- forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
ptr
b
eflags <- forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr Word8
ptr Key
len
c
cookie <- forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr Word8
ptr (Key
len forall a. Num a => a -> a -> a
+ Key
4)
Word32
pathLen :: Word32 <- forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr Word8
ptr (Key
len forall a. Num a => a -> a -> a
+ Key
8)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8
ewd, b
eflags, c
cookie, forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
pathLen)
watchToStream :: Config -> Watch -> SerialT IO Event
watchToStream :: Config -> Watch -> SerialT IO Event
watchToStream Config
cfg wt :: Watch
wt@(Watch Handle
handle IORef (IntMap (Array Word8, Array Word8))
_) = do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(IsStream t, MonadThrow m) =>
Parser m a b -> t m a -> t m b
S.parseMany (Config -> Watch -> Parser IO Word8 Event
readOneEvent Config
cfg Watch
wt) forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(IsStream t, Monad m) =>
Unfold m a b -> a -> t m b
S.unfold forall (m :: * -> *). MonadIO m => Unfold m Handle Word8
FH.read Handle
handle
watchWith :: (Config -> Config) -> NonEmpty (Array Word8) -> SerialT IO Event
watchWith :: (Config -> Config) -> NonEmpty (Array Word8) -> SerialT IO Event
watchWith Config -> Config
f NonEmpty (Array Word8)
paths = forall (t :: (* -> *) -> * -> *) (m :: * -> *) b c a.
(IsStream t, MonadAsync m, MonadCatch m) =>
m b -> (b -> m c) -> (b -> t m a) -> t m a
S.bracket IO Watch
before Watch -> IO ()
after (Config -> Watch -> SerialT IO Event
watchToStream Config
cfg)
where
cfg :: Config
cfg = Config -> Config
f Config
defaultConfig
before :: IO Watch
before = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Config -> NonEmpty (Array Word8) -> IO Watch
openWatch Config
cfg NonEmpty (Array Word8)
paths
after :: Watch -> IO ()
after = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Watch -> IO ()
closeWatch
watchRecursive :: NonEmpty (Array Word8) -> SerialT IO Event
watchRecursive :: NonEmpty (Array Word8) -> SerialT IO Event
watchRecursive = (Config -> Config) -> NonEmpty (Array Word8) -> SerialT IO Event
watchWith (Switch -> Config -> Config
setRecursiveMode Switch
On)
watch :: NonEmpty (Array Word8) -> SerialT IO Event
watch :: NonEmpty (Array Word8) -> SerialT IO Event
watch = (Config -> Config) -> NonEmpty (Array Word8) -> SerialT IO Event
watchWith forall a. a -> a
id
getRoot :: Event -> Array Word8
getRoot :: Event -> Array Word8
getRoot Event{Word32
CInt
IntMap (Array Word8, Array Word8)
Array Word8
eventMap :: IntMap (Array Word8, Array Word8)
eventRelPath :: Array Word8
eventCookie :: Word32
eventFlags :: Word32
eventWd :: CInt
eventMap :: Event -> IntMap (Array Word8, Array Word8)
eventRelPath :: Event -> Array Word8
eventCookie :: Event -> Word32
eventFlags :: Event -> Word32
eventWd :: Event -> CInt
..} =
if CInt
eventWd forall a. Ord a => a -> a -> Bool
>= CInt
1
then
case forall a. Key -> IntMap a -> Maybe a
Map.lookup (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
eventWd) IntMap (Array Word8, Array Word8)
eventMap of
Just (Array Word8, Array Word8)
path -> forall a b. (a, b) -> a
fst (Array Word8, Array Word8)
path
Maybe (Array Word8, Array Word8)
Nothing ->
forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Bug: getRoot: No path found corresponding to the "
forall a. [a] -> [a] -> [a]
++ String
"watch descriptor " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CInt
eventWd
else forall a. Storable a => [a] -> Array a
A.fromList []
getRelPath :: Event -> Array Word8
getRelPath :: Event -> Array Word8
getRelPath Event{Word32
CInt
IntMap (Array Word8, Array Word8)
Array Word8
eventMap :: IntMap (Array Word8, Array Word8)
eventRelPath :: Array Word8
eventCookie :: Word32
eventFlags :: Word32
eventWd :: CInt
eventMap :: Event -> IntMap (Array Word8, Array Word8)
eventRelPath :: Event -> Array Word8
eventCookie :: Event -> Word32
eventFlags :: Event -> Word32
eventWd :: Event -> CInt
..} = Array Word8
eventRelPath
getAbsPath :: Event -> Array Word8
getAbsPath :: Event -> Array Word8
getAbsPath Event
ev =
let relpath :: Array Word8
relpath = Event -> Array Word8
getRelPath Event
ev
root :: Array Word8
root = Event -> Array Word8
getRoot Event
ev
in if forall a. Array a -> Key
byteLength Array Word8
relpath forall a. Eq a => a -> a -> Bool
/= Key
0
then Array Word8 -> Array Word8
ensureTrailingSlash Array Word8
root forall a. Semigroup a => a -> a -> a
<> Array Word8
relpath
else Array Word8 -> Array Word8
removeTrailingSlash Array Word8
root
getCookie :: Event -> Cookie
getCookie :: Event -> Cookie
getCookie Event{Word32
CInt
IntMap (Array Word8, Array Word8)
Array Word8
eventMap :: IntMap (Array Word8, Array Word8)
eventRelPath :: Array Word8
eventCookie :: Word32
eventFlags :: Word32
eventWd :: CInt
eventMap :: Event -> IntMap (Array Word8, Array Word8)
eventRelPath :: Event -> Array Word8
eventCookie :: Event -> Word32
eventFlags :: Event -> Word32
eventWd :: Event -> CInt
..} = Word32 -> Cookie
Cookie Word32
eventCookie
getFlag :: Word32 -> Event -> Bool
getFlag :: Word32 -> Event -> Bool
getFlag Word32
mask Event{Word32
CInt
IntMap (Array Word8, Array Word8)
Array Word8
eventMap :: IntMap (Array Word8, Array Word8)
eventRelPath :: Array Word8
eventCookie :: Word32
eventFlags :: Word32
eventWd :: CInt
eventMap :: Event -> IntMap (Array Word8, Array Word8)
eventRelPath :: Event -> Array Word8
eventCookie :: Event -> Word32
eventFlags :: Event -> Word32
eventWd :: Event -> CInt
..} = Word32
eventFlags forall a. Bits a => a -> a -> a
.&. Word32
mask forall a. Eq a => a -> a -> Bool
/= Word32
0
foreign import capi
"sys/inotify.h value IN_Q_OVERFLOW" iN_Q_OVERFLOW :: Word32
isEventsLost :: Event -> Bool
isEventsLost :: Event -> Bool
isEventsLost = Word32 -> Event -> Bool
getFlag Word32
iN_Q_OVERFLOW
foreign import capi
"sys/inotify.h value IN_IGNORED" iN_IGNORED :: Word32
isRootUnwatched :: Event -> Bool
isRootUnwatched :: Event -> Bool
isRootUnwatched = Word32 -> Event -> Bool
getFlag Word32
iN_IGNORED
isRootDeleted :: Event -> Bool
isRootDeleted :: Event -> Bool
isRootDeleted = Word32 -> Event -> Bool
getFlag Word32
iN_DELETE_SELF
isRootMoved :: Event -> Bool
isRootMoved :: Event -> Bool
isRootMoved = Word32 -> Event -> Bool
getFlag Word32
iN_MOVE_SELF
foreign import capi
"sys/inotify.h value IN_UNMOUNT" iN_UNMOUNT :: Word32
isRootUnmounted :: Event -> Bool
isRootUnmounted :: Event -> Bool
isRootUnmounted = Word32 -> Event -> Bool
getFlag Word32
iN_UNMOUNT
isRootPathEvent :: Event -> Bool
isRootPathEvent :: Event -> Bool
isRootPathEvent = Word32 -> Event -> Bool
getFlag (Word32
iN_DELETE_SELF forall a. Bits a => a -> a -> a
.|. Word32
iN_MOVE_SELF forall a. Bits a => a -> a -> a
.|. Word32
iN_UNMOUNT)
isAttrsModified :: Event -> Bool
isAttrsModified :: Event -> Bool
isAttrsModified = Word32 -> Event -> Bool
getFlag Word32
iN_ATTRIB
isAccessed :: Event -> Bool
isAccessed :: Event -> Bool
isAccessed = Word32 -> Event -> Bool
getFlag Word32
iN_ACCESS
isOpened :: Event -> Bool
isOpened :: Event -> Bool
isOpened = Word32 -> Event -> Bool
getFlag Word32
iN_OPEN
isWriteClosed :: Event -> Bool
isWriteClosed :: Event -> Bool
isWriteClosed = Word32 -> Event -> Bool
getFlag Word32
iN_CLOSE_WRITE
isNonWriteClosed :: Event -> Bool
isNonWriteClosed :: Event -> Bool
isNonWriteClosed = Word32 -> Event -> Bool
getFlag Word32
iN_CLOSE_NOWRITE
isCreated :: Event -> Bool
isCreated :: Event -> Bool
isCreated = Word32 -> Event -> Bool
getFlag Word32
iN_CREATE
isDeleted :: Event -> Bool
isDeleted :: Event -> Bool
isDeleted = Word32 -> Event -> Bool
getFlag Word32
iN_DELETE
isMovedFrom :: Event -> Bool
isMovedFrom :: Event -> Bool
isMovedFrom = Word32 -> Event -> Bool
getFlag Word32
iN_MOVED_FROM
isMovedTo :: Event -> Bool
isMovedTo :: Event -> Bool
isMovedTo = Word32 -> Event -> Bool
getFlag Word32
iN_MOVED_TO
isMoved :: Event -> Bool
isMoved :: Event -> Bool
isMoved Event
ev = Event -> Bool
isMovedFrom Event
ev Bool -> Bool -> Bool
|| Event -> Bool
isMovedTo Event
ev
isModified :: Event -> Bool
isModified :: Event -> Bool
isModified = Word32 -> Event -> Bool
getFlag Word32
iN_MODIFY
foreign import capi
"sys/inotify.h value IN_ISDIR" iN_ISDIR :: Word32
isDir :: Event -> Bool
isDir :: Event -> Bool
isDir = Word32 -> Event -> Bool
getFlag Word32
iN_ISDIR
showEvent :: Event -> String
showEvent :: Event -> String
showEvent ev :: Event
ev@Event{Word32
CInt
IntMap (Array Word8, Array Word8)
Array Word8
eventMap :: IntMap (Array Word8, Array Word8)
eventRelPath :: Array Word8
eventCookie :: Word32
eventFlags :: Word32
eventWd :: CInt
eventMap :: Event -> IntMap (Array Word8, Array Word8)
eventRelPath :: Event -> Array Word8
eventCookie :: Event -> Word32
eventFlags :: Event -> Word32
eventWd :: Event -> CInt
..} =
String
"--------------------------"
forall a. [a] -> [a] -> [a]
++ String
"\nWd = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CInt
eventWd
forall a. [a] -> [a] -> [a]
++ String
"\nRoot = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Array Word8 -> String
utf8ToString forall a b. (a -> b) -> a -> b
$ Event -> Array Word8
getRoot Event
ev)
forall a. [a] -> [a] -> [a]
++ String
"\nPath = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Array Word8 -> String
utf8ToString forall a b. (a -> b) -> a -> b
$ Event -> Array Word8
getRelPath Event
ev)
forall a. [a] -> [a] -> [a]
++ String
"\nCookie = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Event -> Cookie
getCookie Event
ev)
forall a. [a] -> [a] -> [a]
++ String
"\nFlags " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word32
eventFlags
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isEventsLost String
"Overflow"
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isRootUnwatched String
"RootUnwatched"
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isRootDeleted String
"RootDeleted"
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isRootMoved String
"RootMoved"
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isRootUnmounted String
"RootUnmounted"
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isAttrsModified String
"AttrsModified"
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isAccessed String
"Accessed"
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isOpened String
"Opened"
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isWriteClosed String
"WriteClosed"
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isNonWriteClosed String
"NonWriteClosed"
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isCreated String
"Created"
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isDeleted String
"Deleted"
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isModified String
"Modified"
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isMovedFrom String
"MovedFrom"
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isMovedTo String
"MovedTo"
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isDir String
"Dir"
forall a. [a] -> [a] -> [a]
++ String
"\n"
where showev :: (Event -> Bool) -> ShowS
showev Event -> Bool
f String
str = if Event -> Bool
f Event
ev then String
"\n" forall a. [a] -> [a] -> [a]
++ String
str else String
""
#else
#warning "Disabling module Streamly.Internal.FileSystem.Event.Linux. Does not support kernels older than 2.6.36."
module Streamly.Internal.FileSystem.Event.Linux () where
#endif