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
This commit is contained in:
2026-05-19 23:23:04 -04:00
parent a2a8ea7b99
commit d8e2cc101d
+18 -16
View File
@@ -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