Merge branch 'live' into main — live recipe watching via fsnotify
Build and Deploy / build-and-deploy (push) Successful in 4m30s

This commit is contained in:
2026-05-20 06:30:07 -04:00
8 changed files with 701 additions and 20 deletions
@@ -0,0 +1,473 @@
# Live Recipe Watching Implementation Plan
> **For agentic workers:** REQUIRED SUB-SKILL: Use superpowers:subagent-driven-development (recommended) or superpowers:executing-plans to implement this plan task-by-task. Steps use checkbox (`- [ ]`) syntax for tracking.
**Goal:** Watch the recipe directory for `.cook` file changes and update the in-memory recipe index without a server restart.
**Architecture:** Replace the `[RecipeInfo]` closure with an `IORef (Map FilePath RecipeInfo)`. A `forkIO`'d watcher thread using `fsnotify` subscribes to filesystem events, debounces within a 200ms window, and updates the `IORef` via `atomicModifyIORef'`. HTTP handlers read from the `IORef` on each request.
**Tech Stack:** Haskell, `fsnotify-0.4.4.0`, `Data.IORef`, `Data.Map.Strict`, `Data.Time.Clock`, `Control.Concurrent`.
---
## File Map
| File | Action | Purpose |
|---|---|---|
| `stack.yaml` | Modify | Add `fsnotify` as extra-dep (not in LTS-24.38) |
| `package.yaml` | Modify | Add `fsnotify` to library dependencies |
| `roux-server.cabal` | Regenerate | Via `./hs hpack` |
| `src/Roux/Server.hs` | Modify | State type, watcher thread, handler updates |
No new files needed — all changes are contained in `Server.hs`.
---
### Task 1: Add `fsnotify` dependency
**Files:**
- Modify: `package.yaml`, `stack.yaml`
- Regenerate: `roux-server.cabal`
- [ ] **Step 1: Add fsnotify to stack.yaml extra-deps**
Since `fsnotify` is not in LTS-24.38, add it as an extra-dep in `stack.yaml`:
```yaml
extra-deps:
- fsnotify-0.4.4.0
```
- [ ] **Step 2: Add fsnotify to package.yaml library dependencies**
```yaml
- containers
- directory
- filepath
- fsnotify
- http-types
```
- [ ] **Step 3: Regenerate roux-server.cabal**
Run: `./hs hpack`
Expected: no errors.
- [ ] **Step 4: Verify stack can resolve fsnotify**
Run: `./hs stack build --no-run-tests 2>&1 | tail -10`
Expected: builds successfully (or at least resolves deps).
- [ ] **Step 5: Commit**
```bash
git add package.yaml stack.yaml roux-server.cabal
git commit -m "chore: add fsnotify dependency for live recipe watching"
```
---
### Task 2: Refactor `Server.hs` for live watching
**Files:**
- Modify: `src/Roux/Server.hs`
This is the main implementation task. All changes are in one file.
- [ ] **Step 1: Rewrite imports**
Replace all imports in `src/Roux/Server.hs` with:
```haskell
{-# LANGUAGE OverloadedStrings #-}
{- | 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.IORef (IORef, atomicModifyIORef', newIORef, readIORef)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Time.Clock (UTCTime, getCurrentTime, diffUTCTime)
import qualified Network.HTTP.Types as HTTP
import qualified Network.Wai as Wai
import System.Directory (doesFileExist)
import System.FilePath ((</>), takeBaseName)
import System.FSNotify (Event (..), EventIsDirectory (..), StopListening,
WatchConfig (..), WatchMode (..), withManagerConf,
watchTreeChan)
import qualified Roux.Html as Html
import qualified Roux.RecipeIndex as Idx
```
- [ ] **Step 2: Rewrite `app` to use `IORef` and fork the watcher**
Replace the entire `app` function body:
```haskell
-- | Build the WAI 'Application' given a path to the recipe directory.
--
-- Recipes are scanned at startup and then watched live via fsnotify.
app :: FilePath -> IO Wai.Application
app recipeDir = do
putStrLn $ "[roux] scanning recipes from " <> recipeDir
recipes <- Idx.scanRecipes recipeDir
let count = length recipes
ok = length [() | r <- recipes, isRight (Idx.riRecipe r)]
errs = count - ok
putStrLn $ "[roux] found " <> show count <> " recipe(s)"
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]
state <- newIORef recipeMap
-- Start the filesystem watcher
forkIO (watchRecipes recipeDir state)
pure (handleRequest state)
where
isRight (Right _) = True
isRight (Left _) = False
```
Note: `isRight` was previously a top-level function. It's now local to `app`. That's fine.
- [ ] **Step 3: Add the `watchRecipes` function**
Add after `app` (before `handleRequest`):
```haskell
-- | 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
-- lastSeen tracks when we last processed each path (for debouncing)
debounceLoop chan state dir Map.empty
where
debounceLoop :: Chan Event -> IORef (Map FilePath Idx.RecipeInfo) -> FilePath -> Map FilePath UTCTime -> IO ()
debounceLoop chan state dir lastSeen = do
ev <- readChan chan
-- Only process file events (skip directory events)
let isDir = eventIsDirectory ev
now <- getCurrentTime
if isDir == IsDirectory
then debounceLoop chan state dir 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
-- Debounced: skip, but pass through lastSeen
debounceLoop chan state dir lastSeen
_ -> do
-- Process the event
reReadRecipe dir path state
debounceLoop chan state dir (Map.insert key now lastSeen)
```
Key points:
- Uses `defaultConfig` with `WatchModeOS` (inotify on Linux)
- `watchTreeChan` takes an `ActionPredicate` (`const True` means watch everything)
- `readChan` blocks until events arrive
- Debouncing: if the same path was processed within 0.2 seconds, skip
- Directory events are filtered out
- [ ] **Step 4: Add the `reReadRecipe` helper**
Add after `watchRecipes`:
```haskell
-- | 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 path
let fullPath = dir </> path
exists <- doesFileExist fullPath
if not exists
then do
atomicModifyIORef' state $ \m ->
(Map.delete key m, ())
putStrLn $ "[roux] removed " <> path
else do
content <- readFile fullPath
let parsed = parseCookFile (T.pack content)
title = case parsed of
Right r -> extractTitle r path
Left _ -> T.pack (takeBaseName path)
case parsed of
Left err -> do
putStrLn $ "[roux] parse error in " <> path <> ": " <> err
putStrLn $ "[roux] keeping previous version"
Right _ -> do
let info =
Idx.RecipeInfo
{ Idx.riFilename = path
, Idx.riTitle = title
, Idx.riRecipe = parsed
}
atomicModifyIORef' state $ \m ->
(Map.insert key info m, ())
putStrLn $ "[roux] updated " <> path
where
extractTitle recipe filename =
case metaTitle (recipeMetadata recipe) of
Just t -> t
Nothing -> T.pack (takeBaseName filename)
metaTitle (Data.CookLang.Metadata m) = m ... -- WRONG, need to check Data.CookLang
```
**Wait — the `extractTitle` function already exists in `Roux.RecipeIndex`**. Let me check what's exported.
`Idx.extractTitle` is a module-internal function (not exported from `Roux.RecipeIndex`). The `Idx.loadRecipe` function does the same logic internally.
I have two options:
1. Export `extractTitle` from `Roux.RecipeIndex`
2. Import `Data.CookLang` and extract title inline
Option 1 is cleaner. I'll add `extractTitle` to the export list of `RecipeIndex.hs`.
Actually wait — looking at the `Roux.RecipeIndex` module:
```haskell
module Roux.RecipeIndex (
RecipeInfo (..),
RecipeSearchEntry (..),
scanRecipes,
toSearchEntry,
) where
```
`extractTitle` is defined but not exported. I have a few choices:
Option A: Add `extractTitle` to the export list.
Option B: Use the existing `loadRecipe` pattern but that requires access to the raw recipe's metadata via `Data.CookLang`.
Option C: Write a local helper in Server.hs.
The simplest is Option A or creating a small helper in `Roux.RecipeIndex` that can load a single file (like `loadRecipe`).
Actually, the cleanest approach: export `loadRecipe` from `RecipeIndex`. It's already defined there. Then I can call `Idx.reloadRecipe` or reuse `loadRecipe` directly.
Looking at `loadRecipe`:
```haskell
loadRecipe :: FilePath -> FilePath -> IO RecipeInfo
loadRecipe dir filename = do
content <- readFile (dir </> filename)
let parsed = parseCookFile (T.pack content)
title = case parsed of
Right r -> extractTitle r filename
Left _err -> T.pack (takeBaseName filename)
return RecipeInfo{ riFilename = filename, riTitle = title, riRecipe = parsed }
```
Perfect. I can either:
- Export `loadRecipe` from `RecipeIndex` and call it from `Server.hs`
- Or keep the local `reReadRecipe` with its own inline logic
Since loadRecipe is already tested and working, exporting it is cleaner. But actually, the plan says to keep changes minimal. Let me just add `loadRecipe` to the exports of `RecipeIndex.hs` and use it in `Server.hs`.
Let me update the Step 4 code:
```haskell
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
-- Use Idx.loadRecipe to read and parse
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
```
This is much cleaner. I need to export `loadRecipe` from `RecipeIndex.hs`.
- [ ] **Step 5: Update `handleRequest` to accept `IORef`**
Replace `handleRequest`:
```haskell
-- | Route an incoming request to the appropriate handler.
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 recipeList))
-- Index page (sorted by tags) — sort mode ignored, driven client-side
["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 recipeList))
-- Recipe detail page
["recipes", rawPath] ->
case lookupRecipe (urlDecodePath rawPath) recipes of
Just info -> respond (htmlResponse (Html.recipePage info))
Nothing -> respond notFound
_ -> respond notFound
```
`handleRequest` is now an `IO` action — it reads from the `IORef` on each request. `Wai.Application` is `Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived`, so returning `IO` is fine.
- [ ] **Step 6: Simplify `lookupRecipe` to use `Map.lookup`**
Replace `lookupRecipe`:
```haskell
-- | Look up a recipe by filename (case-insensitive, .cook extension optional).
lookupRecipe :: FilePath -> Map FilePath Idx.RecipeInfo -> Maybe Idx.RecipeInfo
lookupRecipe target recipes =
Map.lookup (map toLower (stripCookExt target)) recipes
```
- [ ] **Step 7: Remove `stripCookExt` and `urlDecodePath` helpers**
These are unchanged. Keep them.
- [ ] **Step 8: Remove unused imports**
Remove from imports:
- `Data.List (find)` — no longer used
Keep:
- `Data.Char (toLower)` — still used in `lookupRecipe` and `reReadRecipe`
- [ ] **Step 9: Export `loadRecipe` from `RecipeIndex.hs`**
In `src/Roux/RecipeIndex.hs`, add `loadRecipe` to the export list:
```haskell
module Roux.RecipeIndex (
RecipeInfo (..),
RecipeSearchEntry (..),
loadRecipe,
scanRecipes,
toSearchEntry,
) where
```
- [ ] **Step 10: Build to verify compilation**
Run: `./hs stack build`
Expected: compiles without errors.
- [ ] **Step 11: Run tests to verify nothing broke**
Run: `./hs stack test`
Expected: all tests pass.
- [ ] **Step 12: Commit**
```bash
git add src/Roux/Server.hs src/Roux/RecipeIndex.hs
git commit -m "feat: watch recipe directory for live updates via fsnotify"
```
---
### Task 3: Manual smoke test
**Files:** (none, manual testing)
- [ ] **Step 1: Start the server in the background**
```bash
./hs stack exec roux-server -- --recipe-dir recipes &
sleep 2
```
- [ ] **Step 2: Verify a recipe loads**
```bash
curl -s http://localhost:8080/ | grep -i "recipe" | head -5
```
Expected: index page HTML with recipe titles.
- [ ] **Step 3: Check server logs for watching confirmation**
Should see: `[roux] watching recipes for changes`
- [ ] **Step 4: Modify a recipe file and verify the change is picked up**
```bash
# Pick a recipe, temporarily replace content
RECIPE=$(ls recipes/*.cook | head -1)
RECIPE_NAME=$(basename "$RECIPE" .cook)
echo "---" > /tmp/test_change.cook
echo "title: Test Live Update" >> /tmp/test_change.cook
echo "---" >> /tmp/test_change.cook
echo "Testing live file watching." >> /tmp/test_change.cook
cp "$RECIPE" /tmp/backup.cook
cp /tmp/test_change.cook "$RECIPE"
sleep 1
curl -s "http://localhost:8080/recipes/$RECIPE_NAME" | grep "Test Live Update"
# Restore original
cp /tmp/backup.cook "$RECIPE"
```
Expected: grep finds "Test Live Update" in the response.
- [ ] **Step 5: Delete a recipe file and verify 404**
```bash
RECIPE2=$(ls recipes/*.cook | grep -v "$(basename "$RECIPE")" | head -1)
RECIPE2_NAME=$(basename "$RECIPE2" .cook)
cp "$RECIPE2" /tmp/backup2.cook
rm "$RECIPE2"
sleep 1
curl -s -o /dev/null -w "%{http_code}" "http://localhost:8080/recipes/$RECIPE2_NAME"
# Restore
cp /tmp/backup2.cook "$RECIPE2"
```
Expected: HTTP 404.
- [ ] **Step 6: Add a new recipe file and verify it appears**
```bash
echo "---" > /tmp/new_recipe.cook
echo "title: New Test Recipe" >> /tmp/new_recipe.cook
echo "---" >> /tmp/new_recipe.cook
echo "A brand new recipe." >> /tmp/new_recipe.cook
cp /tmp/new_recipe.cook recipes/new_test_recipe.cook
sleep 1
curl -s "http://localhost:8080/recipes/new_test_recipe" | grep "New Test Recipe"
# Cleanup
rm recipes/new_test_recipe.cook
```
Expected: grep finds "New Test Recipe" in the response.
- [ ] **Step 7: Kill the server**
```bash
kill %1 2>/dev/null; wait 2>/dev/null
```
@@ -0,0 +1,118 @@
# Live Recipe Watching
**Date:** 2026-05-19
**Status:** Approved
## Problem
The server loads all recipes once at startup and serves them read-only for the
duration of the server process. Since the recipe directory is the source of
truth, any edits to `.cook` files on disk require a server restart to be
reflected on the site.
## Goal
Watch the recipe directory for file changes (additions, modifications, deletions)
and update the in-memory recipe index live, without a restart.
## Non-Goals
- Real-time push to open browser tabs (a page refresh will show new content).
- Watching subdirectories (all recipes are flat in one directory).
- Watcher restart on failure (log and let it die; restart the container if needed).
## Architecture
### State
Replace the current `[RecipeInfo]` closure with an `IORef (Map FilePath RecipeInfo)`:
- **`IORef`** — provides atomic reads and swaps; in `base`, no extra dependency.
- **`Map`** — `Data.Map.Strict`, already a project dependency.
- **Key** — lowercased filename (e.g., `"pad-thai.cook"`) for O(log n) case-insensitive
lookups, matching the current `lookupRecipe` behavior.
- **Value** — the existing `RecipeInfo`, which includes the original (mixed-case)
filename in `riFilename`.
### Watcher Thread
A `forkIO`'d thread uses the `fsnotify` package to subscribe to all events on the
recipe directory. Three event types are handled:
| Event | Action |
|------------|-----------------------------------------------------|
| `Added` | Read & parse the file → upsert in the Map |
| `Modified` | Read & parse the file → upsert in the Map |
| `Removed` | Delete from the Map |
All mutations go through `atomicModifyIORef'` so HTTP handlers always see a
consistent snapshot.
### Debouncing
Text editors fire multiple filesystem events per save (e.g., delete+create for
atomic saves, multiple metadata events). A simple 200ms debounce collects
events from `fsnotify`'s callback into a set, then processes them after 200ms of
silence. This prevents redundant re-parses.
### Startup Flow
1. Scan the recipe directory with `Idx.scanRecipes` (same as today).
2. Build the initial `IORef (Map FilePath RecipeInfo)`.
3. `forkIO` the watcher thread.
4. Return the WAI `Application` (now closing over the `IORef`).
### Request Handling
- `handleRequest` reads from the `IORef` to get the current `[RecipeInfo]`
(via `Map.elems`) or a single `RecipeInfo` (via `Map.lookup`).
- The index page continues to receive `[RecipeInfo]` and re-renders on each
request — no caching changes needed.
- `lookupRecipe` becomes a `Map.lookup` with a normalized key instead of a
linear scan.
### Error Handling
- **Parse error on modification:** log the error (with `[roux]` prefix), keep
the old recipe in the Map. The last valid version stays accessible.
- **File read error (permissions, race):** log and skip.
- **Watcher thread crash:** log and let it die. The server continues serving
the last known state. A container restart would restore watching.
## Dependencies
Add `fsnotify` to `package.yaml` (and the `.cabal` file via `hpack`).
No new concurrency libraries needed — `IORef` and `forkIO` are in `base`.
## Changes by File
### `package.yaml`
- Add `fsnotify` to library dependencies.
### `src/Roux/RecipeIndex.hs`
- No changes (the scanning/loading functions are already correct).
### `src/Roux/Server.hs`
- `app :: FilePath -> IO Wai.Application` — same signature, new internals:
- Return type is already `IO Wai.Application`, so signature stays the same.
- Scan recipes → populate `IORef`.
- Fork watcher thread (with debounce).
- Return handler closing over the `IORef`.
- `handleRequest :: IORef (Map FilePath RecipeInfo) -> Wai.Application`
— updated to accept the `IORef`.
- `lookupRecipe :: FilePath -> Map FilePath RecipeInfo -> Maybe RecipeInfo`
— simplified to a `Map.lookup` with normalized key.
- New module-level imports: `Data.IORef`, `Control.Concurrent (forkIO)`,
`System.FSNotify`, `Data.Map.Strict`.
### `app/Main.hs`
- No changes needed (it just calls `Roux.app` as before).
## Testing
- **Manual test:** edit a `.cook` file while the server runs and confirm the
change is reflected on a page refresh.
- **Invalid recipe test:** introduce a parse error and confirm the old version
stays live.
- **Delete test:** remove a `.cook` file and confirm a 404 on refresh.
+1
View File
@@ -37,6 +37,7 @@ dependencies:
- containers - containers
- directory - directory
- filepath - filepath
- fsnotify
- http-types - http-types
- optparse-applicative - optparse-applicative
- parsec - parsec
+4
View File
@@ -46,6 +46,7 @@ library
, containers , containers
, directory , directory
, filepath , filepath
, fsnotify
, http-types , http-types
, json-fleece-aeson , json-fleece-aeson
, json-fleece-core , json-fleece-core
@@ -80,6 +81,7 @@ executable check-recipes
, containers , containers
, directory , directory
, filepath , filepath
, fsnotify
, http-types , http-types
, json-fleece-aeson , json-fleece-aeson
, json-fleece-core , json-fleece-core
@@ -115,6 +117,7 @@ executable roux-server
, containers , containers
, directory , directory
, filepath , filepath
, fsnotify
, http-types , http-types
, json-fleece-aeson , json-fleece-aeson
, json-fleece-core , json-fleece-core
@@ -155,6 +158,7 @@ test-suite roux-server-test
, containers , containers
, directory , directory
, filepath , filepath
, fsnotify
, hspec , hspec
, http-types , http-types
, json-fleece-aeson , json-fleece-aeson
+1
View File
@@ -2,6 +2,7 @@
module Roux.RecipeIndex ( module Roux.RecipeIndex (
RecipeInfo (..), RecipeInfo (..),
RecipeSearchEntry (..), RecipeSearchEntry (..),
loadRecipe,
recipeSearchEntrySchema, recipeSearchEntrySchema,
scanRecipes, scanRecipes,
toSearchEntry, toSearchEntry,
+96 -20
View File
@@ -1,28 +1,46 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{- | WAI application for the Roux recipe server. {- | WAI application for the Roux recipe server.
Handles HTTP requests directly via wai — no framework. Handles HTTP requests directly via wai — no framework.
Recipes are loaded from disk at startup, then watched live via fsnotify.
-} -}
module Roux.Server ( module Roux.Server (
app, app,
) where ) 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.ByteString.Lazy (ByteString)
import Data.Char (toLower) 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 Data.Text (Text)
import qualified Network.HTTP.Types as HTTP import qualified Network.HTTP.Types as HTTP
import qualified Network.Wai as Wai 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.Html as Html
import qualified Roux.RecipeIndex as Idx import qualified Roux.RecipeIndex as Idx
{- | Build the WAI 'Application' given a path to the recipe directory. {- | Build the WAI 'Application' given a path to the recipe directory.
Recipes are scanned once at startup. A future improvement could watch Recipes are scanned at startup and then watched live via fsnotify.
the directory for changes and rebuild the index.
-} -}
app :: FilePath -> IO Wai.Application app :: FilePath -> IO Wai.Application
app recipeDir = do app recipeDir = do
@@ -35,18 +53,84 @@ app recipeDir = do
when (errs > 0) $ when (errs > 0) $
putStrLn $ putStrLn $
"[roux] " <> show errs <> " had parse errors" "[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. -- | Route an incoming request to the appropriate handler.
handleRequest :: [Idx.RecipeInfo] -> Wai.Application handleRequest :: IORef (Map FilePath Idx.RecipeInfo) -> Wai.Application
handleRequest recipes request respond = handleRequest state request respond = do
recipes <- readIORef state
let recipeList = Map.elems recipes
case Wai.pathInfo request of case Wai.pathInfo request of
-- Index page (default: alphabetical) -- 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 -- 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 -- 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 -- Recipe detail page
["recipes", rawPath] -> ["recipes", rawPath] ->
case lookupRecipe (urlDecodePath rawPath) recipes of case lookupRecipe (urlDecodePath rawPath) recipes of
@@ -55,18 +139,15 @@ handleRequest recipes request respond =
_ -> respond notFound _ -> respond notFound
-- | Look up a recipe by filename (case-insensitive, .cook extension optional). -- | 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 = lookupRecipe target recipes =
let normalised = map toLower (stripCookExt target) Map.lookup (map toLower (stripCookExt target)) recipes
in find (\(Idx.RecipeInfo fp _ _) -> map toLower (stripCookExt fp) == normalised) recipes
-- | Strip the .cook extension if present. -- | Strip the .cook extension if present.
stripCookExt :: FilePath -> FilePath 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
@@ -86,8 +167,3 @@ notFound =
HTTP.status404 HTTP.status404
[("Content-Type", "text/plain")] [("Content-Type", "text/plain")]
"Not found" "Not found"
-- | Check if an 'Either' is 'Right'.
isRight :: Either a b -> Bool
isRight (Right _) = True
isRight (Left _) = False
+1
View File
@@ -13,3 +13,4 @@ extra-deps:
subdirs: subdirs:
- json-fleece-core - json-fleece-core
- json-fleece-aeson - json-fleece-aeson
- fsnotify-0.4.4.0
+7
View File
@@ -43,6 +43,13 @@ packages:
original: original:
subdir: json-fleece-aeson subdir: json-fleece-aeson
url: https://github.com/flipstone/json-fleece/archive/f2df040dee441a25dd1bbdc8bcf939bf04c74875.tar.gz url: https://github.com/flipstone/json-fleece/archive/f2df040dee441a25dd1bbdc8bcf939bf04c74875.tar.gz
- completed:
hackage: fsnotify-0.4.4.0@sha256:21cc696377bf01bc9b0a2e1edf2e03e43f6655d52d0622bdb493192820e1a5ba,3624
pantry-tree:
sha256: 1f7fb52c136e080355803941c0b772640a19c4fd418eb56fa62cc24859092b36
size: 1408
original:
hackage: fsnotify-0.4.4.0
snapshots: snapshots:
- completed: - completed:
sha256: abc790b571e0c70e929db74b329e3c18d7e76a6e173e8bdf94f1ba20770d4c24 sha256: abc790b571e0c70e929db74b329e3c18d7e76a6e173e8bdf94f1ba20770d4c24