From d8e2cc101d8aed77ec6c76ddbde3c1785e35cde9 Mon Sep 17 00:00:00 2001 From: James Brechtel Date: Tue, 19 May 2026 23:23:04 -0400 Subject: [PATCH] fix: correct path handling in live recipe watching - Strip .cook from map keys to match lookupRecipe behavior - Use makeRelative for event paths to match relative map keys - Filter watcher to only .cook files - Log watcher thread exceptions - Use imported isSuffixOf from Data.List --- src/Roux/Server.hs | 34 ++++++++++++++++++---------------- 1 file changed, 18 insertions(+), 16 deletions(-) diff --git a/src/Roux/Server.hs b/src/Roux/Server.hs index d4449eb..55ddb30 100644 --- a/src/Roux/Server.hs +++ b/src/Roux/Server.hs @@ -11,10 +11,12 @@ module Roux.Server ( import Control.Concurrent (forkIO) import Control.Concurrent.Chan (Chan, newChan, readChan) +import Control.Exception (SomeException, catch) import Control.Monad (when) import Data.ByteString.Lazy (ByteString) import Data.Char (toLower) import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef) +import Data.List (isSuffixOf) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.Text (Text) @@ -31,7 +33,7 @@ import System.FSNotify ( watchTreeChan, withManagerConf, ) -import System.FilePath (()) +import System.FilePath (makeRelative, ()) import qualified Roux.Html as Html import qualified Roux.RecipeIndex as Idx @@ -51,11 +53,14 @@ app recipeDir = do when (errs > 0) $ putStrLn $ "[roux] " <> show errs <> " had parse errors" - -- Build initial map keyed by lowercased filename - let recipeMap = Map.fromList [(map toLower (Idx.riFilename r), r) | r <- recipes] + -- Build initial map keyed by lowercased filename (without .cook extension) + let recipeMap = Map.fromList [(map toLower (stripCookExt (Idx.riFilename r)), r) | r <- recipes] state <- newIORef recipeMap -- Start the filesystem watcher - _ <- forkIO (watchRecipes recipeDir state) + _ <- + forkIO $ + watchRecipes recipeDir state `catch` \e -> + putStrLn $ "[roux] watcher thread crashed: " <> show (e :: SomeException) pure (handleRequest state) where isRight (Right _) = True @@ -70,23 +75,23 @@ watchRecipes dir state = do let cfg = defaultConfig{confWatchMode = WatchModeOS} withManagerConf cfg $ \mgr -> do chan <- newChan - _stopListening <- watchTreeChan mgr dir (const True) chan + _stopListening <- watchTreeChan mgr dir ((".cook" `isSuffixOf`) . eventPath) chan debounceLoop chan state dir Map.empty where debounceLoop :: Chan Event -> IORef (Map FilePath Idx.RecipeInfo) -> FilePath -> Map FilePath UTCTime -> IO () debounceLoop chan st dr lastSeen = do ev <- readChan chan - let isDir = eventIsDirectory ev - now <- getCurrentTime - if isDir == IsDirectory + if eventIsDirectory ev == IsDirectory then debounceLoop chan st dr lastSeen else do - let path = eventPath ev - let key = map toLower path + 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 -> do - debounceLoop chan st dr lastSeen + 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) @@ -96,17 +101,16 @@ On read/parse errors, logs the error and keeps the previous version. -} reReadRecipe :: FilePath -> FilePath -> IORef (Map FilePath Idx.RecipeInfo) -> IO () reReadRecipe dir path state = do + let key = map toLower (stripCookExt path) let fullPath = dir path exists <- doesFileExist fullPath if not exists then do - let key = map toLower path atomicModifyIORef' state $ \m -> (Map.delete key m, ()) putStrLn $ "[roux] removed " <> path else do info <- Idx.loadRecipe dir path - let key = map toLower path case Idx.riRecipe info of Left err -> do putStrLn $ "[roux] parse error in " <> path <> ": " <> err @@ -145,8 +149,6 @@ stripCookExt :: FilePath -> FilePath stripCookExt fp | ".cook" `isSuffixOf` fp = take (length fp - 5) fp | otherwise = fp - where - isSuffixOf suffix s = suffix == drop (length s - length suffix) s -- | Decode a percent-encoded URL path segment to a FilePath. urlDecodePath :: Text -> FilePath