diff --git a/IHP/IDE/FileWatcher.hs b/IHP/IDE/FileWatcher.hs index 2f1c63559..cf00d3e88 100644 --- a/IHP/IDE/FileWatcher.hs +++ b/IHP/IDE/FileWatcher.hs @@ -2,7 +2,11 @@ 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) +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 @@ -13,8 +17,55 @@ withFileWatcher :: (?context :: Context) => IO () -> IO () withFileWatcher inner = withAsync callback \_ -> inner where callback = FS.withManagerConf fileWatcherConfig \manager -> do - FS.watchTree manager "." shouldActOnFileChange handleFileChange + state <- newFileWatcherState + watchRootDirectoryFiles manager state + watchSubDirectories manager state forever (threadDelay maxBound) `finally` FS.stopManager manager + watchRootDirectoryFiles manager state = + FS.watchDir manager "." shouldActOnRootFileChange (handleRootFileChange manager state) + watchSubDirectories manager state = do + directories <- listWatchableDirectories + forM_ directories \directory -> do + 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 "." + filterM shouldWatchDirectory rootDirectoryContents + +shouldWatchDirectory :: String -> IO Bool +shouldWatchDirectory path = do + isDirectory <- doesDirectoryExist path + pure $ isDirectory && isDirectoryWatchable path + +isDirectoryWatchable :: String -> Bool +isDirectoryWatchable path = + path /= ".devenv" && path /= ".direnv" fileWatcherDebounceTime :: NominalDiffTime fileWatcherDebounceTime = Clock.secondsToNominalDiffTime 0.1 -- 100ms @@ -32,7 +83,25 @@ 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 + startWatchingSubDirectory manager state filePath + else pure () + FS.Removed filePath _ true -> + stopWatchingSubDirectory state filePath + _ -> + 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 @@ -55,4 +124,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