#include "config.h"
#if HAVE_DECL_IN_EXCL_UNLINK
module Streamly.Internal.FS.Event.Linux
(
Config (..)
, 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 Data.Bits ((.|.), (.&.), complement)
import Data.Foldable (foldlM)
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, FD(..))
import GHC.IO.Handle.FD (mkHandleFromFD)
import Streamly.Data.Stream (Stream)
import Streamly.Data.Parser (Parser)
import System.Directory (doesDirectoryExist)
import System.IO (Handle, hClose, IOMode(ReadMode))
import GHC.IO.Handle.FD (handleToFd)
import Streamly.Internal.Data.Array (byteLength)
import Streamly.Internal.FileSystem.Path (Path)
import qualified Data.IntMap.Lazy as Map
import qualified Data.List.NonEmpty as NonEmpty
import qualified Streamly.Data.Fold as FL
import qualified Streamly.Data.Array as A (createOf)
import qualified Streamly.Data.Stream as S
import qualified Streamly.FileSystem.Handle as FH
import qualified Streamly.Internal.FileSystem.Path as Path
import qualified Streamly.Internal.Data.Array as A
( asCStringUnsafe, unsafePinnedAsPtr
)
import qualified Streamly.Internal.FileSystem.DirIO as Dir (readDirs)
import qualified Streamly.Internal.Data.Parser as PR
(takeEQ, fromEffect, fromFold)
data Config = Config
{ Config -> Bool
watchRec :: Bool
, Config -> Word32
createFlags :: Word32
}
setFlag :: Word32 -> Bool -> Config -> Config
setFlag :: Word32 -> Bool -> Config -> Config
setFlag Word32
mask Bool
status cfg :: Config
cfg@Config{Bool
Word32
watchRec :: Config -> Bool
createFlags :: Config -> Word32
watchRec :: Bool
createFlags :: Word32
..} =
let flags :: Word32
flags =
if Bool
status
then Word32
createFlags Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
mask
else Word32
createFlags Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32 -> Word32
forall a. Bits a => a -> a
complement Word32
mask
in Config
cfg {createFlags :: Word32
createFlags = Word32
flags}
setRecursiveMode :: Bool -> Config -> Config
setRecursiveMode :: Bool -> Config -> Config
setRecursiveMode Bool
recursive cfg :: Config
cfg@Config{} = Config
cfg {watchRec :: Bool
watchRec = Bool
recursive}
foreign import capi
"sys/inotify.h value IN_DONT_FOLLOW" iN_DONT_FOLLOW :: Word32
setFollowSymLinks :: Bool -> Config -> Config
setFollowSymLinks :: Bool -> Config -> Config
setFollowSymLinks Bool
s = Word32 -> Bool -> Config -> Config
setFlag Word32
iN_DONT_FOLLOW (Bool -> Bool
not Bool
s)
foreign import capi
"sys/inotify.h value IN_EXCL_UNLINK" iN_EXCL_UNLINK :: Word32
setUnwatchMoved :: Bool -> Config -> Config
setUnwatchMoved :: Bool -> Config -> Config
setUnwatchMoved = Word32 -> Bool -> 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 -> Bool -> Config -> Config
setFlag Word32
iN_MASK_ADD Bool
True Config
cfg
WhenExists
ReplaceIfExists -> Word32 -> Bool -> Config -> Config
setFlag Word32
iN_MASK_ADD Bool
False Config
cfg
#if HAVE_DECL_IN_MASK_CREATE
WhenExists
FailIfExists -> Word32 -> Bool -> Config -> Config
setFlag Word32
iN_MASK_CREATE Bool
True Config
cfg
#endif
foreign import capi
"sys/inotify.h value IN_ONESHOT" iN_ONESHOT :: Word32
setOneShot :: Bool -> Config -> Config
setOneShot :: Bool -> Config -> Config
setOneShot = Word32 -> Bool -> Config -> Config
setFlag Word32
iN_ONESHOT
foreign import capi
"sys/inotify.h value IN_ONLYDIR" iN_ONLYDIR :: Word32
setOnlyDir :: Bool -> Config -> Config
setOnlyDir :: Bool -> Config -> Config
setOnlyDir = Word32 -> Bool -> Config -> Config
setFlag Word32
iN_ONLYDIR
foreign import capi
"sys/inotify.h value IN_DELETE_SELF" iN_DELETE_SELF :: Word32
setRootDeleted :: Bool -> Config -> Config
setRootDeleted :: Bool -> Config -> Config
setRootDeleted = Word32 -> Bool -> Config -> Config
setFlag Word32
iN_DELETE_SELF
foreign import capi
"sys/inotify.h value IN_MOVE_SELF" iN_MOVE_SELF :: Word32
setRootMoved :: Bool -> Config -> Config
setRootMoved :: Bool -> Config -> Config
setRootMoved = Word32 -> Bool -> Config -> Config
setFlag Word32
iN_MOVE_SELF
setRootPathEvents :: Bool -> Config -> Config
setRootPathEvents :: Bool -> Config -> Config
setRootPathEvents = Word32 -> Bool -> Config -> Config
setFlag (Word32
iN_DELETE_SELF Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
iN_MOVE_SELF)
foreign import capi
"sys/inotify.h value IN_ATTRIB" iN_ATTRIB :: Word32
setAttrsModified :: Bool -> Config -> Config
setAttrsModified :: Bool -> Config -> Config
setAttrsModified = Word32 -> Bool -> Config -> Config
setFlag Word32
iN_ATTRIB
foreign import capi
"sys/inotify.h value IN_ACCESS" iN_ACCESS :: Word32
setAccessed :: Bool -> Config -> Config
setAccessed :: Bool -> Config -> Config
setAccessed = Word32 -> Bool -> Config -> Config
setFlag Word32
iN_ACCESS
foreign import capi
"sys/inotify.h value IN_OPEN" iN_OPEN :: Word32
setOpened :: Bool -> Config -> Config
setOpened :: Bool -> Config -> Config
setOpened = Word32 -> Bool -> Config -> Config
setFlag Word32
iN_OPEN
foreign import capi
"sys/inotify.h value IN_CLOSE_WRITE" iN_CLOSE_WRITE :: Word32
setWriteClosed :: Bool -> Config -> Config
setWriteClosed :: Bool -> Config -> Config
setWriteClosed = Word32 -> Bool -> Config -> Config
setFlag Word32
iN_CLOSE_WRITE
foreign import capi
"sys/inotify.h value IN_CLOSE_NOWRITE" iN_CLOSE_NOWRITE :: Word32
setNonWriteClosed :: Bool -> Config -> Config
setNonWriteClosed :: Bool -> Config -> Config
setNonWriteClosed = Word32 -> Bool -> Config -> Config
setFlag Word32
iN_CLOSE_NOWRITE
foreign import capi
"sys/inotify.h value IN_CREATE" iN_CREATE :: Word32
setCreated :: Bool -> Config -> Config
setCreated :: Bool -> Config -> Config
setCreated = Word32 -> Bool -> Config -> Config
setFlag Word32
iN_CREATE
foreign import capi
"sys/inotify.h value IN_DELETE" iN_DELETE :: Word32
setDeleted :: Bool -> Config -> Config
setDeleted :: Bool -> Config -> Config
setDeleted = Word32 -> Bool -> Config -> Config
setFlag Word32
iN_DELETE
foreign import capi
"sys/inotify.h value IN_MOVED_FROM" iN_MOVED_FROM :: Word32
setMovedFrom :: Bool -> Config -> Config
setMovedFrom :: Bool -> Config -> Config
setMovedFrom = Word32 -> Bool -> Config -> Config
setFlag Word32
iN_MOVED_FROM
foreign import capi
"sys/inotify.h value IN_MOVED_TO" iN_MOVED_TO :: Word32
setMovedTo :: Bool -> Config -> Config
setMovedTo :: Bool -> Config -> Config
setMovedTo = Word32 -> Bool -> Config -> Config
setFlag Word32
iN_MOVED_TO
foreign import capi
"sys/inotify.h value IN_MODIFY" iN_MODIFY :: Word32
setModified :: Bool -> Config -> Config
setModified :: Bool -> Config -> Config
setModified = Word32 -> Bool -> Config -> Config
setFlag Word32
iN_MODIFY
setAllEvents :: Bool -> Config -> Config
setAllEvents :: Bool -> Config -> Config
setAllEvents Bool
s =
Bool -> Config -> Config
setRootDeleted Bool
s
(Config -> Config) -> (Config -> Config) -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Config -> Config
setRootMoved Bool
s
(Config -> Config) -> (Config -> Config) -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Config -> Config
setAttrsModified Bool
s
(Config -> Config) -> (Config -> Config) -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Config -> Config
setAccessed Bool
s
(Config -> Config) -> (Config -> Config) -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Config -> Config
setOpened Bool
s
(Config -> Config) -> (Config -> Config) -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Config -> Config
setWriteClosed Bool
s
(Config -> Config) -> (Config -> Config) -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Config -> Config
setNonWriteClosed Bool
s
(Config -> Config) -> (Config -> Config) -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Config -> Config
setCreated Bool
s
(Config -> Config) -> (Config -> Config) -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Config -> Config
setDeleted Bool
s
(Config -> Config) -> (Config -> Config) -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Config -> Config
setMovedFrom Bool
s
(Config -> Config) -> (Config -> Config) -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Config -> Config
setMovedTo Bool
s
(Config -> Config) -> (Config -> Config) -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Config -> Config
setModified Bool
s
defaultConfig :: Config
defaultConfig :: Config
defaultConfig =
WhenExists -> Config -> Config
setWhenExists WhenExists
AddIfExists
(Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Bool -> Config -> Config
setCreated Bool
True
(Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Bool -> Config -> Config
setDeleted Bool
True
(Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Bool -> Config -> Config
setMovedFrom Bool
True
(Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Bool -> Config -> Config
setMovedTo Bool
True
(Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Bool -> Config -> Config
setModified Bool
True
(Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Config
{ watchRec :: Bool
watchRec = Bool
False
, createFlags :: Word32
createFlags = Word32
0
}
type PathRep =
( Path
, Maybe Path
)
{-# INLINE combinePathRep #-}
combinePathRep :: PathRep -> Path
combinePathRep :: PathRep -> PosixPath
combinePathRep (PosixPath
root, Maybe PosixPath
Nothing) = PosixPath
root
combinePathRep (PosixPath
root, Just PosixPath
sub) = PosixPath -> PosixPath -> PosixPath
Path.append PosixPath
root PosixPath
sub
{-# INLINE addSub #-}
addSub :: PathRep -> Path -> PathRep
addSub :: PathRep -> PosixPath -> PathRep
addSub (PosixPath
root, Maybe PosixPath
Nothing) PosixPath
sub = (PosixPath
root, PosixPath -> Maybe PosixPath
forall a. a -> Maybe a
Just PosixPath
sub)
addSub (PosixPath
root, Just PosixPath
sub0) PosixPath
sub1 = (PosixPath
root, PosixPath -> Maybe PosixPath
forall a. a -> Maybe a
Just (PosixPath -> PosixPath -> PosixPath
Path.append PosixPath
sub0 PosixPath
sub1))
{-# INLINE getRepRoot #-}
getRepRoot :: PathRep -> Path
getRepRoot :: PathRep -> PosixPath
getRepRoot = PathRep -> PosixPath
forall a b. (a, b) -> a
fst
{-# INLINE getRepSub #-}
getRepSub :: PathRep -> Maybe Path
getRepSub :: PathRep -> Maybe PosixPath
getRepSub = PathRep -> Maybe PosixPath
forall a b. (a, b) -> b
snd
data Watch =
Watch
Handle
(IORef
(IntMap
PathRep
)
)
newtype WD = WD CInt deriving Key -> WD -> ShowS
[WD] -> ShowS
WD -> [Char]
(Key -> WD -> ShowS)
-> (WD -> [Char]) -> ([WD] -> ShowS) -> Show WD
forall a.
(Key -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Key -> WD -> ShowS
showsPrec :: Key -> WD -> ShowS
$cshow :: WD -> [Char]
show :: WD -> [Char]
$cshowList :: [WD] -> ShowS
showList :: [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 <- [Char] -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => [Char] -> IO a -> IO a
throwErrnoIfMinus1 [Char]
"createWatch" IO CInt
c_inotify_init
let fd :: FD
fd =
FD
{ fdFD :: CInt
fdFD = CInt
rawfd
#if !defined(mingw32_HOST_OS)
, fdIsNonBlocking :: Key
fdIsNonBlocking = Key
0
#else
, fdIsSocket_ = 0
#endif
}
Handle
h <-
FD
-> IODeviceType
-> [Char]
-> IOMode
-> Bool
-> Maybe TextEncoding
-> IO Handle
mkHandleFromFD
FD
fd
IODeviceType
Stream
([Char]
"<createWatch fd: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ FD -> [Char]
forall a. Show a => a -> [Char]
show FD
fd [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
">")
IOMode
ReadMode
Bool
False
Maybe TextEncoding
forall a. Maybe a
Nothing
IORef (IntMap PathRep)
emptyMapRef <- IntMap PathRep -> IO (IORef (IntMap PathRep))
forall a. a -> IO (IORef a)
newIORef IntMap PathRep
forall a. IntMap a
Map.empty
Watch -> IO Watch
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Watch -> IO Watch) -> Watch -> IO Watch
forall a b. (a -> b) -> a -> b
$ Handle -> IORef (IntMap PathRep) -> Watch
Watch Handle
h IORef (IntMap PathRep)
emptyMapRef
foreign import ccall unsafe
"sys/inotify.h inotify_add_watch" c_inotify_add_watch
:: CInt -> CString -> CUInt -> IO CInt
addToWatch :: Config -> Watch -> PathRep -> IO ()
addToWatch :: Config -> Watch -> PathRep -> IO ()
addToWatch cfg :: Config
cfg@Config{Bool
Word32
watchRec :: Config -> Bool
createFlags :: Config -> Word32
watchRec :: Bool
createFlags :: Word32
..} watch0 :: Watch
watch0@(Watch Handle
handle IORef (IntMap PathRep)
wdMap) PathRep
prep = do
let absPath :: PosixPath
absPath = PathRep -> PosixPath
combinePathRep PathRep
prep
FD
fd <- Handle -> IO FD
handleToFd Handle
handle
CInt
wd <- Array Word8 -> (CString -> IO CInt) -> IO CInt
forall a b. Array a -> (CString -> IO b) -> IO b
A.asCStringUnsafe (PosixPath -> Array Word8
forall a. IsPath PosixPath a => a -> Array Word8
Path.toChunk PosixPath
absPath) ((CString -> IO CInt) -> IO CInt)
-> (CString -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \CString
pathPtr ->
[Char] -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => [Char] -> IO a -> IO a
throwErrnoIfMinus1 ([Char]
"addToWatch: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ PosixPath -> [Char]
forall a. IsPath PosixPath a => a -> [Char]
Path.toString PosixPath
absPath) (IO CInt -> IO CInt) -> IO CInt -> IO CInt
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)
IORef (IntMap PathRep)
-> (IntMap PathRep -> IntMap PathRep) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef (IntMap PathRep)
wdMap (Key -> PathRep -> IntMap PathRep -> IntMap PathRep
forall a. Key -> a -> IntMap a -> IntMap a
Map.insert (CInt -> Key
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
wd) PathRep
prep)
Bool
pathIsDir <- [Char] -> IO Bool
doesDirectoryExist (PosixPath -> [Char]
forall a. IsPath PosixPath a => a -> [Char]
Path.toString PosixPath
absPath)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
watchRec Bool -> Bool -> Bool
&& Bool
pathIsDir) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let f :: PosixPath -> IO ()
f = Config -> Watch -> PathRep -> IO ()
addToWatch Config
cfg Watch
watch0 (PathRep -> IO ()) -> (PosixPath -> PathRep) -> PosixPath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathRep -> PosixPath -> PathRep
addSub PathRep
prep
in Fold IO PosixPath () -> Stream IO PosixPath -> IO ()
forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Stream m a -> m b
S.fold ((PosixPath -> IO ()) -> Fold IO PosixPath ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Fold m a ()
FL.drainMapM PosixPath -> IO ()
f) (Stream IO PosixPath -> IO ()) -> Stream IO PosixPath -> IO ()
forall a b. (a -> b) -> a -> b
$ PosixPath -> Stream IO PosixPath
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
PosixPath -> Stream m PosixPath
Dir.readDirs PosixPath
absPath
foreign import ccall unsafe
"sys/inotify.h inotify_rm_watch" c_inotify_rm_watch
:: CInt -> CInt -> IO CInt
removeFromWatch :: Watch -> Path -> IO ()
removeFromWatch :: Watch -> PosixPath -> IO ()
removeFromWatch (Watch Handle
handle IORef (IntMap PathRep)
wdMap) PosixPath
root = do
FD
fd <- Handle -> IO FD
handleToFd Handle
handle
IntMap PathRep
km <- IORef (IntMap PathRep) -> IO (IntMap PathRep)
forall a. IORef a -> IO a
readIORef IORef (IntMap PathRep)
wdMap
IntMap PathRep
wdMap1 <- (IntMap PathRep -> (Key, PathRep) -> IO (IntMap PathRep))
-> IntMap PathRep -> [(Key, PathRep)] -> IO (IntMap PathRep)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM (FD -> IntMap PathRep -> (Key, PathRep) -> IO (IntMap PathRep)
step FD
fd) IntMap PathRep
forall a. IntMap a
Map.empty (IntMap PathRep -> [(Key, PathRep)]
forall a. IntMap a -> [(Key, a)]
Map.toList IntMap PathRep
km)
IORef (IntMap PathRep) -> IntMap PathRep -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (IntMap PathRep)
wdMap IntMap PathRep
wdMap1
where
step :: FD -> IntMap PathRep -> (Key, PathRep) -> IO (IntMap PathRep)
step FD
fd IntMap PathRep
newMap (Key
wd, PathRep
v) = do
if PosixPath -> Array Word8
forall a. IsPath PosixPath a => a -> Array Word8
Path.toChunk (PathRep -> PosixPath
getRepRoot PathRep
v) Array Word8 -> Array Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== PosixPath -> Array Word8
forall a. IsPath PosixPath a => a -> Array Word8
Path.toChunk PosixPath
root
then do
let err :: [Char]
err = [Char]
"removeFromWatch: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show (PosixPath -> [Char]
forall a. IsPath PosixPath a => a -> [Char]
Path.toString PosixPath
root)
rm :: IO CInt
rm = CInt -> CInt -> IO CInt
c_inotify_rm_watch (FD -> CInt
fdFD FD
fd) (Key -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Key
wd)
IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => [Char] -> IO a -> IO a
throwErrnoIfMinus1 [Char]
err IO CInt
rm
IntMap PathRep -> IO (IntMap PathRep)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IntMap PathRep
newMap
else IntMap PathRep -> IO (IntMap PathRep)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IntMap PathRep -> IO (IntMap PathRep))
-> IntMap PathRep -> IO (IntMap PathRep)
forall a b. (a -> b) -> a -> b
$ Key -> PathRep -> IntMap PathRep -> IntMap PathRep
forall a. Key -> a -> IntMap a -> IntMap a
Map.insert Key
wd PathRep
v IntMap PathRep
newMap
openWatch :: Config -> NonEmpty Path -> IO Watch
openWatch :: Config -> NonEmpty PosixPath -> IO Watch
openWatch Config
cfg NonEmpty PosixPath
paths = do
Watch
w <- IO Watch
createWatch
(PosixPath -> IO ()) -> [PosixPath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\PosixPath
root -> Config -> Watch -> PathRep -> IO ()
addToWatch Config
cfg Watch
w (PosixPath
root, Maybe PosixPath
forall a. Maybe a
Nothing)) ([PosixPath] -> IO ()) -> [PosixPath] -> IO ()
forall a b. (a -> b) -> a -> b
$ NonEmpty PosixPath -> [PosixPath]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty PosixPath
paths
Watch -> IO Watch
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Watch
w
closeWatch :: Watch -> IO ()
closeWatch :: Watch -> IO ()
closeWatch (Watch Handle
h IORef (IntMap PathRep)
_) = Handle -> IO ()
hClose Handle
h
newtype Cookie = Cookie Word32 deriving (Key -> Cookie -> ShowS
[Cookie] -> ShowS
Cookie -> [Char]
(Key -> Cookie -> ShowS)
-> (Cookie -> [Char]) -> ([Cookie] -> ShowS) -> Show Cookie
forall a.
(Key -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Key -> Cookie -> ShowS
showsPrec :: Key -> Cookie -> ShowS
$cshow :: Cookie -> [Char]
show :: Cookie -> [Char]
$cshowList :: [Cookie] -> ShowS
showList :: [Cookie] -> ShowS
Show, Cookie -> Cookie -> Bool
(Cookie -> Cookie -> Bool)
-> (Cookie -> Cookie -> Bool) -> Eq Cookie
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cookie -> Cookie -> Bool
== :: Cookie -> Cookie -> Bool
$c/= :: Cookie -> Cookie -> Bool
/= :: Cookie -> Cookie -> Bool
Eq)
data Event = Event
{ Event -> CInt
eventWd :: CInt
, Event -> Word32
eventFlags :: Word32
, Event -> Word32
eventCookie :: Word32
, Event -> Maybe PosixPath
eventRelPath :: Maybe Path
, Event -> IntMap PathRep
eventMap :: IntMap PathRep
}
readOneEvent :: Config -> Watch -> Parser Word8 IO Event
readOneEvent :: Config -> Watch -> Parser Word8 IO Event
readOneEvent Config
cfg wt :: Watch
wt@(Watch Handle
_ IORef (IntMap PathRep)
wdMap) = do
let headerLen :: Key
headerLen = CInt -> Key
forall a. Storable a => a -> Key
sizeOf (CInt
forall a. HasCallStack => a
undefined :: CInt) Key -> Key -> Key
forall a. Num a => a -> a -> a
+ Key
12
Array Word8
arr <- Key -> Fold IO Word8 (Array Word8) -> Parser Word8 IO (Array Word8)
forall (m :: * -> *) a b.
Monad m =>
Key -> Fold m a b -> Parser a m b
PR.takeEQ Key
headerLen (Key -> Fold IO Word8 (Array Word8)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Key -> Fold m a (Array a)
A.createOf Key
headerLen)
(Word8
ewd, Word32
eflags, Word32
cookie, Key
pathLen) <- IO (Word8, Word32, Word32, Key)
-> Parser Word8 IO (Word8, Word32, Word32, Key)
forall (m :: * -> *) b a. Monad m => m b -> Parser a m b
PR.fromEffect (IO (Word8, Word32, Word32, Key)
-> Parser Word8 IO (Word8, Word32, Word32, Key))
-> IO (Word8, Word32, Word32, Key)
-> Parser Word8 IO (Word8, Word32, Word32, Key)
forall a b. (a -> b) -> a -> b
$ Array Word8
-> (Ptr Word8 -> Key -> IO (Word8, Word32, Word32, Key))
-> IO (Word8, Word32, Word32, Key)
forall (m :: * -> *) a b.
MonadIO m =>
Array a -> (Ptr a -> Key -> IO b) -> m b
A.unsafePinnedAsPtr Array Word8
arr Ptr Word8 -> Key -> IO (Word8, Word32, Word32, Key)
forall {b} {c} {d} {p}.
(Storable b, Storable c, Num d) =>
Ptr Word8 -> p -> IO (Word8, b, c, d)
readHeader
IntMap PathRep
wdm <- IO (IntMap PathRep) -> Parser Word8 IO (IntMap PathRep)
forall (m :: * -> *) b a. Monad m => m b -> Parser a m b
PR.fromEffect (IO (IntMap PathRep) -> Parser Word8 IO (IntMap PathRep))
-> IO (IntMap PathRep) -> Parser Word8 IO (IntMap PathRep)
forall a b. (a -> b) -> a -> b
$ IORef (IntMap PathRep) -> IO (IntMap PathRep)
forall a. IORef a -> IO a
readIORef IORef (IntMap PathRep)
wdMap
let prep :: PathRep
prep =
case Key -> IntMap PathRep -> Maybe PathRep
forall a. Key -> IntMap a -> Maybe a
Map.lookup (Word8 -> Key
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
ewd) IntMap PathRep
wdm of
Just PathRep
prep0 -> PathRep
prep0
Maybe PathRep
Nothing ->
[Char] -> PathRep
forall a. HasCallStack => [Char] -> a
error ([Char] -> PathRep) -> [Char] -> PathRep
forall a b. (a -> b) -> a -> b
$ [Char]
"readOneEvent: "
[Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"Unknown watch descriptor: "
[Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
ewd
PathRep
prep1 <-
if Key
pathLen Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
/= Key
0
then do
Array Word8
pth <-
Fold IO Word8 (Array Word8) -> Parser Word8 IO (Array Word8)
forall (m :: * -> *) a b. Monad m => Fold m a b -> Parser a m b
PR.fromFold
(Fold IO Word8 (Array Word8) -> Parser Word8 IO (Array Word8))
-> Fold IO Word8 (Array Word8) -> Parser Word8 IO (Array Word8)
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool)
-> Fold IO Word8 (Array Word8) -> Fold IO Word8 (Array Word8)
forall (m :: * -> *) a b.
Monad m =>
(a -> Bool) -> Fold m a b -> Fold m a b
FL.takeEndBy_ (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0)
(Fold IO Word8 (Array Word8) -> Fold IO Word8 (Array Word8))
-> Fold IO Word8 (Array Word8) -> Fold IO Word8 (Array Word8)
forall a b. (a -> b) -> a -> b
$ Key -> Fold IO Word8 (Array Word8) -> Fold IO Word8 (Array Word8)
forall (m :: * -> *) a b.
Monad m =>
Key -> Fold m a b -> Fold m a b
FL.take Key
pathLen (Key -> Fold IO Word8 (Array Word8)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Key -> Fold m a (Array a)
A.createOf Key
pathLen)
let remaining :: Key
remaining = Key
pathLen Key -> Key -> Key
forall a. Num a => a -> a -> a
- Array Word8 -> Key
forall a. Array a -> Key
byteLength Array Word8
pth Key -> Key -> Key
forall a. Num a => a -> a -> a
- Key
1
Bool -> Parser Word8 IO () -> Parser Word8 IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Key
remaining Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
/= Key
0) (Parser Word8 IO () -> Parser Word8 IO ())
-> Parser Word8 IO () -> Parser Word8 IO ()
forall a b. (a -> b) -> a -> b
$ Key -> Fold IO Word8 () -> Parser Word8 IO ()
forall (m :: * -> *) a b.
Monad m =>
Key -> Fold m a b -> Parser a m b
PR.takeEQ Key
remaining Fold IO Word8 ()
forall (m :: * -> *) a. Monad m => Fold m a ()
FL.drain
PathRep -> Parser Word8 IO PathRep
forall a. a -> Parser Word8 IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PathRep -> Parser Word8 IO PathRep)
-> PathRep -> Parser Word8 IO PathRep
forall a b. (a -> b) -> a -> b
$ PathRep -> PosixPath -> PathRep
addSub PathRep
prep (Array Word8 -> PosixPath
forall a. IsPath PosixPath a => Array Word8 -> a
Path.unsafeFromChunk Array Word8
pth)
else PathRep -> Parser Word8 IO PathRep
forall a. a -> Parser Word8 IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PathRep -> Parser Word8 IO PathRep)
-> PathRep -> Parser Word8 IO PathRep
forall a b. (a -> b) -> a -> b
$ PathRep
prep
let isDirCreate :: Bool
isDirCreate = Word32
eflags Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
iN_ISDIR Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0 Bool -> Bool -> Bool
&& Word32
eflags Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
iN_CREATE Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0
Bool -> Parser Word8 IO () -> Parser Word8 IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Config -> Bool
watchRec Config
cfg Bool -> Bool -> Bool
&& Bool
isDirCreate)
(Parser Word8 IO () -> Parser Word8 IO ())
-> Parser Word8 IO () -> Parser Word8 IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> Parser Word8 IO ()
forall (m :: * -> *) b a. Monad m => m b -> Parser a m b
PR.fromEffect (IO () -> Parser Word8 IO ()) -> IO () -> Parser Word8 IO ()
forall a b. (a -> b) -> a -> b
$ Config -> Watch -> PathRep -> IO ()
addToWatch Config
cfg Watch
wt PathRep
prep1
Event -> Parser Word8 IO Event
forall a. a -> Parser Word8 IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Event -> Parser Word8 IO Event) -> Event -> Parser Word8 IO Event
forall a b. (a -> b) -> a -> b
$ Event
{ eventWd :: CInt
eventWd = Word8 -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
ewd
, eventFlags :: Word32
eventFlags = Word32
eflags
, eventCookie :: Word32
eventCookie = Word32
cookie
, eventRelPath :: Maybe PosixPath
eventRelPath = PathRep -> Maybe PosixPath
getRepSub PathRep
prep1
, eventMap :: IntMap PathRep
eventMap = IntMap PathRep
wdm
}
where
readHeader :: Ptr Word8 -> p -> IO (Word8, b, c, d)
readHeader (Ptr Word8
ptr :: Ptr Word8) p
_ = do
let len :: Key
len = CInt -> Key
forall a. Storable a => a -> Key
sizeOf (CInt
forall a. HasCallStack => a
undefined :: CInt)
Word8
ewd <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
ptr
b
eflags <- Ptr Word8 -> Key -> IO b
forall b. Ptr b -> Key -> IO b
forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr Word8
ptr Key
len
c
cookie <- Ptr Word8 -> Key -> IO c
forall b. Ptr b -> Key -> IO c
forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr Word8
ptr (Key
len Key -> Key -> Key
forall a. Num a => a -> a -> a
+ Key
4)
Word32
pathLen :: Word32 <- Ptr Word8 -> Key -> IO Word32
forall b. Ptr b -> Key -> IO Word32
forall a b. Storable a => Ptr b -> Key -> IO a
peekByteOff Ptr Word8
ptr (Key
len Key -> Key -> Key
forall a. Num a => a -> a -> a
+ Key
8)
(Word8, b, c, d) -> IO (Word8, b, c, d)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8
ewd, b
eflags, c
cookie, Word32 -> d
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
pathLen)
watchToStream :: Config -> Watch -> Stream IO Event
watchToStream :: Config -> Watch -> Stream IO Event
watchToStream Config
cfg wt :: Watch
wt@(Watch Handle
handle IORef (IntMap PathRep)
_) = do
Stream IO (Either ParseError Event) -> Stream IO Event
forall (m :: * -> *) a b.
Monad m =>
Stream m (Either a b) -> Stream m b
S.catRights (Stream IO (Either ParseError Event) -> Stream IO Event)
-> Stream IO (Either ParseError Event) -> Stream IO Event
forall a b. (a -> b) -> a -> b
$ Parser Word8 IO Event
-> Stream IO Word8 -> Stream IO (Either ParseError Event)
forall (m :: * -> *) a b.
Monad m =>
Parser a m b -> Stream m a -> Stream m (Either ParseError b)
S.parseMany (Config -> Watch -> Parser Word8 IO Event
readOneEvent Config
cfg Watch
wt) (Stream IO Word8 -> Stream IO (Either ParseError Event))
-> Stream IO Word8 -> Stream IO (Either ParseError Event)
forall a b. (a -> b) -> a -> b
$ Unfold IO Handle Word8 -> Handle -> Stream IO Word8
forall (m :: * -> *) a b.
Applicative m =>
Unfold m a b -> a -> Stream m b
S.unfold Unfold IO Handle Word8
forall (m :: * -> *). MonadIO m => Unfold m Handle Word8
FH.reader Handle
handle
watchWith :: (Config -> Config) -> NonEmpty Path -> Stream IO Event
watchWith :: (Config -> Config) -> NonEmpty PosixPath -> Stream IO Event
watchWith Config -> Config
f NonEmpty PosixPath
paths = IO Watch
-> (Watch -> IO ())
-> (Watch -> Stream IO Event)
-> Stream IO Event
forall (m :: * -> *) b c a.
(MonadIO m, MonadCatch m) =>
IO b -> (b -> IO c) -> (b -> Stream m a) -> Stream m a
S.bracketIO IO Watch
before Watch -> IO ()
after (Config -> Watch -> Stream IO Event
watchToStream Config
cfg)
where
cfg :: Config
cfg = Config -> Config
f Config
defaultConfig
before :: IO Watch
before = Config -> NonEmpty PosixPath -> IO Watch
openWatch Config
cfg NonEmpty PosixPath
paths
after :: Watch -> IO ()
after = Watch -> IO ()
closeWatch
watchRecursive :: NonEmpty Path -> Stream IO Event
watchRecursive :: NonEmpty PosixPath -> Stream IO Event
watchRecursive = (Config -> Config) -> NonEmpty PosixPath -> Stream IO Event
watchWith (Bool -> Config -> Config
setRecursiveMode Bool
True)
watch :: NonEmpty Path -> Stream IO Event
watch :: NonEmpty PosixPath -> Stream IO Event
watch = (Config -> Config) -> NonEmpty PosixPath -> Stream IO Event
watchWith Config -> Config
forall a. a -> a
id
getRoot :: Event -> Path
getRoot :: Event -> PosixPath
getRoot Event{Maybe PosixPath
Word32
CInt
IntMap PathRep
eventWd :: Event -> CInt
eventFlags :: Event -> Word32
eventCookie :: Event -> Word32
eventRelPath :: Event -> Maybe PosixPath
eventMap :: Event -> IntMap PathRep
eventWd :: CInt
eventFlags :: Word32
eventCookie :: Word32
eventRelPath :: Maybe PosixPath
eventMap :: IntMap PathRep
..} =
if CInt
eventWd CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
>= CInt
1
then
case Key -> IntMap PathRep -> Maybe PathRep
forall a. Key -> IntMap a -> Maybe a
Map.lookup (CInt -> Key
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
eventWd) IntMap PathRep
eventMap of
Just PathRep
prep -> PathRep -> PosixPath
getRepRoot PathRep
prep
Maybe PathRep
Nothing ->
[Char] -> PosixPath
forall a. HasCallStack => [Char] -> a
error ([Char] -> PosixPath) -> [Char] -> PosixPath
forall a b. (a -> b) -> a -> b
$ [Char]
"Bug: getRoot: No path found corresponding to the "
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"watch descriptor " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
eventWd
else [Char] -> PosixPath
forall a. HasCallStack => [Char] -> a
error ([Char] -> PosixPath) -> [Char] -> PosixPath
forall a b. (a -> b) -> a -> b
$ [Char]
"getRoot: ewd = " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
eventWd
getRelPath :: Event -> Maybe Path
getRelPath :: Event -> Maybe PosixPath
getRelPath Event{Maybe PosixPath
Word32
CInt
IntMap PathRep
eventWd :: Event -> CInt
eventFlags :: Event -> Word32
eventCookie :: Event -> Word32
eventRelPath :: Event -> Maybe PosixPath
eventMap :: Event -> IntMap PathRep
eventWd :: CInt
eventFlags :: Word32
eventCookie :: Word32
eventRelPath :: Maybe PosixPath
eventMap :: IntMap PathRep
..} = Maybe PosixPath
eventRelPath
getAbsPath :: Event -> Path
getAbsPath :: Event -> PosixPath
getAbsPath Event
ev =
case Event -> Maybe PosixPath
getRelPath Event
ev of
Just PosixPath
relPath -> PosixPath -> PosixPath -> PosixPath
Path.append (Event -> PosixPath
getRoot Event
ev) PosixPath
relPath
Maybe PosixPath
Nothing -> Event -> PosixPath
getRoot Event
ev
getCookie :: Event -> Cookie
getCookie :: Event -> Cookie
getCookie Event{Maybe PosixPath
Word32
CInt
IntMap PathRep
eventWd :: Event -> CInt
eventFlags :: Event -> Word32
eventCookie :: Event -> Word32
eventRelPath :: Event -> Maybe PosixPath
eventMap :: Event -> IntMap PathRep
eventWd :: CInt
eventFlags :: Word32
eventCookie :: Word32
eventRelPath :: Maybe PosixPath
eventMap :: IntMap PathRep
..} = Word32 -> Cookie
Cookie Word32
eventCookie
getFlag :: Word32 -> Event -> Bool
getFlag :: Word32 -> Event -> Bool
getFlag Word32
mask Event{Maybe PosixPath
Word32
CInt
IntMap PathRep
eventWd :: Event -> CInt
eventFlags :: Event -> Word32
eventCookie :: Event -> Word32
eventRelPath :: Event -> Maybe PosixPath
eventMap :: Event -> IntMap PathRep
eventWd :: CInt
eventFlags :: Word32
eventCookie :: Word32
eventRelPath :: Maybe PosixPath
eventMap :: IntMap PathRep
..} = Word32
eventFlags Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
mask Word32 -> Word32 -> Bool
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 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
iN_MOVE_SELF Word32 -> Word32 -> Word32
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 -> [Char]
showEvent ev :: Event
ev@Event{Maybe PosixPath
Word32
CInt
IntMap PathRep
eventWd :: Event -> CInt
eventFlags :: Event -> Word32
eventCookie :: Event -> Word32
eventRelPath :: Event -> Maybe PosixPath
eventMap :: Event -> IntMap PathRep
eventWd :: CInt
eventFlags :: Word32
eventCookie :: Word32
eventRelPath :: Maybe PosixPath
eventMap :: IntMap PathRep
..} =
[Char]
"--------------------------"
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\nWd = " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
eventWd
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\nRoot = " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show (PosixPath -> [Char]
forall a. IsPath PosixPath a => a -> [Char]
Path.toString (PosixPath -> [Char]) -> PosixPath -> [Char]
forall a b. (a -> b) -> a -> b
$ Event -> PosixPath
getRoot Event
ev)
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\nPath = " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char] -> (PosixPath -> [Char]) -> Maybe PosixPath -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" (ShowS
forall a. Show a => a -> [Char]
show ShowS -> (PosixPath -> [Char]) -> PosixPath -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> [Char]
forall a. IsPath PosixPath a => a -> [Char]
Path.toString) (Event -> Maybe PosixPath
getRelPath Event
ev)
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\nCookie = " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Cookie -> [Char]
forall a. Show a => a -> [Char]
show (Event -> Cookie
getCookie Event
ev)
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\nFlags " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> [Char]
forall a. Show a => a -> [Char]
show Word32
eventFlags
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isEventsLost [Char]
"Overflow"
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isRootUnwatched [Char]
"RootUnwatched"
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isRootDeleted [Char]
"RootDeleted"
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isRootMoved [Char]
"RootMoved"
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isRootUnmounted [Char]
"RootUnmounted"
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isAttrsModified [Char]
"AttrsModified"
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isAccessed [Char]
"Accessed"
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isOpened [Char]
"Opened"
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isWriteClosed [Char]
"WriteClosed"
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isNonWriteClosed [Char]
"NonWriteClosed"
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isCreated [Char]
"Created"
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isDeleted [Char]
"Deleted"
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isModified [Char]
"Modified"
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isMovedFrom [Char]
"MovedFrom"
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isMovedTo [Char]
"MovedTo"
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Event -> Bool) -> ShowS
showev Event -> Bool
isDir [Char]
"Dir"
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
where showev :: (Event -> Bool) -> ShowS
showev Event -> Bool
f [Char]
str = if Event -> Bool
f Event
ev then [Char]
"\n" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
str else [Char]
""
#else
#warning "Disabling module Streamly.Internal.FS.Event.Linux. Does not support kernels older than 2.6.36."
module Streamly.Internal.FS.Event.Linux () where
#endif