hinotify-bytestring (empty) → 0.3.8.1

raw patch · 13 files changed

+1027/−0 lines, 13 filesdep +basedep +bytestringdep +containerssetup-changed

Dependencies added: base, bytestring, containers, directory, hinotify-bytestring, posix-paths, unix, utf8-string

Files

• CHANGELOG.md +7/−0
• LICENSE +30/−0
• README.md +133/−0
• Setup.lhs +3/−0
• hinotify-bytestring.cabal +76/−0
• src/System/INotify.hsc +340/−0
• src/System/INotify/Masks.hsc +93/−0
• tests/Utils.hs +109/−0
• tests/test001-list-dir-contents.hs +25/−0
• tests/test002-writefile.hs +37/−0
• tests/test003-removefile.hs +51/−0
• tests/test004-modify-file.hs +62/−0
• tests/test005-move-file.hs +61/−0

@@ -0,0 +1,7 @@+hinotify+======++hinotify-0.3.8.1+--------------++- fork the library and use `ByteString` instead of `String` as filepath, see https://github.com/kolmodin/hinotify/issues/19 for more information

@@ -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.

@@ -0,0 +1,133 @@+hinotify-bytestring: inotify for Haskell using ByteString for filepaths+=============================++[![Build Status](https://api.travis-ci.org/hasufell/hinotify-bytestring.png?branch=master)](http://travis-ci.org/hasufell/hinotify-bytestring)++About+-----++hinotify-bytestring, 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 `hinotify-bytestring`.++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.3.7**++* Bug fix: When registerering a new watch on a path which is already watched,+  don't overwrite the event listener from the previous watch.++**hinotify 0.3.2**++* Make each `WatchDescriptor` contain its `INotify`. Changes to the function types:++>      -removeWatch :: INotify -> WatchDescriptor -> IO ()+>      +removeWatch :: WatchDescriptor -> IO ()++* Fix typo in declaration of `Deleted` in `data Event`;++>      - { isDirecotry :: Bool+>      + { isDirectory :: Bool++**hinotify 0.3.1**++* Use `inotify.h` from `glibc` rather than from the linux headers, as+      recommended upstream.++**hinotify 0.3**++* Compiles with GHC 6.12, GHC 6.10.4, GHC 6.8.2 and GHC 6.6.1++**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:++```haskell+initINotify :: IO INotify+addWatch :: INotify+         -> [EventVariety]   -- different events to listen on+         -> ByteString       -- file/directory to watch+         -> (Event -> IO ()) -- event handler+         -> IO WatchDescriptor+removeWatch :: WatchDescriptor -> IO ()+```++A sample program:++```haskell+{-# LANGUAGE OverloadedStrings #-}++import System.Posix.Env.ByteString+import System.IO++import System.INotify++main :: IO ()+main = do+  inotify <- initINotify+  print inotify+  home <- getEnvDefault "HOME" "/home"+  wd <- addWatch+          inotify+          [Open,Close,Access,Modify,Move]+          home+          print+  print wd+  putStrLn "Listens to your home directory. Hit enter to terminate."+  getLine+  removeWatch wd+```++Download+--------++The code is available via the [homepage]:++    git clone https://github.com/hasufell/hinotify-bytestring.git++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 gmail.com`++Legal+-----++This software is released under a BSD-style license. See LICENSE for+more details.++Copyright &copy; 2007-2012 Lennart Kolmodin++[homepage]: https://github.com/hasufell/hinotify-bytestring.git++[API]: http://hackage.haskell.org/packages/archive/hinotify-bytestring/latest/doc/html/System-INotify.html

@@ -0,0 +1,3 @@+#!/usr/bin/runhaskell+> import Distribution.Simple+> main = defaultMain

@@ -0,0 +1,76 @@+name:               hinotify-bytestring+version:            0.3.8.1+build-type:         Simple+synopsis:           Haskell binding to inotify, using ByteString filepaths+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. Filepaths are represented as ByteStrings.+category:           System+homepage:           https://github.com/hasufell/hinotify-bytestring.git+license:            BSD3+license-file:       LICENSE+author:             Lennart Kolmodin+maintainer:         Julian Ospald <hasufell@posteo.de>+extra-source-files: README.md, CHANGELOG.md+cabal-version:      >= 1.8++source-repository head+  type: git+  location: git://github.com/hasufell/hinotify-bytestring.git++library+    build-depends:  base >= 4.5.0.0 && < 5, bytestring, containers, directory, unix+    extensions:     ForeignFunctionInterface++    exposed-modules:+        System.INotify+    other-modules:+        System.INotify.Masks++    ghc-options: -Wall+    includes: sys/inotify.h+    hs-source-dirs: src++++test-suite test001+    type: exitcode-stdio-1.0+    build-depends: base, bytestring, directory, hinotify-bytestring, posix-paths, unix, utf8-string+    hs-source-dirs: src tests+    main-is: test001-list-dir-contents.hs+    other-modules: Utils+    ghc-options: -Wall++test-suite test002+    type: exitcode-stdio-1.0+    build-depends: base, bytestring, directory, hinotify-bytestring, posix-paths, unix, utf8-string+    hs-source-dirs: src tests+    main-is: test002-writefile.hs+    other-modules: Utils+    ghc-options: -Wall++test-suite test003+    type: exitcode-stdio-1.0+    build-depends: base, bytestring, directory, hinotify-bytestring, posix-paths, unix, utf8-string+    hs-source-dirs: src tests+    main-is: test003-removefile.hs+    other-modules: Utils+    ghc-options: -Wall++test-suite test004+    type: exitcode-stdio-1.0+    build-depends: base, bytestring, directory, hinotify-bytestring, posix-paths, unix, utf8-string+    hs-source-dirs: src tests+    main-is: test004-modify-file.hs+    other-modules: Utils+    ghc-options: -Wall++test-suite test005+    type: exitcode-stdio-1.0+    build-depends: base, bytestring, directory, hinotify-bytestring, posix-paths, unix, utf8-string+    hs-source-dirs: src tests+    main-is: test005-move-file.hs+    other-modules: Utils+    ghc-options: -Wall+

@@ -0,0 +1,340 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  System.INotify+-- Copyright   :  (c) Lennart Kolmodin 2006-2012+-- License     :  BSD3+-- Maintainer  :  hasufell@posteo.de+-- 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 '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 'removeWatch' once you don't want to watch a file any more.+--+-----------------------------------------------------------------------------++module System.INotify+    ( initINotify+    , killINotify+    , withINotify+    , addWatch+    , removeWatch+    , INotify+    , WatchDescriptor+    , Event(..)+    , EventVariety(..)+    , Cookie+    ) where++#include "sys/inotify.h"++import Prelude hiding (init)+import Data.ByteString(ByteString)+import qualified Data.ByteString as BS+import Control.Monad+import Control.Concurrent+import Control.Exception as E (bracket, catch, mask_, SomeException)+import Data.Maybe+import Data.Map (Map)+import qualified Data.Map as Map+import Foreign.C hiding (peekCString)+import Foreign.Marshal hiding (void)+import Foreign.Ptr+import Foreign.Storable+import System.IO+import System.IO.Error+#if __GLASGOW_HASKELL__ >= 612+import GHC.IO.Handle.FD (fdToHandle')+import GHC.IO.Device (IODeviceType(Stream))+#else+import GHC.Handle+import System.Posix.Internals+#endif+import System.Posix.Files.ByteString+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) ThreadId ThreadId+data WatchDescriptor = WatchDescriptor INotify WD deriving Eq++instance Eq INotify where+  (INotify _ fd1 _ _ _) == (INotify _ fd2 _ _ _) = fd1 == fd2++newtype Cookie = Cookie CUInt deriving (Eq,Ord)++data FDEvent = FDEvent WD Masks CUInt{-Cookie-} (Maybe ByteString) deriving (Eq, Show)++data Event =+    -- | A file was accessed. @Accessed isDirectory file@+      Accessed+        { isDirectory :: Bool+        , maybeFilePath :: Maybe ByteString+        }+    -- | A file was modified. @Modified isDirectory file@+    | Modified+        { isDirectory :: Bool+        , maybeFilePath :: Maybe ByteString+        }+    -- | A files attributes where changed. @Attributes isDirectory file@+    | Attributes+        { isDirectory :: Bool+        , maybeFilePath :: Maybe ByteString+        }+    -- | A file was closed. @Closed isDirectory file wasWriteable@+    | Closed+        { isDirectory :: Bool+        , maybeFilePath :: Maybe ByteString+        , wasWriteable :: Bool+        }+    -- | A file was opened. @Opened isDirectory maybeFilePath@+    | Opened+        { isDirectory :: Bool+        , maybeFilePath :: Maybe ByteString+        }+    -- | A file was moved away from the watched dir. @MovedFrom isDirectory from cookie@+    | MovedOut+        { isDirectory :: Bool+        , filePath :: ByteString+        , moveCookie :: Cookie+        }+    -- | A file was moved into the watched dir. @MovedTo isDirectory to cookie@+    | MovedIn+        { isDirectory :: Bool+        , filePath :: ByteString+        , moveCookie :: Cookie+        }+    -- | The watched file was moved. @MovedSelf isDirectory@+    | MovedSelf+        { isDirectory :: Bool+        }+    -- | A file was created. @Created isDirectory file@+    | Created+        { isDirectory :: Bool+        , filePath :: ByteString+        }+    -- | A file was deleted. @Deleted isDirectory file@+    | Deleted+        { isDirectory :: Bool+        , filePath :: ByteString+        }+    -- | The file watched was deleted.+    | DeletedSelf+    -- | The file watched was unmounted.+    | Unmounted+    -- | The queue overflowed.+    | QOverflow+    | Ignored+    | Unknown FDEvent+    deriving (Eq, 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 $ ">"++initINotify :: IO INotify+initINotify = do+    fd <- throwErrnoIfMinus1 "initINotify" c_inotify_init+    let desc = showString "<inotify handle, fd=" . shows fd $ ">"+#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+    em <- newMVar Map.empty+    (tid1, tid2) <- inotify_start_thread h em+    return (INotify h fd em tid1 tid2)++addWatch :: INotify -> [EventVariety] -> ByteString -> (Event -> IO ()) -> IO WatchDescriptor+addWatch inotify@(INotify _ fd em _ _) masks fp cb = do+    catch_IO (void $+              (if (NoSymlink `elem` masks) then getSymbolicLinkStatus else getFileStatus)+              fp) $ \_ ->+        ioError $ mkIOError doesNotExistErrorType+             "can't watch what isn't there!"+             Nothing+             (Just $ show fp)+    let mask = joinMasks (map eventVarietyToMask masks)+    wd <- BS.useAsCString fp $ \fp_c ->+            throwErrnoIfMinus1 "addWatch" $+              c_inotify_add_watch (fromIntegral fd) fp_c mask+    let event = \e -> ignore_failure $ do+            case e of+              -- if the event is Ignored then we know for sure that+              -- this is the last event on that WatchDescriptor+              Ignored -> rm_watch inotify wd+              _       -> return ()+            cb e+    modifyMVar_ em $ \em' -> return (Map.insertWith (liftM2 (>>)) wd event em')+    return (WatchDescriptor inotify wd)+    where+    -- catch_IO is same as catchIOError from base >= 4.5.0.0+    catch_IO :: IO a -> (IOError -> IO a) -> IO a+    catch_IO = E.catch+    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++    ignore_failure :: IO () -> IO ()+    ignore_failure action = mask_ (action `E.catch` ignore)+      where+      ignore :: SomeException -> IO ()+      ignore _ = return ()++removeWatch :: WatchDescriptor -> IO ()+removeWatch (WatchDescriptor (INotify _ fd _ _ _) wd) = do+    _ <- throwErrnoIfMinus1 "removeWatch" $+      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 do+                        fmap Just $ BS.packCString ((#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 nameM (isSet inCloseWrite)+            | isSet inOpen       = Opened isDir nameM+            | 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+            | 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 (ThreadId, ThreadId)+inotify_start_thread h em = do+    chan_events <- newChan+    tid1 <- forkIO (dispatcher chan_events)+    tid2 <- forkIO (start_thread chan_events)+    return (tid1,tid2)+    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+        mapM_ ($ e) (Map.elems handlers)+    runHandler (wd, event) = do +        handlers <- readMVar em+        let handlerM = Map.lookup wd handlers+        case handlerM of+          Nothing -> putStrLn "runHandler: couldn't find handler" -- impossible?+          Just handler -> handler event++killINotify :: INotify -> IO ()+killINotify (INotify h _ _ tid1 tid2) =+    do killThread tid1+       killThread tid2+       hClose h++withINotify :: (INotify -> IO a) -> IO a+withINotify = bracket initINotify killINotify+        +foreign import ccall unsafe "sys/inotify.h inotify_init" c_inotify_init :: IO CInt+foreign import ccall unsafe "sys/inotify.h inotify_add_watch" c_inotify_add_watch :: CInt -> CString -> CUInt -> IO CInt+foreign import ccall unsafe "sys/inotify.h inotify_rm_watch" c_inotify_rm_watch :: CInt -> CInt -> IO CInt+

@@ -0,0 +1,93 @@+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 "sys/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

@@ -0,0 +1,109 @@+{-# LANGUAGE OverloadedStrings #-}++module Utils where+++import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import Data.ByteString.UTF8 (fromString)++import Control.Concurrent.Chan+import Control.Exception++import GHC.IO.Exception ( IOErrorType(InappropriateType) )++import System.Environment+import System.Exit++import System.INotify++import System.IO.Error+  ( ioeSetErrorString+  , ioeSetLocation+  , mkIOError+  , modifyIOError )++import System.Posix.Directory.ByteString+import System.Posix.Directory.Traversals+import System.Posix.FilePath+import System.Posix.Files.ByteString++++testName :: IO ByteString+testName = do+    n <- getProgName+    return (fromString n `BS.append` "-playground")++withTempDir :: (ByteString -> IO a) -> IO a+withTempDir f = do+    path' <- testName+    bracket+        ( createDirectory path' accessModes >> return path' )+        removeDirectoryRecursive+        f++withWatch :: INotify -> [EventVariety] -> ByteString -> (Event -> IO ()) -> IO a -> IO a+withWatch inot events path action f =+    bracket+        ( addWatch inot events path action )+        removeWatch+        ( const f )++inTestEnviron :: [EventVariety] -> (ByteString -> IO a) -> ([Event] -> IO b) -> IO b+inTestEnviron events action f =+    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 :: Show a => [a] -> [a] -> String+explainFailure expected reality = unlines $+    [ "Expected:" ] +++    [ "> " ++ show x | x <- expected ] +++    [ "But got:" ] +++    [ "< " ++ show x | x <- asMany expected reality ]++testFailure, testSuccess :: IO a+testFailure = exitFailure +testSuccess = exitSuccess+++removeDirectoryRecursive :: ByteString -> IO ()+removeDirectoryRecursive path =+  (`ioeSetLocation` "removeDirectoryRecursive") `modifyIOError` do+    stat <- getSymbolicLinkStatus path+    if System.Posix.Files.ByteString.isDirectory stat+       then removeContentsRecursive path+       else ioError . (`ioeSetErrorString` "not a directory") $+            mkIOError InappropriateType "" Nothing (Just $ show path)+++removeContentsRecursive :: ByteString -> IO ()+removeContentsRecursive path =+  (`ioeSetLocation` "removeContentsRecursive") `modifyIOError` do+    cont <- (filter (\(_, y) -> y /= "." && y /= ".."))+            `fmap` getDirectoryContents path+    mapM_ removePathRecursive $ fmap (\(_, y) -> path </> y) cont+    removeDirectory path+++removePathRecursive :: ByteString -> IO ()+removePathRecursive path =+  (`ioeSetLocation` "removePathRecursive") `modifyIOError` do+  stat <- getSymbolicLinkStatus path+  if System.Posix.Files.ByteString.isDirectory stat+     then removeContentsRecursive path+     else removeLink path+

@@ -0,0 +1,25 @@+module Main where++import Control.Monad++import System.INotify++import qualified System.Posix.Directory.Traversals as PT++import Utils+++main :: IO ()+main =+  inTestEnviron [Open, Close] PT.getDirectoryContents $ \ events -> do+        when (expected ~= events)+            testSuccess+        putStrLn $ explainFailure expected events+        testFailure+++expected :: [Event]+expected =+    [ Opened True Nothing+    , Closed True Nothing False+    ]

@@ -0,0 +1,37 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Control.Exception+import Control.Monad++import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import System.INotify++import System.Posix.Files.ByteString+import System.Posix.IO.ByteString++import Utils++write :: ByteString -> IO ()+write path =+    bracket (createFile (path `BS.append` "/hello") stdFileMode)+            closeFd+            (\fd -> void $ fdWrite fd " ")+    +main :: IO ()+main =+    inTestEnviron [AllEvents] write $ \ events -> do+        when (expected ~= events)+            testSuccess+        putStrLn $ explainFailure expected events+        testFailure++expected :: [Event]+expected =+    [ Created   False "hello"+    , Opened    False (Just "hello")+    , Modified  False (Just "hello")+    , Closed    False (Just "hello") True+    ]

@@ -0,0 +1,51 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Control.Exception+import Control.Monad++import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import System.INotify++import System.Posix.Files.ByteString+import System.Posix.IO.ByteString++import Utils+++file :: ByteString+file = "hello"++write :: ByteString -> IO ()+write path =+  bracket (createFile (path `BS.append` "/" `BS.append` file) stdFileMode)+          closeFd+          (\fd -> void $ fdWrite fd " ")++remove :: ByteString -> IO ()+remove path =+    removeLink (path `BS.append` "/" `BS.append` file)++action :: ByteString -> IO ()+action path = do+    write path+    remove path++main :: IO ()+main =+    inTestEnviron [AllEvents] action $ \ events -> do+        when (expected ~= events)+            testSuccess+        putStrLn $ explainFailure expected events+        testFailure++expected :: [Event]+expected =+    [ Created   False file+    , Opened    False (Just file)+    , Modified  False (Just file)+    , Closed    False (Just file) True+    , Deleted   False file+    ]

@@ -0,0 +1,62 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Control.Exception+import Control.Monad++import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import System.INotify++import System.Posix.Files.ByteString+import System.Posix.IO.ByteString++import Utils+++file :: ByteString+file = "hello"++write :: ByteString -> IO ()+write path =+  bracket (createFile (path `BS.append` "/" `BS.append` file) stdFileMode)+          closeFd+          (\fd -> void $ fdWrite fd " ")++modify :: ByteString -> IO ()+modify path =+  bracket (openFd (path `BS.append` "/" `BS.append` file) WriteOnly+                  Nothing defaultFileFlags)+          closeFd+          (\fd -> void $ fdWrite fd "yarr!")++remove :: ByteString -> IO ()+remove path =+    removeLink (path `BS.append` "/" `BS.append` file)++action :: ByteString -> IO ()+action path = do+    write path+    modify path+    remove path++main :: IO ()+main =+    inTestEnviron [AllEvents] action $ \ events -> do+        when (expected ~= events)+            testSuccess+        putStrLn $ explainFailure expected events+        testFailure++expected :: [Event]+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+    ]

@@ -0,0 +1,61 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Control.Exception+import Control.Monad++import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import System.INotify++import System.Posix.Files.ByteString+import System.Posix.IO.ByteString++import Utils+++file, file2 :: ByteString+file = "hello"+file2 = file `BS.append` "2"++write :: ByteString -> IO ()+write path =+  bracket (createFile (path `BS.append` "/" `BS.append` file) stdFileMode)+          closeFd+          (\fd -> void $ fdWrite fd " ")++move :: ByteString -> IO ()+move path =+    rename (path `BS.append` "/" `BS.append` file)+           (path `BS.append` "/" `BS.append` file2)++remove :: ByteString -> IO ()+remove path =+    removeLink (path `BS.append` "/" `BS.append` file2)++action :: ByteString -> IO ()+action path = do+    write path+    move path+    remove path++main :: IO ()+main =+    inTestEnviron [AllEvents] action $ \ events -> do+        let cookie = head [ c | MovedOut _ _ c <- events ]+        when (expected cookie ~= events)+            testSuccess+        putStrLn $ explainFailure (expected cookie) events+        testFailure++expected :: Cookie -> [Event]+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+    ]