diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,11 @@ Changes ======= +Version 0.4.3.0 +---------- +* Use polling as a generic fallback and add support for WASM (https://github.com/haskell-fswatch/hfsnotify/pull/110) +* Gracefully handle broken symlinks (https://github.com/haskell-fswatch/hfsnotify/pull/120) + Version 0.4.2.0 ---------- diff --git a/fsnotify.cabal b/fsnotify.cabal --- a/fsnotify.cabal +++ b/fsnotify.cabal @@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.37.0. +-- This file has been generated from package.yaml by hpack version 0.38.0. -- -- see: https://github.com/sol/hpack name: fsnotify -version: 0.4.2.0 +version: 0.4.3.0 synopsis: Cross platform library for file change notification. description: Cross platform library for file creation, modification, and deletion notification. This library builds upon existing libraries for platform-specific Windows, Mac, and Linux filesystem event notification. category: Filesystem @@ -49,13 +49,11 @@ , unix-compat >=0.2 default-language: Haskell2010 if os(linux) - cpp-options: -DOS_Linux + cpp-options: -DOS_Linux -DHAVE_NATIVE_WATCHER if os(windows) - cpp-options: -DOS_Win32 + cpp-options: -DOS_Win32 -DHAVE_NATIVE_WATCHER if os(darwin) - cpp-options: -DOS_Mac - if os(freebsd) || os(netbsd) || os(openbsd) - cpp-options: -DOS_BSD + cpp-options: -DOS_Mac -DHAVE_NATIVE_WATCHER if os(linux) other-modules: System.FSNotify.Linux @@ -91,7 +89,7 @@ example default-extensions: ScopedTypeVariables - ghc-options: -threaded -Wall + ghc-options: -Wall build-depends: base , directory @@ -108,13 +106,13 @@ , unliftio default-language: Haskell2010 if os(linux) - cpp-options: -DOS_Linux + cpp-options: -DOS_Linux -DHAVE_NATIVE_WATCHER if os(windows) - cpp-options: -DOS_Win32 + cpp-options: -DOS_Win32 -DHAVE_NATIVE_WATCHER if os(darwin) - cpp-options: -DOS_Mac - if os(freebsd) || os(netbsd) || os(openbsd) - cpp-options: -DOS_BSD + cpp-options: -DOS_Mac -DHAVE_NATIVE_WATCHER + if !arch(wasm32) + ghc-options: -threaded test-suite tests type: exitcode-stdio-1.0 @@ -145,13 +143,11 @@ , unliftio >=0.2.20 default-language: Haskell2010 if os(linux) - cpp-options: -DOS_Linux + cpp-options: -DOS_Linux -DHAVE_NATIVE_WATCHER if os(windows) - cpp-options: -DOS_Win32 + cpp-options: -DOS_Win32 -DHAVE_NATIVE_WATCHER if os(darwin) - cpp-options: -DOS_Mac - if os(freebsd) || os(netbsd) || os(openbsd) - cpp-options: -DOS_BSD + cpp-options: -DOS_Mac -DHAVE_NATIVE_WATCHER if os(windows) build-depends: Win32 diff --git a/src/System/FSNotify.hs b/src/System/FSNotify.hs --- a/src/System/FSNotify.hs +++ b/src/System/FSNotify.hs @@ -110,10 +110,10 @@ -- | Default configuration -- --- * Uses OS watch mode and single thread. +-- * Uses OS watch mode (if possible) and single thread. defaultConfig :: WatchConfig defaultConfig = WatchConfig { -#ifdef OS_BSD +#ifndef HAVE_NATIVE_WATCHER confWatchMode = WatchModePoll 500000 #else confWatchMode = WatchModeOS @@ -163,12 +163,12 @@ case confWatchMode conf of WatchModePoll interval -> WatchManager conf <$> liftIO (createPollManager interval) <*> globalWatchChan -#ifndef OS_BSD +#ifdef HAVE_NATIVE_WATCHER WatchModeOS -> liftIO (initSession ()) >>= createManager #endif where -#ifndef OS_BSD +#ifdef HAVE_NATIVE_WATCHER createManager :: Either T.Text NativeManager -> IO WatchManager createManager (Right nativeManager) = WatchManager conf nativeManager <$> globalWatchChan createManager (Left err) = throwIO $ userError $ T.unpack $ "Error: couldn't start native file manager: " <> err diff --git a/src/System/FSNotify/Linux/Util.hs b/src/System/FSNotify/Linux/Util.hs --- a/src/System/FSNotify/Linux/Util.hs +++ b/src/System/FSNotify/Linux/Util.hs @@ -33,7 +33,7 @@ import System.FilePath (FilePath) import System.Posix.ByteString (RawFilePath) import System.Posix.Directory.ByteString (openDirStream, readDirStream, closeDirStream) -import System.Posix.Files (getFileStatus, isDirectory) +import System.Posix.Files (getSymbolicLinkStatus, isDirectory) canonicalizeRawDirPath :: RawFilePath -> IO RawFilePath @@ -47,8 +47,8 @@ traverseAllDirs :: RawFilePath -> (RawFilePath -> IO ()) -> IO () traverseAllDirs dir cb = traverseAll dir $ \subPath -> -- TODO: wish we didn't need fromRawFilePath here - -- TODO: make sure this does the right thing with symlinks - fromRawFilePath subPath >>= getFileStatus >>= \case + -- TODO: should this follow symlinks? (What then about symlinks that escape the parent?) + fromRawFilePath subPath >>= getSymbolicLinkStatus >>= \case (isDirectory -> True) -> cb subPath >> return True _ -> return False diff --git a/src/System/FSNotify/Types.hs b/src/System/FSNotify/Types.hs --- a/src/System/FSNotify/Types.hs +++ b/src/System/FSNotify/Types.hs @@ -61,10 +61,10 @@ } -- ^ Detect changes by polling the filesystem. Less efficient and may miss fast changes. Not recommended -- unless you're experiencing problems with 'WatchModeOS' (or 'WatchModeOS' is not supported on your platform). -#ifndef OS_BSD +#ifdef HAVE_NATIVE_WATCHER | WatchModeOS -- ^ Use OS-specific mechanisms to be notified of changes (inotify on Linux, FSEvents on OSX, etc.). - -- Not currently available on *BSD. + -- Not currently available on e.g. *BSD and Wasm/WASI. #endif data ThreadingMode = diff --git a/test/FSNotify/Test/EventTests.hs b/test/FSNotify/Test/EventTests.hs --- a/test/FSNotify/Test/EventTests.hs +++ b/test/FSNotify/Test/EventTests.hs @@ -32,7 +32,7 @@ MonadUnliftIO m, MonadThrow m ) => TestFolderGenerator -> ThreadingMode -> SpecFree context m () eventTests testFolderGenerator threadingMode = describe "Tests" $ parallelWithoutDirectory $ do - let pollOptions = if isBSD then [True] else [False, True] + let pollOptions = if haveNativeWatcher then [False, True] else [True] forM_ pollOptions $ \poll -> describe (if poll then "Polling" else "Native") $ parallelWithoutDirectory $ do forM_ [False, True] $ \recursive -> describe (if recursive then "Recursive" else "Non-recursive") $ parallelWithoutDirectory $ @@ -86,6 +86,10 @@ | otherwise -> case events of [Removed {..}] | eventPath `equalFilePath` f && eventIsDirectory == IsFile -> return () _ -> expectationFailure $ "Got wrong events: " <> show events + + unless isWin $ do + it "works if there is bad symlink" $ withFolder' (\f -> liftIO $ createSymLink (f <> ".doesNotExist") f) $ \() (TestFolderContext _watchedDir f getEvents _clearEvents) -> do + waitForEvents getEvents $ \events -> events `shouldBe` [] it "works with a deleted directory" $ withFolder' (\f -> liftIO $ createDirectory f) $ \() (TestFolderContext _watchedDir f getEvents _clearEvents) -> do removeDirectory f diff --git a/test/FSNotify/Test/Util.hs b/test/FSNotify/Test/Util.hs --- a/test/FSNotify/Test/Util.hs +++ b/test/FSNotify/Test/Util.hs @@ -31,17 +31,29 @@ #ifdef mingw32_HOST_OS import Data.Bits import System.Win32.File (getFileAttributes, setFileAttributes, fILE_ATTRIBUTE_TEMPORARY) +import System.Win32.SymbolicLink (createSymbolicLinkFile) -- Perturb the file's attributes, to check that a modification event is emitted changeFileAttributes :: FilePath -> IO () changeFileAttributes file = do attrs <- getFileAttributes file setFileAttributes file (attrs `xor` fILE_ATTRIBUTE_TEMPORARY) + +createSymLink :: FilePath -> FilePath -> IO () +#if __GLASGOW_HASKELL__ < 900 +createSymLink file1 file2 = createSymbolicLinkFile file1 file2 #else -import System.PosixCompat.Files (touchFile) +createSymLink file1 file2 = createSymbolicLinkFile file1 file2 True +#endif +#else +import System.PosixCompat.Files (touchFile, createSymbolicLink) + changeFileAttributes :: FilePath -> IO () changeFileAttributes = touchFile + +createSymLink :: FilePath -> FilePath -> IO () +createSymLink = createSymbolicLink #endif @@ -66,11 +78,11 @@ isLinux = False #endif -isBSD :: Bool -#ifdef OS_BSD -isBSD = True +haveNativeWatcher :: Bool +#ifdef HAVE_NATIVE_WATCHER +haveNativeWatcher = True #else -isBSD = False +haveNativeWatcher = False #endif waitUntil :: MonadUnliftIO m => Double -> m a -> m a @@ -159,7 +171,7 @@ threadDelay (max 5_000_000 (3 * pollInterval)) let conf = defaultConfig { -#ifdef OS_BSD +#ifndef HAVE_NATIVE_WATCHER confWatchMode = if poll then WatchModePoll pollInterval else error "No native watcher available." #else confWatchMode = if poll then WatchModePoll pollInterval else WatchModeOS