Merge branch 'live' into main — live recipe watching via fsnotify

src/Roux/RecipeIndex.hs

@@ -2,6 +2,7 @@
 module Roux.RecipeIndex (
     RecipeInfo (..),
     RecipeSearchEntry (..),
+    loadRecipe,
     recipeSearchEntrySchema,
     scanRecipes,
     toSearchEntry,

src/Roux/Server.hs

@@ -1,28 +1,46 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 {- | 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.Monad (when)
+import Control.Concurrent (forkIO, threadDelay)
+import Control.Exception (IOException, SomeException, catch, try)
+import Control.Monad (forever, when)
 import Data.ByteString.Lazy (ByteString)
 import Data.Char (toLower)
-import Data.List (find)
+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)
+
 import qualified Network.HTTP.Types as HTTP
 import qualified Network.Wai as Wai
+import System.Directory (doesFileExist, makeAbsolute)
+import System.FSNotify (
+    Event (..),
+    EventIsDirectory (..),
+    WatchConfig (..),
+    WatchMode (..),
+    defaultConfig,
+    watchDir,
+    withManagerConf,
+ )
+import System.FilePath (makeRelative, (</>))
 
 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 +53,84 @@ app recipeDir = do
     when (errs > 0) $
         putStrLn $
             "[roux] " <> show errs <> " had parse errors"
-    pure (handleRequest 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
+    -- Resolve to absolute path so makeRelative works with fsnotify events
+    absDir <- makeAbsolute recipeDir
+    -- Start the filesystem watcher
+    _ <-
+        forkIO $
+            watchRecipes absDir state `catch` \e ->
+                putStrLn $ "[roux] watcher thread crashed: " <> show (e :: SomeException)
+    pure (handleRequest state)
+  where
+    isRight (Right _) = True
+    isRight (Left _) = False
+
+{- | Watch a directory for .cook file changes and update the shared state.
+Uses watchDir callback for simplicity.
+-}
+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
+        _stopListening <- watchDir mgr dir (const True) $ \ev ->
+            catch
+                ( do
+                    when (eventIsDirectory ev == IsFile && ".cook" `isSuffixOf` eventPath ev) $ do
+                        let path = makeRelative dir (eventPath ev)
+                        reReadRecipe dir path state
+                )
+                ( \e ->
+                    putStrLn $
+                        "[roux] watchDir callback error: " <> show (e :: SomeException)
+                )
+        -- Keep the thread alive (watchDir runs the callback on the manager thread)
+        forever $ threadDelay 1000000
+
+{- | 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 key = map toLower (stripCookExt path)
+    let fullPath = dir </> path
+    result <- try (doesFileExist fullPath)
+    case result of
+        Left (_ :: IOException) -> do
+            putStrLn $ "[roux] IO error checking " <> path <> ", skipping"
+        Right False -> do
+            atomicModifyIORef' state $ \m ->
+                (Map.delete key m, ())
+            putStrLn $ "[roux] removed " <> path
+        Right True -> do
+            content <- try (Idx.loadRecipe dir path)
+            case content of
+                Left (_ :: IOException) -> do
+                    putStrLn $ "[roux] IO error reading " <> path <> ", keeping previous version"
+                Right info -> 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,18 +139,15 @@ 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
 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
@@ -86,8 +167,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