fsnotify 0.3.0.0 → 0.3.0.1

raw patch · 5 files changed

+293/−4 lines, 5 filesdep −Win32-notifyPVP ok

version bump matches the API change (PVP)

Dependencies removed: Win32-notify

API changes (from Hackage documentation)

Files

CHANGELOG.md +15/−0
README.md +1/−1
fsnotify.cabal +6/−3
win-src/System/Win32/FileNotify.hsc +160/−0
win-src/System/Win32/Notify.hs +111/−0

CHANGELOG.md view

@@ -1,6 +1,21 @@ Changes ======= +Version 0.3.0.0+---------------++API breaking update with a number of bugfixes and improvements.++* Now we can detect directory creation/deletion. A boolean flag has been added+  to `Event` to indicate if the event pertains to a directory or not. This is the+  only API change.+* Test stability improvements + CI test suites now passing on Windows, Linux, and Mac.+* Interpreting OSX hfsevents flags is more sane now (see comments in OSX.hs for details).+* Improve a race condition when adding watches on Linux.+* Improve robustness of the PollManager.+* Fix double call to `closeHandle` on Windows.+* Remove comments about locking from the documentation.+ Version 0.2.1.2 ---------------

README.md view

@@ -1,4 +1,4 @@-hfsnotify [![Linux and Mac build Status](https://travis-ci.org/codedownio/hfsnotify.svg)](https://travis-ci.org/codedownio/hfsnotify) [![Windows build status](https://ci.appveyor.com/api/projects/status/u47y5jexvn4lix3c?svg=true)](https://ci.appveyor.com/project/thomasjm/hfsnotify)+hfsnotify [![Linux and Mac build Status](https://travis-ci.org/haskell-fswatch/hfsnotify.svg)](https://travis-ci.org/haskell-fswatch/hfsnotify) [![Windows build status](https://ci.appveyor.com/api/projects/status/7h1msaokgpqo0q42?svg=true)](https://ci.appveyor.com/project/thomasjm/hfsnotify-v2smx) =========  Unified Haskell interface for basic file system notifications.

fsnotify.cabal view

@@ -1,6 +1,6 @@ Name:                   fsnotify-Version:                0.3.0.0-Author:                 Mark Dittmer <mark.s.dittmer@gmail.com>+Version:                0.3.0.1+Author:                 Mark Dittmer <mark.s.dittmer@gmail.com>, Niklas Broberg Maintainer:             Tom McLaughlin <tom@codedown.io> License:                BSD3 License-File:           LICENSE@@ -48,7 +48,10 @@     if os(windows)       CPP-Options:      -DOS_Win32       Other-Modules:    System.FSNotify.Win32-      Build-Depends:    Win32-notify >= 0.3+                      , System.Win32.FileNotify+                      , System.Win32.Notify+      Build-Depends:    Win32+      Hs-Source-Dirs:   win-src     else       if os(darwin)         CPP-Options:    -DOS_Mac

+ win-src/System/Win32/FileNotify.hsc view

@@ -0,0 +1,160 @@+{-# LANGUAGE ForeignFunctionInterface #-}
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE InterruptibleFFI #-}
+#endif
+
+module System.Win32.FileNotify
+       ( Handle
+       , Action(..)
+       , getWatchHandle
+       , readDirectoryChanges
+       ) where
+
+import System.Win32.File
+import System.Win32.Types
+
+import Foreign
+import Foreign.C
+
+import Data.Bits
+
+
+#include <windows.h>
+
+type Handle = HANDLE
+
+getWatchHandle :: FilePath -> IO Handle
+getWatchHandle dir =
+    createFile dir
+        fILE_LIST_DIRECTORY -- Access mode
+        (fILE_SHARE_READ .|. fILE_SHARE_WRITE) -- Share mode
+        Nothing -- security attributes
+        oPEN_EXISTING -- Create mode, we want to look at an existing directory
+        fILE_FLAG_BACKUP_SEMANTICS -- File attribute, nb NOT using OVERLAPPED since we work synchronously
+        Nothing -- No template file
+
+
+readDirectoryChanges :: Handle -> Bool -> FileNotificationFlag -> IO [(Action, String)]
+readDirectoryChanges h wst mask = do
+  let maxBuf = 16384
+  allocaBytes maxBuf $ \buffer -> do
+    alloca $ \bret -> do
+      readDirectoryChangesW h buffer (toEnum maxBuf) wst mask bret
+      readChanges buffer
+
+data Action = FileAdded | FileRemoved | FileModified | FileRenamedOld | FileRenamedNew
+  deriving (Show, Read, Eq, Ord, Enum)
+
+readChanges :: Ptr FILE_NOTIFY_INFORMATION -> IO [(Action, String)]
+readChanges pfni = do
+  fni <- peekFNI pfni
+  let entry = (faToAction $ fniAction fni, fniFileName fni)
+      nioff = fromEnum $ fniNextEntryOffset fni
+  entries <- if nioff == 0 then return [] else readChanges $ pfni `plusPtr` nioff
+  return $ entry:entries
+
+faToAction :: FileAction -> Action
+faToAction fa = toEnum $ fromEnum fa - 1
+
+-------------------------------------------------------------------
+-- Low-level stuff that binds to notifications in the Win32 API
+
+-- Defined in System.Win32.File, but with too few cases:
+-- type AccessMode = UINT
+
+#if !(MIN_VERSION_Win32(2,4,0))
+#{enum AccessMode,
+ , fILE_LIST_DIRECTORY = FILE_LIST_DIRECTORY
+ }
+-- there are many more cases but I only need this one.
+#endif
+
+type FileAction = DWORD
+
+#{enum FileAction,
+ , fILE_ACTION_ADDED            = FILE_ACTION_ADDED
+ , fILE_ACTION_REMOVED          = FILE_ACTION_REMOVED
+ , fILE_ACTION_MODIFIED         = FILE_ACTION_MODIFIED
+ , fILE_ACTION_RENAMED_OLD_NAME = FILE_ACTION_RENAMED_OLD_NAME
+ , fILE_ACTION_RENAMED_NEW_NAME = FILE_ACTION_RENAMED_NEW_NAME
+ }
+
+type WCHAR = Word16
+-- This is a bit overkill for now, I'll only use nullFunPtr anyway,
+-- but who knows, maybe someday I'll want asynchronous callbacks on the OS level.
+type LPOVERLAPPED_COMPLETION_ROUTINE = FunPtr ((DWORD, DWORD, LPOVERLAPPED) -> IO ())
+
+data FILE_NOTIFY_INFORMATION = FILE_NOTIFY_INFORMATION
+    { fniNextEntryOffset, fniAction :: DWORD
+    , fniFileName :: String
+    }
+
+-- instance Storable FILE_NOTIFY_INFORMATION where
+-- ... well, we can't write an instance since the struct is not of fix size,
+-- so we'll have to do it the hard way, and not get anything for free. Sigh.
+
+-- sizeOfFNI :: FILE_NOTIFY_INFORMATION -> Int
+-- sizeOfFNI fni =  (#size FILE_NOTIFY_INFORMATION) + (#size WCHAR) * (length (fniFileName fni) - 1)
+
+peekFNI :: Ptr FILE_NOTIFY_INFORMATION -> IO FILE_NOTIFY_INFORMATION
+peekFNI buf = do
+  neof <- (#peek FILE_NOTIFY_INFORMATION, NextEntryOffset) buf
+  acti <- (#peek FILE_NOTIFY_INFORMATION, Action) buf
+  fnle <- (#peek FILE_NOTIFY_INFORMATION, FileNameLength) buf
+  fnam <- peekCWStringLen
+            (buf `plusPtr` (#offset FILE_NOTIFY_INFORMATION, FileName), -- start of array
+            fromEnum (fnle :: DWORD) `div` 2 ) -- fnle is the length in *bytes*, and a WCHAR is 2 bytes
+  return $ FILE_NOTIFY_INFORMATION neof acti fnam
+
+
+readDirectoryChangesW :: Handle -> Ptr FILE_NOTIFY_INFORMATION -> DWORD -> BOOL -> FileNotificationFlag -> LPDWORD -> IO ()
+readDirectoryChangesW h buf bufSize wst f br =
+  failIfFalse_ "ReadDirectoryChangesW" $ c_ReadDirectoryChangesW h (castPtr buf) bufSize wst f br nullPtr nullFunPtr
+
+{-
+asynchReadDirectoryChangesW :: Handle -> Ptr FILE_NOTIFY_INFORMATION -> DWORD -> BOOL -> FileNotificationFlag
+                                -> LPOVERLAPPED -> IO ()
+asynchReadDirectoryChangesW h buf bufSize wst f over =
+  failIfFalse_ "ReadDirectoryChangesW" $ c_ReadDirectoryChangesW h (castPtr buf) bufSize wst f nullPtr over nullFunPtr
+
+cbReadDirectoryChangesW :: Handle -> Ptr FILE_NOTIFY_INFORMATION -> DWORD -> BOOL -> FileNotificationFlag
+                                -> LPOVERLAPPED -> IO BOOL
+cbReadDirectoryChanges
+-}
+
+-- The interruptible qualifier will keep threads listening for events from hanging blocking when killed
+#if __GLASGOW_HASKELL__ >= 701
+foreign import stdcall interruptible "windows.h ReadDirectoryChangesW"
+#else
+foreign import stdcall safe "windows.h ReadDirectoryChangesW"
+#endif
+  c_ReadDirectoryChangesW :: Handle -> LPVOID -> DWORD -> BOOL -> DWORD -> LPDWORD -> LPOVERLAPPED -> LPOVERLAPPED_COMPLETION_ROUTINE -> IO BOOL
+
+{-
+type CompletionRoutine :: (DWORD, DWORD, LPOVERLAPPED) -> IO ()
+foreign import ccall "wrapper"
+    mkCompletionRoutine :: CompletionRoutine -> IO (FunPtr CompletionRoutine)
+
+type LPOVERLAPPED = Ptr OVERLAPPED
+type LPOVERLAPPED_COMPLETION_ROUTINE = FunPtr CompletionRoutine
+
+data OVERLAPPED = OVERLAPPED
+    {
+    }
+
+
+-- In System.Win32.File, but missing a crucial case:
+-- type FileNotificationFlag = DWORD
+-}
+
+-- See https://msdn.microsoft.com/en-us/library/windows/desktop/aa365465(v=vs.85).aspx
+#{enum FileNotificationFlag,
+ , fILE_NOTIFY_CHANGE_FILE_NAME = FILE_NOTIFY_CHANGE_FILE_NAME
+ , fILE_NOTIFY_CHANGE_DIR_NAME = FILE_NOTIFY_CHANGE_DIR_NAME
+ , fILE_NOTIFY_CHANGE_ATTRIBUTES = FILE_NOTIFY_CHANGE_ATTRIBUTES
+ , fILE_NOTIFY_CHANGE_SIZE = FILE_NOTIFY_CHANGE_SIZE
+ , fILE_NOTIFY_CHANGE_LAST_WRITE = FILE_NOTIFY_CHANGE_LAST_WRITE
+ , fILE_NOTIFY_CHANGE_LAST_ACCESS = FILE_NOTIFY_CHANGE_LAST_ACCESS
+ , fILE_NOTIFY_CHANGE_CREATION = FILE_NOTIFY_CHANGE_CREATION
+ , fILE_NOTIFY_CHANGE_SECURITY = FILE_NOTIFY_CHANGE_SECURITY
+ }

+ win-src/System/Win32/Notify.hs view

@@ -0,0 +1,111 @@+
+module System.Win32.Notify
+  ( Event(..)
+  , EventVariety(..)
+  , Handler
+  , WatchId(..)
+  , WatchManager(..)
+  , initWatchManager
+  , killWatch
+  , killWatchManager
+  , watch
+  , watchDirectory
+  , fILE_NOTIFY_CHANGE_FILE_NAME
+  , fILE_NOTIFY_CHANGE_DIR_NAME
+  , fILE_NOTIFY_CHANGE_ATTRIBUTES
+  , fILE_NOTIFY_CHANGE_SIZE
+  , fILE_NOTIFY_CHANGE_LAST_WRITE
+  -- , fILE_NOTIFY_CHANGE_LAST_ACCESS
+  -- , fILE_NOTIFY_CHANGE_CREATION
+  , fILE_NOTIFY_CHANGE_SECURITY
+  ) where
+
+import Control.Concurrent
+import Control.Concurrent.MVar
+import Control.Monad (forever)
+import Data.Bits
+import Data.List (intersect)
+import Data.Map (Map)
+import qualified Data.Map as Map
+import System.Directory
+import System.FilePath
+import System.Win32 (closeHandle)
+import System.Win32.File
+import System.Win32.FileNotify
+
+data EventVariety = Modify
+                  | Create
+                  | Delete
+                  | Move deriving Eq
+
+data Event
+    -- | A file was modified. @Modified isDirectory file@
+    = Modified { filePath :: FilePath }
+    -- | A file was created. @Created isDirectory file@
+    | Created { filePath :: FilePath }
+    -- | A file was deleted. @Deleted isDirectory file@
+    | Deleted { filePath :: FilePath }
+    deriving (Eq, Show)
+
+type Handler = Event -> IO ()
+
+data WatchId = WatchId ThreadId ThreadId Handle deriving (Eq, Ord, Show)
+type WatchMap = Map WatchId Handler
+data WatchManager = WatchManager (MVar WatchMap)
+
+initWatchManager :: IO WatchManager
+initWatchManager =  do
+  mvarMap <- newMVar Map.empty
+  return (WatchManager mvarMap)
+
+killWatchManager :: WatchManager -> IO ()
+killWatchManager (WatchManager mvarMap) = do
+  watchMap <- readMVar mvarMap
+  flip mapM_ (Map.keys watchMap) $ killWatch
+
+watchDirectory :: WatchManager -> FilePath -> Bool -> FileNotificationFlag -> Handler -> IO WatchId
+watchDirectory (WatchManager mvarMap) dir watchSubTree flags handler = do
+  watchHandle <- getWatchHandle dir
+  chanEvents <- newChan
+  tid1 <- forkIO $ dispatcher chanEvents
+  tid2 <- forkIO $ osEventsReader watchHandle chanEvents
+  modifyMVar_ mvarMap $ \watchMap -> return (Map.insert (WatchId tid1 tid2 watchHandle) handler watchMap)
+  return (WatchId tid1 tid2 watchHandle)
+
+  where
+    dispatcher :: Chan [Event] -> IO ()
+    dispatcher chanEvents = forever $ readChan chanEvents >>= mapM_ handler
+
+    osEventsReader :: Handle -> Chan [Event] -> IO ()
+    osEventsReader watchHandle chanEvents = forever $ do
+      (readDirectoryChanges watchHandle watchSubTree flags >>= (actsToEvents dir) >>= writeChan chanEvents)
+
+watch :: WatchManager -> FilePath -> Bool -> FileNotificationFlag -> IO (WatchId, Chan [Event])
+watch (WatchManager mvarMap) dir watchSubTree flags = do
+  watchHandle <- getWatchHandle dir
+  chanEvents <- newChan
+  tid <- forkIO $ osEventsReader watchHandle chanEvents
+  modifyMVar_ mvarMap $ \watchMap -> return (Map.insert (WatchId tid tid watchHandle) (const $ return ()) watchMap)
+  return ((WatchId tid tid watchHandle), chanEvents)
+
+  where
+    osEventsReader :: Handle -> Chan [Event] -> IO ()
+    osEventsReader watchHandle chanEvents = forever $ do
+      (readDirectoryChanges watchHandle watchSubTree flags >>= (actsToEvents dir) >>= writeChan chanEvents)
+
+killWatch :: WatchId -> IO ()
+killWatch (WatchId tid1 tid2 handle) = do
+    killThread tid1
+    if tid1 /= tid2 then killThread tid2 else return ()
+    closeHandle handle
+
+actsToEvents :: FilePath -> [(Action, String)] -> IO [Event]
+actsToEvents baseDir = mapM actToEvent
+  where
+    actToEvent (act, fn) = do
+      case act of
+        FileModified -> return $ Modified $ baseDir </> fn
+        FileAdded -> return $ Created $ baseDir </> fn
+        FileRemoved -> return $ Deleted $ baseDir </> fn
+        FileRenamedOld -> return $ Deleted $ baseDir </> fn
+        FileRenamedNew -> return $ Created $ baseDir </> fn