hinotify 0.3.9 → 0.3.10

raw patch · 9 files changed

+115/−81 lines, 9 filesdep +bytestringdep ~asyncPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: bytestring

Dependency ranges changed: async

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−0
• hinotify.cabal +9/−9
• src/System/INotify.hsc +33/−26
• tests/Utils.hs +21/−12
• tests/test002-writefile.hs +6/−3
• tests/test003-removefile.hs +8/−7
• tests/test004-modify-file.hs +13/−12
• tests/test005-move-file.hs +13/−11
• tests/test006-callbackHang.hs +3/−1

@@ -1,6 +1,15 @@ hinotify ====== +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 -------------- 

@@ -1,5 +1,5 @@ name:               hinotify-version:            0.3.9+version:            0.3.10 build-type:         Simple synopsis:           Haskell binding to inotify description:@@ -21,8 +21,8 @@  library     default-language: Haskell2010-    build-depends:  base >= 4.5.0.0 && < 5, containers, directory, unix,-                    async >= 1.0 && < 2.2+    build-depends:  base >= 4.5.0.0 && < 5, bytestring, containers, unix,+                    async >= 1.0 && < 2.3      exposed-modules:         System.INotify@@ -36,7 +36,7 @@ test-suite test001     type: exitcode-stdio-1.0     default-language: Haskell2010-    build-depends: base, directory, hinotify+    build-depends: base, bytestring, directory, hinotify, unix     hs-source-dirs: src tests     main-is: test001-list-dir-contents.hs     other-modules: Utils@@ -45,7 +45,7 @@ test-suite test002     type: exitcode-stdio-1.0     default-language: Haskell2010-    build-depends: base, directory, hinotify+    build-depends: base, bytestring, directory, hinotify, unix     hs-source-dirs: src tests     main-is: test002-writefile.hs     other-modules: Utils@@ -54,7 +54,7 @@ test-suite test003     type: exitcode-stdio-1.0     default-language: Haskell2010-    build-depends: base, directory, hinotify+    build-depends: base, bytestring, directory, hinotify, unix     hs-source-dirs: src tests     main-is: test003-removefile.hs     other-modules: Utils@@ -63,7 +63,7 @@ test-suite test004     type: exitcode-stdio-1.0     default-language: Haskell2010-    build-depends: base, directory, hinotify+    build-depends: base, bytestring, directory, hinotify, unix     hs-source-dirs: src tests     main-is: test004-modify-file.hs     other-modules: Utils@@ -71,7 +71,7 @@  test-suite test005     type: exitcode-stdio-1.0-    build-depends: base, directory, hinotify+    build-depends: base, bytestring, directory, hinotify, unix     default-language: Haskell2010     hs-source-dirs: src tests     main-is: test005-move-file.hs@@ -80,7 +80,7 @@  test-suite test006     type: exitcode-stdio-1.0-    build-depends: base, directory, hinotify+    build-depends: base, bytestring, directory, hinotify, unix     default-language: Haskell2010     hs-source-dirs: src tests     main-is: test006-callbackHang.hs

