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 (forkIO)
import Control.Concurrent.Chan (Chan, newChan, readChan) import Control.Concurrent.Chan (Chan, newChan, readChan)
import Control.Exception (SomeException, catch)
import Control.Monad (when) import Control.Monad (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)
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)
@@ -31,7 +33,7 @@ import System.FSNotify (
watchTreeChan, watchTreeChan,
withManagerConf, withManagerConf,
) )
import System.FilePath ((</>)) import System.FilePath (makeRelative, (</>))
import qualified Roux.Html as Html import qualified Roux.Html as Html
import qualified Roux.RecipeIndex as Idx import qualified Roux.RecipeIndex as Idx
@@ -51,11 +53,14 @@ app recipeDir = do
when (errs > 0) $ when (errs > 0) $
putStrLn $ putStrLn $
"[roux] " <> show errs <> " had parse errors" "[roux] " <> show errs <> " had parse errors"
-- Build initial map keyed by lowercased filename -- Build initial map keyed by lowercased filename (without .cook extension)
let recipeMap = Map.fromList [(map toLower (Idx.riFilename r), r) | r <- recipes] let recipeMap = Map.fromList [(map toLower (stripCookExt (Idx.riFilename r)), r) | r <- recipes]
state <- newIORef recipeMap state <- newIORef recipeMap
-- Start the filesystem watcher -- 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) pure (handleRequest state)
where where
isRight (Right _) = True isRight (Right _) = True
@@ -70,23 +75,23 @@ watchRecipes dir state = do
let cfg = defaultConfig{confWatchMode = WatchModeOS} let cfg = defaultConfig{confWatchMode = WatchModeOS}
withManagerConf cfg $ \mgr -> do withManagerConf cfg $ \mgr -> do
chan <- newChan chan <- newChan
_stopListening <- watchTreeChan mgr dir (const True) chan _stopListening <- watchTreeChan mgr dir ((".cook" `isSuffixOf`) . eventPath) chan
debounceLoop chan state dir Map.empty debounceLoop chan state dir Map.empty
where where
debounceLoop :: Chan Event -> IORef (Map FilePath Idx.RecipeInfo) -> FilePath -> Map FilePath UTCTime -> IO () debounceLoop :: Chan Event -> IORef (Map FilePath Idx.RecipeInfo) -> FilePath -> Map FilePath UTCTime -> IO ()
debounceLoop chan st dr lastSeen = do debounceLoop chan st dr lastSeen = do
ev <- readChan chan ev <- readChan chan
let isDir = eventIsDirectory ev if eventIsDirectory ev == IsDirectory
now <- getCurrentTime
if isDir == IsDirectory
then debounceLoop chan st dr lastSeen then debounceLoop chan st dr lastSeen
else do else do
let path = eventPath ev let path = makeRelative dr (eventPath ev)
let key = map toLower path let key = map toLower (stripCookExt path)
now <- getCurrentTime
let lastTime = Map.lookup key lastSeen let lastTime = Map.lookup key lastSeen
case lastTime of case lastTime of
Just t | diffUTCTime now t < 0.2 -> do Just t
debounceLoop chan st dr lastSeen | diffUTCTime now t < 0.2 ->
debounceLoop chan st dr lastSeen
_ -> do _ -> do
reReadRecipe dr path st reReadRecipe dr path st
debounceLoop chan st dr (Map.insert key now lastSeen) 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 :: FilePath -> FilePath -> IORef (Map FilePath Idx.RecipeInfo) -> IO ()
reReadRecipe dir path state = do reReadRecipe dir path state = do
let key = map toLower (stripCookExt path)
let fullPath = dir </> path let fullPath = dir </> path
exists <- doesFileExist fullPath exists <- doesFileExist fullPath
if not exists if not exists
then do then do
let key = map toLower path
atomicModifyIORef' state $ \m -> atomicModifyIORef' state $ \m ->
(Map.delete key m, ()) (Map.delete key m, ())
putStrLn $ "[roux] removed " <> path putStrLn $ "[roux] removed " <> path
else do else do
info <- Idx.loadRecipe dir path info <- Idx.loadRecipe dir path
let key = map toLower path
case Idx.riRecipe info of case Idx.riRecipe info of
Left err -> do Left err -> do
putStrLn $ "[roux] parse error in " <> path <> ": " <> err putStrLn $ "[roux] parse error in " <> path <> ": " <> err
@@ -145,8 +149,6 @@ stripCookExt :: FilePath -> FilePath
stripCookExt fp stripCookExt fp
| ".cook" `isSuffixOf` fp = take (length fp - 5) fp | ".cook" `isSuffixOf` fp = take (length fp - 5) fp
| otherwise = fp | otherwise = fp
where
isSuffixOf suffix s = suffix == drop (length s - length suffix) s
-- | Decode a percent-encoded URL path segment to a FilePath. -- | Decode a percent-encoded URL path segment to a FilePath.
urlDecodePath :: Text -> FilePath urlDecodePath :: Text -> FilePath