{-# LINE 1 "src/System/INotify.hsc" #-}
{-# LANGUAGE CPP #-}
module System.INotify
( initINotify
, killINotify
, withINotify
, addWatch
, removeWatch
, INotify
, WatchDescriptor
, Event(..)
, EventVariety(..)
, Cookie
) where
import Prelude hiding (init)
import Control.Monad
import Control.Concurrent
import Control.Concurrent.Async
import Control.Exception as E hiding (mask)
import Data.Maybe
import Data.Map (Map)
import qualified Data.Map as Map
import Foreign.C
import Foreign.Marshal hiding (void)
import Foreign.Ptr
import Foreign.Storable
import System.IO
import System.IO.Error
import System.Posix.ByteString.FilePath
import System.Posix.Files.ByteString
import GHC.IO.FD as FD (mkFD)
import GHC.IO.Handle.FD (mkHandleFromFD)
import GHC.IO.Device (IODeviceType(Stream))
import System.INotify.Masks
type FD = CInt
type WD = CInt
type Masks = CUInt
type EventMap = Map WD (Event -> IO ())
type WDEvent = (WD, Event)
data INotify = INotify Handle FD (MVar EventMap) (Async ()) (Async ())
data WatchDescriptor = WatchDescriptor INotify WD deriving WatchDescriptor -> WatchDescriptor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WatchDescriptor -> WatchDescriptor -> Bool
$c/= :: WatchDescriptor -> WatchDescriptor -> Bool
== :: WatchDescriptor -> WatchDescriptor -> Bool
$c== :: WatchDescriptor -> WatchDescriptor -> Bool
Eq
instance Eq INotify where
(INotify Handle
_ WD
fd1 MVar EventMap
_ Async ()
_ Async ()
_) == :: INotify -> INotify -> Bool
== (INotify Handle
_ WD
fd2 MVar EventMap
_ Async ()
_ Async ()
_) = WD
fd1 forall a. Eq a => a -> a -> Bool
== WD
fd2
newtype Cookie = Cookie CUInt deriving (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,Eq Cookie
Cookie -> Cookie -> Bool
Cookie -> Cookie -> Ordering
Cookie -> Cookie -> Cookie
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 :: Cookie -> Cookie -> Cookie
$cmin :: Cookie -> Cookie -> Cookie
max :: Cookie -> Cookie -> Cookie
$cmax :: Cookie -> Cookie -> Cookie
>= :: Cookie -> Cookie -> Bool
$c>= :: Cookie -> Cookie -> Bool
> :: Cookie -> Cookie -> Bool
$c> :: Cookie -> Cookie -> Bool
<= :: Cookie -> Cookie -> Bool
$c<= :: Cookie -> Cookie -> Bool
< :: Cookie -> Cookie -> Bool
$c< :: Cookie -> Cookie -> Bool
compare :: Cookie -> Cookie -> Ordering
$ccompare :: Cookie -> Cookie -> Ordering
Ord)
data FDEvent = FDEvent WD Masks CUInt (Maybe RawFilePath) deriving (FDEvent -> FDEvent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FDEvent -> FDEvent -> Bool
$c/= :: FDEvent -> FDEvent -> Bool
== :: FDEvent -> FDEvent -> Bool
$c== :: FDEvent -> FDEvent -> Bool
Eq, Int -> FDEvent -> ShowS
[FDEvent] -> ShowS
FDEvent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FDEvent] -> ShowS
$cshowList :: [FDEvent] -> ShowS
show :: FDEvent -> String
$cshow :: FDEvent -> String
showsPrec :: Int -> FDEvent -> ShowS
$cshowsPrec :: Int -> FDEvent -> ShowS
Show)
data Event =
Accessed
{ Event -> Bool
isDirectory :: Bool
, Event -> Maybe RawFilePath
maybeFilePath :: Maybe RawFilePath
}
| Modified
{ isDirectory :: Bool
, maybeFilePath :: Maybe RawFilePath
}
| Attributes
{ isDirectory :: Bool
, maybeFilePath :: Maybe RawFilePath
}
| Closed
{ isDirectory :: Bool
, maybeFilePath :: Maybe RawFilePath
, Event -> Bool
wasWriteable :: Bool
}
| Opened
{ isDirectory :: Bool
, maybeFilePath :: Maybe RawFilePath
}
| MovedOut
{ isDirectory :: Bool
, Event -> RawFilePath
filePath :: RawFilePath
, Event -> Cookie
moveCookie :: Cookie
}
| MovedIn
{ isDirectory :: Bool
, filePath :: RawFilePath
, moveCookie :: Cookie
}
| MovedSelf
{ isDirectory :: Bool
}
| Created
{ isDirectory :: Bool
, filePath :: RawFilePath
}
| Deleted
{ isDirectory :: Bool
, filePath :: RawFilePath
}
| DeletedSelf
| Unmounted
| QOverflow
| Ignored
| Unknown FDEvent
deriving (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, Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Int -> Event -> ShowS
$cshowsPrec :: Int -> Event -> ShowS
Show)
data EventVariety
= Access
| Modify
| Attrib
| Close
| CloseWrite
| CloseNoWrite
| Open
| Move
| MoveIn
| MoveOut
| MoveSelf
| Create
| Delete
| DeleteSelf
| OnlyDir
| NoSymlink
| MaskAdd
| OneShot
| AllEvents
deriving EventVariety -> EventVariety -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventVariety -> EventVariety -> Bool
$c/= :: EventVariety -> EventVariety -> Bool
== :: EventVariety -> EventVariety -> Bool
$c== :: EventVariety -> EventVariety -> Bool
Eq
instance Show INotify where
show :: INotify -> String
show (INotify Handle
_ WD
fd MVar EventMap
_ Async ()
_ Async ()
_) =
String -> ShowS
showString String
"<inotify fd=" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. Show a => a -> ShowS
shows WD
fd forall a b. (a -> b) -> a -> b
$ String
">"
instance Show WatchDescriptor where
show :: WatchDescriptor -> String
show (WatchDescriptor INotify
_ WD
wd) = String -> ShowS
showString String
"<wd=" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows WD
wd forall a b. (a -> b) -> a -> b
$ String
">"
instance Show Cookie where
show :: Cookie -> String
show (Cookie CUInt
c) = String -> ShowS
showString String
"<cookie " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows CUInt
c forall a b. (a -> b) -> a -> b
$ String
">"
initINotify :: IO INotify
initINotify :: IO INotify
initINotify = do
WD
fdint <- forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 String
"initINotify" IO WD
c_inotify_init
(FD
fd,IODeviceType
fd_type) <- WD
-> IOMode
-> Maybe (IODeviceType, CDev, CIno)
-> Bool
-> Bool
-> IO (FD, IODeviceType)
FD.mkFD WD
fdint IOMode
ReadMode (forall a. a -> Maybe a
Just (IODeviceType
Stream,CDev
0,CIno
0))
Bool
False
Bool
False
Handle
h <- FD
-> IODeviceType
-> String
-> IOMode
-> Bool
-> Maybe TextEncoding
-> IO Handle
mkHandleFromFD FD
fd IODeviceType
fd_type
(String -> ShowS
showString String
"<inotify handle, fd=" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows FD
fd forall a b. (a -> b) -> a -> b
$ String
">")
IOMode
ReadMode
Bool
True
forall a. Maybe a
Nothing
MVar EventMap
em <- forall a. a -> IO (MVar a)
newMVar forall k a. Map k a
Map.empty
(Async ()
tid1, Async ()
tid2) <- Handle -> MVar EventMap -> IO (Async (), Async ())
inotify_start_thread Handle
h MVar EventMap
em
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle -> WD -> MVar EventMap -> Async () -> Async () -> INotify
INotify Handle
h WD
fdint MVar EventMap
em Async ()
tid1 Async ()
tid2)
addWatch :: INotify -> [EventVariety] -> RawFilePath -> (Event -> IO ()) -> IO WatchDescriptor
addWatch :: INotify
-> [EventVariety]
-> RawFilePath
-> (Event -> IO ())
-> IO WatchDescriptor
addWatch inotify :: INotify
inotify@(INotify Handle
_ WD
fd MVar EventMap
em Async ()
_ Async ()
_) [EventVariety]
masks RawFilePath
fp Event -> IO ()
cb = do
forall a. IO a -> (IOError -> IO a) -> IO a
catch_IO (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
(if (EventVariety
NoSymlink forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [EventVariety]
masks) then RawFilePath -> IO FileStatus
getSymbolicLinkStatus else RawFilePath -> IO FileStatus
getFileStatus)
RawFilePath
fp) forall a b. (a -> b) -> a -> b
$ \IOError
_ ->
forall a. IOError -> IO a
ioError forall a b. (a -> b) -> a -> b
$ IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
mkIOError IOErrorType
doesNotExistErrorType
String
"can't watch what isn't there!"
forall a. Maybe a
Nothing
(forall a. a -> Maybe a
Just (forall a. Show a => a -> String
show RawFilePath
fp))
let mask :: CUInt
mask = [Mask] -> CUInt
joinMasks (forall a b. (a -> b) -> [a] -> [b]
map EventVariety -> Mask
eventVarietyToMask [EventVariety]
masks)
WD
wd <- forall a. RawFilePath -> (CString -> IO a) -> IO a
withFilePath RawFilePath
fp forall a b. (a -> b) -> a -> b
$ \CString
fp_c ->
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 String
"addWatch" forall a b. (a -> b) -> a -> b
$
WD -> CString -> CUInt -> IO WD
c_inotify_add_watch (forall a b. (Integral a, Num b) => a -> b
fromIntegral WD
fd) CString
fp_c CUInt
mask
let event :: Event -> IO ()
event = \Event
e -> IO () -> IO ()
ignore_failure forall a b. (a -> b) -> a -> b
$ do
case Event
e of
Event
Ignored -> INotify -> WD -> IO ()
rm_watch INotify
inotify WD
wd
Event
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Event -> IO ()
cb Event
e
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar EventMap
em forall a b. (a -> b) -> a -> b
$ \EventMap
em' -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith (forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>)) WD
wd Event -> IO ()
event EventMap
em')
forall (m :: * -> *) a. Monad m => a -> m a
return (INotify -> WD -> WatchDescriptor
WatchDescriptor INotify
inotify WD
wd)
where
catch_IO :: IO a -> (IOError -> IO a) -> IO a
catch_IO :: forall a. IO a -> (IOError -> IO a) -> IO a
catch_IO = forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch
eventVarietyToMask :: EventVariety -> Mask
eventVarietyToMask EventVariety
ev =
case EventVariety
ev of
EventVariety
Access -> Mask
inAccess
EventVariety
Modify -> Mask
inModify
EventVariety
Attrib -> Mask
inAttrib
EventVariety
Close -> Mask
inClose
EventVariety
CloseWrite -> Mask
inCloseWrite
EventVariety
CloseNoWrite -> Mask
inCloseNowrite
EventVariety
Open -> Mask
inOpen
EventVariety
Move -> Mask
inMove
EventVariety
MoveIn -> Mask
inMovedTo
EventVariety
MoveOut -> Mask
inMovedFrom
EventVariety
MoveSelf -> Mask
inMoveSelf
EventVariety
Create -> Mask
inCreate
EventVariety
Delete -> Mask
inDelete
EventVariety
DeleteSelf-> Mask
inDeleteSelf
EventVariety
OnlyDir -> Mask
inOnlydir
EventVariety
NoSymlink -> Mask
inDontFollow
EventVariety
MaskAdd -> Mask
inMaskAdd
EventVariety
OneShot -> Mask
inOneshot
EventVariety
AllEvents -> Mask
inAllEvents
ignore_failure :: IO () -> IO ()
ignore_failure :: IO () -> IO ()
ignore_failure IO ()
action = IO ()
action forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` SomeException -> IO ()
ignore
where
ignore :: SomeException -> IO ()
ignore :: SomeException -> IO ()
ignore SomeException
e
#if MIN_VERSION_async(2,2,1)
| Just AsyncCancelled
AsyncCancelled <- forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e = forall e a. Exception e => e -> IO a
throwIO SomeException
e
#else
| Just ThreadKilled{} <- fromException e = throwIO e
#endif
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return ()
removeWatch :: WatchDescriptor -> IO ()
removeWatch :: WatchDescriptor -> IO ()
removeWatch (WatchDescriptor (INotify Handle
_ WD
fd MVar EventMap
_ Async ()
_ Async ()
_) WD
wd) = do
WD
_ <- forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 String
"removeWatch" forall a b. (a -> b) -> a -> b
$
WD -> WD -> IO WD
c_inotify_rm_watch (forall a b. (Integral a, Num b) => a -> b
fromIntegral WD
fd) WD
wd
forall (m :: * -> *) a. Monad m => a -> m a
return ()
rm_watch :: INotify -> WD -> IO ()
rm_watch :: INotify -> WD -> IO ()
rm_watch (INotify Handle
_ WD
_ MVar EventMap
em Async ()
_ Async ()
_) WD
wd =
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar EventMap
em (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Map k a
Map.delete WD
wd)
read_events :: Handle -> IO [WDEvent]
read_events :: Handle -> IO [WDEvent]
read_events Handle
h =
let maxRead :: Int
maxRead = Int
16385 in
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
maxRead forall a b. (a -> b) -> a -> b
$ \Ptr Any
buffer -> do
Bool
_ <- Handle -> Int -> IO Bool
hWaitForInput Handle
h (-Int
1)
Int
r <- forall a. Handle -> Ptr a -> Int -> IO Int
hGetBufNonBlocking Handle
h Ptr Any
buffer Int
maxRead
forall a. Ptr a -> Int -> IO [WDEvent]
read_events' Ptr Any
buffer Int
r
where
read_events' :: Ptr a -> Int -> IO [WDEvent]
read_events' :: forall a. Ptr a -> Int -> IO [WDEvent]
read_events' Ptr a
_ Int
r | Int
r forall a. Ord a => a -> a -> Bool
<= Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return []
read_events' Ptr a
ptr Int
r = do
WD
wd <- ((\Ptr a
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr a
hsc_ptr Int
0)) Ptr a
ptr :: IO CInt
{-# LINE 273 "src/System/INotify.hsc" #-}
CUInt
mask <- ((\Ptr a
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr a
hsc_ptr Int
4)) Ptr a
ptr :: IO CUInt
{-# LINE 274 "src/System/INotify.hsc" #-}
CUInt
cookie <- ((\Ptr a
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr a
hsc_ptr Int
8)) Ptr a
ptr :: IO CUInt
{-# LINE 275 "src/System/INotify.hsc" #-}
CUInt
len <- ((\Ptr a
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr a
hsc_ptr Int
12)) Ptr a
ptr :: IO CUInt
{-# LINE 276 "src/System/INotify.hsc" #-}
Maybe RawFilePath
nameM <- if CUInt
len forall a. Eq a => a -> a -> Bool
== CUInt
0
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else do
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ CString -> IO RawFilePath
peekFilePath (((\Ptr a
hsc_ptr -> Ptr a
hsc_ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16)) Ptr a
ptr)
{-# LINE 280 "src/System/INotify.hsc" #-}
let event_size :: Int
event_size = ((Int
16)) forall a. Num a => a -> a -> a
+ (forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
len)
{-# LINE 281 "src/System/INotify.hsc" #-}
event :: WDEvent
event = FDEvent -> WDEvent
cEvent2Haskell (WD -> CUInt -> CUInt -> Maybe RawFilePath -> FDEvent
FDEvent WD
wd CUInt
mask CUInt
cookie Maybe RawFilePath
nameM)
[WDEvent]
rest <- forall a. Ptr a -> Int -> IO [WDEvent]
read_events' (Ptr a
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
event_size) (Int
r forall a. Num a => a -> a -> a
- Int
event_size)
forall (m :: * -> *) a. Monad m => a -> m a
return (WDEvent
eventforall a. a -> [a] -> [a]
:[WDEvent]
rest)
cEvent2Haskell :: FDEvent
-> WDEvent
cEvent2Haskell :: FDEvent -> WDEvent
cEvent2Haskell fdevent :: FDEvent
fdevent@(FDEvent WD
wd CUInt
mask CUInt
cookie Maybe RawFilePath
nameM)
= (WD
wd, Event
event)
where
event :: Event
event
| Mask -> Bool
isSet Mask
inAccess = Bool -> Maybe RawFilePath -> Event
Accessed Bool
isDir Maybe RawFilePath
nameM
| Mask -> Bool
isSet Mask
inModify = Bool -> Maybe RawFilePath -> Event
Modified Bool
isDir Maybe RawFilePath
nameM
| Mask -> Bool
isSet Mask
inAttrib = Bool -> Maybe RawFilePath -> Event
Attributes Bool
isDir Maybe RawFilePath
nameM
| Mask -> Bool
isSet Mask
inClose = Bool -> Maybe RawFilePath -> Bool -> Event
Closed Bool
isDir Maybe RawFilePath
nameM (Mask -> Bool
isSet Mask
inCloseWrite)
| Mask -> Bool
isSet Mask
inOpen = Bool -> Maybe RawFilePath -> Event
Opened Bool
isDir Maybe RawFilePath
nameM
| Mask -> Bool
isSet Mask
inMovedFrom = Bool -> RawFilePath -> Cookie -> Event
MovedOut Bool
isDir RawFilePath
name (CUInt -> Cookie
Cookie CUInt
cookie)
| Mask -> Bool
isSet Mask
inMovedTo = Bool -> RawFilePath -> Cookie -> Event
MovedIn Bool
isDir RawFilePath
name (CUInt -> Cookie
Cookie CUInt
cookie)
| Mask -> Bool
isSet Mask
inMoveSelf = Bool -> Event
MovedSelf Bool
isDir
| Mask -> Bool
isSet Mask
inCreate = Bool -> RawFilePath -> Event
Created Bool
isDir RawFilePath
name
| Mask -> Bool
isSet Mask
inDelete = Bool -> RawFilePath -> Event
Deleted Bool
isDir RawFilePath
name
| Mask -> Bool
isSet Mask
inDeleteSelf = Event
DeletedSelf
| Mask -> Bool
isSet Mask
inUnmount = Event
Unmounted
| Mask -> Bool
isSet Mask
inQOverflow = Event
QOverflow
| Mask -> Bool
isSet Mask
inIgnored = Event
Ignored
| Bool
otherwise = FDEvent -> Event
Unknown FDEvent
fdevent
isDir :: Bool
isDir = Mask -> Bool
isSet Mask
inIsdir
isSet :: Mask -> Bool
isSet Mask
bits = Mask -> CUInt -> Bool
maskIsSet Mask
bits CUInt
mask
name :: RawFilePath
name = forall a. HasCallStack => Maybe a -> a
fromJust Maybe RawFilePath
nameM
inotify_start_thread :: Handle -> MVar EventMap -> IO (Async (), Async ())
inotify_start_thread :: Handle -> MVar EventMap -> IO (Async (), Async ())
inotify_start_thread Handle
h MVar EventMap
em = do
Chan [WDEvent]
chan_events <- forall a. IO (Chan a)
newChan
Async ()
tid1 <- forall a. IO a -> IO (Async a)
async (String -> IO () -> IO ()
logFailure String
"dispatcher" (Chan [WDEvent] -> IO ()
dispatcher Chan [WDEvent]
chan_events))
Async ()
tid2 <- forall a. IO a -> IO (Async a)
async (String -> IO () -> IO ()
logFailure String
"start_thread" (Chan [WDEvent] -> IO ()
start_thread Chan [WDEvent]
chan_events))
forall (m :: * -> *) a. Monad m => a -> m a
return (Async ()
tid1,Async ()
tid2)
where
start_thread :: Chan [WDEvent] -> IO ()
start_thread :: Chan [WDEvent] -> IO ()
start_thread Chan [WDEvent]
chan_events = do
[WDEvent]
events <- Handle -> IO [WDEvent]
read_events Handle
h
forall a. Chan a -> a -> IO ()
writeChan Chan [WDEvent]
chan_events [WDEvent]
events
Chan [WDEvent] -> IO ()
start_thread Chan [WDEvent]
chan_events
dispatcher :: Chan [WDEvent] -> IO ()
dispatcher :: Chan [WDEvent] -> IO ()
dispatcher Chan [WDEvent]
chan_events = do
[WDEvent]
events <- forall a. Chan a -> IO a
readChan Chan [WDEvent]
chan_events
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ WDEvent -> IO ()
runHandler [WDEvent]
events
Chan [WDEvent] -> IO ()
dispatcher Chan [WDEvent]
chan_events
runHandler :: WDEvent -> IO ()
runHandler :: WDEvent -> IO ()
runHandler (WD
_, e :: Event
e@Event
QOverflow) = do
EventMap
handlers <- forall a. MVar a -> IO a
readMVar MVar EventMap
em
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b. (a -> b) -> a -> b
$ Event
e) (forall k a. Map k a -> [a]
Map.elems EventMap
handlers)
runHandler (WD
wd, Event
event) = do
EventMap
handlers <- forall a. MVar a -> IO a
readMVar MVar EventMap
em
let handlerM :: Maybe (Event -> IO ())
handlerM = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup WD
wd EventMap
handlers
case Maybe (Event -> IO ())
handlerM of
Maybe (Event -> IO ())
Nothing -> String -> IO ()
putStrLn String
"runHandler: couldn't find handler"
Just Event -> IO ()
handler -> Event -> IO ()
handler Event
event
logFailure :: String -> IO () -> IO ()
logFailure String
name IO ()
io = IO ()
io forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \SomeException
e ->
case SomeException
e of
#if MIN_VERSION_async(2,2,1)
SomeException
_ | Just AsyncCancelled
AsyncCancelled <- forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
#else
_ | Just ThreadKilled{} <- fromException e -> return ()
#endif
| Bool
otherwise -> Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
name forall a. [a] -> [a] -> [a]
++ String
" dying: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SomeException
e)
killINotify :: INotify -> IO ()
killINotify :: INotify -> IO ()
killINotify (INotify Handle
h WD
_ MVar EventMap
_ Async ()
tid1 Async ()
tid2) =
do forall a. Async a -> IO ()
cancelWait Async ()
tid1
forall a. Async a -> IO ()
cancelWait Async ()
tid2
Handle -> IO ()
hClose Handle
h
cancelWait :: Async a -> IO ()
#if MIN_VERSION_async(2,1,1)
cancelWait :: forall a. Async a -> IO ()
cancelWait = forall a. Async a -> IO ()
cancel
#else
cancelWait a = do cancel a; void $ waitCatch a
#endif
withINotify :: (INotify -> IO a) -> IO a
withINotify :: forall a. (INotify -> IO a) -> IO a
withINotify = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO INotify
initINotify INotify -> IO ()
killINotify
foreign import ccall unsafe "sys/inotify.h inotify_init" c_inotify_init :: IO CInt
foreign import ccall unsafe "sys/inotify.h inotify_add_watch" c_inotify_add_watch :: CInt -> CString -> CUInt -> IO CInt
foreign import ccall unsafe "sys/inotify.h inotify_rm_watch" c_inotify_rm_watch :: CInt -> CInt -> IO CInt