hinotify 0.3.6 → 0.3.7
raw patch · 17 files changed
+16/−591 lines, 17 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- .gitignore +0/−4
- ANNOUNCE +0/−58
- Makefile +0/−7
- README.md +5/−0
- docs/hcar/hinotify-Lh.tex +0/−36
- examples/DirTree/DirTree.hs +0/−111
- examples/simple/simple.hs +0/−17
- hinotify.cabal +1/−1
- hinotify.css +0/−89
- src/System/INotify.hsc +10/−10
- tests/Utils.hs +0/−55
- tests/test-all +0/−31
- tests/test001-list-dir-contents.hs +0/−20
- tests/test002-writefile.hs +0/−24
- tests/test003-removefile.hs +0/−35
- tests/test004-modify-file.hs +0/−47
- tests/test005-move-file.hs +0/−46
− .gitignore
@@ -1,4 +0,0 @@-dist-_darcs-tests/*.hi-tests/*.o
− ANNOUNCE
@@ -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/
− Makefile
@@ -1,7 +0,0 @@--.PHONY : docs--docs : README.html--%.html : %- pandoc -s -S --toc -c hinotify.css $< -o $@
README.md view
@@ -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:
− docs/hcar/hinotify-Lh.tex
@@ -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}
− examples/DirTree/DirTree.hs
@@ -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
− examples/simple/simple.hs
@@ -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
hinotify.cabal view
@@ -1,5 +1,5 @@ name: hinotify-version: 0.3.6+version: 0.3.7 build-type: Simple synopsis: Haskell binding to inotify description:
− hinotify.css
@@ -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;-}-
src/System/INotify.hsc view
@@ -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) =
− tests/Utils.hs
@@ -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
− tests/test-all
@@ -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
− tests/test001-list-dir-contents.hs
@@ -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- ]
− tests/test002-writefile.hs
@@ -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- ]
− tests/test003-removefile.hs
@@ -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- ]
− tests/test004-modify-file.hs
@@ -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- ]
− tests/test005-move-file.hs
@@ -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- ]