module System.Inotify
( ChangeEvent(..)
, Option(..)
, Alert(..)
, Event(..)
, Inotify
, Watch
, inotify
, addWatch
, next
, allChangeEvents
) where
import Control.Concurrent (threadWaitRead)
import Control.Concurrent.MVar
import Data.Bits ((.&.), (.|.))
import qualified Data.ByteString as B
import Data.IORef
import Data.Word (Word32)
import System.Posix.Types (Fd(..))
import Foreign.C.Error
import Foreign.C.Types
import Foreign.C.String (withCString)
import Foreign.Ptr
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Storable
data ChangeEvent = Accessed
| Modified
| AttributeModified
| WritableClosed
| Closed
| Opened
| MovedFrom
| MovedTo
| SelfMoved
| Created
| Deleted
| SelfDeleted
deriving (Show, Eq, Enum)
data Option = DontFollow
| MaskAdd
| Oneshot
| OnlyDir
deriving (Show, Eq, Enum)
data Alert = Ignored
| QueueOverflowed
| Unmounted
deriving (Show, Eq, Enum)
allChangeEvents :: [ChangeEvent]
allChangeEvents = enumFromTo Accessed SelfDeleted
eventValue :: ChangeEvent -> Word32
eventValue Accessed = (1)
eventValue Modified = (2)
eventValue AttributeModified = (4)
eventValue WritableClosed = (8)
eventValue Closed = (16)
eventValue Opened = (32)
eventValue MovedFrom = (64)
eventValue MovedTo = (128)
eventValue SelfMoved = (2048)
eventValue Created = (256)
eventValue Deleted = (512)
eventValue SelfDeleted = (1024)
optionValue :: Option -> Word32
optionValue DontFollow = (33554432)
optionValue MaskAdd = (536870912)
optionValue Oneshot = (2147483648)
optionValue OnlyDir = (16777216)
alertValue :: Alert -> Word32
alertValue Ignored = (32768)
alertValue QueueOverflowed = (16384)
alertValue Unmounted = (8192)
eventsToMask :: [ChangeEvent] -> Word32
eventsToMask = foldl (.|.) 0 . map eventValue
optionsToMask :: [Option] -> Word32
optionsToMask = foldl (.|.) 0 . map optionValue
decodeMask :: Word32 -> ([ChangeEvent], [Alert])
decodeMask mask = (events, alerts) where
events = filter (\ev -> mask .&. eventValue ev /= 0) $ enumFromTo Accessed SelfDeleted
alerts = filter (\al -> mask .&. alertValue al /= 0) $ enumFromTo Ignored Unmounted
foreign import ccall unsafe "inotify_init"
_init :: IO CInt
foreign import ccall unsafe "inotify_add_watch"
_add_watch :: CInt -> Ptr CChar -> Word32 -> IO CInt
foreign import ccall unsafe "inotify_rm_watch"
_rm_watch :: CInt -> CInt -> IO CInt
foreign import ccall unsafe "close"
_close :: CInt -> IO ()
foreign import ccall unsafe "read"
_read :: CInt -> Ptr CChar -> CSize -> IO CInt
newtype Watch = Watch CInt deriving (Show, Eq)
data Inotify = Inotify (IORef [Event]) (MVar CInt)
inotify :: IO Inotify
inotify = do
fd <- _init
mv <- newMVar fd
addMVarFinalizer mv (_close fd)
buffer <- newIORef []
return $ Inotify buffer mv
addWatch :: Inotify -> FilePath -> [ChangeEvent] -> [Option] -> IO Watch
addWatch (Inotify _ mv) path events options = do
fd <- readMVar mv
withCString path $ \ptr -> do
watch <- _add_watch fd ptr (optionsToMask options .|. eventsToMask events)
return $ Watch watch
data Event = Event { evwatch :: Watch
, evevents :: [ChangeEvent]
, evalerts :: [Alert]
, evcookie :: Word32
, evname :: B.ByteString
} deriving (Show)
eventFromBuffer :: Ptr CChar -> IO Event
eventFromBuffer ptr = do
namelen <- (((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr) :: IO Word32
name <- if namelen > 0
then B.packCString (ptr `plusPtr` ((16)))
else return B.empty
watchno <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
mask <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
cookie <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
let (events, alerts) = decodeMask mask
return $ Event (Watch watchno) events alerts cookie name
eventLength :: Ptr CChar -> IO Int
eventLength ptr = do
namelen <- (((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr) :: IO Word32
return $ ((16)) + fromIntegral namelen
unfoldrM :: (Monad m) => (b -> m (Maybe (a, b))) -> b -> m [a]
unfoldrM f b = do
r <- f b
case r of
Just (a, new_b) -> do
next <- unfoldrM f new_b
return $ a : next
Nothing -> return []
unfoldEvents :: Int -> (Int, Ptr CChar) -> IO (Maybe (Event, (Int, Ptr CChar)))
unfoldEvents length (done, ptr)
| done == length = return Nothing
| otherwise = do
event <- eventFromBuffer ptr
len <- eventLength ptr
return $ Just (event, (done + len, ptr `plusPtr` len))
next :: Inotify -> IO Event
next i@(Inotify buffer mv) = do
previousEvents <- readIORef buffer
case previousEvents of
x:xs -> do
writeIORef buffer xs
return x
[] -> do
fd <- readMVar mv
threadWaitRead $ Fd fd
let bufsize = ((16)) + 1024
allocaBytes bufsize $ \ptr -> do
n <- _read fd ptr $ fromIntegral bufsize
case n of
(1) -> do
errno <- getErrno
if errno == eINTR
then next i
else throwErrno "Inotify next"
0 -> next i
_ -> do
events <- unfoldrM (unfoldEvents $ fromIntegral n) (0, ptr)
case events of
[] -> next i
[x] -> return x
x:xs -> writeIORef buffer xs >> return x