pax_global_header00006660000000000000000000000064120462624660014522gustar00rootroot0000000000000052 comment=3e31f80c9c92330084de87b4459c4d71e937db02 hinotify-0.3.5/000077500000000000000000000000001204626246600133605ustar00rootroot00000000000000hinotify-0.3.5/.gitignore000066400000000000000000000000411204626246600153430ustar00rootroot00000000000000dist _darcs tests/*.hi tests/*.o hinotify-0.3.5/ANNOUNCE000066400000000000000000000031301204626246600145060ustar00rootroot00000000000000Greetings! I'm pleased to announce hinotify 0.1, a library to inotify[1] which has been part of the Linux kernel since 2.6.13. inotify provides file system event notification, simply add a watcher to a file or directory and get an event when it is accessed or modified. The API basically consists of: inotify_init :: IO INotify inotify_add_watch :: INotify -> [EventVariety] -- different events to listen on -> FilePath -- file/directory to watch -> (Event -> IO ()) -- event handler -> IO WatchDescriptor inotify_rm_watch :: INotify -> WatchDescriptor -> IO () A sample program: > import System.Directory > import System.IO > > import System.INotify > > main :: IO () > main = do > inotify <- inotify_init > print inotify > home <- getHomeDirectory > wd <- inotify_add_watch inotify > [Open,Close,Access,Modify,Move] > home > print > print wd > putStrLn "Listens to your home directory. Hit enter to terminate." > getLine > inotify_rm_watch inotify wd The code is available via www: http://haskell.org/~kolmodin/code/hinotify/download/hinotify-0.1.tar.gz and via darcs: darcs get http://haskell.org/~kolmodin/code/hinotify/ The API is available at: http://haskell.org/~kolmodin/code/hinotify/docs/api/ The library is very young and I'm most grateful for feedback on the API, and what else you might have to suggest. Cheers, Lennart Kolmodin [1] http://www.kernel.org/pub/linux/kernel/people/rml/inotify/ hinotify-0.3.5/LICENSE000066400000000000000000000026631204626246600143740ustar00rootroot00000000000000Copyright (c) Lennart Kolmodin All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hinotify-0.3.5/Makefile000066400000000000000000000001341204626246600150160ustar00rootroot00000000000000 .PHONY : docs docs : README.html %.html : % pandoc -s -S --toc -c hinotify.css $< -o $@ hinotify-0.3.5/README.md000066400000000000000000000051411204626246600146400ustar00rootroot00000000000000hinotify: inotify for Haskell ============================= About ----- hinotify, a library to [inotify] which has been part of the Linux kernel since 2.6.13. inotify provides file system event notification, simply add a watcher to a file or directory and get an event when it is accessed or modified. This module is named `hinotify`. See example code in the `examples` directory, distributed with the source code. [inotify]: http://www.kernel.org/pub/linux/kernel/people/rml/inotify/ News ---- **hinotify 0.3.2** * Make each `WatchDescriptor` contain its `INotify`. Changes to the function types: > -removeWatch :: INotify -> WatchDescriptor -> IO () > +removeWatch :: WatchDescriptor -> IO () * Fix typo in declaration of `Deleted` in `data Event`; > - { isDirecotry :: Bool > + { isDirectory :: Bool **hinotify 0.3.1** * Use `inotify.h` from `glibc` rather than from the linux headers, as recommended upstream. **hinotify 0.3** * Compiles with GHC 6.12, GHC 6.10.4, GHC 6.8.2 and GHC 6.6.1 **hinotify 0.2** * Updates to the API - Function names is now in semiCamelCase - Restructure event parameters to make it more consistent * Small test suit in `tests/` * Compiles with GHC 6.8.2 and GHC 6.6.1 * Requires Cabal 1.2 **hinotify 0.1** : Initial release API --- The API basically consists of: ```haskell initINotify :: IO INotify addWatch :: INotify -> [EventVariety] -- different events to listen on -> FilePath -- file/directory to watch -> (Event -> IO ()) -- event handler -> IO WatchDescriptor removeWatch :: WatchDescriptor -> IO () ``` A sample program: ```haskell import System.Directory import System.IO import System.INotify main :: IO () main = do inotify <- initINotify print inotify home <- getHomeDirectory wd <- addWatch inotify [Open,Close,Access,Modify,Move] home print print wd putStrLn "Listens to your home directory. Hit enter to terminate." getLine removeWatch wd ``` Download -------- The code is available via the [homepage], and via darcs: git clone https://github.com/kolmodin/hinotify.git The [API] is available online. I'm most grateful for feedback on the API, and what else you might have to suggest. Author ------ Lennart Kolmodin `kolmodin at gmail.com` Legal ----- This software is released under a BSD-style license. See LICENSE for more details. Copyright © 2007-2012 Lennart Kolmodin [homepage]: https://github.com/kolmodin/hinotify.git [API]: http://hackage.haskell.org/packages/archive/hinotify/latest/doc/html/System-INotify.html hinotify-0.3.5/Setup.lhs000077500000000000000000000001101204626246600151630ustar00rootroot00000000000000#!/usr/bin/runhaskell > import Distribution.Simple > main = defaultMain hinotify-0.3.5/docs/000077500000000000000000000000001204626246600143105ustar00rootroot00000000000000hinotify-0.3.5/docs/hcar/000077500000000000000000000000001204626246600152255ustar00rootroot00000000000000hinotify-0.3.5/docs/hcar/hinotify-Lh.tex000066400000000000000000000024011204626246600201360ustar00rootroot00000000000000\begin{hcarentry}{hinotify} \report{Lennart Kolmodin} \status{alive} \makeheader ``hinotify'' is a simple Haskell wrapper for the Linux kernel's inotify mechanism. inotify allows applications to watch file changes since Linux kernel 2.6.13. You can for example use it to do a proper locking procedure on a set of files, or keep your application up do date on a directory of files in a fast and clean way. As file and directory notification is available for many operating systems upcoming work will include to try to find a common API that could be shared for all platforms. Last work has been to see what's possible to do under Microsoft Windows, and finding a suiting API for both platforms. This has been a joint work with Niklas Broberg. We're still looking for contributors to *BSD and Mac OS X. If you're interested, contact us. \FurtherReading \begin{compactitem} \item Development version: \texttt{darcs get} \url{http://www.haskell.org/~kolmodin/code/hinotify/} \item Latest released version: \url{http://www.haskell.org/~kolmodin/code/hinotify/download/} \item Documentation: \url{http://www.haskell.org/~kolmodin/code/hinotify/docs/api} \item inotify: \url{http://www.kernel.org/pub/linux/kernel/people/rml/inotify/} \end{compactitem} \end{hcarentry} hinotify-0.3.5/examples/000077500000000000000000000000001204626246600151765ustar00rootroot00000000000000hinotify-0.3.5/examples/DirTree/000077500000000000000000000000001204626246600165345ustar00rootroot00000000000000hinotify-0.3.5/examples/DirTree/DirTree.hs000066400000000000000000000102201204626246600204210ustar00rootroot00000000000000-- Duncan Coutts 2006-2007 -- Requires gtk2hs 0.9.11 import qualified Data.Map as Map import System.Directory import System.Environment import Control.Concurrent import Data.IORef import Control.Monad (liftM) import Ix (inRange) import System.INotify import Graphics.UI.Gtk hiding (TreeModelFlags(TreeModelListOnly), cellText) import Graphics.UI.Gtk.ModelView.CellLayout import Graphics.UI.Gtk.ModelView.Types (TypedTreeModelClass) import Graphics.UI.Gtk.ModelView.TreeModel (TreeModelFlags(TreeModelListOnly)) import Graphics.UI.Gtk.ModelView.CellRendererText (cellText) import Graphics.UI.Gtk.ModelView.CustomStore import Graphics.UI.Gtk.TreeList.TreeIter instance TypedTreeModelClass (CustomTreeModel a) dirModelNew :: FilePath -> IO (CustomTreeModel () FilePath) dirModelNew path = do dirContents <- getDirectoryContents path rows <- newIORef (Map.fromList (zip dirContents (repeat ()))) model <- customTreeModelNew () CustomTreeModelImplementation { customTreeModelGetFlags = return [TreeModelListOnly], customTreeModelGetIter = \[n] -> return (Just (TreeIter 0 (fromIntegral n) 0 0)), customTreeModelGetPath = \(TreeIter _ n _ _) -> return [fromIntegral n], customTreeModelGetRow = \(TreeIter _ n _ _) -> readIORef rows >>= \rows -> if inRange (0, Map.size rows - 1) (fromIntegral n) then return (fst $ Map.elemAt (fromIntegral n) rows) else fail "DirModel.getRow: iter does not refer to a valid entry", customTreeModelIterNext = \(TreeIter _ n _ _) -> readIORef rows >>= \rows -> if n >= fromIntegral (Map.size rows) - 1 then return Nothing else return (Just (TreeIter 0 (n+1) 0 0)), customTreeModelIterChildren = \_ -> return Nothing, customTreeModelIterHasChild = \_ -> return False, customTreeModelIterNChildren = \index -> readIORef rows >>= \rows -> case index of Nothing -> return $! Map.size rows _ -> return 0, customTreeModelIterNthChild = \index n -> case index of Nothing -> return (Just (TreeIter 0 (fromIntegral n) 0 0)) _ -> return Nothing, customTreeModelIterParent = \_ -> return Nothing, customTreeModelRefNode = \_ -> return (), customTreeModelUnrefNode = \_ -> return () } notify <- initINotify watch <- addWatch notify [Move, Create, Delete] path $ \event -> let add file = do index <- atomicModifyIORef rows (\map -> let map' = Map.insert file () map in (map', Map.findIndex file map')) treeModelRowInserted model [index] (TreeIter 0 (fromIntegral index) 0 0) remove file = do index <- atomicModifyIORef rows (\map -> let map' = Map.delete file map in (map', Map.findIndex file map)) treeModelRowDeleted model [index] in case event of MovedIn _ file _ -> add file MovedOut _ file _ -> remove file Created _ file -> add file Deleted _ file -> remove file _ -> putStrLn $ "other event: " ++ show event -- TODO: on destroy model (INotify.removeWatch watch) return model main = do initGUI win <- windowNew win `onDestroy` mainQuit args <- getArgs let dir = case args of [d] -> d _ -> "." model <- dirModelNew dir tv <- treeViewNewWithModel model win `containerAdd` tv tvc <- treeViewColumnNew treeViewAppendColumn tv tvc text <- cellRendererTextNew cellLayoutPackStart tvc text True cellLayoutSetAttributes tvc text model (\file -> [cellText := file]) widgetShowAll win timeoutAddFull (yield >> return True) priorityDefaultIdle 50 mainGUI hinotify-0.3.5/examples/simple/000077500000000000000000000000001204626246600164675ustar00rootroot00000000000000hinotify-0.3.5/examples/simple/simple.hs000066400000000000000000000005671204626246600203240ustar00rootroot00000000000000module Main where import System.Directory import System.IO import System.INotify main :: IO () main = do inotify <- initINotify print inotify home <- getHomeDirectory wd <- addWatch inotify [Open,Close,Access,Modify,Move] home print print wd putStrLn "Listens to your home directory. Hit enter to terminate." getLine removeWatch inotify wd hinotify-0.3.5/hinotify.cabal000066400000000000000000000021701204626246600161750ustar00rootroot00000000000000name: hinotify version: 0.3.5 build-type: Simple synopsis: Haskell binding to inotify description: . This library provides a wrapper to the Linux Kernel's inotify feature, allowing applications to subscribe to notifications when a file is accessed or modified. . category: System homepage: https://github.com/kolmodin/hinotify.git license: BSD3 license-file: LICENSE author: Lennart Kolmodin maintainer: Lennart Kolmodin extra-source-files: README.md cabal-version: >= 1.6 source-repository head type: git location: git://github.com/kolmodin/hinotify.git flag split-base description: Choose the new smaller, split-up base package. library build-depends: unix if flag(split-base) build-depends: base >= 4.3.0.0 && < 5, containers, directory else build-depends: base < 3 extensions: ForeignFunctionInterface exposed-modules: System.INotify other-modules: System.INotify.Masks ghc-options: -Wall hs-source-dirs: src hinotify-0.3.5/hinotify.css000066400000000000000000000025721204626246600157310ustar00rootroot00000000000000body { margin: auto; padding-right: 1em; padding-left: 1em; max-width: 50em; border-left: 1px solid black; border-right: 1px solid black; color: black; font-family: Verdana, sans-serif; font-size: 100%; line-height: 140%; color: #333; } pre { border: 1px dotted gray; background-color: #9999ff; color: #111111; padding: 0.5em; } code { font-family: monospace; font-size: 110%; } h1 a, h2 a, h3 a, h4 a, h5 a { text-decoration: none; color: #000099; } h1, h2, h3, h4, h5 { font-family: verdana; font-weight: bold; border-bottom: 1px dotted black; color: #000099; } h1 { font-size: 130%; } h2 { font-size: 110%; border-bottom: 1px dotted black; } h3 { font-size: 95%; } h4 { font-size: 90%; font-style: italic; } h5 { font-size: 90%; font-style: italic; } h1.title { font-size: 150%; font-weight: bold; text-align: left; border: none; } dt code { font-weight: bold; } dd p { margin-top: 0; } a:link { color: #000099 } a:visited { color: #666699 } a:hover { color: #666699 } a:active { color: #000099 } #footer { padding-top: 1em; font-size: 70%; color: gray; text-align: center; } hinotify-0.3.5/src/000077500000000000000000000000001204626246600141475ustar00rootroot00000000000000hinotify-0.3.5/src/System/000077500000000000000000000000001204626246600154335ustar00rootroot00000000000000hinotify-0.3.5/src/System/INotify.hsc000066400000000000000000000257741204626246600175320ustar00rootroot00000000000000----------------------------------------------------------------------------- -- | -- 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 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 #include "sys/inotify.h" import Prelude hiding (init) import Control.Monad import Control.Concurrent import Control.Exception as E (bracket, catch, mask_, SomeException) 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 #if __GLASGOW_HASKELL__ >= 612 import GHC.IO.Handle.FD (fdToHandle') import GHC.IO.Device (IODeviceType(Stream)) #else import GHC.Handle import System.Posix.Internals #endif import System.Posix.Files 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) ThreadId ThreadId data WatchDescriptor = WatchDescriptor INotify WD deriving Eq instance Eq INotify where (INotify _ fd1 _ _ _) == (INotify _ fd2 _ _ _) = fd1 == fd2 newtype Cookie = Cookie CUInt deriving (Eq,Ord) data FDEvent = FDEvent WD Masks CUInt{-Cookie-} (Maybe String) deriving (Eq, Show) data Event = -- | A file was accessed. @Accessed isDirectory file@ Accessed { isDirectory :: Bool , maybeFilePath :: Maybe FilePath } -- | A file was modified. @Modified isDirectory file@ | Modified { isDirectory :: Bool , maybeFilePath :: Maybe FilePath } -- | A files attributes where changed. @Attributes isDirectory file@ | Attributes { isDirectory :: Bool , maybeFilePath :: Maybe FilePath } -- | A file was closed. @Closed isDirectory file wasWriteable@ | Closed { isDirectory :: Bool , maybeFilePath :: Maybe FilePath , wasWriteable :: Bool } -- | A file was opened. @Opened isDirectory maybeFilePath@ | Opened { isDirectory :: Bool , maybeFilePath :: Maybe FilePath } -- | A file was moved away from the watched dir. @MovedFrom isDirectory from cookie@ | MovedOut { isDirectory :: Bool , filePath :: FilePath , moveCookie :: Cookie } -- | A file was moved into the watched dir. @MovedTo isDirectory to cookie@ | MovedIn { isDirectory :: Bool , filePath :: FilePath , moveCookie :: Cookie } -- | The watched file was moved. @MovedSelf isDirectory@ | MovedSelf { isDirectory :: Bool } -- | A file was created. @Created isDirectory file@ | Created { isDirectory :: Bool , filePath :: FilePath } -- | A file was deleted. @Deleted isDirectory file@ | Deleted { isDirectory :: Bool , filePath :: FilePath } -- | The file watched was deleted. | DeletedSelf -- | The file watched was unmounted. | Unmounted -- | The queue overflowed. | QOverflow | Ignored | Unknown FDEvent deriving (Eq, Show) data EventVariety = Access | Modify | Attrib | Close | CloseWrite | CloseNoWrite | Open | Move | MoveIn | MoveOut | MoveSelf | Create | Delete | DeleteSelf | OnlyDir | NoSymlink | MaskAdd | OneShot | AllEvents deriving Eq instance Show INotify where show (INotify _ fd _ _ _) = showString "" instance Show WatchDescriptor where show (WatchDescriptor _ wd) = showString "" instance Show Cookie where show (Cookie c) = showString "" initINotify :: IO INotify initINotify = do fd <- throwErrnoIfMinus1 "initINotify" c_inotify_init let desc = showString "" #if __GLASGOW_HASKELL__ < 608 h <- openFd (fromIntegral fd) (Just Stream) False{-is_socket-} desc ReadMode True{-binary-} #else h <- fdToHandle' (fromIntegral fd) (Just Stream) False{-is_socket-} desc ReadMode True{-binary-} #endif em <- newMVar Map.empty (tid1, tid2) <- inotify_start_thread h em return (INotify h fd em tid1 tid2) addWatch :: INotify -> [EventVariety] -> FilePath -> (Event -> IO ()) -> IO WatchDescriptor addWatch inotify@(INotify _ fd em _ _) masks fp cb = do catch_IO (void $ (if (NoSymlink `elem` masks) then getSymbolicLinkStatus else getFileStatus) fp) $ \_ -> ioError $ mkIOError doesNotExistErrorType "can't watch what isn't there!" Nothing (Just fp) let mask = joinMasks (map eventVarietyToMask masks) wd <- withCString fp $ \fp_c -> throwErrnoIfMinus1 "addWatch" $ c_inotify_add_watch (fromIntegral fd) fp_c mask let event = \e -> do case e of -- if the event is Ignored then we know for sure that -- this is the last event on that WatchDescriptor Ignored -> rm_watch inotify wd _ -> return () cb e modifyMVar_ em $ \em' -> return (Map.insert wd event em') return (WatchDescriptor inotify 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 = E.catch eventVarietyToMask ev = case ev of Access -> inAccess Modify -> inModify Attrib -> inAttrib Close -> inClose CloseWrite -> inCloseWrite CloseNoWrite -> inCloseNowrite Open -> inOpen Move -> inMove MoveIn -> inMovedTo MoveOut -> inMovedFrom MoveSelf -> inMoveSelf Create -> inCreate Delete -> inDelete DeleteSelf-> inDeleteSelf OnlyDir -> inOnlydir NoSymlink -> inDontFollow MaskAdd -> inMaskAdd OneShot -> inOneshot AllEvents -> inAllEvents removeWatch :: WatchDescriptor -> IO () removeWatch (WatchDescriptor (INotify _ fd _ _ _) wd) = do _ <- throwErrnoIfMinus1 "removeWatch" $ c_inotify_rm_watch (fromIntegral fd) wd return () rm_watch :: INotify -> WD -> IO () rm_watch (INotify _ _ em _ _) wd = modifyMVar_ em (return . Map.delete wd) read_events :: Handle -> IO [WDEvent] read_events h = let maxRead = 16385 in allocaBytes maxRead $ \buffer -> do _ <- hWaitForInput h (-1) -- wait forever r <- hGetBufNonBlocking h buffer maxRead read_events' buffer r where read_events' :: Ptr a -> Int -> IO [WDEvent] read_events' _ r | r <= 0 = return [] read_events' ptr r = do wd <- (#peek struct inotify_event, wd) ptr :: IO CInt mask <- (#peek struct inotify_event, mask) ptr :: IO CUInt cookie <- (#peek struct inotify_event, cookie) ptr :: IO CUInt len <- (#peek struct inotify_event, len) ptr :: IO CUInt nameM <- if len == 0 then return Nothing else fmap Just $ peekCString ((#ptr struct inotify_event, name) ptr) let event_size = (#size struct inotify_event) + (fromIntegral len) event = cEvent2Haskell (FDEvent wd mask cookie nameM) rest <- read_events' (ptr `plusPtr` event_size) (r - event_size) return (event:rest) cEvent2Haskell :: FDEvent -> WDEvent cEvent2Haskell fdevent@(FDEvent wd mask cookie nameM) = (wd, event) where event | isSet inAccess = Accessed isDir nameM | isSet inModify = Modified isDir nameM | isSet inAttrib = Attributes isDir nameM | isSet inClose = Closed isDir nameM (isSet inCloseWrite) | isSet inOpen = Opened isDir nameM | isSet inMovedFrom = MovedOut isDir name (Cookie cookie) | isSet inMovedTo = MovedIn isDir name (Cookie cookie) | isSet inMoveSelf = MovedSelf isDir | isSet inCreate = Created isDir name | isSet inDelete = Deleted isDir name | isSet inDeleteSelf = DeletedSelf | isSet inUnmount = Unmounted | isSet inQOverflow = QOverflow | isSet inIgnored = Ignored | otherwise = Unknown fdevent isDir = isSet inIsdir isSet bits = maskIsSet bits mask name = fromJust nameM inotify_start_thread :: Handle -> MVar EventMap -> IO (ThreadId, ThreadId) inotify_start_thread h em = do chan_events <- newChan tid1 <- forkIO (dispatcher chan_events) tid2 <- forkIO (start_thread chan_events) return (tid1,tid2) where start_thread :: Chan [WDEvent] -> IO () start_thread chan_events = do events <- read_events h writeChan chan_events events start_thread chan_events dispatcher :: Chan [WDEvent] -> IO () dispatcher chan_events = do events <- readChan chan_events mapM_ runHandler events dispatcher chan_events runHandler :: WDEvent -> IO () runHandler (_, e@QOverflow) = do -- send overflows to all handlers handlers <- readMVar em flip mapM_ (Map.elems handlers) $ \handler -> ignore_failure (handler e) -- supress errors runHandler (wd, event) = do handlers <- readMVar em let handlerM = Map.lookup wd handlers case handlerM of Nothing -> putStrLn "runHandler: couldn't find handler" -- impossible? Just handler -> ignore_failure (handler event) ignore_failure :: IO () -> IO () ignore_failure action = mask_ (action `E.catch` ignore) where ignore :: SomeException -> IO () ignore _ = return () killINotify :: INotify -> IO () killINotify (INotify h _ _ tid1 tid2) = do killThread tid1 killThread tid2 hClose h withINotify :: (INotify -> IO a) -> IO a withINotify = bracket initINotify 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 hinotify-0.3.5/src/System/INotify/000077500000000000000000000000001204626246600170145ustar00rootroot00000000000000hinotify-0.3.5/src/System/INotify/Masks.hsc000066400000000000000000000043601204626246600205740ustar00rootroot00000000000000module System.INotify.Masks ( inAccess , inModify , inAttrib , inCloseWrite , inCloseNowrite , inOpen , inMovedFrom , inMovedTo , inMoveSelf , inCreate , inDelete , inDeleteSelf , inUnmount , inQOverflow , inIgnored , inClose , inMove , inOnlydir , inDontFollow , inMaskAdd , inIsdir , inOneshot , inAllEvents , maskIsSet , joinMasks , Mask ) where import Data.Bits import Data.Maybe import Foreign.C.Types #include "sys/inotify.h" data Mask = UserSpace CUInt | Extra CUInt | Helper CUInt | Special CUInt | All CUInt deriving (Eq,Ord) maskIsSet :: Mask -> CUInt -> Bool maskIsSet mask cuint = value mask .&. cuint > 0 value :: Mask -> CUInt value (UserSpace i) = i value (Extra i) = i value (Helper i) = i value (Special i) = i value (All i) = i instance Show Mask where show mask = fromJust $ lookup mask [ (inAccess, "IN_ACCESS"), (inModify, "IN_MODIFY"), (inAttrib, "IN_ATTRIB"), (inClose, "IN_CLOSE"), (inCloseWrite, "IN_CLOSE_WRITE"), (inCloseNowrite, "IN_CLOSE_NOWRITE"), (inOpen, "IN_OPEN"), (inMove, "IN_MOVE"), (inMovedFrom, "IN_MOVED_FROM"), (inMovedTo, "IN_MOVED_TO"), (inMoveSelf, "IN_MOVE_SELF"), (inCreate, "IN_CREATE"), (inDelete, "IN_DELETE"), (inDeleteSelf, "IN_DELETE_SELF"), (inUnmount, "IN_UNMOUNT"), (inQOverflow, "IN_Q_OVERFLOW"), (inIgnored, "IN_IGNORED"), (inClose, "IN_CLOSE"), (inIsdir, "IN_ISDIR"), (inOneshot, "IN_ONESHOT")] joinMasks :: [Mask] -> CUInt joinMasks = foldr (.|.) 0 . map value #enum Mask, UserSpace, IN_ACCESS, IN_MODIFY, IN_ATTRIB, IN_CLOSE_WRITE #enum Mask, UserSpace, IN_CLOSE_NOWRITE, IN_OPEN, IN_MOVED_FROM, IN_MOVED_TO #enum Mask, UserSpace, IN_CREATE, IN_DELETE, IN_DELETE_SELF, IN_MOVE_SELF #enum Mask, Extra, IN_UNMOUNT, IN_Q_OVERFLOW, IN_IGNORED #enum Mask, Helper, IN_CLOSE, IN_MOVE #enum Mask, Special, IN_ONLYDIR, IN_DONT_FOLLOW, IN_MASK_ADD, IN_ISDIR #enum Mask, Special, IN_ONESHOT #enum Mask, All, IN_ALL_EVENTS hinotify-0.3.5/tests/000077500000000000000000000000001204626246600145225ustar00rootroot00000000000000hinotify-0.3.5/tests/Utils.hs000066400000000000000000000023441204626246600161610ustar00rootroot00000000000000module Utils where import Control.Concurrent.Chan import Control.Exception import System.Directory import System.Environment import System.Exit import System.INotify testName = do n <- getProgName return (n ++ "-playground") withTempDir f = do path <- testName bracket ( createDirectory path >> return path ) ( removeDirectoryRecursive ) ( f ) withWatch inot events path action f = bracket ( addWatch inot events path action ) removeWatch ( const f ) inTestEnviron events action f = do withTempDir $ \testPath -> do inot <- initINotify chan <- newChan withWatch inot events testPath (writeChan chan) $ do action testPath events <- getChanContents chan f events (~=) :: Eq a => [a] -> [a] -> Bool [] ~= _ = True (x:xs) ~= (y:ys) = x == y && xs ~= ys _ ~= _ = False asMany :: [a] -> [a] -> [a] asMany xs ys = take (length xs) ys explainFailure expected reality = do putStrLn "Expected:" mapM_ (\x -> putStr "> " >> print x) expected putStrLn "But got:" mapM_ (\x -> putStr "< " >> print x) (asMany expected reality) testFailure testFailure = exitFailure testSuccess = exitWith ExitSuccess hinotify-0.3.5/tests/test-all000077500000000000000000000010501204626246600161710ustar00rootroot00000000000000#!/bin/bash GHC=ghc if [[ -n $1 ]]; then GHC="$1" echo Using GHC: $GHC fi TESTS=( `ls test*.hs | cut -d. -f1` ) rm -rf *.o *.hi for t in ${TESTS[@]}; do rm -rf $t{,.o,.hi} rm -rf $t-playground $GHC -v0 --make $t.hs -o $t echo -n Testing $t ... if [[ -x $t ]]; then ./$t exitCode=$? if [[ $exitCode == 0 ]]; then echo Success rm -rf $t{,.o,.hi} else echo Failure with exit code $exitCode fi else echo Compilation failed fi done hinotify-0.3.5/tests/test001-list-dir-contents.hs000066400000000000000000000005541204626246600216420ustar00rootroot00000000000000module Main where import Control.Monad import System.Directory import System.INotify as INotify import Utils main = inTestEnviron [Open, Close] getDirectoryContents $ \ events -> do when (expected ~= events) testSuccess explainFailure expected events expected = [ Opened True Nothing , Closed True Nothing False ] hinotify-0.3.5/tests/test002-writefile.hs000066400000000000000000000010161204626246600202450ustar00rootroot00000000000000module Main where import Control.Monad import System.INotify as INotify import Utils write path = do writeFile (path ++ "/hello") "" -- actually writing any contents gives me two Modified main = inTestEnviron [AllEvents] write $ \ events -> do when (expected ~= events) testSuccess explainFailure expected events expected = [ Created False "hello" , Opened False (Just "hello") , Modified False (Just "hello") , Closed False (Just "hello") True ] hinotify-0.3.5/tests/test003-removefile.hs000066400000000000000000000011611204626246600204120ustar00rootroot00000000000000module Main where import Control.Monad import System.Directory import System.INotify as INotify import Utils file = "hello" write path = do writeFile (path ++ '/':file) "" remove path = do removeFile (path ++ '/':file) action path = do write path remove path main = inTestEnviron [AllEvents] action $ \ events -> do when (expected ~= events) testSuccess explainFailure expected events expected = [ Created False file , Opened False (Just file) , Modified False (Just file) , Closed False (Just file) True , Deleted False file ] hinotify-0.3.5/tests/test004-modify-file.hs000066400000000000000000000016301204626246600204630ustar00rootroot00000000000000module Main where import Control.Exception import Control.Monad import System.Directory import System.IO import System.INotify as INotify import Utils file = "hello" write path = do writeFile (path ++ '/':file) "" modify path = do bracket (openFile (path ++ '/':file) AppendMode) (hClose) (\h -> hPutStr h "yarr!") remove path = do removeFile (path ++ '/':file) action path = do write path modify path remove path main = inTestEnviron [AllEvents] action $ \ events -> do when (expected ~= events) testSuccess explainFailure expected events expected = [ Created False file , Opened False (Just file) , Modified False (Just file) , Closed False (Just file) True , Opened False (Just file) , Modified False (Just file) , Closed False (Just file) True , Deleted False file ] hinotify-0.3.5/tests/test005-move-file.hs000066400000000000000000000016271204626246600201510ustar00rootroot00000000000000module Main where import Data.Maybe import Control.Monad import System.Directory import System.IO import System.INotify as INotify import Utils file = "hello" file2 = file ++ "2" write path = do writeFile (path ++ '/':file) "" move path = do renameFile (path ++ '/':file) (path ++ '/':file2) remove path = do removeFile (path ++ '/':file2) action path = do write path move path remove path main = inTestEnviron [AllEvents] action $ \ events -> do let cookie = head [ c | MovedOut _ _ c <- events ] when (expected cookie ~= events) testSuccess explainFailure (expected cookie) events expected cookie = [ Created False file , Opened False (Just file) , Modified False (Just file) , Closed False (Just file) True , MovedOut False file cookie , MovedIn False file2 cookie , Deleted False file2 ]