diff --git a/ANNOUNCE b/ANNOUNCE new file mode 100644 --- /dev/null +++ b/ANNOUNCE @@ -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/ diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +#!/usr/bin/runhaskell +import Distribution.Simple +main = defaultMain diff --git a/hinotify.cabal b/hinotify.cabal new file mode 100644 --- /dev/null +++ b/hinotify.cabal @@ -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 diff --git a/include/inotify-syscalls.h b/include/inotify-syscalls.h new file mode 100644 --- /dev/null +++ b/include/inotify-syscalls.h @@ -0,0 +1,61 @@ +#ifndef _LINUX_INOTIFY_SYSCALLS_H +#define _LINUX_INOTIFY_SYSCALLS_H + +#include + +#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 */ diff --git a/include/inotify.h b/include/inotify.h new file mode 100644 --- /dev/null +++ b/include/inotify.h @@ -0,0 +1,113 @@ +/* + * Inode based directory notification for Linux + * + * Copyright (C) 2005 John McCutchan + */ + +#ifndef _LINUX_INOTIFY_H +#define _LINUX_INOTIFY_H + +#include + +/* + * 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 +#include +#include + +#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 */ diff --git a/src/System/INotify.hsc b/src/System/INotify.hsc new file mode 100644 --- /dev/null +++ b/src/System/INotify.hsc @@ -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 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 "" + +instance Show WatchDescriptor where + show (WatchDescriptor _ wd) = showString "" + +instance Show Cookie where + show (Cookie c) = showString "" + +inotify_init :: IO INotify +inotify_init = do + fd <- c_inotify_init + em <- newMVar Map.empty + let desc = showString "" + 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 diff --git a/src/System/INotify/Masks.hsc b/src/System/INotify/Masks.hsc new file mode 100644 --- /dev/null +++ b/src/System/INotify/Masks.hsc @@ -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 */ +-} diff --git a/tests/DirTree/DirTree.hs b/tests/DirTree/DirTree.hs new file mode 100644 --- /dev/null +++ b/tests/DirTree/DirTree.hs @@ -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 diff --git a/tests/simple/simple.hs b/tests/simple/simple.hs new file mode 100644 --- /dev/null +++ b/tests/simple/simple.hs @@ -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