From 8f2fa65ded91181c7e2bc42a6a43ced13a5be918 Mon Sep 17 00:00:00 2001 From: Paul d'Hubert Date: Fri, 30 Jun 2023 20:42:44 +0200 Subject: [PATCH 1/6] feat: do not watch .direnv and .devenv subdirectories --- IHP/IDE/FileWatcher.hs | 24 ++++++++++++++++++++++-- 1 file changed, 22 insertions(+), 2 deletions(-) diff --git a/IHP/IDE/FileWatcher.hs b/IHP/IDE/FileWatcher.hs index 2f1c63559..f3e022505 100644 --- a/IHP/IDE/FileWatcher.hs +++ b/IHP/IDE/FileWatcher.hs @@ -3,6 +3,8 @@ module IHP.IDE.FileWatcher (withFileWatcher) where import IHP.Prelude import Control.Exception import Control.Concurrent (threadDelay, myThreadId) +import Control.Monad (filterM) +import System.Directory (listDirectory, doesDirectoryExist) import qualified System.FSNotify as FS import IHP.IDE.Types import qualified Data.Time.Clock as Clock @@ -13,8 +15,26 @@ withFileWatcher :: (?context :: Context) => IO () -> IO () withFileWatcher inner = withAsync callback \_ -> inner where callback = FS.withManagerConf fileWatcherConfig \manager -> do - FS.watchTree manager "." shouldActOnFileChange handleFileChange + watchRootDirectoryFiles manager + watchSubDirectories manager forever (threadDelay maxBound) `finally` FS.stopManager manager + watchRootDirectoryFiles manager = + FS.watchDir manager "." shouldActOnFileChange handleFileChange + watchSubDirectories manager = do + directories <- listWatchableDirectories + forM_ directories \directory -> do + FS.watchTree manager directory shouldActOnFileChange handleFileChange + +listWatchableDirectories :: IO [String] +listWatchableDirectories = do + rootDirectoryContents <- listDirectory "." + filterM shouldWatchDirectory rootDirectoryContents + +shouldWatchDirectory :: String -> IO Bool +shouldWatchDirectory path = do + isDirectory <- doesDirectoryExist path + pure $ isDirectory && path /= ".devenv" && path /= ".direnv" + fileWatcherDebounceTime :: NominalDiffTime fileWatcherDebounceTime = Clock.secondsToNominalDiffTime 0.1 -- 100ms @@ -55,4 +75,4 @@ getEventFilePath event = case event of FS.Added filePath _ _ -> filePath FS.Modified filePath _ _ -> filePath FS.Removed filePath _ _ -> filePath - FS.Unknown filePath _ _ -> filePath \ No newline at end of file + FS.Unknown filePath _ _ -> filePath From e49d955b493d8113efbb03c8a2f2bac45b4c9de0 Mon Sep 17 00:00:00 2001 From: Paul d'Hubert Date: Thu, 6 Jul 2023 07:41:59 +0200 Subject: [PATCH 2/6] feat: FileWatcher tracks directory changes When a directory is added or removed from the root directory of the application, we start or stop watching it accordingly. --- IHP/IDE/FileWatcher.hs | 72 ++++++++++++++++++++++++++++++++++++------ 1 file changed, 63 insertions(+), 9 deletions(-) diff --git a/IHP/IDE/FileWatcher.hs b/IHP/IDE/FileWatcher.hs index f3e022505..062b7ccd8 100644 --- a/IHP/IDE/FileWatcher.hs +++ b/IHP/IDE/FileWatcher.hs @@ -3,28 +3,57 @@ module IHP.IDE.FileWatcher (withFileWatcher) where import IHP.Prelude import Control.Exception import Control.Concurrent (threadDelay, myThreadId) -import Control.Monad (filterM) +import Control.Concurrent.MVar +import Control.Monad (filterM, guard) import System.Directory (listDirectory, doesDirectoryExist) +import qualified Data.Map as Map import qualified System.FSNotify as FS import IHP.IDE.Types import qualified Data.Time.Clock as Clock import qualified Data.List as List import IHP.IDE.LiveReloadNotificationServer (notifyAssetChange) +import qualified IHP.Log as Log withFileWatcher :: (?context :: Context) => IO () -> IO () withFileWatcher inner = withAsync callback \_ -> inner where callback = FS.withManagerConf fileWatcherConfig \manager -> do - watchRootDirectoryFiles manager - watchSubDirectories manager + state <- newFileWatcherState + watchRootDirectoryFiles manager state + watchSubDirectories manager state forever (threadDelay maxBound) `finally` FS.stopManager manager - watchRootDirectoryFiles manager = - FS.watchDir manager "." shouldActOnFileChange handleFileChange - watchSubDirectories manager = do + watchRootDirectoryFiles manager state = + FS.watchDir manager "." shouldActOnRootFileChange (handleRootFileChange manager state) + watchSubDirectories manager state = do directories <- listWatchableDirectories forM_ directories \directory -> do - FS.watchTree manager directory shouldActOnFileChange handleFileChange - + startWatchingSubDirectory manager state directory + +type WatchedDirectories = Map FilePath FS.StopListening + +type FileWatcherState = MVar WatchedDirectories + +newFileWatcherState :: IO FileWatcherState +newFileWatcherState = newMVar mempty + +startWatchingSubDirectory :: (?context :: Context) => FS.WatchManager -> FileWatcherState -> FilePath -> IO () +startWatchingSubDirectory manager state path = do + watchedDirectories <- readMVar state + case Map.lookup path watchedDirectories of + Just _ -> pure () + Nothing -> do + stop <- FS.watchTree manager path shouldActOnFileChange handleFileChange + putMVar state $ Map.insert path stop watchedDirectories + +stopWatchingSubDirectory :: FileWatcherState -> FilePath -> IO () +stopWatchingSubDirectory state path = do + watchedDirectories <- readMVar state + case Map.lookup path watchedDirectories of + Just stop -> do + stop + putMVar state $ Map.delete path watchedDirectories + Nothing -> pure () + listWatchableDirectories :: IO [String] listWatchableDirectories = do rootDirectoryContents <- listDirectory "." @@ -33,8 +62,11 @@ listWatchableDirectories = do shouldWatchDirectory :: String -> IO Bool shouldWatchDirectory path = do isDirectory <- doesDirectoryExist path - pure $ isDirectory && path /= ".devenv" && path /= ".direnv" + pure $ isDirectory && isDirectoryWatchable path +isDirectoryWatchable :: String -> Bool +isDirectoryWatchable path = + path /= ".devenv" && path /= ".direnv" fileWatcherDebounceTime :: NominalDiffTime fileWatcherDebounceTime = Clock.secondsToNominalDiffTime 0.1 -- 100ms @@ -52,7 +84,29 @@ handleFileChange event = do else if isAssetFile filePath then notifyAssetChange else mempty + +handleRootFileChange :: (?context :: Context) => FS.WatchManager -> FileWatcherState -> FS.Event -> IO () +handleRootFileChange manager state event = + case event of + FS.Added filePath _ true -> + if isDirectoryWatchable filePath then do + Log.info $ "Watching directory " <> tshow filePath + startWatchingSubDirectory manager state filePath + else pure () + FS.Removed filePath _ true -> + if isDirectoryWatchable filePath then do + Log.info $ "Unwatching directory " <> tshow filePath + stopWatchingSubDirectory state filePath + else pure () + _ -> + handleFileChange event +shouldActOnRootFileChange :: FS.ActionPredicate +shouldActOnRootFileChange event = + if FS.eventIsDirectory event + then isDirectoryWatchable (getEventFilePath event) + else shouldActOnFileChange event + shouldActOnFileChange :: FS.ActionPredicate shouldActOnFileChange event = let path = getEventFilePath event From 8829bd48c9b70f3002a29b33b6afe8afd2bda510 Mon Sep 17 00:00:00 2001 From: Paul d'Hubert Date: Thu, 6 Jul 2023 07:47:03 +0200 Subject: [PATCH 3/6] chore: remove debug logs --- IHP/IDE/FileWatcher.hs | 3 --- 1 file changed, 3 deletions(-) diff --git a/IHP/IDE/FileWatcher.hs b/IHP/IDE/FileWatcher.hs index 062b7ccd8..4aa552ab7 100644 --- a/IHP/IDE/FileWatcher.hs +++ b/IHP/IDE/FileWatcher.hs @@ -12,7 +12,6 @@ import IHP.IDE.Types import qualified Data.Time.Clock as Clock import qualified Data.List as List import IHP.IDE.LiveReloadNotificationServer (notifyAssetChange) -import qualified IHP.Log as Log withFileWatcher :: (?context :: Context) => IO () -> IO () withFileWatcher inner = withAsync callback \_ -> inner @@ -90,12 +89,10 @@ handleRootFileChange manager state event = case event of FS.Added filePath _ true -> if isDirectoryWatchable filePath then do - Log.info $ "Watching directory " <> tshow filePath startWatchingSubDirectory manager state filePath else pure () FS.Removed filePath _ true -> if isDirectoryWatchable filePath then do - Log.info $ "Unwatching directory " <> tshow filePath stopWatchingSubDirectory state filePath else pure () _ -> From b6f266f483d50488bb53a85f74751074ea42ff1f Mon Sep 17 00:00:00 2001 From: Paul d'Hubert Date: Thu, 6 Jul 2023 07:49:58 +0200 Subject: [PATCH 4/6] refactor: skip unnecessary test When we stop watching a directory we do not need to test whether it is watchable or not. It being in the WatchedDirectories state is sufficient --- IHP/IDE/FileWatcher.hs | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/IHP/IDE/FileWatcher.hs b/IHP/IDE/FileWatcher.hs index 4aa552ab7..ceec50fa1 100644 --- a/IHP/IDE/FileWatcher.hs +++ b/IHP/IDE/FileWatcher.hs @@ -92,10 +92,8 @@ handleRootFileChange manager state event = startWatchingSubDirectory manager state filePath else pure () FS.Removed filePath _ true -> - if isDirectoryWatchable filePath then do - stopWatchingSubDirectory state filePath - else pure () - _ -> + stopWatchingSubDirectory state filePath + _ -> handleFileChange event shouldActOnRootFileChange :: FS.ActionPredicate From 78880a57e9a09bba170e48e92433d51a3fa4480d Mon Sep 17 00:00:00 2001 From: Paul d'Hubert Date: Thu, 6 Jul 2023 12:10:30 +0200 Subject: [PATCH 5/6] chore: indent with 4 spaces --- IHP/IDE/FileWatcher.hs | 54 +++++++++++++++++++++--------------------- 1 file changed, 27 insertions(+), 27 deletions(-) diff --git a/IHP/IDE/FileWatcher.hs b/IHP/IDE/FileWatcher.hs index ceec50fa1..2063fbf54 100644 --- a/IHP/IDE/FileWatcher.hs +++ b/IHP/IDE/FileWatcher.hs @@ -26,7 +26,7 @@ withFileWatcher inner = withAsync callback \_ -> inner watchSubDirectories manager state = do directories <- listWatchableDirectories forM_ directories \directory -> do - startWatchingSubDirectory manager state directory + startWatchingSubDirectory manager state directory type WatchedDirectories = Map FilePath FS.StopListening @@ -37,35 +37,35 @@ newFileWatcherState = newMVar mempty startWatchingSubDirectory :: (?context :: Context) => FS.WatchManager -> FileWatcherState -> FilePath -> IO () startWatchingSubDirectory manager state path = do - watchedDirectories <- readMVar state - case Map.lookup path watchedDirectories of - Just _ -> pure () - Nothing -> do - stop <- FS.watchTree manager path shouldActOnFileChange handleFileChange - putMVar state $ Map.insert path stop watchedDirectories + watchedDirectories <- readMVar state + case Map.lookup path watchedDirectories of + Just _ -> pure () + Nothing -> do + stop <- FS.watchTree manager path shouldActOnFileChange handleFileChange + putMVar state $ Map.insert path stop watchedDirectories stopWatchingSubDirectory :: FileWatcherState -> FilePath -> IO () stopWatchingSubDirectory state path = do - watchedDirectories <- readMVar state - case Map.lookup path watchedDirectories of - Just stop -> do - stop - putMVar state $ Map.delete path watchedDirectories - Nothing -> pure () + watchedDirectories <- readMVar state + case Map.lookup path watchedDirectories of + Just stop -> do + stop + putMVar state $ Map.delete path watchedDirectories + Nothing -> pure () listWatchableDirectories :: IO [String] listWatchableDirectories = do - rootDirectoryContents <- listDirectory "." - filterM shouldWatchDirectory rootDirectoryContents + rootDirectoryContents <- listDirectory "." + filterM shouldWatchDirectory rootDirectoryContents shouldWatchDirectory :: String -> IO Bool shouldWatchDirectory path = do - isDirectory <- doesDirectoryExist path - pure $ isDirectory && isDirectoryWatchable path + isDirectory <- doesDirectoryExist path + pure $ isDirectory && isDirectoryWatchable path isDirectoryWatchable :: String -> Bool isDirectoryWatchable path = - path /= ".devenv" && path /= ".direnv" + path /= ".devenv" && path /= ".direnv" fileWatcherDebounceTime :: NominalDiffTime fileWatcherDebounceTime = Clock.secondsToNominalDiffTime 0.1 -- 100ms @@ -86,15 +86,15 @@ handleFileChange event = do handleRootFileChange :: (?context :: Context) => FS.WatchManager -> FileWatcherState -> FS.Event -> IO () handleRootFileChange manager state event = - case event of - FS.Added filePath _ true -> - if isDirectoryWatchable filePath then do - startWatchingSubDirectory manager state filePath - else pure () - FS.Removed filePath _ true -> - stopWatchingSubDirectory state filePath - _ -> - handleFileChange event + case event of + FS.Added filePath _ true -> + if isDirectoryWatchable filePath then do + startWatchingSubDirectory manager state filePath + else pure () + FS.Removed filePath _ true -> + stopWatchingSubDirectory state filePath + _ -> + handleFileChange event shouldActOnRootFileChange :: FS.ActionPredicate shouldActOnRootFileChange event = From 7b9fac8a48844c27b2843d226724c7f28bf7d01f Mon Sep 17 00:00:00 2001 From: Paul d'Hubert Date: Thu, 6 Jul 2023 12:12:07 +0200 Subject: [PATCH 6/6] chore: remove unused imports --- IHP/IDE/FileWatcher.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/IHP/IDE/FileWatcher.hs b/IHP/IDE/FileWatcher.hs index 2063fbf54..cf00d3e88 100644 --- a/IHP/IDE/FileWatcher.hs +++ b/IHP/IDE/FileWatcher.hs @@ -2,9 +2,9 @@ module IHP.IDE.FileWatcher (withFileWatcher) where import IHP.Prelude import Control.Exception -import Control.Concurrent (threadDelay, myThreadId) +import Control.Concurrent (threadDelay) import Control.Concurrent.MVar -import Control.Monad (filterM, guard) +import Control.Monad (filterM) import System.Directory (listDirectory, doesDirectoryExist) import qualified Data.Map as Map import qualified System.FSNotify as FS