hinotify-0.4.1/0000755000000000000000000000000007346545000011536 5ustar0000000000000000hinotify-0.4.1/CHANGELOG.md0000755000000000000000000000165507346545000013361 0ustar0000000000000000hinotify ====== hinotify-0.3.10 --------------- - Allow async-2.2. - Use `RawFilePath` (`ByteString`) for filenames, from `unix` package. Changes the `Event` type and `addWatch` function. hinotify-0.3.9 -------------- Patches contributed by Simon Marlow marlowsd@gmail.com - Don't run callbacks in `mask_`. It prevented the callback threads from receiving StackOverflow, amongst other things. - Synchronous `killThread`. `killThread` will now wait for the callback dispatcher threads to finish. - Bug fixes https://github.com/kolmodin/hinotify/pull/23 hinotify-0.3.8 -------------- - Use file system encoding for file names. When run in a locale like LANG=C, this ensures that the filename is encoded as a filename, so that arbitrary bytes in it will round-trip correctly, rather than being stripped out. Fixes https://github.com/kolmodin/hinotify/issues/13 Patch contributed by Joey Hess joeyh@joeyh.name hinotify-0.4.1/LICENSE0000644000000000000000000000266307346545000012552 0ustar0000000000000000Copyright (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. hinotify-0.4.1/README.md0000755000000000000000000000557407346545000013033 0ustar0000000000000000hinotify: inotify for Haskell ============================= [![Build Status](https://api.travis-ci.org/kolmodin/hinotify.png?branch=master)](http://travis-ci.org/kolmodin/hinotify) 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 `hinotify`. 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 -> FilePath -- file/directory to watch -> (Event -> IO ()) -- event handler -> IO WatchDescriptor removeWatch :: WatchDescriptor -> IO () ``` A sample program: ```haskell 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 wd ``` Download -------- The code is available via the [homepage], and via darcs: git clone https://github.com/kolmodin/hinotify.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 © 2007-2012 Lennart Kolmodin [homepage]: https://github.com/kolmodin/hinotify.git [API]: http://hackage.haskell.org/packages/archive/hinotify/latest/doc/html/System-INotify.html hinotify-0.4.1/Setup.lhs0000644000000000000000000000011007346545000013336 0ustar0000000000000000#!/usr/bin/runhaskell > import Distribution.Simple > main = defaultMain hinotify-0.4.1/hinotify.cabal0000644000000000000000000000523407346545000014357 0ustar0000000000000000name: hinotify version: 0.4.1 build-type: Simple 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: https://github.com/kolmodin/hinotify bug-reports: https://github.com/kolmodin/hinotify/issues license: BSD3 license-file: LICENSE author: Lennart Kolmodin maintainer: Lennart Kolmodin extra-source-files: README.md, CHANGELOG.md cabal-version: >= 1.10 source-repository head type: git location: git://github.com/kolmodin/hinotify.git library default-language: Haskell2010 build-depends: base >= 4.5.0.0 && < 5, bytestring, containers, unix, async == 2.* exposed-modules: System.INotify other-modules: System.INotify.Masks ghc-options: -Wall includes: sys/inotify.h hs-source-dirs: src if os(freebsd) || os(openbsd) extra-libraries: inotify test-suite test001 type: exitcode-stdio-1.0 default-language: Haskell2010 build-depends: base, bytestring, directory, hinotify, unix 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 default-language: Haskell2010 build-depends: base, bytestring, directory, hinotify, unix hs-source-dirs: src tests main-is: test002-writefile.hs other-modules: Utils ghc-options: -Wall test-suite test003 type: exitcode-stdio-1.0 default-language: Haskell2010 build-depends: base, bytestring, directory, hinotify, unix hs-source-dirs: src tests main-is: test003-removefile.hs other-modules: Utils ghc-options: -Wall test-suite test004 type: exitcode-stdio-1.0 default-language: Haskell2010 build-depends: base, bytestring, directory, hinotify, unix 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, unix default-language: Haskell2010 hs-source-dirs: src tests main-is: test005-move-file.hs other-modules: Utils ghc-options: -Wall test-suite test006 type: exitcode-stdio-1.0 build-depends: base, bytestring, directory, hinotify, unix default-language: Haskell2010 hs-source-dirs: src tests main-is: test006-callbackHang.hs other-modules: Utils ghc-options: -Wall hinotify-0.4.1/src/System/0000755000000000000000000000000007346545000013611 5ustar0000000000000000hinotify-0.4.1/src/System/INotify.hsc0000644000000000000000000002747607346545000015711 0ustar0000000000000000{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : System.INotify -- Copyright : (c) Lennart Kolmodin 2006-2012 -- License : BSD3 -- Maintainer : kolmodin@gmail.com -- Stability : experimental -- Portability : hc portable, linux only -- -- A Haskell binding to INotify. -- See 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 Control.Monad import Control.Concurrent import Control.Concurrent.Async import Control.Exception as E hiding (mask) import Data.Maybe import Data.Map (Map) import qualified Data.Map as Map import Foreign.C import Foreign.Marshal hiding (void) import Foreign.Ptr import Foreign.Storable import System.IO import System.IO.Error import System.Posix.ByteString.FilePath import System.Posix.Files.ByteString import GHC.IO.FD as FD (mkFD) import GHC.IO.Handle.FD (mkHandleFromFD) import GHC.IO.Device (IODeviceType(Stream)) 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) (Async ()) (Async ()) 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 RawFilePath) deriving (Eq, Show) data Event = -- | A file was accessed. @Accessed isDirectory file@ Accessed { isDirectory :: Bool , maybeFilePath :: Maybe RawFilePath } -- | A file was modified. @Modified isDirectory file@ | Modified { isDirectory :: Bool , maybeFilePath :: Maybe RawFilePath } -- | A files attributes where changed. @Attributes isDirectory file@ | Attributes { isDirectory :: Bool , maybeFilePath :: Maybe RawFilePath } -- | A file was closed. @Closed isDirectory file wasWriteable@ | Closed { isDirectory :: Bool , maybeFilePath :: Maybe RawFilePath , wasWriteable :: Bool } -- | A file was opened. @Opened isDirectory maybeFilePath@ | Opened { isDirectory :: Bool , maybeFilePath :: Maybe RawFilePath } -- | A file was moved away from the watched dir. @MovedFrom isDirectory from cookie@ | MovedOut { isDirectory :: Bool , filePath :: RawFilePath , moveCookie :: Cookie } -- | A file was moved into the watched dir. @MovedTo isDirectory to cookie@ | MovedIn { isDirectory :: Bool , filePath :: RawFilePath , moveCookie :: Cookie } -- | The watched file was moved. @MovedSelf isDirectory@ | MovedSelf { isDirectory :: Bool } -- | A file was created. @Created isDirectory file@ | Created { isDirectory :: Bool , filePath :: RawFilePath } -- | A file was deleted. @Deleted isDirectory file@ | Deleted { isDirectory :: Bool , filePath :: RawFilePath } -- | 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 "" instance Show WatchDescriptor where show (WatchDescriptor _ wd) = showString "" instance Show Cookie where show (Cookie c) = showString "" initINotify :: IO INotify initINotify = do fdint <- throwErrnoIfMinus1 "initINotify" c_inotify_init (fd,fd_type) <- FD.mkFD fdint ReadMode (Just (Stream,0,0)) False{-is_socket-} False{-is_nonblock-} h <- mkHandleFromFD fd fd_type (showString "") ReadMode True -- make non-blocking. Otherwise reading uses select(), which -- can fail when there are >=1024 FDs Nothing -- no encoding, so binary em <- newMVar Map.empty (tid1, tid2) <- inotify_start_thread h em return (INotify h fdint em tid1 tid2) addWatch :: INotify -> [EventVariety] -> RawFilePath -> (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 <- withFilePath 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 = action `E.catch` ignore where ignore :: SomeException -> IO () ignore e ##if MIN_VERSION_async(2,2,1) | Just AsyncCancelled <- fromException e = throwIO e ##else | Just ThreadKilled{} <- fromException e = throwIO e ##endif | otherwise = 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 $ peekFilePath ((#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 (Async (), Async ()) inotify_start_thread h em = do chan_events <- newChan tid1 <- async (logFailure "dispatcher" (dispatcher chan_events)) tid2 <- async (logFailure "start_thread" (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 logFailure name io = io `E.catch` \e -> case e of ##if MIN_VERSION_async(2,2,1) _ | Just AsyncCancelled <- fromException e -> return () ##else _ | Just ThreadKilled{} <- fromException e -> return () ##endif | otherwise -> hPutStrLn stderr (name ++ " dying: " ++ show e) killINotify :: INotify -> IO () killINotify (INotify h _ _ tid1 tid2) = do cancelWait tid1 cancelWait tid2 hClose h cancelWait :: Async a -> IO () ##if MIN_VERSION_async(2,1,1) cancelWait = cancel ##else cancelWait a = do cancel a; void $ waitCatch a ##endif 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 hinotify-0.4.1/src/System/INotify/0000755000000000000000000000000007346545000015172 5ustar0000000000000000hinotify-0.4.1/src/System/INotify/Masks.hsc0000644000000000000000000000436007346545000016752 0ustar0000000000000000module 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 hinotify-0.4.1/tests/0000755000000000000000000000000007346545000012700 5ustar0000000000000000hinotify-0.4.1/tests/Utils.hs0000644000000000000000000000356307346545000014343 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Utils where import Control.Concurrent.Chan import Control.Exception import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC8 import Data.String import System.Directory ( removeDirectoryRecursive ) import System.Environment import System.Exit import System.INotify import System.Posix.ByteString.FilePath import System.Posix.Directory.ByteString import System.Posix.Files.ByteString testName :: IO RawFilePath testName = do n <- getProgName return (fromString n `B.append` "-playground") withTempDir :: (RawFilePath -> IO a) -> IO a withTempDir f = do path <- testName bracket ( createDirectory path ownerModes >> return path ) ( removeDirectoryRecursive . fromString . BC8.unpack ) f withWatch :: INotify -> [EventVariety] -> RawFilePath -> (Event -> IO ()) -> IO a -> IO a withWatch inot events path action f = bracket ( addWatch inot events path action ) removeWatch ( const f ) inTestEnviron :: [EventVariety] -> (FilePath -> 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 (fromString . BC8.unpack $ 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 hinotify-0.4.1/tests/test001-list-dir-contents.hs0000644000000000000000000000065507346545000020022 0ustar0000000000000000module Main where import Control.Monad import System.Directory import System.INotify as INotify import Utils main :: IO () main = inTestEnviron [Open, Close] getDirectoryContents $ \ events -> do when (expected ~= events) testSuccess putStrLn $ explainFailure expected events testFailure expected :: [Event] expected = [ Opened True Nothing , Closed True Nothing False ] hinotify-0.4.1/tests/test002-writefile.hs0000644000000000000000000000126307346545000016427 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Main where import Control.Monad import qualified Data.ByteString as B import System.INotify as INotify import Utils write :: FilePath -> IO () write path = B.writeFile (path ++ "/hello") "" -- actually writing any contents gives me two Modified 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 ] hinotify-0.4.1/tests/test003-removefile.hs0000644000000000000000000000146607346545000016600 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Main where import Control.Monad import System.Directory import System.INotify as INotify import Utils file :: String file = "hello" write :: String -> IO () write path = writeFile (path ++ '/':file) "" remove :: String -> IO () remove path = removeFile (path ++ '/':file) action :: String -> 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 "hello" , Opened False (Just "hello") , Modified False (Just "hello") , Closed False (Just "hello") True , Deleted False "hello" ] hinotify-0.4.1/tests/test004-modify-file.hs0000644000000000000000000000217307346545000016644 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Main where import Control.Exception import Control.Monad import System.Directory import System.IO import System.INotify as INotify import Utils file :: String file = "hello" write :: String -> IO () write path = writeFile (path ++ '/':file) "" modify :: String -> IO () modify path = bracket (openFile (path ++ '/':file) AppendMode) hClose (\h -> hPutStr h "yarr!") remove :: String -> IO () remove path = removeFile (path ++ '/':file) action :: String -> 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 "hello" , Opened False (Just "hello") , Modified False (Just "hello") , Closed False (Just "hello") True , Opened False (Just "hello") , Modified False (Just "hello") , Closed False (Just "hello") True , Deleted False "hello" ] hinotify-0.4.1/tests/test005-move-file.hs0000644000000000000000000000214107346545000016317 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Main where import Control.Monad import System.Directory import System.INotify as INotify import Utils file, file2 :: String file = "hello" file2 = "hello2" write :: String -> IO () write path = writeFile (path ++ '/':file) "" move :: String -> IO () move path = renameFile (path ++ '/':file) (path ++ '/':file2) remove :: String -> IO () remove path = removeFile (path ++ '/':file2) action :: String -> 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 "hello" , Opened False (Just "hello") , Modified False (Just "hello") , Closed False (Just "hello") True , MovedOut False "hello" cookie , MovedIn False "hello2" cookie , Deleted False "hello2" ] hinotify-0.4.1/tests/test006-callbackHang.hs0000644000000000000000000000154707346545000017000 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Main where import qualified Data.ByteString.Char8 as BC8 import Control.Concurrent import Control.Exception import System.INotify as INotify import System.Timeout import Utils file :: String file = "hello" write :: String -> IO () write path = do writeFile (path ++ '/':file) "" main :: IO () main = maybe testFailure (const testSuccess) =<< timeout 1000000 doTest doTest :: IO () doTest = withTempDir $ \testPath -> bracket initINotify killINotify -- should complete and kill all threads $ \inot -> do mvar1 <- newEmptyMVar mvar2 <- newEmptyMVar _ <- addWatch inot [AllEvents] testPath $ \_event -> do putMVar mvar1 () takeMVar mvar2 -- hangs here write (BC8.unpack testPath) takeMVar mvar1