@@ -15,7 +15,7 @@ -- 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. -- -----------------------------------------------------------------------------@@ -43,18 +43,19 @@ import Data.Maybe import Data.Map (Map) import qualified Data.Map as Map-import Foreign.C hiding (withCString, peekCString)+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.Posix.Files-import GHC.IO.Encoding (getFileSystemEncoding)-import GHC.Foreign (withCString, peekCString)  import System.INotify.Masks @@ -73,45 +74,45 @@  newtype Cookie = Cookie CUInt deriving (Eq,Ord) -data FDEvent = FDEvent WD Masks CUInt{-Cookie-} (Maybe String) deriving (Eq, Show)+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 FilePath+        , maybeFilePath :: Maybe RawFilePath         }     -- | A file was modified. @Modified isDirectory file@     | Modified         { isDirectory :: Bool-        , maybeFilePath :: Maybe FilePath+        , maybeFilePath :: Maybe RawFilePath         }     -- | A files attributes where changed. @Attributes isDirectory file@     | Attributes         { isDirectory :: Bool-        , maybeFilePath :: Maybe FilePath+        , maybeFilePath :: Maybe RawFilePath         }     -- | A file was closed. @Closed isDirectory file wasWriteable@     | Closed         { isDirectory :: Bool-        , maybeFilePath :: Maybe FilePath+        , maybeFilePath :: Maybe RawFilePath         , wasWriteable :: Bool         }     -- | A file was opened. @Opened isDirectory maybeFilePath@     | Opened         { isDirectory :: Bool-        , maybeFilePath :: Maybe FilePath+        , maybeFilePath :: Maybe RawFilePath         }     -- | A file was moved away from the watched dir. @MovedFrom isDirectory from cookie@     | MovedOut         { isDirectory :: Bool-        , filePath :: FilePath+        , filePath :: RawFilePath         , moveCookie :: Cookie         }     -- | A file was moved into the watched dir. @MovedTo isDirectory to cookie@     | MovedIn         { isDirectory :: Bool-        , filePath :: FilePath+        , filePath :: RawFilePath         , moveCookie :: Cookie         }     -- | The watched file was moved. @MovedSelf isDirectory@@@ -121,12 +122,12 @@     -- | A file was created. @Created isDirectory file@     | Created         { isDirectory :: Bool-        , filePath :: FilePath+        , filePath :: RawFilePath         }     -- | A file was deleted. @Deleted isDirectory file@     | Deleted         { isDirectory :: Bool-        , filePath :: FilePath+        , filePath :: RawFilePath         }     -- | The file watched was deleted.     | DeletedSelf@@ -162,7 +163,7 @@  instance Show INotify where     show (INotify _ fd _ _ _) =-        showString "<inotify fd=" . +        showString "<inotify fd=" .         shows fd $ ">"  instance Show WatchDescriptor where@@ -187,7 +188,7 @@     (tid1, tid2) <- inotify_start_thread h em     return (INotify h fdint em tid1 tid2) -addWatch :: INotify -> [EventVariety] -> FilePath -> (Event -> IO ()) -> IO WatchDescriptor+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)@@ -195,10 +196,9 @@         ioError $ mkIOError doesNotExistErrorType              "can't watch what isn't there!"              Nothing-             (Just fp)+             (Just (show fp))     let mask = joinMasks (map eventVarietyToMask masks)-    enc <- getFileSystemEncoding-    wd <- withCString enc fp $ \fp_c ->+    wd <- withFilePath fp $ \fp_c ->             throwErrnoIfMinus1 "addWatch" $               c_inotify_add_watch (fromIntegral fd) fp_c mask     let event = \e -> ignore_failure $ do@@ -241,7 +241,11 @@       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 ()@@ -255,7 +259,7 @@     modifyMVar_ em (return . Map.delete wd)  read_events :: Handle -> IO [WDEvent]-read_events h = +read_events h =     let maxRead = 16385 in     allocaBytes maxRead $ \buffer -> do         _ <- hWaitForInput h (-1)  -- wait forever@@ -272,13 +276,12 @@         nameM  <- if len == 0                     then return Nothing                     else do-                        enc <- getFileSystemEncoding-                        fmap Just $ peekCString enc ((#ptr struct inotify_event, name) ptr)-        let event_size = (#size struct inotify_event) + (fromIntegral len) +                        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 +    cEvent2Haskell :: FDEvent                -> WDEvent     cEvent2Haskell fdevent@(FDEvent wd mask cookie nameM)         = (wd, event)@@ -324,7 +327,7 @@     runHandler (_,  e@QOverflow) = do -- send overflows to all handlers         handlers <- readMVar em         mapM_ ($ e) (Map.elems handlers)-    runHandler (wd, event) = do +    runHandler (wd, event) = do         handlers <- readMVar em         let handlerM = Map.lookup wd handlers         case handlerM of@@ -333,7 +336,11 @@      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 ()

@@ -1,41 +1,50 @@+{-# LANGUAGE OverloadedStrings #-} module Utils where  import Control.Concurrent.Chan import Control.Exception -import System.Directory+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 -testName :: IO String+import System.Posix.ByteString.FilePath+import System.Posix.Directory.ByteString+import System.Posix.Files.ByteString++testName :: IO RawFilePath testName = do     n <- getProgName-    return (n ++ "-playground")+    return (fromString n `B.append` "-playground") -withTempDir :: (String -> IO a) -> IO a+withTempDir :: (RawFilePath -> IO a) -> IO a withTempDir f = do     path <- testName     bracket-        ( createDirectory path >> return path )-        ( removeDirectoryRecursive )-        ( f )+        ( createDirectory path ownerModes >> return path )+        ( removeDirectoryRecursive . fromString . BC8.unpack )+        f -withWatch :: INotify -> [EventVariety] -> FilePath -> (Event -> IO ()) -> IO a -> IO a+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] -> (String -> IO a) -> ([Event] -> IO b) -> IO b-inTestEnviron events action f = do+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 testPath+            _ <- action (fromString . BC8.unpack $ testPath)             events' <- getChanContents chan             f events' @@ -56,5 +65,5 @@  testFailure, testSuccess :: IO a testFailure = exitFailure -testSuccess = exitWith ExitSuccess+testSuccess = exitSuccess 

@@ -1,14 +1,17 @@+{-# LANGUAGE OverloadedStrings #-} module Main where  import Control.Monad +import qualified Data.ByteString as B+ import System.INotify as INotify  import Utils -write :: String -> IO ()-write path = do-    writeFile (path ++ "/hello") ""+write :: FilePath -> IO ()+write path =+    B.writeFile (path ++ "/hello") ""     -- actually writing any contents gives me two Modified      main :: IO ()

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} module Main where  import Control.Monad@@ -12,11 +13,11 @@ file = "hello"  write :: String -> IO ()-write path = do+write path =     writeFile (path ++ '/':file) ""  remove :: String -> IO ()-remove path = do+remove path =     removeFile (path ++ '/':file)  action :: String -> IO ()@@ -34,9 +35,9 @@  expected :: [Event] expected =-    [ Created   False file-    , Opened    False (Just file)-    , Modified  False (Just file)-    , Closed    False (Just file) True-    , Deleted   False file+    [ Created   False "hello"+    , Opened    False (Just "hello")+    , Modified  False (Just "hello")+    , Closed    False (Just "hello") True+    , Deleted   False "hello"     ]

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} module Main where  import Control.Exception@@ -14,18 +15,18 @@ file = "hello"  write :: String -> IO ()-write path = do+write path =     writeFile (path ++ '/':file) ""  modify :: String -> IO ()-modify path = do+modify path =     bracket         (openFile (path ++ '/':file) AppendMode)-        (hClose)+        hClose         (\h -> hPutStr h "yarr!")  remove :: String -> IO ()-remove path = do+remove path =     removeFile (path ++ '/':file)  action :: String -> IO ()@@ -44,12 +45,12 @@  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+    [ 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"     ]

@@ -1,6 +1,8 @@+{-# LANGUAGE OverloadedStrings #-} module Main where  import Control.Monad+ import System.Directory  import System.INotify as INotify@@ -9,18 +11,18 @@  file, file2 :: String file = "hello"-file2 = file ++ "2"+file2 = "hello2"  write :: String -> IO ()-write path = do+write path =     writeFile (path ++ '/':file) ""  move :: String -> IO ()-move path = do+move path =     renameFile (path ++ '/':file) (path ++ '/':file2)  remove :: String -> IO ()-remove path = do+remove path =     removeFile (path ++ '/':file2)  action :: String -> IO ()@@ -40,11 +42,11 @@  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+    [ 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"     ]

@@ -1,5 +1,7 @@+{-# LANGUAGE OverloadedStrings #-} module Main where +import qualified Data.ByteString.Char8 as BC8 import Control.Concurrent import Control.Exception @@ -30,5 +32,5 @@             _ <- addWatch inot [AllEvents] testPath $ \_event -> do                 putMVar mvar1 ()                 takeMVar mvar2 -- hangs here-            write testPath+            write (BC8.unpack testPath)             takeMVar mvar1