{-|
Module      : Z.IO.FileSystem.Watch
Description : cross-platform recursive fs watcher
Copyright   : (c) Dong Han, 2017-2020
License     : BSD
Maintainer  : winterland1989@gmail.com
Stability   : experimental
Portability : non-portable

This module provides fs watcher based on libuv's fs_event, we also maintain watch list if target OS doesn't
support recursive watch(Linux's inotify).

@
-- start watching threads, cleanup watching threads automatically when finished.
withResource (initWatchDirs ["fold_to_be_watch"] True) $ \ srcf -> do
    -- dup a file event source
    src <- srcf
    -- print event to stdout
    BIO.run_ $ src . sinkToIO printStd
@
-}

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

-- | File event with path info.
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)

-- | Watching a list of given directories.
watchDirs :: [CBytes]     -- ^ Directories to be watched
          -> Bool         -- ^ recursively watch?
          -> (FileEvent -> IO ())  -- ^ Callback function to handle 'FileEvent'
          -> 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

-- | Start watching a list of given directories, stream version.
initWatchDirs :: [CBytes]       -- ^ watching list
              -> Bool           -- ^ recursively watch?
              -> 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)
    -- inotify doesn't support recursive watch, so we manually maintain watch list
    [[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

-- Internal function to start watching
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
    -- HashMap to store all watchers
    MVar (HashMap CBytes ThreadId)
mRef <- forall a. a -> IO (MVar a)
newMVar forall k v. HashMap k v
HM.empty
    -- there's only one place to pull the sink, that is cleanUpWatcher
    (Sink FileEvent
sink, IO (Source FileEvent)
srcf) <- forall a. Int -> IO (Sink a, IO (Source a))
newBroadcastTChanPair Int
1
    -- lock UVManager first
    (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 store temp events to de-duplicated
        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)
                    -- init uv struct
                    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
                        -- init uv_check_t must come after poking buffer
                        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`
                -- when a directory is removed, either watcher is killed
                -- or hs_uv_fs_event_start return ENOENT
                (\ (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) ->
        -- don't report event about directory itself, it will reported by its parent
        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)