packages feed

hinotify 0.1 → 0.2

raw patch · 20 files changed

+903/−182 lines, 20 filesdep +containersdep +directorydep +unixdep ~basesetup-changednew-uploader

Dependencies added: containers, directory, unix

Dependency ranges changed: base

Files

+ LICENSE view
@@ -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.
+ Makefile view
@@ -0,0 +1,7 @@++.PHONY : docs++docs : README.html++%.html : %+	pandoc -s -S --toc -c hinotify.css $< -o $@
+ README view
@@ -0,0 +1,100 @@+% hinotify: inotify for Haskell+% Lennart Kolmodin <kolmodin@gentoo.org>+% 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 &copy; 2007 Lennart Kolmodin++[homepage]: http://haskell.org/~kolmodin/code/hinotify/++[API]: http://haskell.org/~kolmodin/code/hinotify/docs/api/
+ README.html view
@@ -0,0 +1,179 @@+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">+<html xmlns="http://www.w3.org/1999/xhtml"+><head+  ><title+    >hinotify: inotify for Haskell</title+    ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8"+     /><meta name="generator" content="pandoc"+     /><meta name="author" content="Lennart Kolmodin &lt;kolmodin@gentoo.org&gt;"+     /><meta name="date" content="December 26, 2007"+     /><link rel="stylesheet" href="hinotify.css" type="text/css" media="all" />+</head+  ><body+  ><h1 class="title"+    >hinotify: inotify for Haskell</h1+    ><div id="toc"+    ><ul+      ><li+	><a href="#about" id="TOC-about"+	  >About</a+	  ></li+	><li+	><a href="#news" id="TOC-news"+	  >News</a+	  ></li+	><li+	><a href="#api" id="TOC-api"+	  >API</a+	  ></li+	><li+	><a href="#download" id="TOC-download"+	  >Download</a+	  ></li+	><li+	><a href="#author" id="TOC-author"+	  >Author</a+	  ></li+	><li+	><a href="#legal" id="TOC-legal"+	  >Legal</a+	  ></li+	></ul+      ></div+    ><h2 id="about"+    ><a href="#TOC-about"+      >About</a+      ></h2+    ><p+    >hinotify, a library to <a href="http://www.kernel.org/pub/linux/kernel/people/rml/inotify/"+      >inotify</a+      > which has been part of the Linux kernel since 2.6.13.</p+    ><p+    >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.</p+    ><p+    >This module is named <code+      >inotify</code+      >.</p+    ><p+    >See example code in the <code+      >examples</code+      > directory, distributed with the source code.</p+    ><h2 id="news"+    ><a href="#TOC-news"+      >News</a+      ></h2+    ><dl+    ><dt+      ><strong+	>hinotify 0.2</strong+	></dt+      ><dd+      ><ul+	><li+	  >Updates to the API<ul+	    ><li+	      >Function names is now in semiCamelCase</li+	      ><li+	      >Restructure event parameters to make it more consistent</li+	      ></ul+	    ></li+	  ><li+	  >Small test suit in <code+	    >tests/</code+	    ></li+	  ><li+	  >Compiles with GHC 6.8.2 and GHC 6.6.1</li+	  ><li+	  >Requires Cabal 1.2</li+	  ></ul+	></dd+      ><dt+      ><strong+	>hinotify 0.1</strong+	></dt+      ><dd+      >Initial release</dd+      ></dl+    ><h2 id="api"+    ><a href="#TOC-api"+      >API</a+      ></h2+    ><p+    >The API basically consists of:</p+    ><pre+    ><code+      >initINotify :: IO INotify+addWatch :: INotify+         -&gt; [EventVariety]   -- different events to listen on+         -&gt; FilePath         -- file/directory to watch+         -&gt; (Event -&gt; IO ()) -- event handler+         -&gt; IO WatchDescriptor+removeWatch :: INotify -&gt; WatchDescriptor -&gt; IO ()+</code+      ></pre+    ><p+    >A sample program:</p+    ><pre+    ><code+      >import System.Directory+import System.IO++import System.INotify++main :: IO ()+main = do+    inotify &lt;- initINotify+    print inotify+    home &lt;- getHomeDirectory+    wd &lt;- addWatch+            inotify+            [Open,Close,Access,Modify,Move]+            home+            print+    print wd+    putStrLn &quot;Listens to your home directory. Hit enter to terminate.&quot;+    getLine+    removeWatch inotify wd+</code+      ></pre+    ><h2 id="download"+    ><a href="#TOC-download"+      >Download</a+      ></h2+    ><p+    >The code is available via the <a href="http://haskell.org/~kolmodin/code/hinotify/"+      >homepage</a+      >, and via darcs:</p+    ><pre+    ><code+      >darcs get --partial http://haskell.org/~kolmodin/code/hinotify/+</code+      ></pre+    ><p+    >The <a href="http://haskell.org/~kolmodin/code/hinotify/docs/api/"+      >API</a+      > is available online.</p+    ><p+    >I&rsquo;m most grateful for feedback on the API, and what else you might have to suggest.</p+    ><h2 id="author"+    ><a href="#TOC-author"+      >Author</a+      ></h2+    ><p+    >Lennart Kolmodin</p+    ><p+    ><code+      >kolmodin at gentoo.org</code+      ></p+    ><h2 id="legal"+    ><a href="#TOC-legal"+      >Legal</a+      ></h2+    ><p+    >This software is released under a BSD-style license. See LICENSE for more details.</p+    ><p+    >Copyright © 2007 Lennart Kolmodin</p+    ></body+  ></html+>+
− Setup.hs 
@@ -1,3 +0,0 @@-#!/usr/bin/runhaskell-import Distribution.Simple-main = defaultMain
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/runhaskell+> import Distribution.Simple+> main = defaultMain
+ examples/DirTree/DirTree.hs view
@@ -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
+ examples/simple/simple.hs view
@@ -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
hinotify.cabal view
@@ -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 <kolmodin@gentoo.org>+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
+ hinotify.css view
@@ -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;+}+
src/System/INotify.hsc view
@@ -11,18 +11,18 @@ -- 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+-- 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 "<cookie " . shows c $ ">" -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 "<inotify handle, fd=" . shows fd $ ">"-    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
− tests/DirTree/DirTree.hs 
@@ -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
+ tests/Utils.hs view
@@ -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
− tests/simple/simple.hs 
@@ -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
+ tests/test-all view
@@ -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
+ tests/test001-list-dir-contents.hs view
@@ -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+    ]
+ tests/test002-writefile.hs view
@@ -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+    ]
+ tests/test003-removefile.hs view
@@ -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+    ]
+ tests/test004-modify-file.hs view
@@ -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+    ]
+ tests/test005-move-file.hs view
@@ -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+    ]