{-# LINE 1 "src/System/INotify.hsc" #-}
{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  System.INotify
-- Copyright   :  (c) Lennart Kolmodin 2006-2012
-- License     :  BSD3
-- Maintainer  :  kolmodin@gmail.com
-- Stability   :  experimental
-- Portability :  hc portable, linux only
--
-- A Haskell binding to INotify.
-- See <http://www.kernel.org/pub/linux/kernel/people/rml/inotify/> and @man
-- inotify@.
--
-- Use 'initINotify' to get a 'INotify', then use 'addWatch' to
-- add a watch on a file or directory. Select which events you're interested
-- in with 'EventVariety', which corresponds to the 'Event' events.
--
-- Use 'removeWatch' once you don't want to watch a file any more.
--
-----------------------------------------------------------------------------

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
(WatchDescriptor -> WatchDescriptor -> Bool)
-> (WatchDescriptor -> WatchDescriptor -> Bool)
-> Eq WatchDescriptor
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 _ fd1 :: FD
fd1 _ _ _) == :: INotify -> INotify -> Bool
== (INotify _ fd2 :: FD
fd2 _ _ _) = FD
fd1 FD -> FD -> Bool
forall a. Eq a => a -> a -> Bool
== FD
fd2

newtype Cookie = Cookie CUInt deriving (Cookie -> Cookie -> Bool
(Cookie -> Cookie -> Bool)
-> (Cookie -> Cookie -> Bool) -> Eq Cookie
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
Eq Cookie =>
(Cookie -> Cookie -> Ordering)
-> (Cookie -> Cookie -> Bool)
-> (Cookie -> Cookie -> Bool)
-> (Cookie -> Cookie -> Bool)
-> (Cookie -> Cookie -> Bool)
-> (Cookie -> Cookie -> Cookie)
-> (Cookie -> Cookie -> Cookie)
-> Ord 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
$cp1Ord :: Eq Cookie
Ord)

data FDEvent = FDEvent WD Masks CUInt{-Cookie-} (Maybe RawFilePath) deriving (FDEvent -> FDEvent -> Bool
(FDEvent -> FDEvent -> Bool)
-> (FDEvent -> FDEvent -> Bool) -> Eq FDEvent
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
(Int -> FDEvent -> ShowS)
-> (FDEvent -> String) -> ([FDEvent] -> ShowS) -> Show FDEvent
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 =
    -- | A file was accessed. @Accessed isDirectory file@
      Accessed
        { Event -> Bool
isDirectory :: Bool
        , Event -> Maybe RawFilePath
maybeFilePath :: Maybe RawFilePath
        }
    -- | A file was modified. @Modified isDirectory file@
    | Modified
        { isDirectory :: Bool
        , maybeFilePath :: Maybe RawFilePath
        }
    -- | A files attributes where changed. @Attributes isDirectory file@
    | Attributes
        { isDirectory :: Bool
        , maybeFilePath :: Maybe RawFilePath
        }
    -- | A file was closed. @Closed isDirectory file wasWriteable@
    | Closed
        { isDirectory :: Bool
        , maybeFilePath :: Maybe RawFilePath
        , Event -> Bool
wasWriteable :: Bool
        }
    -- | A file was opened. @Opened isDirectory maybeFilePath@
    | Opened
        { isDirectory :: Bool
        , maybeFilePath :: Maybe RawFilePath
        }
    -- | A file was moved away from the watched dir. @MovedFrom isDirectory from cookie@
    | MovedOut
        { isDirectory :: Bool
        , Event -> RawFilePath
filePath :: RawFilePath
        , Event -> Cookie
moveCookie :: Cookie
        }
    -- | A file was moved into the watched dir. @MovedTo isDirectory to cookie@
    | MovedIn
        { isDirectory :: Bool
        , filePath :: RawFilePath
        , moveCookie :: Cookie
        }
    -- | The watched file was moved. @MovedSelf isDirectory@
    | MovedSelf
        { isDirectory :: Bool
        }
    -- | A file was created. @Created isDirectory file@
    | Created
        { isDirectory :: Bool
        , filePath :: RawFilePath
        }
    -- | A file was deleted. @Deleted isDirectory file@
    | Deleted
        { isDirectory :: Bool
        , filePath :: RawFilePath
        }
    -- | The file watched was deleted.
    | DeletedSelf
    -- | The file watched was unmounted.
    | Unmounted
    -- | The queue overflowed.
    | QOverflow
    | Ignored
    | Unknown FDEvent
    deriving (Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
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
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
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
(EventVariety -> EventVariety -> Bool)
-> (EventVariety -> EventVariety -> Bool) -> Eq EventVariety
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 _ fd :: FD
fd _ _ _) =
        String -> ShowS
showString "<inotify fd=" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        FD -> ShowS
forall a. Show a => a -> ShowS
shows FD
fd ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ">"

instance Show WatchDescriptor where
    show :: WatchDescriptor -> String
show (WatchDescriptor _ wd :: FD
wd) = String -> ShowS
showString "<wd=" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FD -> ShowS
forall a. Show a => a -> ShowS
shows FD
wd ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ">"

instance Show Cookie where
    show :: Cookie -> String
show (Cookie c :: CUInt
c) = String -> ShowS
showString "<cookie " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> ShowS
forall a. Show a => a -> ShowS
shows CUInt
c ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ">"

initINotify :: IO INotify
initINotify :: IO INotify
initINotify = do
    FD
fdint <- String -> IO FD -> IO FD
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 "initINotify" IO FD
c_inotify_init
    (fd :: FD
fd,fd_type :: IODeviceType
fd_type) <- FD
-> IOMode
-> Maybe (IODeviceType, CDev, CIno)
-> Bool
-> Bool
-> IO (FD, IODeviceType)
FD.mkFD FD
fdint IOMode
ReadMode ((IODeviceType, CDev, CIno) -> Maybe (IODeviceType, CDev, CIno)
forall a. a -> Maybe a
Just (IODeviceType
Stream,0,0))
            Bool
False{-is_socket-}
            Bool
False{-is_nonblock-}
    Handle
h <- FD
-> IODeviceType
-> String
-> IOMode
-> Bool
-> Maybe TextEncoding
-> IO Handle
mkHandleFromFD FD
fd IODeviceType
fd_type
           (String -> ShowS
showString "<inotify handle, fd=" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FD -> ShowS
forall a. Show a => a -> ShowS
shows FD
fd ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ">")
           IOMode
ReadMode
           Bool
True  -- make non-blocking.  Otherwise reading uses select(), which
                 -- can fail when there are >=1024 FDs
           Maybe TextEncoding
forall a. Maybe a
Nothing -- no encoding, so binary
    MVar (Map FD (Event -> IO ()))
em <- Map FD (Event -> IO ()) -> IO (MVar (Map FD (Event -> IO ())))
forall a. a -> IO (MVar a)
newMVar Map FD (Event -> IO ())
forall k a. Map k a
Map.empty
    (tid1 :: Async ()
tid1, tid2 :: Async ()
tid2) <- Handle -> MVar (Map FD (Event -> IO ())) -> IO (Async (), Async ())
inotify_start_thread Handle
h MVar (Map FD (Event -> IO ()))
em
    INotify -> IO INotify
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle
-> FD
-> MVar (Map FD (Event -> IO ()))
-> Async ()
-> Async ()
-> INotify
INotify Handle
h FD
fdint MVar (Map FD (Event -> IO ()))
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 _ fd :: FD
fd em :: MVar (Map FD (Event -> IO ()))
em _ _) masks :: [EventVariety]
masks fp :: RawFilePath
fp cb :: Event -> IO ()
cb = do
    IO () -> (IOError -> IO ()) -> IO ()
forall a. IO a -> (IOError -> IO a) -> IO a
catch_IO (IO FileStatus -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO FileStatus -> IO ()) -> IO FileStatus -> IO ()
forall a b. (a -> b) -> a -> b
$
              (if (EventVariety
NoSymlink EventVariety -> [EventVariety] -> Bool
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) ((IOError -> IO ()) -> IO ()) -> (IOError -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \_ ->
        IOError -> IO ()
forall a. IOError -> IO a
ioError (IOError -> IO ()) -> IOError -> IO ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
mkIOError IOErrorType
doesNotExistErrorType
             "can't watch what isn't there!"
             Maybe Handle
forall a. Maybe a
Nothing
             (String -> Maybe String
forall a. a -> Maybe a
Just (RawFilePath -> String
forall a. Show a => a -> String
show RawFilePath
fp))
    let mask :: CUInt
mask = [Mask] -> CUInt
joinMasks ((EventVariety -> Mask) -> [EventVariety] -> [Mask]
forall a b. (a -> b) -> [a] -> [b]
map EventVariety -> Mask
eventVarietyToMask [EventVariety]
masks)
    FD
wd <- RawFilePath -> (CString -> IO FD) -> IO FD
forall a. RawFilePath -> (CString -> IO a) -> IO a
withFilePath RawFilePath
fp ((CString -> IO FD) -> IO FD) -> (CString -> IO FD) -> IO FD
forall a b. (a -> b) -> a -> b
$ \fp_c :: CString
fp_c ->
            String -> IO FD -> IO FD
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 "addWatch" (IO FD -> IO FD) -> IO FD -> IO FD
forall a b. (a -> b) -> a -> b
$
              FD -> CString -> CUInt -> IO FD
c_inotify_add_watch (FD -> FD
forall a b. (Integral a, Num b) => a -> b
fromIntegral FD
fd) CString
fp_c CUInt
mask
    let event :: Event -> IO ()
event = \e :: Event
e -> IO () -> IO ()
ignore_failure (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            case Event
e of
              -- if the event is Ignored then we know for sure that
              -- this is the last event on that WatchDescriptor
              Ignored -> INotify -> FD -> IO ()
rm_watch INotify
inotify FD
wd
              _       -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Event -> IO ()
cb Event
e
    MVar (Map FD (Event -> IO ()))
-> (Map FD (Event -> IO ()) -> IO (Map FD (Event -> IO ())))
-> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar (Map FD (Event -> IO ()))
em ((Map FD (Event -> IO ()) -> IO (Map FD (Event -> IO ())))
 -> IO ())
-> (Map FD (Event -> IO ()) -> IO (Map FD (Event -> IO ())))
-> IO ()
forall a b. (a -> b) -> a -> b
$ \em' :: Map FD (Event -> IO ())
em' -> Map FD (Event -> IO ()) -> IO (Map FD (Event -> IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (((Event -> IO ()) -> (Event -> IO ()) -> Event -> IO ())
-> FD
-> (Event -> IO ())
-> Map FD (Event -> IO ())
-> Map FD (Event -> IO ())
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith ((IO () -> IO () -> IO ())
-> (Event -> IO ()) -> (Event -> IO ()) -> Event -> IO ()
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>)) FD
wd Event -> IO ()
event Map FD (Event -> IO ())
em')
    WatchDescriptor -> IO WatchDescriptor
forall (m :: * -> *) a. Monad m => a -> m a
return (INotify -> FD -> WatchDescriptor
WatchDescriptor INotify
inotify FD
wd)
    where
    -- catch_IO is same as catchIOError from base >= 4.5.0.0
    catch_IO :: IO a -> (IOError -> IO a) -> IO a
    catch_IO :: IO a -> (IOError -> IO a) -> IO a
catch_IO = IO a -> (IOError -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch
    eventVarietyToMask :: EventVariety -> Mask
eventVarietyToMask ev :: EventVariety
ev =
        case EventVariety
ev of
            Access -> Mask
inAccess
            Modify -> Mask
inModify
            Attrib -> Mask
inAttrib
            Close -> Mask
inClose
            CloseWrite -> Mask
inCloseWrite
            CloseNoWrite -> Mask
inCloseNowrite
            Open -> Mask
inOpen
            Move -> Mask
inMove
            MoveIn -> Mask
inMovedTo
            MoveOut -> Mask
inMovedFrom
            MoveSelf -> Mask
inMoveSelf
            Create -> Mask
inCreate
            Delete -> Mask
inDelete
            DeleteSelf-> Mask
inDeleteSelf
            OnlyDir -> Mask
inOnlydir
            NoSymlink -> Mask
inDontFollow
            MaskAdd -> Mask
inMaskAdd
            OneShot -> Mask
inOneshot
            AllEvents -> Mask
inAllEvents

    ignore_failure :: IO () -> IO ()
    ignore_failure :: IO () -> IO ()
ignore_failure action :: IO ()
action = IO ()
action IO () -> (SomeException -> IO ()) -> IO ()
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 e :: SomeException
e
#if MIN_VERSION_async(2,2,1)
        | Just AsyncCancelled <- SomeException -> Maybe AsyncCancelled
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e = SomeException -> IO ()
forall e a. Exception e => e -> IO a
throwIO SomeException
e
#else
        | Just ThreadKilled{} <- fromException e = throwIO e
#endif
        | Bool
otherwise = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

removeWatch :: WatchDescriptor -> IO ()
removeWatch :: WatchDescriptor -> IO ()
removeWatch (WatchDescriptor (INotify _ fd :: FD
fd _ _ _) wd :: FD
wd) = do
    FD
_ <- String -> IO FD -> IO FD
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 "removeWatch" (IO FD -> IO FD) -> IO FD -> IO FD
forall a b. (a -> b) -> a -> b
$
      FD -> FD -> IO FD
c_inotify_rm_watch (FD -> FD
forall a b. (Integral a, Num b) => a -> b
fromIntegral FD
fd) FD
wd
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

rm_watch :: INotify -> WD -> IO ()
rm_watch :: INotify -> FD -> IO ()
rm_watch (INotify _ _ em :: MVar (Map FD (Event -> IO ()))
em _ _) wd :: FD
wd =
    MVar (Map FD (Event -> IO ()))
-> (Map FD (Event -> IO ()) -> IO (Map FD (Event -> IO ())))
-> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar (Map FD (Event -> IO ()))
em (Map FD (Event -> IO ()) -> IO (Map FD (Event -> IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Map FD (Event -> IO ()) -> IO (Map FD (Event -> IO ())))
-> (Map FD (Event -> IO ()) -> Map FD (Event -> IO ()))
-> Map FD (Event -> IO ())
-> IO (Map FD (Event -> IO ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FD -> Map FD (Event -> IO ()) -> Map FD (Event -> IO ())
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete FD
wd)

read_events :: Handle -> IO [WDEvent]
read_events :: Handle -> IO [WDEvent]
read_events h :: Handle
h =
    let maxRead :: Int
maxRead = 16385 in
    Int -> (Ptr Any -> IO [WDEvent]) -> IO [WDEvent]
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
maxRead ((Ptr Any -> IO [WDEvent]) -> IO [WDEvent])
-> (Ptr Any -> IO [WDEvent]) -> IO [WDEvent]
forall a b. (a -> b) -> a -> b
$ \buffer :: Ptr Any
buffer -> do
        Bool
_ <- Handle -> Int -> IO Bool
hWaitForInput Handle
h (-1)  -- wait forever
        Int
r <- Handle -> Ptr Any -> Int -> IO Int
forall a. Handle -> Ptr a -> Int -> IO Int
hGetBufNonBlocking Handle
h Ptr Any
buffer Int
maxRead
        Ptr Any -> Int -> IO [WDEvent]
forall a. Ptr a -> Int -> IO [WDEvent]
read_events' Ptr Any
buffer Int
r
    where
    read_events' :: Ptr a -> Int -> IO [WDEvent]
    read_events' :: Ptr a -> Int -> IO [WDEvent]
read_events' _ r :: Int
r |  Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = [WDEvent] -> IO [WDEvent]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    read_events' ptr :: Ptr a
ptr r :: Int
r = do
        FD
wd     <- ((\hsc_ptr :: Ptr a
hsc_ptr -> Ptr a -> Int -> IO FD
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr a
hsc_ptr 0))     Ptr a
ptr :: IO CInt
{-# LINE 273 "src/System/INotify.hsc" #-}
        CUInt
mask   <- ((\hsc_ptr :: Ptr a
hsc_ptr -> Ptr a -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr a
hsc_ptr 4))   Ptr a
ptr :: IO CUInt
{-# LINE 274 "src/System/INotify.hsc" #-}
        CUInt
cookie <- ((\hsc_ptr :: Ptr a
hsc_ptr -> Ptr a -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr a
hsc_ptr 8)) Ptr a
ptr :: IO CUInt
{-# LINE 275 "src/System/INotify.hsc" #-}
        CUInt
len    <- ((\hsc_ptr :: Ptr a
hsc_ptr -> Ptr a -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr a
hsc_ptr 12))    Ptr a
ptr :: IO CUInt
{-# LINE 276 "src/System/INotify.hsc" #-}
        Maybe RawFilePath
nameM  <- if CUInt
len CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
== 0
                    then Maybe RawFilePath -> IO (Maybe RawFilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RawFilePath
forall a. Maybe a
Nothing
                    else do
                        (RawFilePath -> Maybe RawFilePath)
-> IO RawFilePath -> IO (Maybe RawFilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RawFilePath -> Maybe RawFilePath
forall a. a -> Maybe a
Just (IO RawFilePath -> IO (Maybe RawFilePath))
-> IO RawFilePath -> IO (Maybe RawFilePath)
forall a b. (a -> b) -> a -> b
$ CString -> IO RawFilePath
peekFilePath (((\hsc_ptr :: Ptr a
hsc_ptr -> Ptr a
hsc_ptr Ptr a -> Int -> CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16)) Ptr a
ptr)
{-# LINE 280 "src/System/INotify.hsc" #-}
        let event_size :: Int
event_size = ((16)) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
len)
{-# LINE 281 "src/System/INotify.hsc" #-}
            event :: WDEvent
event = FDEvent -> WDEvent
cEvent2Haskell (FD -> CUInt -> CUInt -> Maybe RawFilePath -> FDEvent
FDEvent FD
wd CUInt
mask CUInt
cookie Maybe RawFilePath
nameM)
        [WDEvent]
rest <- Ptr Any -> Int -> IO [WDEvent]
forall a. Ptr a -> Int -> IO [WDEvent]
read_events' (Ptr a
ptr Ptr a -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
event_size) (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
event_size)
        [WDEvent] -> IO [WDEvent]
forall (m :: * -> *) a. Monad m => a -> m a
return (WDEvent
eventWDEvent -> [WDEvent] -> [WDEvent]
forall a. a -> [a] -> [a]
:[WDEvent]
rest)
    cEvent2Haskell :: FDEvent
               -> WDEvent
    cEvent2Haskell :: FDEvent -> WDEvent
cEvent2Haskell fdevent :: FDEvent
fdevent@(FDEvent wd :: FD
wd mask :: CUInt
mask cookie :: CUInt
cookie nameM :: Maybe RawFilePath
nameM)
        = (FD
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 bits :: Mask
bits = Mask -> CUInt -> Bool
maskIsSet Mask
bits CUInt
mask
        name :: RawFilePath
name = Maybe RawFilePath -> RawFilePath
forall a. HasCallStack => Maybe a -> a
fromJust Maybe RawFilePath
nameM

inotify_start_thread :: Handle -> MVar EventMap -> IO (Async (), Async ())
inotify_start_thread :: Handle -> MVar (Map FD (Event -> IO ())) -> IO (Async (), Async ())
inotify_start_thread h :: Handle
h em :: MVar (Map FD (Event -> IO ()))
em = do
    Chan [WDEvent]
chan_events <- IO (Chan [WDEvent])
forall a. IO (Chan a)
newChan
    Async ()
tid1 <- IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async (String -> IO () -> IO ()
logFailure "dispatcher" (Chan [WDEvent] -> IO ()
dispatcher Chan [WDEvent]
chan_events))
    Async ()
tid2 <- IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async (String -> IO () -> IO ()
logFailure "start_thread" (Chan [WDEvent] -> IO ()
start_thread Chan [WDEvent]
chan_events))
    (Async (), Async ()) -> IO (Async (), Async ())
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_events :: Chan [WDEvent]
chan_events = do
        [WDEvent]
events <- Handle -> IO [WDEvent]
read_events Handle
h
        Chan [WDEvent] -> [WDEvent] -> IO ()
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_events :: Chan [WDEvent]
chan_events = do
        [WDEvent]
events <- Chan [WDEvent] -> IO [WDEvent]
forall a. Chan a -> IO a
readChan Chan [WDEvent]
chan_events
        (WDEvent -> IO ()) -> [WDEvent] -> IO ()
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 (_,  e :: Event
e@Event
QOverflow) = do -- send overflows to all handlers
        Map FD (Event -> IO ())
handlers <- MVar (Map FD (Event -> IO ())) -> IO (Map FD (Event -> IO ()))
forall a. MVar a -> IO a
readMVar MVar (Map FD (Event -> IO ()))
em
        ((Event -> IO ()) -> IO ()) -> [Event -> IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Event -> IO ()) -> Event -> IO ()
forall a b. (a -> b) -> a -> b
$ Event
e) (Map FD (Event -> IO ()) -> [Event -> IO ()]
forall k a. Map k a -> [a]
Map.elems Map FD (Event -> IO ())
handlers)
    runHandler (wd :: FD
wd, event :: Event
event) = do
        Map FD (Event -> IO ())
handlers <- MVar (Map FD (Event -> IO ())) -> IO (Map FD (Event -> IO ()))
forall a. MVar a -> IO a
readMVar MVar (Map FD (Event -> IO ()))
em
        let handlerM :: Maybe (Event -> IO ())
handlerM = FD -> Map FD (Event -> IO ()) -> Maybe (Event -> IO ())
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FD
wd Map FD (Event -> IO ())
handlers
        case Maybe (Event -> IO ())
handlerM of
          Nothing -> String -> IO ()
putStrLn "runHandler: couldn't find handler" -- impossible?
          Just handler :: Event -> IO ()
handler -> Event -> IO ()
handler Event
event

    logFailure :: String -> IO () -> IO ()
logFailure name :: String
name io :: IO ()
io = IO ()
io IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \e :: SomeException
e ->
       case SomeException
e of
#if MIN_VERSION_async(2,2,1)
         _ | Just AsyncCancelled <- SomeException -> Maybe AsyncCancelled
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e -> () -> IO ()
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 String -> ShowS
forall a. [a] -> [a] -> [a]
++ " dying: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SomeException -> String
forall a. Show a => a -> String
show SomeException
e)

killINotify :: INotify -> IO ()
killINotify :: INotify -> IO ()
killINotify (INotify h :: Handle
h _ _ tid1 :: Async ()
tid1 tid2 :: Async ()
tid2) =
    do Async () -> IO ()
forall a. Async a -> IO ()
cancelWait Async ()
tid1
       Async () -> IO ()
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 :: Async a -> IO ()
cancelWait = Async a -> IO ()
forall a. Async a -> IO ()
cancel
#else
cancelWait a = do cancel a; void $ waitCatch a
#endif

withINotify :: (INotify -> IO a) -> IO a
withINotify :: (INotify -> IO a) -> IO a
withINotify = IO INotify -> (INotify -> IO ()) -> (INotify -> IO a) -> IO a
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