module Z.IO.FileSystem.Watch
( FileEvent(..)
, watchDirs
, initWatchDirs
) where
import Control.Concurrent
import Control.Monad
import Data.Bits
import qualified Data.HashMap.Strict as HM
import Data.IORef
#if defined(linux_HOST_OS)
import qualified Data.List as List
#endif
import Data.Primitive.PrimArray
import Data.Word
import GHC.Generics
import Z.Data.Array.Unaligned
import Z.Data.CBytes (CBytes)
import qualified Z.Data.CBytes as CBytes
import Z.Data.JSON (JSON)
import Z.Data.Text.Print (Print)
import Z.Data.Vector (defaultChunkSize)
import Z.Foreign
import Z.IO.BIO as BIO
import Z.IO.Exception
import Z.IO.FileSystem.Base
import qualified Z.IO.FileSystem.FilePath as P
import Z.IO.LowResTimer
import Z.IO.Resource
import Z.IO.UV.FFI
import Z.IO.UV.Manager
data FileEvent = FileAdd CBytes | FileRemove CBytes | FileModify CBytes
deriving (Int -> FileEvent -> ShowS
[FileEvent] -> ShowS
FileEvent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileEvent] -> ShowS
$cshowList :: [FileEvent] -> ShowS
show :: FileEvent -> String
$cshow :: FileEvent -> String
showsPrec :: Int -> FileEvent -> ShowS
$cshowsPrec :: Int -> FileEvent -> ShowS
Show, ReadPrec [FileEvent]
ReadPrec FileEvent
Int -> ReadS FileEvent
ReadS [FileEvent]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FileEvent]
$creadListPrec :: ReadPrec [FileEvent]
readPrec :: ReadPrec FileEvent
$creadPrec :: ReadPrec FileEvent
readList :: ReadS [FileEvent]
$creadList :: ReadS [FileEvent]
readsPrec :: Int -> ReadS FileEvent
$creadsPrec :: Int -> ReadS FileEvent
Read, Eq FileEvent
FileEvent -> FileEvent -> Bool
FileEvent -> FileEvent -> Ordering
FileEvent -> FileEvent -> FileEvent
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 :: FileEvent -> FileEvent -> FileEvent
$cmin :: FileEvent -> FileEvent -> FileEvent
max :: FileEvent -> FileEvent -> FileEvent
$cmax :: FileEvent -> FileEvent -> FileEvent
>= :: FileEvent -> FileEvent -> Bool
$c>= :: FileEvent -> FileEvent -> Bool
> :: FileEvent -> FileEvent -> Bool
$c> :: FileEvent -> FileEvent -> Bool
<= :: FileEvent -> FileEvent -> Bool
$c<= :: FileEvent -> FileEvent -> Bool
< :: FileEvent -> FileEvent -> Bool
$c< :: FileEvent -> FileEvent -> Bool
compare :: FileEvent -> FileEvent -> Ordering
$ccompare :: FileEvent -> FileEvent -> Ordering
Ord, FileEvent -> FileEvent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileEvent -> FileEvent -> Bool
$c/= :: FileEvent -> FileEvent -> Bool
== :: FileEvent -> FileEvent -> Bool
$c== :: FileEvent -> FileEvent -> Bool
Eq, forall x. Rep FileEvent x -> FileEvent
forall x. FileEvent -> Rep FileEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FileEvent x -> FileEvent
$cfrom :: forall x. FileEvent -> Rep FileEvent x
Generic)
deriving anyclass (Int -> FileEvent -> Builder ()
forall a. (Int -> a -> Builder ()) -> Print a
toUTF8BuilderP :: Int -> FileEvent -> Builder ()
$ctoUTF8BuilderP :: Int -> FileEvent -> Builder ()
Print, Value -> Converter FileEvent
FileEvent -> Value
FileEvent -> Builder ()
forall a.
(Value -> Converter a)
-> (a -> Value) -> (a -> Builder ()) -> JSON a
encodeJSON :: FileEvent -> Builder ()
$cencodeJSON :: FileEvent -> Builder ()
toValue :: FileEvent -> Value
$ctoValue :: FileEvent -> Value
fromValue :: Value -> Converter FileEvent
$cfromValue :: Value -> Converter FileEvent
JSON)
watchDirs :: [CBytes]
-> Bool
-> (FileEvent -> IO ())
-> IO ()
{-# INLINABLE watchDirs #-}
watchDirs :: [CBytes] -> Bool -> (FileEvent -> IO ()) -> IO ()
watchDirs [CBytes]
dirs Bool
rec FileEvent -> IO ()
callback = do
forall (m :: * -> *) a b.
(MonadMask m, MonadIO m, HasCallStack) =>
Resource a -> (a -> m b) -> m b
withResource ([CBytes] -> Bool -> Resource (IO (Source FileEvent))
initWatchDirs [CBytes]
dirs Bool
rec) forall a b. (a -> b) -> a -> b
$ \ IO (Source FileEvent)
srcf -> do
Source FileEvent
src <- IO (Source FileEvent)
srcf
forall inp out. HasCallStack => BIO inp out -> IO ()
run_ forall a b. (a -> b) -> a -> b
$ Source FileEvent
src forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => (a -> IO ()) -> Sink a
sinkToIO FileEvent -> IO ()
callback
initWatchDirs :: [CBytes]
-> Bool
-> Resource (IO (Source FileEvent))
{-# INLINABLE initWatchDirs #-}
initWatchDirs :: [CBytes] -> Bool -> Resource (IO (Source FileEvent))
initWatchDirs [CBytes]
dirs Bool
False = do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [CBytes]
dirs forall a b. (a -> b) -> a -> b
$ \ CBytes
dir -> do
Bool
b <- HasCallStack => CBytes -> IO Bool
isDir CBytes
dir
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
b (forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (forall (m :: * -> *) a. Monad m => a -> m a
return CInt
UV_ENOTDIR))
CUInt -> [CBytes] -> Resource (IO (Source FileEvent))
watch_ CUInt
0 [CBytes]
dirs
initWatchDirs [CBytes]
dirs Bool
_ = do
#if defined(linux_HOST_OS)
[[CBytes]]
subDirs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [CBytes]
dirs forall a b. (a -> b) -> a -> b
$ \ CBytes
dir ->
HasCallStack =>
CBytes -> (CBytes -> DirEntType -> IO Bool) -> IO [CBytes]
scandirRecursively CBytes
dir (\ CBytes
_ DirEntType
t -> forall (m :: * -> *) a. Monad m => a -> m a
return (DirEntType
t forall a. Eq a => a -> a -> Bool
== DirEntType
DirEntDir))
CUInt -> [CBytes] -> Resource (IO (Source FileEvent))
watch_ CUInt
UV_FS_EVENT_RECURSIVE (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
List.concat ([CBytes]
dirsforall a. a -> [a] -> [a]
:[[CBytes]]
subDirs))
#else
watch_ UV_FS_EVENT_RECURSIVE dirs
#endif
watch_ :: CUInt -> [CBytes] -> Resource (IO (Source FileEvent))
{-# INLINABLE watch_ #-}
watch_ :: CUInt -> [CBytes] -> Resource (IO (Source FileEvent))
watch_ CUInt
flag [CBytes]
dirs = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IO a -> (a -> IO ()) -> Resource a
initResource (do
MVar (HashMap CBytes ThreadId)
mRef <- forall a. a -> IO (MVar a)
newMVar forall k v. HashMap k v
HM.empty
(Sink FileEvent
sink, IO (Source FileEvent)
srcf) <- forall a. Int -> IO (Sink a, IO (Source a))
newBroadcastTChanPair Int
1
(forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [CBytes]
dirs forall a b. (a -> b) -> a -> b
$ \ CBytes
dir -> do
CBytes
dir' <- CBytes -> IO CBytes
P.normalize CBytes
dir
ThreadId
tid <- IO () -> IO ThreadId
forkIO forall a b. (a -> b) -> a -> b
$ MVar (HashMap CBytes ThreadId) -> CBytes -> Sink FileEvent -> IO ()
watchThread MVar (HashMap CBytes ThreadId)
mRef CBytes
dir' Sink FileEvent
sink
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar (HashMap CBytes ThreadId)
mRef forall a b. (a -> b) -> a -> b
$ \ HashMap CBytes ThreadId
m ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert CBytes
dir' ThreadId
tid HashMap CBytes ThreadId
m) forall a b. IO a -> IO b -> IO a
`onException` forall {t :: * -> *} {a} {a} {a}.
Foldable t =>
MVar (t ThreadId) -> ((a -> IO ()) -> Maybe a -> IO a) -> IO ()
cleanUpWatcher MVar (HashMap CBytes ThreadId)
mRef Sink FileEvent
sink
forall (m :: * -> *) a. Monad m => a -> m a
return (IO (Source FileEvent)
srcf, (Sink FileEvent
sink, MVar (HashMap CBytes ThreadId)
mRef)))
(\ (IO (Source FileEvent)
_, (Sink FileEvent
sink, MVar (HashMap CBytes ThreadId)
mRef)) -> forall {t :: * -> *} {a} {a} {a}.
Foldable t =>
MVar (t ThreadId) -> ((a -> IO ()) -> Maybe a -> IO a) -> IO ()
cleanUpWatcher MVar (HashMap CBytes ThreadId)
mRef Sink FileEvent
sink)
where
eventBufSiz :: Int
eventBufSiz = Int
defaultChunkSize
cleanUpWatcher :: MVar (t ThreadId) -> ((a -> IO ()) -> Maybe a -> IO a) -> IO ()
cleanUpWatcher MVar (t ThreadId)
mRef (a -> IO ()) -> Maybe a -> IO a
sink = do
t ThreadId
m <- forall a. MVar a -> IO a
takeMVar MVar (t ThreadId)
mRef
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ t ThreadId
m ThreadId -> IO ()
killThread
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((a -> IO ()) -> Maybe a -> IO a
sink forall a. a -> IO ()
discard forall a. Maybe a
EOF)
watchThread :: MVar (HashMap CBytes ThreadId) -> CBytes -> Sink FileEvent -> IO ()
watchThread MVar (HashMap CBytes ThreadId)
mRef CBytes
dir Sink FileEvent
sink = do
IORef (Maybe FileEvent)
eRef <- forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
UVManager
uvm <- IO UVManager
getUVManager
(forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
(do forall a. HasCallStack => UVManager -> (Ptr UVLoop -> IO a) -> IO a
withUVManager UVManager
uvm forall a b. (a -> b) -> a -> b
$ \ Ptr UVLoop
loop -> do
Ptr UVHandle
hdl <- Ptr UVLoop -> IO (Ptr UVHandle)
hs_uv_handle_alloc Ptr UVLoop
loop
Int
slot <- HasCallStack => UVManager -> IO UVSlotUnsafe -> IO Int
getUVSlot UVManager
uvm (Ptr UVHandle -> IO UVSlotUnsafe
peekUVHandleData Ptr UVHandle
hdl)
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (Ptr UVLoop -> Ptr UVHandle -> IO CInt
uv_fs_event_init Ptr UVLoop
loop Ptr UVHandle
hdl)
MutablePrimArray RealWorld Word8
buf <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPinnedPrimArray Int
eventBufSiz :: IO (MutablePrimArray RealWorld Word8)
Ptr UVHandle
check <- forall a. HasCallStack => IO (Ptr a) -> IO (Ptr a)
throwOOMIfNull forall a b. (a -> b) -> a -> b
$ IO (Ptr UVHandle)
hs_uv_check_alloc
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (Ptr UVHandle -> Ptr UVHandle -> IO CInt
hs_uv_check_init Ptr UVHandle
check Ptr UVHandle
hdl)
forall a b. MutablePrimArray RealWorld a -> (Ptr a -> IO b) -> IO b
withMutablePrimArrayContents MutablePrimArray RealWorld Word8
buf forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
p -> do
UVManager -> Int -> Ptr Word8 -> Int -> IO ()
pokeBufferTable UVManager
uvm Int
slot (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
p) Int
eventBufSiz
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ forall a b. (a -> b) -> a -> b
$ Ptr UVHandle -> IO CInt
hs_uv_fs_event_check_start Ptr UVHandle
check
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr UVHandle
hdl, Int
slot, MutablePrimArray RealWorld Word8
buf, Ptr UVHandle
check))
(\ (Ptr UVHandle
hdl,Int
_,MutablePrimArray RealWorld Word8
_,Ptr UVHandle
check) -> Ptr UVHandle -> IO ()
hs_uv_handle_close Ptr UVHandle
hdl forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr UVHandle -> IO ()
hs_uv_check_close Ptr UVHandle
check)
(\ (Ptr UVHandle
hdl, Int
slot, MutablePrimArray RealWorld Word8
buf, Ptr UVHandle
_) -> do
MVar Int
m <- UVManager -> Int -> IO (MVar Int)
getBlockMVar UVManager
uvm Int
slot
forall a. HasCallStack => UVManager -> IO a -> IO a
withUVManager' UVManager
uvm forall a b. (a -> b) -> a -> b
$ do
Maybe Int
_ <- forall a. MVar a -> IO (Maybe a)
tryTakeMVar MVar Int
m
UVManager -> Int -> Int -> IO ()
pokeBufferSizeTable UVManager
uvm Int
slot Int
eventBufSiz
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
CBytes.withCBytesUnsafe CBytes
dir forall a b. (a -> b) -> a -> b
$ \ BA# Word8
p ->
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (Ptr UVHandle -> BA# Word8 -> CUInt -> IO CInt
hs_uv_fs_event_start Ptr UVHandle
hdl BA# Word8
p CUInt
flag)
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ do
Int
_ <- forall a. MVar a -> IO a
takeMVar MVar Int
m forall a b. IO a -> IO b -> IO a
`onException` (do
CInt
_ <- forall a. HasCallStack => UVManager -> IO a -> IO a
withUVManager' UVManager
uvm forall a b. (a -> b) -> a -> b
$ Ptr UVHandle -> IO CInt
uv_fs_event_stop Ptr UVHandle
hdl
forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall a. MVar a -> IO (Maybe a)
tryTakeMVar MVar Int
m))
(PrimArray BA# Word8
buf#) <- forall a. HasCallStack => UVManager -> IO a -> IO a
withUVManager' UVManager
uvm forall a b. (a -> b) -> a -> b
$ do
Maybe Int
_ <- forall a. MVar a -> IO (Maybe a)
tryTakeMVar MVar Int
m
Int
r <- UVManager -> Int -> IO Int
peekBufferSizeTable UVManager
uvm Int
slot
UVManager -> Int -> Int -> IO ()
pokeBufferSizeTable UVManager
uvm Int
slot Int
eventBufSiz
let eventSiz :: Int
eventSiz = Int
eventBufSiz forall a. Num a => a -> a -> a
- Int
r
MutablePrimArray RealWorld Word8
buf' <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
eventSiz
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> MutablePrimArray (PrimState m) a -> Int -> Int -> m ()
copyMutablePrimArray MutablePrimArray RealWorld Word8
buf' Int
0 MutablePrimArray RealWorld Word8
buf Int
r Int
eventSiz
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld Word8
buf'
IO () -> IO ThreadId
forkIO forall a b. (a -> b) -> a -> b
$ CBytes
-> MVar (HashMap CBytes ThreadId)
-> IORef (Maybe FileEvent)
-> Sink FileEvent
-> [(Word8, CBytes)]
-> IO ()
processEvent CBytes
dir MVar (HashMap CBytes ThreadId)
mRef IORef (Maybe FileEvent)
eRef Sink FileEvent
sink forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall {m :: * -> *} {a}.
(Monad m, Unaligned a) =>
BA# Word8 -> Int -> [(a, CBytes)] -> m [(a, CBytes)]
loopReadFileEvent BA# Word8
buf# Int
0 [])
) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch`
(\ (NoSuchThing
_ :: NoSuchThing) -> forall (m :: * -> *) a. Monad m => a -> m a
return ())
loopReadFileEvent :: BA# Word8 -> Int -> [(a, CBytes)] -> m [(a, CBytes)]
loopReadFileEvent BA# Word8
buf# Int
i [(a, CBytes)]
acc
| Int
i forall a. Ord a => a -> a -> Bool
>= Int
siz = forall (m :: * -> *) a. Monad m => a -> m a
return [(a, CBytes)]
acc
| Bool
otherwise =
let !event :: a
event = forall a. Unaligned a => BA# Word8 -> Int -> a
indexBA BA# Word8
buf# Int
i
!path :: CBytes
path = BA# Word8 -> Int -> CBytes
CBytes.indexBACBytes BA# Word8
buf# (Int
i forall a. Num a => a -> a -> a
+ Int
1)
in BA# Word8 -> Int -> [(a, CBytes)] -> m [(a, CBytes)]
loopReadFileEvent BA# Word8
buf# (Int
i forall a. Num a => a -> a -> a
+ CBytes -> Int
CBytes.length CBytes
path forall a. Num a => a -> a -> a
+ Int
2) ((a
event,CBytes
path)forall a. a -> [a] -> [a]
:[(a, CBytes)]
acc)
where siz :: Int
siz = forall a. Prim a => PrimArray a -> Int
sizeofPrimArray (forall a. BA# Word8 -> PrimArray a
PrimArray BA# Word8
buf# :: PrimArray Word8)
processEvent :: CBytes
-> MVar (HashMap CBytes ThreadId)
-> IORef (Maybe FileEvent)
-> Sink FileEvent
-> [(Word8, CBytes)]
-> IO ()
processEvent CBytes
pdir MVar (HashMap CBytes ThreadId)
mRef IORef (Maybe FileEvent)
eRef Sink FileEvent
sink = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a b. (a -> b) -> a -> b
$ \ (Word8
e, CBytes
path) ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CBytes -> Bool
CBytes.null CBytes
path) forall a b. (a -> b) -> a -> b
$ do
CBytes
f <- CBytes
pdir CBytes -> CBytes -> IO CBytes
`P.join` CBytes
path
if (Word8
e forall a. Bits a => a -> a -> a
.&. Word8
UV_RENAME) forall a. Eq a => a -> a -> Bool
/= Word8
0
then forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch
(do FStat
_s <- HasCallStack => CBytes -> IO FStat
lstat CBytes
f
#if defined(linux_HOST_OS)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((FStat -> CInt
stMode FStat
_s forall a. Bits a => a -> a -> a
.&. CInt
S_IFMT forall a. Eq a => a -> a -> Bool
== CInt
S_IFDIR) Bool -> Bool -> Bool
&& (CUInt
flag forall a. Bits a => a -> a -> a
.&. CUInt
UV_FS_EVENT_RECURSIVE forall a. Eq a => a -> a -> Bool
/= CUInt
0)) forall a b. (a -> b) -> a -> b
$ do
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar (HashMap CBytes ThreadId)
mRef forall a b. (a -> b) -> a -> b
$ \ HashMap CBytes ThreadId
m -> do
case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup CBytes
f HashMap CBytes ThreadId
m of
Just ThreadId
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return HashMap CBytes ThreadId
m
Maybe ThreadId
_ -> do
[CBytes]
ds <- HasCallStack =>
CBytes -> (CBytes -> DirEntType -> IO Bool) -> IO [CBytes]
scandirRecursively CBytes
f (\ CBytes
_ DirEntType
t -> forall (m :: * -> *) a. Monad m => a -> m a
return (DirEntType
t forall a. Eq a => a -> a -> Bool
== DirEntType
DirEntDir))
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\ HashMap CBytes ThreadId
m' CBytes
d -> do
ThreadId
tid <- IO () -> IO ThreadId
forkIO forall a b. (a -> b) -> a -> b
$ MVar (HashMap CBytes ThreadId) -> CBytes -> Sink FileEvent -> IO ()
watchThread MVar (HashMap CBytes ThreadId)
mRef CBytes
d Sink FileEvent
sink
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert CBytes
d ThreadId
tid HashMap CBytes ThreadId
m') HashMap CBytes ThreadId
m (CBytes
fforall a. a -> [a] -> [a]
:[CBytes]
ds)
#endif
forall {a} {out}.
Eq a =>
IORef (Maybe a) -> BIO a out -> a -> IO ()
pushDedup IORef (Maybe FileEvent)
eRef Sink FileEvent
sink (CBytes -> FileEvent
FileAdd CBytes
f))
(\ (NoSuchThing
_ :: NoSuchThing) -> do
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar (HashMap CBytes ThreadId)
mRef forall a b. (a -> b) -> a -> b
$ \ HashMap CBytes ThreadId
m -> do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup CBytes
f HashMap CBytes ThreadId
m) ThreadId -> IO ()
killThread
forall (m :: * -> *) a. Monad m => a -> m a
return (forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HM.delete CBytes
f HashMap CBytes ThreadId
m)
forall {a} {out}.
Eq a =>
IORef (Maybe a) -> BIO a out -> a -> IO ()
pushDedup IORef (Maybe FileEvent)
eRef Sink FileEvent
sink (CBytes -> FileEvent
FileRemove CBytes
f))
else forall {a} {out}.
Eq a =>
IORef (Maybe a) -> BIO a out -> a -> IO ()
pushDedup IORef (Maybe FileEvent)
eRef Sink FileEvent
sink (CBytes -> FileEvent
FileModify CBytes
f)
pushDedup :: IORef (Maybe a) -> BIO a out -> a -> IO ()
pushDedup IORef (Maybe a)
eRef BIO a out
sink a
event = do
Int -> IO () -> IO ()
registerLowResTimer_ Int
1 forall a b. (a -> b) -> a -> b
$ do
Maybe a
me' <- forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (Maybe a)
eRef forall a b. (a -> b) -> a -> b
$ \ Maybe a
me ->
case Maybe a
me of
Just a
e -> (forall a. Maybe a
Nothing, forall a. a -> Maybe a
Just a
e)
Maybe a
_ -> (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe a
me' (forall inp out. HasCallStack => BIO inp out -> inp -> IO ()
BIO.step_ BIO a out
sink)
Maybe a
me' <- forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (Maybe a)
eRef forall a b. (a -> b) -> a -> b
$ \ Maybe a
me ->
case Maybe a
me of
Just a
e -> if (a
e forall a. Eq a => a -> a -> Bool
== a
event)
then (Maybe a
me, forall a. Maybe a
Nothing)
else (forall a. a -> Maybe a
Just a
event, forall a. a -> Maybe a
Just a
e)
Maybe a
_ -> (forall a. a -> Maybe a
Just a
event, forall a. Maybe a
Nothing)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe a
me' (forall inp out. HasCallStack => BIO inp out -> inp -> IO ()
BIO.step_ BIO a out
sink)