feat: watch recipe directory for live updates via fsnotify
This commit is contained in:
@@ -4,6 +4,7 @@
|
|||||||
module Roux.RecipeIndex (
|
module Roux.RecipeIndex (
|
||||||
RecipeInfo (..),
|
RecipeInfo (..),
|
||||||
RecipeSearchEntry (..),
|
RecipeSearchEntry (..),
|
||||||
|
loadRecipe,
|
||||||
scanRecipes,
|
scanRecipes,
|
||||||
toSearchEntry,
|
toSearchEntry,
|
||||||
) where
|
) where
|
||||||
@@ -81,8 +82,9 @@ toSearchEntry info =
|
|||||||
, rseTags = tags
|
, rseTags = tags
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Extract a display title from the recipe's metadata or fall back to the
|
{- | Extract a display title from the recipe's metadata or fall back to the
|
||||||
-- filename.
|
filename.
|
||||||
|
-}
|
||||||
extractTitle :: Recipe -> FilePath -> Text
|
extractTitle :: Recipe -> FilePath -> Text
|
||||||
extractTitle recipe filename =
|
extractTitle recipe filename =
|
||||||
case metaTitle (recipeMetadata recipe) of
|
case metaTitle (recipeMetadata recipe) of
|
||||||
|
|||||||
+92
-17
@@ -3,26 +3,42 @@
|
|||||||
{- | 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.Concurrent (forkIO)
|
||||||
|
import Control.Concurrent.Chan (Chan, newChan, readChan)
|
||||||
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.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.Text (Text)
|
||||||
|
import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime)
|
||||||
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)
|
||||||
|
import System.FSNotify (
|
||||||
|
Event (..),
|
||||||
|
EventIsDirectory (..),
|
||||||
|
WatchConfig (..),
|
||||||
|
WatchMode (..),
|
||||||
|
defaultConfig,
|
||||||
|
watchTreeChan,
|
||||||
|
withManagerConf,
|
||||||
|
)
|
||||||
|
import System.FilePath ((</>))
|
||||||
|
|
||||||
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 +51,83 @@ 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
|
||||||
|
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.
|
-- | 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,10 +136,9 @@ 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
|
||||||
@@ -86,8 +166,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
|
|
||||||
|
|||||||
Reference in New Issue
Block a user