diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (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. diff --git a/Makefile b/Makefile new file mode 100644 --- /dev/null +++ b/Makefile @@ -0,0 +1,7 @@ + +.PHONY : docs + +docs : README.html + +%.html : % + pandoc -s -S --toc -c hinotify.css $< -o $@ diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,100 @@ +% hinotify: inotify for Haskell +% Lennart Kolmodin +% December 26, 2007 + +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 `inotify`. + +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.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: + + initINotify :: IO INotify + addWatch :: INotify + -> [EventVariety] -- different events to listen on + -> FilePath -- file/directory to watch + -> (Event -> IO ()) -- event handler + -> IO WatchDescriptor + removeWatch :: INotify -> WatchDescriptor -> IO () + +A sample program: + + 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 + + +Download +-------- + +The code is available via the [homepage], and via darcs: + + darcs get --partial http://haskell.org/~kolmodin/code/hinotify/ + +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 gentoo.org` + +Legal +----- + +This software is released under a BSD-style license. See LICENSE for +more details. + +Copyright © 2007 Lennart Kolmodin + +[homepage]: http://haskell.org/~kolmodin/code/hinotify/ + +[API]: http://haskell.org/~kolmodin/code/hinotify/docs/api/ diff --git a/README.html b/README.html new file mode 100644 --- /dev/null +++ b/README.html @@ -0,0 +1,179 @@ + +hinotify: inotify for Haskell +

hinotify: 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 inotify.

See example code in the examples directory, distributed with the source code.

News

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:

initINotify :: IO INotify
+addWatch :: INotify
+         -> [EventVariety]   -- different events to listen on
+         -> FilePath         -- file/directory to watch
+         -> (Event -> IO ()) -- event handler
+         -> IO WatchDescriptor
+removeWatch :: INotify -> WatchDescriptor -> IO ()
+

A sample program:

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
+

Download

The code is available via the homepage, and via darcs:

darcs get --partial http://haskell.org/~kolmodin/code/hinotify/
+

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 gentoo.org

This software is released under a BSD-style license. See LICENSE for more details.

Copyright © 2007 Lennart Kolmodin

+ diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,3 +0,0 @@ -#!/usr/bin/runhaskell -import Distribution.Simple -main = defaultMain diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#!/usr/bin/runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/examples/DirTree/DirTree.hs b/examples/DirTree/DirTree.hs new file mode 100644 --- /dev/null +++ b/examples/DirTree/DirTree.hs @@ -0,0 +1,111 @@ +-- 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 new file mode 100644 --- /dev/null +++ b/examples/simple/simple.hs @@ -0,0 +1,17 @@ +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,18 +1,38 @@ -Name: hinotify -Version: 0.1 -License: GPL -Author: Lennart Kolmodin -Homepage: http://haskell.org/~kolmodin/code/hinotify/ -Category: System -Build-Depends: base -Description: Haskell binding to INotify -Maintainer: Lennart Kolmodin -Synopsis: Haskell binding to INotify -Hs-Source-Dirs: src -Extensions: ForeignFunctionInterface -Include-Dirs: include -Exposed-Modules: - System.INotify -Other-Modules: - System.INotify.Masks -Ghc-Options: -O -fvia-C +name: hinotify +version: 0.2 +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: http://haskell.org/~kolmodin/code/hinotify/README.html +license: BSD3 +license-file: LICENSE +author: Lennart Kolmodin +maintainer: Lennart Kolmodin +extra-source-files: README +cabal-version: >= 1.2 + +flag split-base + description: Choose the new smaller, split-up base package. + +library + build-depends: unix + if flag(split-base) + build-depends: base >= 3, containers, directory + else + build-depends: base < 3 + extensions: ForeignFunctionInterface + + exposed-modules: + System.INotify + other-modules: + System.INotify.Masks + + ghc-options: -fvia-C -Wall + + include-dirs: include + hs-source-dirs: src diff --git a/hinotify.css b/hinotify.css new file mode 100644 --- /dev/null +++ b/hinotify.css @@ -0,0 +1,89 @@ +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 @@ -11,18 +11,18 @@ -- See and @man -- inotify@. -- --- Use 'inotify_init' to get a 'INotify', then use 'inotify_add_watch' to +-- 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 'inotify_rm_watch' once you don't want to watch a file any more. +-- Use 'removeWatch' once you don't want to watch a file any more. -- ----------------------------------------------------------------------------- module System.INotify - ( inotify_init - , inotify_add_watch - , inotify_rm_watch + ( initINotify + , addWatch + , removeWatch , INotify , WatchDescriptor , Event(..) @@ -32,6 +32,7 @@ #include "inotify.h" +import Prelude hiding (init) import Control.Monad import Control.Concurrent import Control.Concurrent.MVar @@ -62,36 +63,61 @@ newtype Cookie = Cookie CUInt deriving (Eq,Ord) -data FDEvent = FDEvent WD Masks CUInt{-Cookie-} (Maybe String) deriving Show +data FDEvent = FDEvent WD Masks CUInt{-Cookie-} (Maybe String) deriving (Eq, Show) -data Event = +data Event = -- | A file was accessed. @Accessed isDirectory file@ - Accessed - Bool - (Maybe FilePath) + Accessed + { isDirectory :: Bool + , maybeFilePath :: Maybe FilePath + } -- | A file was modified. @Modified isDiroctory file@ - | Modified Bool (Maybe FilePath) + | Modified + { isDirectory :: Bool + , maybeFilePath :: Maybe FilePath + } -- | A files attributes where changed. @Attributes isDirectory file@ - | Attributes Bool (Maybe FilePath) - -- | A file was closed. @Closed isDirectory wasWritable file@ + | Attributes + { isDirectory :: Bool + , maybeFilePath :: Maybe FilePath + } + -- | A file was closed. @Closed isDirectory file wasWriteable@ | Closed - Bool - Bool - (Maybe FilePath) + { isDirectory :: Bool + , maybeFilePath :: Maybe FilePath + , wasWriteable :: Bool + } -- | A file was opened. @Opened isDirectory maybeFilePath@ | Opened - Bool - (Maybe FilePath) - -- | A file was moved away from the watched dir. @MovedFrom isDirectory from@ - | MovedOut Bool Cookie FilePath - -- | A file was moved into the watched dir. @MovedTo isDirectory to@ - | MovedIn Bool Cookie FilePath + { 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 Bool + | MovedSelf + { isDirectory :: Bool + } -- | A file was created. @Created isDirectory file@ - | Created Bool FilePath + | Created + { isDirectory :: Bool + , filePath :: FilePath + } -- | A file was deleted. @Deleted isDirectory file@ - | Deleted Bool FilePath + | Deleted + { isDirecotry :: Bool + , filePath :: FilePath + } -- | The file watched was deleted. | DeletedSelf -- | The file watched was unmounted. @@ -100,7 +126,7 @@ | QOverflow | Ignored | Unknown FDEvent - deriving Show + deriving (Eq, Show) data EventVariety = Access @@ -135,17 +161,22 @@ instance Show Cookie where show (Cookie c) = showString "" -inotify_init :: IO INotify -inotify_init = do - fd <- c_inotify_init +initINotify :: IO INotify +initINotify = do + fd <- throwErrnoIfMinus1 "initINotify" c_inotify_init em <- newMVar Map.empty let desc = showString "" - h <- openFd (fromIntegral fd) (Just Stream) False{-is_socket-} desc ReadMode True{-binary-} +#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 + -- h <- fdToHandle fd inotify_start_thread h em return (INotify h fd em) -inotify_add_watch :: INotify -> [EventVariety] -> FilePath -> (Event -> IO ()) -> IO WatchDescriptor -inotify_add_watch inotify@(INotify h fd em) masks fp cb = do +addWatch :: INotify -> [EventVariety] -> FilePath -> (Event -> IO ()) -> IO WatchDescriptor +addWatch inotify@(INotify h fd em) masks fp cb = do is_dir <- doesDirectoryExist fp when (not is_dir) $ do file_exist <- doesFileExist fp @@ -159,6 +190,7 @@ let mask = joinMasks (map eventVarietyToMask masks) em' <- takeMVar em wd <- withCString fp $ \fp_c -> + throwErrnoIfMinus1 "addWatch" $ c_inotify_add_watch (fromIntegral fd) fp_c mask let event = \e -> do when (OneShot `elem` masks) $ @@ -194,9 +226,10 @@ OneShot -> inOneshot AllEvents -> inAllEvents -inotify_rm_watch :: INotify -> WatchDescriptor -> IO () -inotify_rm_watch (INotify _ fd _) (WatchDescriptor _ wd) = do - c_inotify_rm_watch (fromIntegral fd) wd +removeWatch :: INotify -> WatchDescriptor -> IO () +removeWatch (INotify _ fd _) (WatchDescriptor _ wd) = do + throwErrnoIfMinus1 "removeWatch" $ + c_inotify_rm_watch (fromIntegral fd) wd return () rm_watch :: INotify -> WD -> IO () @@ -234,10 +267,10 @@ | isSet inAccess = Accessed isDir nameM | isSet inModify = Modified isDir nameM | isSet inAttrib = Attributes isDir nameM - | isSet inClose = Closed isDir (isSet inCloseWrite) nameM + | isSet inClose = Closed isDir nameM (isSet inCloseWrite) | isSet inOpen = Opened isDir nameM - | isSet inMovedFrom = MovedOut isDir (Cookie cookie) name - | isSet inMovedTo = MovedIn isDir (Cookie cookie) name + | 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 diff --git a/tests/DirTree/DirTree.hs b/tests/DirTree/DirTree.hs deleted file mode 100644 --- a/tests/DirTree/DirTree.hs +++ /dev/null @@ -1,107 +0,0 @@ -{- -Duncan Coutts 2006 - -Doesn't compile with gtk2hs 0.9.10, you'll need the darcs version. - --} - -import qualified Data.Map as Map -import System.Directory - -import Data.IORef -import Control.Monad (liftM) -import Ix (inRange) - -import System.INotify - -import Graphics.UI.Gtk -import Graphics.UI.Gtk.TreeList.Types (TypedTreeModelClass) -import Graphics.UI.Gtk.TreeList.TreeModel (TreeModelFlags(TreeModelListOnly)) -import Graphics.UI.Gtk.TreeList.CustomStore -import Graphics.UI.Gtk.TreeList.TreeIter - -import Control.Concurrent - -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 <- inotify_init - watch <- inotify_add_watch 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_rm_watch watch) - - return model - -main = do - initGUI - win <- windowNew - win `onDestroy` mainQuit - - model <- dirModelNew "/home/kolmodin/Desktop" - - 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/tests/Utils.hs b/tests/Utils.hs new file mode 100644 --- /dev/null +++ b/tests/Utils.hs @@ -0,0 +1,55 @@ +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 inot ) + ( 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/simple/simple.hs b/tests/simple/simple.hs deleted file mode 100644 --- a/tests/simple/simple.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Main where - -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 diff --git a/tests/test-all b/tests/test-all new file mode 100644 --- /dev/null +++ b/tests/test-all @@ -0,0 +1,31 @@ +#!/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 new file mode 100644 --- /dev/null +++ b/tests/test001-list-dir-contents.hs @@ -0,0 +1,20 @@ +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 new file mode 100644 --- /dev/null +++ b/tests/test002-writefile.hs @@ -0,0 +1,24 @@ +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 new file mode 100644 --- /dev/null +++ b/tests/test003-removefile.hs @@ -0,0 +1,35 @@ +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 new file mode 100644 --- /dev/null +++ b/tests/test004-modify-file.hs @@ -0,0 +1,47 @@ +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 new file mode 100644 --- /dev/null +++ b/tests/test005-move-file.hs @@ -0,0 +1,46 @@ +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 + ]