fix: use watchDir callback instead of watchTreeChan for reliable event delivery

This commit is contained in:
2026-05-19 23:35:32 -04:00
parent 5bfd3f2308
commit 956a4bc7d7
+11 -27
View File
@@ -9,10 +9,9 @@ module Roux.Server (
app, app,
) where ) where
import Control.Concurrent (forkIO) import Control.Concurrent (forkIO, threadDelay)
import Control.Concurrent.Chan (Chan, newChan, readChan)
import Control.Exception (SomeException, catch) import Control.Exception (SomeException, catch)
import Control.Monad (when) import Control.Monad (forever, when)
import Data.ByteString.Lazy (ByteString) import Data.ByteString.Lazy (ByteString)
import Data.Char (toLower) import Data.Char (toLower)
import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef) import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef)
@@ -20,7 +19,7 @@ import Data.List (isSuffixOf)
import Data.Map.Strict (Map) import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map
import Data.Text (Text) import Data.Text (Text)
import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime)
import qualified Network.HTTP.Types as HTTP import qualified Network.HTTP.Types as HTTP
import qualified Network.Wai as Wai import qualified Network.Wai as Wai
import System.Directory (doesFileExist, makeAbsolute) import System.Directory (doesFileExist, makeAbsolute)
@@ -30,7 +29,7 @@ import System.FSNotify (
WatchConfig (..), WatchConfig (..),
WatchMode (..), WatchMode (..),
defaultConfig, defaultConfig,
watchTreeChan, watchDir,
withManagerConf, withManagerConf,
) )
import System.FilePath (makeRelative, (</>)) import System.FilePath (makeRelative, (</>))
@@ -69,34 +68,19 @@ app recipeDir = do
isRight (Left _) = False isRight (Left _) = False
{- | Watch a directory for .cook file changes and update the shared state. {- | Watch a directory for .cook file changes and update the shared state.
Implements debouncing: events for the same path within 200ms are skipped. Uses watchDir callback for simplicity.
-} -}
watchRecipes :: FilePath -> IORef (Map FilePath Idx.RecipeInfo) -> IO () watchRecipes :: FilePath -> IORef (Map FilePath Idx.RecipeInfo) -> IO ()
watchRecipes dir state = do watchRecipes dir state = do
putStrLn $ "[roux] watching " <> dir <> " for changes" putStrLn $ "[roux] watching " <> dir <> " for changes"
let cfg = defaultConfig{confWatchMode = WatchModeOS} let cfg = defaultConfig{confWatchMode = WatchModeOS}
withManagerConf cfg $ \mgr -> do withManagerConf cfg $ \mgr -> do
chan <- newChan _stopListening <- watchDir mgr dir (const True) $ \ev ->
_stopListening <- watchTreeChan mgr dir ((".cook" `isSuffixOf`) . eventPath) chan when (eventIsDirectory ev == IsFile && ".cook" `isSuffixOf` eventPath ev) $ do
debounceLoop chan state dir Map.empty let path = makeRelative dir (eventPath ev)
where reReadRecipe dir path state
debounceLoop :: Chan Event -> IORef (Map FilePath Idx.RecipeInfo) -> FilePath -> Map FilePath UTCTime -> IO () -- Keep the thread alive (watchDir runs the callback on the manager thread)
debounceLoop chan st dr lastSeen = do forever $ threadDelay 1000000
ev <- readChan chan
if eventIsDirectory ev == IsDirectory
then debounceLoop chan st dr lastSeen
else do
let path = makeRelative dr (eventPath ev)
let key = map toLower (stripCookExt path)
now <- getCurrentTime
let lastTime = Map.lookup key lastSeen
case lastTime of
Just t
| diffUTCTime now t < 0.2 ->
debounceLoop chan st dr lastSeen
_ -> do
reReadRecipe dr path st
debounceLoop chan st dr (Map.insert key now lastSeen)
{- | Re-read a single recipe file and update the shared state. {- | Re-read a single recipe file and update the shared state.
On read/parse errors, logs the error and keeps the previous version. On read/parse errors, logs the error and keeps the previous version.