From 5b44b20ce860cde11a138c69088bc6aeb3af7c67 Mon Sep 17 00:00:00 2001 From: gjz010 Date: Fri, 29 Mar 2024 23:53:27 +0800 Subject: [PATCH 1/3] feat: add confPathFilter to WatchConfig --- src/System/FSNotify.hs | 1 + src/System/FSNotify/Linux.hs | 22 +++++++++++++--------- src/System/FSNotify/Types.hs | 2 ++ 3 files changed, 16 insertions(+), 9 deletions(-) diff --git a/src/System/FSNotify.hs b/src/System/FSNotify.hs index 71adbd2..021ce73 100644 --- a/src/System/FSNotify.hs +++ b/src/System/FSNotify.hs @@ -121,6 +121,7 @@ defaultConfig = WatchConfig { #endif , confThreadingMode = SingleThread , confOnHandlerException = defaultOnHandlerException + , confPathFilter = const True } defaultOnHandlerException :: SomeException -> IO () diff --git a/src/System/FSNotify/Linux.hs b/src/System/FSNotify/Linux.hs index 38293b9..1c1451a 100644 --- a/src/System/FSNotify/Linux.hs +++ b/src/System/FSNotify/Linux.hs @@ -23,6 +23,8 @@ import Control.Concurrent.MVar import Control.Exception.Safe as E import Control.Monad import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BSC +import Data.Bool import Data.Function import Data.Monoid import Data.String @@ -109,7 +111,7 @@ instance FileListener INotifyListener () where when wse $ INo.removeWatch wd return False - listenRecursive _conf listener initialPath actPred callback = do + listenRecursive conf listener initialPath actPred callback = do -- wdVar stores the list of created watch descriptors. We use it to -- cancel the whole recursive listening task. -- @@ -133,7 +135,7 @@ instance FileListener INotifyListener () where rawInitialPath <- toRawFilePath initialPath rawCanonicalInitialPath <- canonicalizeRawDirPath rawInitialPath watchDirectoryRecursively listener wdVar actPred callback True rawCanonicalInitialPath - traverseAllDirs rawCanonicalInitialPath $ \subPath -> + traverseAllDirs rawCanonicalInitialPath ((confPathFilter conf) . BSC.unpack) $ \subPath -> watchDirectoryRecursively listener wdVar actPred callback False subPath return stopListening @@ -201,13 +203,15 @@ canonicalizeRawDirPath p = fromRawFilePath p >>= canonicalizePath >>= toRawFileP () :: RawFilePath -> RawFilePath -> RawFilePath x y = x <> "/" <> y -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 - (isDirectory -> True) -> cb subPath >> return True - _ -> return False +traverseAllDirs :: RawFilePath -> (RawFilePath -> Bool) -> (RawFilePath -> IO ()) -> IO () +traverseAllDirs dir predicate cb = traverseAll dir $ \subPath -> + if not (predicate subPath) then return False + else do + -- TODO: wish we didn't need fromRawFilePath here + -- TODO: make sure this does the right thing with symlinks + fromRawFilePath subPath >>= getFileStatus >>= \case + (isDirectory -> True) -> cb subPath >> return True + _ -> return False traverseAll :: RawFilePath -> (RawFilePath -> IO Bool) -> IO () traverseAll dir cb = bracket (openDirStream dir) closeDirStream $ \dirStream -> diff --git a/src/System/FSNotify/Types.hs b/src/System/FSNotify/Types.hs index 48dc2a7..123427a 100644 --- a/src/System/FSNotify/Types.hs +++ b/src/System/FSNotify/Types.hs @@ -84,6 +84,8 @@ data WatchConfig = WatchConfig -- ^ Threading mode to use. , confOnHandlerException :: SomeException -> IO () -- ^ Called when a handler throws an exception. + , confPathFilter :: String->Bool + -- ^ Called to determine whether to watch a path. } type IOEvent = IORef Event From c1d2817614eaba6f03b1022635b2cdc1474d28e8 Mon Sep 17 00:00:00 2001 From: gjz010 Date: Sat, 30 Mar 2024 00:01:17 +0800 Subject: [PATCH 2/3] fix: export confPathFilter --- src/System/FSNotify.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/System/FSNotify.hs b/src/System/FSNotify.hs index 021ce73..b440c47 100644 --- a/src/System/FSNotify.hs +++ b/src/System/FSNotify.hs @@ -55,6 +55,7 @@ module System.FSNotify ( , confWatchMode , confThreadingMode , confOnHandlerException + , confPathFilter , WatchMode(..) , ThreadingMode(..) From 580e19f6d2fe8996d6027bbeaaab47a458d32996 Mon Sep 17 00:00:00 2001 From: gjz010 Date: Sat, 30 Mar 2024 14:28:43 +0800 Subject: [PATCH 3/3] feat: change type of confPathFilter to IO and limit the hook to Linux only. Use fromRawFilePath. --- src/System/FSNotify.hs | 6 +++++- src/System/FSNotify/Linux.hs | 23 ++++++++++++----------- src/System/FSNotify/Types.hs | 4 +++- 3 files changed, 20 insertions(+), 13 deletions(-) diff --git a/src/System/FSNotify.hs b/src/System/FSNotify.hs index b440c47..658abd9 100644 --- a/src/System/FSNotify.hs +++ b/src/System/FSNotify.hs @@ -55,7 +55,9 @@ module System.FSNotify ( , confWatchMode , confThreadingMode , confOnHandlerException +#ifdef OS_Linux , confPathFilter +#endif , WatchMode(..) , ThreadingMode(..) @@ -122,7 +124,9 @@ defaultConfig = WatchConfig { #endif , confThreadingMode = SingleThread , confOnHandlerException = defaultOnHandlerException - , confPathFilter = const True +#ifdef OS_Linux + , confPathFilter = const (return True) +#endif } defaultOnHandlerException :: SomeException -> IO () diff --git a/src/System/FSNotify/Linux.hs b/src/System/FSNotify/Linux.hs index 1c1451a..725f501 100644 --- a/src/System/FSNotify/Linux.hs +++ b/src/System/FSNotify/Linux.hs @@ -23,7 +23,6 @@ import Control.Concurrent.MVar import Control.Exception.Safe as E import Control.Monad import qualified Data.ByteString as BS -import qualified Data.ByteString.Char8 as BSC import Data.Bool import Data.Function import Data.Monoid @@ -135,7 +134,7 @@ instance FileListener INotifyListener () where rawInitialPath <- toRawFilePath initialPath rawCanonicalInitialPath <- canonicalizeRawDirPath rawInitialPath watchDirectoryRecursively listener wdVar actPred callback True rawCanonicalInitialPath - traverseAllDirs rawCanonicalInitialPath ((confPathFilter conf) . BSC.unpack) $ \subPath -> + traverseAllDirs rawCanonicalInitialPath (confPathFilter conf) $ \subPath -> watchDirectoryRecursively listener wdVar actPred callback False subPath return stopListening @@ -203,15 +202,17 @@ canonicalizeRawDirPath p = fromRawFilePath p >>= canonicalizePath >>= toRawFileP () :: RawFilePath -> RawFilePath -> RawFilePath x y = x <> "/" <> y -traverseAllDirs :: RawFilePath -> (RawFilePath -> Bool) -> (RawFilePath -> IO ()) -> IO () -traverseAllDirs dir predicate cb = traverseAll dir $ \subPath -> - if not (predicate subPath) then return False - else do - -- TODO: wish we didn't need fromRawFilePath here - -- TODO: make sure this does the right thing with symlinks - fromRawFilePath subPath >>= getFileStatus >>= \case - (isDirectory -> True) -> cb subPath >> return True - _ -> return False +traverseAllDirs :: RawFilePath -> (FilePath -> IO Bool) -> (RawFilePath -> IO ()) -> IO () +traverseAllDirs dir predicate cb = traverseAll dir $ \subRawPath -> do + subPath <- fromRawFilePath subRawPath + needWatch <- predicate subPath + if not needWatch then return False + else do + -- TODO: wish we didn't need fromRawFilePath here + -- TODO: make sure this does the right thing with symlinks + getFileStatus subPath >>= \case + (isDirectory -> True) -> cb subRawPath >> return True + _ -> return False traverseAll :: RawFilePath -> (RawFilePath -> IO Bool) -> IO () traverseAll dir cb = bracket (openDirStream dir) closeDirStream $ \dirStream -> diff --git a/src/System/FSNotify/Types.hs b/src/System/FSNotify/Types.hs index 123427a..4449dc6 100644 --- a/src/System/FSNotify/Types.hs +++ b/src/System/FSNotify/Types.hs @@ -84,8 +84,10 @@ data WatchConfig = WatchConfig -- ^ Threading mode to use. , confOnHandlerException :: SomeException -> IO () -- ^ Called when a handler throws an exception. - , confPathFilter :: String->Bool +#ifdef OS_Linux + , confPathFilter :: FilePath->IO Bool -- ^ Called to determine whether to watch a path. +#endif } type IOEvent = IORef Event