hinotify (empty) → 0.1
raw patch · 9 files changed
+785/−0 lines, 9 filesdep +basebuild-type:Customsetup-changed
Dependencies added: base
Files
- ANNOUNCE +58/−0
- Setup.hs +3/−0
- hinotify.cabal +18/−0
- include/inotify-syscalls.h +61/−0
- include/inotify.h +113/−0
- src/System/INotify.hsc +284/−0
- src/System/INotify/Masks.hsc +125/−0
- tests/DirTree/DirTree.hs +107/−0
- tests/simple/simple.hs +16/−0
+ ANNOUNCE view
@@ -0,0 +1,58 @@+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/
+ Setup.hs view
@@ -0,0 +1,3 @@+#!/usr/bin/runhaskell+import Distribution.Simple+main = defaultMain
+ hinotify.cabal view
@@ -0,0 +1,18 @@+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
+ include/inotify-syscalls.h view
@@ -0,0 +1,61 @@+#ifndef _LINUX_INOTIFY_SYSCALLS_H+#define _LINUX_INOTIFY_SYSCALLS_H++#include <sys/syscall.h>++#if defined(__i386__)+# define __NR_inotify_init 291+# define __NR_inotify_add_watch 292+# define __NR_inotify_rm_watch 293+#elif defined(__x86_64__)+# define __NR_inotify_init 253+# define __NR_inotify_add_watch 254+# define __NR_inotify_rm_watch 255+#elif defined(__powerpc__) || defined(__powerpc64__)+# define __NR_inotify_init 275+# define __NR_inotify_add_watch 276+# define __NR_inotify_rm_watch 277+#elif defined (__ia64__)+# define __NR_inotify_init 1277+# define __NR_inotify_add_watch 1278+# define __NR_inotify_rm_watch 1279+#elif defined (__s390__)+# define __NR_inotify_init 284+# define __NR_inotify_add_watch 285+# define __NR_inotify_rm_watch 286+#elif defined (__alpha__)+# define __NR_inotify_init 444+# define __NR_inotify_add_watch 445+# define __NR_inotify_rm_watch 446+#elif defined (__sparc__) || defined (__sparc64__)+# define __NR_inotify_init 151+# define __NR_inotify_add_watch 152+# define __NR_inotify_rm_watch 156+#elif defined (__arm__)+# define __NR_inotify_init 316+# define __NR_inotify_add_watch 317+# define __NR_inotify_rm_watch 318+#elif defined (__sh__)+# define __NR_inotify_init 290+# define __NR_inotify_add_watch 291+# define __NR_inotify_rm_watch 292+#else+# error "Unsupported architecture!"+#endif++static inline int inotify_init (void)+{+ return syscall (__NR_inotify_init);+}++static inline int inotify_add_watch (int fd, const char *name, __u32 mask)+{+ return syscall (__NR_inotify_add_watch, fd, name, mask);+}++static inline int inotify_rm_watch (int fd, __u32 wd)+{+ return syscall (__NR_inotify_rm_watch, fd, wd);+}++#endif /* _LINUX_INOTIFY_SYSCALLS_H */
+ include/inotify.h view
@@ -0,0 +1,113 @@+/*+ * Inode based directory notification for Linux+ *+ * Copyright (C) 2005 John McCutchan+ */++#ifndef _LINUX_INOTIFY_H+#define _LINUX_INOTIFY_H++#include <linux/types.h>++/*+ * struct inotify_event - structure read from the inotify device for each event+ *+ * When you are watching a directory, you will receive the filename for events+ * such as IN_CREATE, IN_DELETE, IN_OPEN, IN_CLOSE, ..., relative to the wd.+ */+struct inotify_event {+ __s32 wd; /* watch descriptor */+ __u32 mask; /* watch mask */+ __u32 cookie; /* cookie to synchronize two events */+ __u32 len; /* length (including nulls) of name */+ char name[0]; /* stub for possible name */+};++/* the following are legal, implemented events that user-space can watch for */+#define IN_ACCESS 0x00000001 /* File was accessed */+#define IN_MODIFY 0x00000002 /* File was modified */+#define IN_ATTRIB 0x00000004 /* Metadata changed */+#define IN_CLOSE_WRITE 0x00000008 /* Writtable file was closed */+#define IN_CLOSE_NOWRITE 0x00000010 /* Unwrittable file closed */+#define IN_OPEN 0x00000020 /* File was opened */+#define IN_MOVED_FROM 0x00000040 /* File was moved from X */+#define IN_MOVED_TO 0x00000080 /* File was moved to Y */+#define IN_CREATE 0x00000100 /* Subfile was created */+#define IN_DELETE 0x00000200 /* Subfile was deleted */+#define IN_DELETE_SELF 0x00000400 /* Self was deleted */+#define IN_MOVE_SELF 0x00000800 /* Self was moved */++/* the following are legal events. they are sent as needed to any watch */+#define IN_UNMOUNT 0x00002000 /* Backing fs was unmounted */+#define IN_Q_OVERFLOW 0x00004000 /* Event queued overflowed */+#define IN_IGNORED 0x00008000 /* File was ignored */++/* helper events */+#define IN_CLOSE (IN_CLOSE_WRITE | IN_CLOSE_NOWRITE) /* close */+#define IN_MOVE (IN_MOVED_FROM | IN_MOVED_TO) /* moves */++/* special flags */+#define IN_ONLYDIR 0x01000000 /* only watch the path if it is a directory */+#define IN_DONT_FOLLOW 0x02000000 /* don't follow a sym link */+#define IN_MASK_ADD 0x20000000 /* add to the mask of an already existing watch */+#define IN_ISDIR 0x40000000 /* event occurred against dir */+#define IN_ONESHOT 0x80000000 /* only send event once */++/*+ * All of the events - we build the list by hand so that we can add flags in+ * the future and not break backward compatibility. Apps will get only the+ * events that they originally wanted. Be sure to add new events here!+ */+#define IN_ALL_EVENTS (IN_ACCESS | IN_MODIFY | IN_ATTRIB | IN_CLOSE_WRITE | \+ IN_CLOSE_NOWRITE | IN_OPEN | IN_MOVED_FROM | \+ IN_MOVED_TO | IN_DELETE | IN_CREATE | IN_DELETE_SELF | \+ IN_MOVE_SELF)++#ifdef __KERNEL__++#include <linux/dcache.h>+#include <linux/fs.h>+#include <linux/config.h>++#ifdef CONFIG_INOTIFY++extern void inotify_inode_queue_event(struct inode *, __u32, __u32,+ const char *);+extern void inotify_dentry_parent_queue_event(struct dentry *, __u32, __u32,+ const char *);+extern void inotify_unmount_inodes(struct list_head *);+extern void inotify_inode_is_dead(struct inode *);+extern u32 inotify_get_cookie(void);++#else++static inline void inotify_inode_queue_event(struct inode *inode,+ __u32 mask, __u32 cookie,+ const char *filename)+{+}++static inline void inotify_dentry_parent_queue_event(struct dentry *dentry,+ __u32 mask, __u32 cookie,+ const char *filename)+{+}++static inline void inotify_unmount_inodes(struct list_head *list)+{+}++static inline void inotify_inode_is_dead(struct inode *inode)+{+}++static inline u32 inotify_get_cookie(void)+{+ return 0;+}++#endif /* CONFIG_INOTIFY */++#endif /* __KERNEL __ */++#endif /* _LINUX_INOTIFY_H */
+ src/System/INotify.hsc view
@@ -0,0 +1,284 @@+-----------------------------------------------------------------------------+-- |+-- Module : System.INotify+-- Copyright : (c) Lennart Kolmodin 2006+-- License : GPL+-- Maintainer : kolmodin@dtek.chalmers.se+-- Stability : experimental+-- Portability : hc portable, linux only+--+-- A Haskell binding to INotify.+-- See <http://www.kernel.org/pub/linux/kernel/people/rml/inotify/> and @man+-- inotify@.+--+-- Use 'inotify_init' to get a 'INotify', then use 'inotify_add_watch' 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.+--+-----------------------------------------------------------------------------++module System.INotify+ ( inotify_init+ , inotify_add_watch+ , inotify_rm_watch+ , INotify+ , WatchDescriptor+ , Event(..)+ , EventVariety(..)+ , Cookie+ ) where++#include "inotify.h"++import Control.Monad+import Control.Concurrent+import Control.Concurrent.MVar+import Data.Maybe+import Data.Map (Map)+import qualified Data.Map as Map+import GHC.Handle+import Foreign.C+import Foreign.Marshal+import Foreign.Ptr+import Foreign.Storable+import System.Directory+import System.IO+import System.IO.Error+import System.Posix.Internals++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)+data WatchDescriptor = WatchDescriptor Handle WD deriving Eq++newtype Cookie = Cookie CUInt deriving (Eq,Ord)++data FDEvent = FDEvent WD Masks CUInt{-Cookie-} (Maybe String) deriving Show++data Event = + -- | A file was accessed. @Accessed isDirectory file@+ Accessed + Bool+ (Maybe FilePath)+ -- | A file was modified. @Modified isDiroctory file@+ | Modified Bool (Maybe FilePath)+ -- | A files attributes where changed. @Attributes isDirectory file@+ | Attributes Bool (Maybe FilePath)+ -- | A file was closed. @Closed isDirectory wasWritable file@+ | Closed+ Bool+ Bool+ (Maybe FilePath)+ -- | 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+ -- | The watched file was moved. @MovedSelf isDirectory@+ | MovedSelf Bool+ -- | A file was created. @Created isDirectory file@+ | Created Bool FilePath+ -- | A file was deleted. @Deleted isDirectory file@+ | Deleted Bool FilePath+ -- | The file watched was deleted.+ | DeletedSelf+ -- | The file watched was unmounted.+ | Unmounted+ -- | The queue overflowed.+ | QOverflow+ | Ignored+ | Unknown FDEvent+ deriving 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 "<inotify fd=" . + shows fd $ ">"++instance Show WatchDescriptor where+ show (WatchDescriptor _ wd) = showString "<wd=" . shows wd $ ">"++instance Show Cookie where+ show (Cookie c) = showString "<cookie " . shows c $ ">"++inotify_init :: IO INotify+inotify_init = do+ fd <- c_inotify_init+ em <- newMVar Map.empty+ let desc = showString "<inotify handle, fd=" . shows fd $ ">"+ h <- openFd (fromIntegral fd) (Just Stream) False{-is_socket-} desc ReadMode True{-binary-}+ 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+ is_dir <- doesDirectoryExist fp+ when (not is_dir) $ do+ file_exist <- doesFileExist fp+ when (not file_exist) $ do+ -- it's not a directory, and not a file...+ -- it doesn't exist+ ioError $ mkIOError doesNotExistErrorType+ "can't watch what isn't there"+ Nothing + (Just fp)+ let mask = joinMasks (map eventVarietyToMask masks)+ em' <- takeMVar em+ wd <- withCString fp $ \fp_c ->+ c_inotify_add_watch (fromIntegral fd) fp_c mask+ let event = \e -> do+ when (OneShot `elem` masks) $+ rm_watch inotify wd+ 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+ putMVar em (Map.insert wd event em')+ return (WatchDescriptor h wd)+ where+ 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++inotify_rm_watch :: INotify -> WatchDescriptor -> IO ()+inotify_rm_watch (INotify _ fd _) (WatchDescriptor _ wd) = do+ 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 (isSet inCloseWrite) nameM+ | isSet inOpen = Opened isDir nameM+ | isSet inMovedFrom = MovedOut isDir (Cookie cookie) name+ | isSet inMovedTo = MovedIn isDir (Cookie cookie) name+ | 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 ()+inotify_start_thread h em = do+ chan_events <- newChan+ forkIO (dispatcher chan_events)+ forkIO (start_thread chan_events)+ return ()+ 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 ->+ catch (handler e) (\_ -> return ()) -- 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 -> catch (handler event) (\_ -> return ())+ +foreign import ccall unsafe "inotify-syscalls.h inotify_init" c_inotify_init :: IO CInt+foreign import ccall unsafe "inotify-syscalls.h inotify_add_watch" c_inotify_add_watch :: CInt -> CString -> CUInt -> IO CInt+foreign import ccall unsafe "inotify-syscalls.h inotify_rm_watch" c_inotify_rm_watch :: CInt -> CInt -> IO CInt
+ src/System/INotify/Masks.hsc view
@@ -0,0 +1,125 @@+module 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 "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++{-+/* the following are legal, implemented events that user-space can watch for */+#define IN_ACCESS 0x00000001 /* File was accessed */+#define IN_MODIFY 0x00000002 /* File was modified */+#define IN_ATTRIB 0x00000004 /* Metadata changed */+#define IN_CLOSE_WRITE 0x00000008 /* Writtable file was closed */+#define IN_CLOSE_NOWRITE 0x00000010 /* Unwrittable file closed */+#define IN_OPEN 0x00000020 /* File was opened */+#define IN_MOVED_FROM 0x00000040 /* File was moved from X */+#define IN_MOVED_TO 0x00000080 /* File was moved to Y */+#define IN_CREATE 0x00000100 /* Subfile was created */+#define IN_DELETE 0x00000200 /* Subfile was deleted */+#define IN_DELETE_SELF 0x00000400 /* Self was deleted */+#define IN_MOVE_SELF 0x00000800 /* Self was moved */++/* the following are legal events. they are sent as needed to any watch */+#define IN_UNMOUNT 0x00002000 /* Backing fs was unmounted */+#define IN_Q_OVERFLOW 0x00004000 /* Event queued overflowed */+#define IN_IGNORED 0x00008000 /* File was ignored */++/* helper events */+#define IN_CLOSE (IN_CLOSE_WRITE | IN_CLOSE_NOWRITE) /* close */+#define IN_MOVE (IN_MOVED_FROM | IN_MOVED_TO) /* moves */++/* special flags */+#define IN_ONLYDIR 0x01000000 /* only watch the path if it is a directory */+#define IN_DONT_FOLLOW 0x02000000 /* don't follow a sym link */+#define IN_MASK_ADD 0x20000000 /* add to the mask of an already existing w atch */+#define IN_ISDIR 0x40000000 /* event occurred against dir */+#define IN_ONESHOT 0x80000000 /* only send event once */+-}
+ tests/DirTree/DirTree.hs view
@@ -0,0 +1,107 @@+{- +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
+ tests/simple/simple.hs view
@@ -0,0 +1,16 @@+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