feat: watch recipe directory for live updates via fsnotify

src/Roux/Server.hs

@@ -3,26 +3,42 @@
 {- | WAI application for the Roux recipe server.
 
 Handles HTTP requests directly via wai — no framework.
+Recipes are loaded from disk at startup, then watched live via fsnotify.
 -}
 module Roux.Server (
     app,
 ) where
 
+import Control.Concurrent (forkIO)
+import Control.Concurrent.Chan (Chan, newChan, readChan)
 import Control.Monad (when)
 import Data.ByteString.Lazy (ByteString)
 import Data.Char (toLower)
-import Data.List (find)
+import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef)
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Map
 import Data.Text (Text)
+import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime)
 import qualified Network.HTTP.Types as HTTP
 import qualified Network.Wai as Wai
+import System.Directory (doesFileExist)
+import System.FSNotify (
+    Event (..),
+    EventIsDirectory (..),
+    WatchConfig (..),
+    WatchMode (..),
+    defaultConfig,
+    watchTreeChan,
+    withManagerConf,
+ )
+import System.FilePath ((</>))
 
 import qualified Roux.Html as Html
 import qualified Roux.RecipeIndex as Idx
 
 {- | Build the WAI 'Application' given a path to the recipe directory.
 
-Recipes are scanned once at startup.  A future improvement could watch
-the directory for changes and rebuild the index.
+Recipes are scanned at startup and then watched live via fsnotify.
 -}
 app :: FilePath -> IO Wai.Application
 app recipeDir = do
@@ -35,18 +51,83 @@ app recipeDir = do
     when (errs > 0) $
         putStrLn $
             "[roux] " <> show errs <> " had parse errors"
-    pure (handleRequest recipes)
+    -- Build initial map keyed by lowercased filename
+    let recipeMap = Map.fromList [(map toLower (Idx.riFilename r), r) | r <- recipes]
+    state <- newIORef recipeMap
+    -- Start the filesystem watcher
+    _ <- forkIO (watchRecipes recipeDir state)
+    pure (handleRequest state)
+  where
+    isRight (Right _) = True
+    isRight (Left _) = False
+
+{- | Watch a directory for .cook file changes and update the shared state.
+Implements debouncing: events for the same path within 200ms are skipped.
+-}
+watchRecipes :: FilePath -> IORef (Map FilePath Idx.RecipeInfo) -> IO ()
+watchRecipes dir state = do
+    putStrLn $ "[roux] watching " <> dir <> " for changes"
+    let cfg = defaultConfig{confWatchMode = WatchModeOS}
+    withManagerConf cfg $ \mgr -> do
+        chan <- newChan
+        _stopListening <- watchTreeChan mgr dir (const True) 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
+            then debounceLoop chan st dr lastSeen
+            else do
+                let path = eventPath ev
+                let key = map toLower path
+                let lastTime = Map.lookup key lastSeen
+                case lastTime of
+                    Just t | diffUTCTime now t < 0.2 -> do
+                        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.
+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 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
+                    putStrLn $ "[roux] keeping previous version"
+                Right _ -> do
+                    atomicModifyIORef' state $ \m ->
+                        (Map.insert key info m, ())
+                    putStrLn $ "[roux] updated " <> path
 
 -- | Route an incoming request to the appropriate handler.
-handleRequest :: [Idx.RecipeInfo] -> Wai.Application
-handleRequest recipes request respond =
+handleRequest :: IORef (Map FilePath Idx.RecipeInfo) -> Wai.Application
+handleRequest state request respond = do
+    recipes <- readIORef state
+    let recipeList = Map.elems recipes
     case Wai.pathInfo request of
         -- Index page (default: alphabetical)
-        [] -> respond (htmlResponse (Html.indexPage Html.AlphaSort recipes))
+        [] -> respond (htmlResponse (Html.indexPage Html.AlphaSort recipeList))
         -- Index page (sorted by tags) — sort mode ignored, driven client-side
-        ["sorted", "tags"] -> respond (htmlResponse (Html.indexPage Html.AlphaSort recipes))
+        ["sorted", "tags"] -> respond (htmlResponse (Html.indexPage Html.AlphaSort recipeList))
         -- Index page (sorted by course/category) — sort mode ignored, driven client-side
-        ["sorted", "course"] -> respond (htmlResponse (Html.indexPage Html.AlphaSort recipes))
+        ["sorted", "course"] -> respond (htmlResponse (Html.indexPage Html.AlphaSort recipeList))
         -- Recipe detail page
         ["recipes", rawPath] ->
             case lookupRecipe (urlDecodePath rawPath) recipes of
@@ -55,10 +136,9 @@ handleRequest recipes request respond =
         _ -> respond notFound
 
 -- | Look up a recipe by filename (case-insensitive, .cook extension optional).
-lookupRecipe :: FilePath -> [Idx.RecipeInfo] -> Maybe Idx.RecipeInfo
+lookupRecipe :: FilePath -> Map FilePath Idx.RecipeInfo -> Maybe Idx.RecipeInfo
 lookupRecipe target recipes =
-    let normalised = map toLower (stripCookExt target)
-     in find (\(Idx.RecipeInfo fp _ _) -> map toLower (stripCookExt fp) == normalised) recipes
+    Map.lookup (map toLower (stripCookExt target)) recipes
 
 -- | Strip the .cook extension if present.
 stripCookExt :: FilePath -> FilePath
@@ -86,8 +166,3 @@ notFound =
         HTTP.status404
         [("Content-Type", "text/plain")]
         "Not found"
-
--- | Check if an 'Either' is 'Right'.
-isRight :: Either a b -> Bool
-isRight (Right _) = True
-isRight (Left _) = False