diff --git a/.gitignore b/.gitignore deleted file mode 100644 --- a/.gitignore +++ /dev/null @@ -1,4 +0,0 @@ -dist -_darcs -tests/*.hi -tests/*.o diff --git a/ANNOUNCE b/ANNOUNCE deleted file mode 100644 --- a/ANNOUNCE +++ /dev/null @@ -1,58 +0,0 @@ -Greetings! - -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/ diff --git a/Makefile b/Makefile deleted file mode 100644 --- a/Makefile +++ /dev/null @@ -1,7 +0,0 @@ - -.PHONY : docs - -docs : README.html - -%.html : % - pandoc -s -S --toc -c hinotify.css $< -o $@ diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -20,6 +20,11 @@ News ---- +**hinotify 0.3.7** + +* Bug fix: When registerering a new watch on a path which is already watched, + don't overwrite the event listener from the previous watch. + **hinotify 0.3.2** * Make each `WatchDescriptor` contain its `INotify`. Changes to the function types: diff --git a/docs/hcar/hinotify-Lh.tex b/docs/hcar/hinotify-Lh.tex deleted file mode 100644 --- a/docs/hcar/hinotify-Lh.tex +++ /dev/null @@ -1,36 +0,0 @@ -\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} diff --git a/examples/DirTree/DirTree.hs b/examples/DirTree/DirTree.hs deleted file mode 100644 --- a/examples/DirTree/DirTree.hs +++ /dev/null @@ -1,111 +0,0 @@ --- 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 diff --git a/examples/simple/simple.hs b/examples/simple/simple.hs deleted file mode 100644 --- a/examples/simple/simple.hs +++ /dev/null @@ -1,17 +0,0 @@ -module 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 diff --git a/hinotify.cabal b/hinotify.cabal --- a/hinotify.cabal +++ b/hinotify.cabal @@ -1,5 +1,5 @@ name: hinotify -version: 0.3.6 +version: 0.3.7 build-type: Simple synopsis: Haskell binding to inotify description: diff --git a/hinotify.css b/hinotify.css deleted file mode 100644 --- a/hinotify.css +++ /dev/null @@ -1,89 +0,0 @@ -body { - 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; -} - diff --git a/src/System/INotify.hsc b/src/System/INotify.hsc --- a/src/System/INotify.hsc +++ b/src/System/INotify.hsc @@ -200,14 +200,14 @@ wd <- withCString enc fp $ \fp_c -> throwErrnoIfMinus1 "addWatch" $ c_inotify_add_watch (fromIntegral fd) fp_c mask - let event = \e -> do + let event = \e -> ignore_failure $ 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') + modifyMVar_ em $ \em' -> return (Map.insertWith (liftM2 (>>)) wd event em') return (WatchDescriptor inotify wd) where -- catch_IO is same as catchIOError from base >= 4.5.0.0 @@ -235,6 +235,12 @@ OneShot -> inOneshot AllEvents -> inAllEvents + ignore_failure :: IO () -> IO () + ignore_failure action = mask_ (action `E.catch` ignore) + where + ignore :: SomeException -> IO () + ignore _ = return () + removeWatch :: WatchDescriptor -> IO () removeWatch (WatchDescriptor (INotify _ fd _ _ _) wd) = do _ <- throwErrnoIfMinus1 "removeWatch" $ @@ -312,19 +318,13 @@ 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 + mapM_ ($ e) (Map.elems handlers) 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 () + Just handler -> handler event killINotify :: INotify -> IO () killINotify (INotify h _ _ tid1 tid2) = diff --git a/tests/Utils.hs b/tests/Utils.hs deleted file mode 100644 --- a/tests/Utils.hs +++ /dev/null @@ -1,55 +0,0 @@ -module 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 diff --git a/tests/test-all b/tests/test-all deleted file mode 100644 --- a/tests/test-all +++ /dev/null @@ -1,31 +0,0 @@ -#!/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 diff --git a/tests/test001-list-dir-contents.hs b/tests/test001-list-dir-contents.hs deleted file mode 100644 --- a/tests/test001-list-dir-contents.hs +++ /dev/null @@ -1,20 +0,0 @@ -module 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 - ] diff --git a/tests/test002-writefile.hs b/tests/test002-writefile.hs deleted file mode 100644 --- a/tests/test002-writefile.hs +++ /dev/null @@ -1,24 +0,0 @@ -module 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 - ] diff --git a/tests/test003-removefile.hs b/tests/test003-removefile.hs deleted file mode 100644 --- a/tests/test003-removefile.hs +++ /dev/null @@ -1,35 +0,0 @@ -module 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 - ] diff --git a/tests/test004-modify-file.hs b/tests/test004-modify-file.hs deleted file mode 100644 --- a/tests/test004-modify-file.hs +++ /dev/null @@ -1,47 +0,0 @@ -module 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 - ] diff --git a/tests/test005-move-file.hs b/tests/test005-move-file.hs deleted file mode 100644 --- a/tests/test005-move-file.hs +++ /dev/null @@ -1,46 +0,0 @@ -module 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 - ]