jbrechtel/roux
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat: wire up cook log DB at server startup

Browse Source
This commit is contained in:
James Brechtel
2026-05-25 22:00:45 -04:00
parent ceadf50c59
commit c6a9c2dee4
2 changed files with 196 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Roux/Html.hs
+118 -5
View File
@@ -14,6 +14,7 @@ module Roux.Html (
importResultPage,
indexPage,
recipePage,
cookHistoryPage,
urlEncode,
urlDecode,
) where
@@ -35,6 +36,9 @@ import Text.Blaze.Html5 as H
import Text.Blaze.Html5.Attributes as A
import Data.CookLang
import Data.Time.Calendar (Day)
import qualified Data.Time.Format as Time
import qualified Roux.CookLog as CookLog
import qualified Roux.RecipeIndex as Idx
-- ---------------------------------------------------------------------------
@@ -625,6 +629,54 @@ titleEditJs =
, "})();"
]
-- | Inline JavaScript for cook log form submission.
cookLogJs :: Text
cookLogJs =
T.unlines
[ "(function(){"
, "'use strict';"
, "var form = document.querySelector('.roux-cook-log-form');"
, "if (!form) return;"
, "var dateInput = form.querySelector('[name=cooked-date]');"
, "if (dateInput && !dateInput.value) dateInput.value = new Date().toISOString().slice(0,10);"
, "form.addEventListener('submit', async function(e) {"
, " e.preventDefault();"
, " var fd = new FormData(form);"
, " var filename = form.dataset.filename;"
, " var res = await fetch('/cook-log/' + encodeURIComponent(filename), {"
, " method: 'POST',"
, " body: fd"
, " });"
, " if (!res.ok) {"
, " var err = await res.json();"
, " alert(err.error || 'Failed to log cooking');"
, " return;"
, " }"
, " var date = fd.get('cooked-date');"
, " var comment = fd.get('comment');"
, " var entryDiv = document.createElement('div');"
, " entryDiv.style.margin = '0.3rem 0';"
, " entryDiv.style.fontSize = '0.9rem';"
, " var dateLine = document.createElement('strong');"
, " dateLine.style.display = 'block';"
, " dateLine.style.textAlign = 'center';"
, " dateLine.style.color = 'var(--muted)';"
, " dateLine.textContent = '\x2014\x2014 ' + date + ' \x2014\x2014';"
, " entryDiv.appendChild(dateLine);"
, " if (comment) {"
, " var commentSpan = document.createElement('span');"
, " commentSpan.style.display = 'block';"
, " commentSpan.style.marginTop = '0.2rem';"
, " commentSpan.textContent = comment;"
, " entryDiv.appendChild(commentSpan);"
, " }"
, " var container = form.nextElementSibling;"
, " if (container) container.prepend(entryDiv);"
, " form.querySelector('[name=comment]').value = '';"
, "});"
, "})();"
]
sseIndexJs :: Text
sseIndexJs =
T.unlines
@@ -766,8 +818,8 @@ importResultPage (ImportError msg) =
H.h2 "Import failed"
H.p $ H.toHtml msg
recipePage :: Idx.RecipeInfo -> ByteString
recipePage info =
recipePage :: Idx.RecipeInfo -> [CookLog.CookEntry] -> ByteString
recipePage info entries =
case Idx.riRecipe info of
Left err ->
page "Parse Error" $ do
@@ -778,7 +830,7 @@ recipePage info =
sseScript
Right recipe ->
page (titleText recipe) $ do
renderRecipe (Idx.riFilename info) recipe
renderRecipe (Idx.riFilename info) recipe entries
hiddenRecipeSpan info
sseScript
where
@@ -790,10 +842,41 @@ recipePage info =
H.script ! A.type_ "text/javascript" $ H.preEscapedText timerJs
H.script ! A.type_ "text/javascript" $ H.preEscapedText recipeImageUploadJs
H.script ! A.type_ "text/javascript" $ H.preEscapedText titleEditJs
H.script ! A.type_ "text/javascript" $ H.preEscapedText cookLogJs
-- | Render the cook log section in the marginalia column.
renderCookLog :: FilePath -> [CookLog.CookEntry] -> Html
renderCookLog _ [] = pure ()
renderCookLog filename entries = do
H.h2 "Cook history"
H.form
! A.class_ "roux-cook-log-form"
! H.dataAttribute "filename" (H.toValue (T.pack filename))
! A.style "display: flex; gap: 0.3rem; margin-bottom: 0.5rem;" $ do
H.input ! A.type_ "date" ! A.name "cooked-date"
H.input ! A.type_ "text" ! A.name "comment" ! A.placeholder "Optional note..."
! A.maxlength "500" ! A.style "flex: 1;"
H.button ! A.type_ "submit" $ "Log it"
H.div ! A.class_ "roux-cook-entries" $ do
mapM_ renderEntry entries
-- | Render a single cook log entry.
renderEntry :: CookLog.CookEntry -> Html
renderEntry entry = do
H.p ! A.style "margin: 0.3rem 0; font-size: 0.9rem;" $ do
H.strong ! A.style "display: block; text-align: center; color: var(--muted);" $
H.toHtml ("\x2014\x2014 " <> formatDay (CookLog.ceCookedDate entry) <> " \x2014\x2014")
unless (T.null (CookLog.ceComment entry)) $
H.span ! A.style "display: block; margin-top: 0.2rem;" $
H.toHtml (CookLog.ceComment entry)
-- | Format a Day as "Mon DD" e.g. "Mar 15".
formatDay :: Day -> Text
formatDay = T.pack . Time.formatTime Time.defaultTimeLocale "%b %e"
-- | Render the body of a recipe page (no page shell).
renderRecipe :: FilePath -> Recipe -> Html
renderRecipe filename recipe = do
renderRecipe :: FilePath -> Recipe -> [CookLog.CookEntry] -> Html
renderRecipe filename recipe entries = do
H.nav ! A.class_ "roux-navbar" $ do
H.ul $ H.li $ H.a ! A.class_ "roux-logo" ! A.href "/" $ "Roux"
H.ul $ H.li $ H.a ! A.href "/" $ "Recipes"
@@ -847,6 +930,7 @@ renderRecipe filename recipe = do
H.div ! A.class_ "note" $ do
H.h2 "Tags"
H.p $ H.toHtml (T.intercalate " · " recipeTags)
renderCookLog filename entries
unless (null notes) $ do
H.h2 "Notes"
mapM_ renderMarginalNote notes
@@ -1112,3 +1196,32 @@ isLeft _ = False
-- | Check if an 'Either' is 'Right'.
isRight :: Either a b -> Bool
isRight = not . isLeft
-- | Render the cook history page (all entries across recipes).
cookHistoryPage :: [(Text, [CookLog.CookEntry])] -> ByteString
cookHistoryPage grouped =
page "Cook History" $ do
H.nav ! A.class_ "roux-navbar" $ do
H.ul $ H.li $ H.a ! A.class_ "roux-logo" ! A.href "/" $ "Roux"
H.ul $ do
H.li $ H.a ! A.href "/" $ "Recipes"
H.li $ H.a ! A.class_ "active" ! A.href "/cook-history" $ "Cook History"
H.h1 "Cook History"
mapM_ renderMonthGroup grouped
renderMonthGroup :: (Text, [CookLog.CookEntry]) -> Html
renderMonthGroup (month, entries) = do
H.h2 $ H.toHtml month
H.ul ! A.style "list-style: none; padding: 0;" $ do
mapM_ renderHistoryEntry entries
renderHistoryEntry :: CookLog.CookEntry -> Html
renderHistoryEntry entry = do
H.li ! A.style "margin-bottom: 0.5rem;" $ do
H.strong $ H.toHtml (formatDay (CookLog.ceCookedDate entry))
" — "
H.a ! A.href (H.toValue ("/recipes/" <> CookLog.ceRecipeFilename entry <> ".cook")) $
H.toHtml (CookLog.ceRecipeFilename entry)
unless (T.null (CookLog.ceComment entry)) $ do
H.br
H.span $ H.toHtml (CookLog.ceComment entry)
src/Roux/Server.hs
+78 -7
View File
@@ -47,8 +47,13 @@ import qualified Data.Aeson.KeyMap as KM
import qualified Data.ByteString as BS
import Data.Maybe (fromMaybe, mapMaybe)
import qualified Data.Text.Encoding as TE
import qualified Database.SQLite.Simple as SQL
import Data.Time.Calendar (Day, fromGregorianValid)
import qualified Data.Time.Format as Time
import Text.Read (readMaybe)
import Roux.Config (AnthropicConfig (..), RouxConfig (..))
import qualified Roux.CooklangPrint as CooklangPrint
import qualified Roux.CookLog as CookLog
import qualified Roux.Html as Html
import qualified Roux.RecipeIndex as Idx
import Roux.SchemaOrg (SchemaOrgRecipe (..), parseSchemaOrgRecipe, schemaOrgToCooklang)
@@ -95,7 +100,11 @@ app recipeDir config = do
forkIO $
watchRecipes absDir state changeLog `catch` \e ->
putStrLn $ "[roux] watcher thread crashed: " <> show (e :: SomeException)
pure (router absDir config state changeLog)
-- Initialize cook log database
let dbPath = recipeDir </> "cook-log.db"
db <- CookLog.initDb dbPath
putStrLn $ "[roux] cook log DB: " <> dbPath
pure (router absDir config state changeLog db)
where
isRight (Right _) = True
isRight (Left _) = False
@@ -177,8 +186,8 @@ sseHandler changeLog _request respond = do
go `finally` pure ()
-- | Route requests — SSE endpoint, recipe pages, or import.
router :: FilePath -> RouxConfig -> IORef (Map FilePath Idx.RecipeInfo) -> ChangeLog -> Wai.Application
router recipeDir config state changeLog request respond =
router :: FilePath -> RouxConfig -> IORef (Map FilePath Idx.RecipeInfo) -> ChangeLog -> SQL.Connection -> Wai.Application
router recipeDir config state changeLog db request respond =
case Wai.pathInfo request of
["events"] -> sseHandler changeLog request respond
["import"] -> importHandler recipeDir config state request respond
@@ -187,7 +196,16 @@ router recipeDir config state changeLog request respond =
["recipes", _, "title"]
| Wai.requestMethod request == "PATCH" ->
titleUpdateHandler recipeDir state request respond
_ -> handleRequest state request respond
pathInfo
| Just filename <- dispatchLogPost pathInfo
, Wai.requestMethod request == "POST" ->
handleCookLogPost db filename request respond
_ -> handleRequest state db request respond
-- | Extract filename from /cook-log/{filename} POST path, if it matches.
dispatchLogPost :: [Text] -> Maybe Text
dispatchLogPost ["cook-log", filename] = Just filename
dispatchLogPost _ = Nothing
{- | Handle GET and POST requests to /import.
GET — show the import form.
@@ -604,8 +622,8 @@ reReadRecipe dir path state changeLog = do
putStrLn $ "[roux] updated " <> path
-- | Route an incoming request to the appropriate handler.
handleRequest :: IORef (Map FilePath Idx.RecipeInfo) -> Wai.Application
handleRequest state request respond = do
handleRequest :: IORef (Map FilePath Idx.RecipeInfo) -> SQL.Connection -> Wai.Application
handleRequest state db request respond = do
recipes <- readIORef state
let recipeList = Map.elems recipes
case Wai.pathInfo request of
@@ -618,10 +636,63 @@ handleRequest state request respond = do
-- Recipe detail page
["recipes", rawPath] ->
case lookupRecipe (urlDecodePath rawPath) recipes of
Just info -> respond (htmlResponse (Html.recipePage info))
Just info -> do
let filename = T.pack (map toLower (stripCookExt (urlDecodePath rawPath)))
entries <- CookLog.fetchEntries db filename
respond (htmlResponse (Html.recipePage info entries))
Nothing -> respond notFound
-- Cook log JSON endpoint for a specific recipe
["cook-log", filename] -> do
entries <- CookLog.fetchEntries db filename
let body = A.encode entries
respond $ Wai.responseLBS HTTP.status200
[("Content-Type", "application/json")]
body
-- Cook history page (all entries across recipes)
["cook-log"] -> do
entries <- CookLog.fetchAllEntries db
let grouped = groupEntries entries
respond $ htmlResponse (Html.cookHistoryPage grouped)
_ -> respond notFound
-- | Handle POST /cook-log/{filename}
handleCookLogPost :: SQL.Connection -> Text -> Wai.Application
handleCookLogPost db filename request respond = do
body <- readRequestBody request
let params = parseFormBody body
dateStr = fromMaybe "" (lookup "cooked-date" params)
comment = lookup "comment" params
case parseDate dateStr of
Just day -> do
_ <- CookLog.insertEntry db filename day comment
let resp = Wai.responseLBS HTTP.status200 [("Content-Type", "application/json")]
(LB.fromStrict (encodeUtf8 "{\"ok\":true}"))
respond resp
Nothing ->
let resp = Wai.responseLBS HTTP.status400
[("Content-Type", "application/json")]
(LB.fromStrict (encodeUtf8 "{\"error\":\"Invalid date format\"}"))
in respond resp
-- | Parse a YYYY-MM-DD date string.
parseDate :: Text -> Maybe Day
parseDate t = case T.splitOn "-" t of
[y, m, d] -> do
y' <- readMaybe (T.unpack y)
m' <- readMaybe (T.unpack m)
d' <- readMaybe (T.unpack d)
fromGregorianValid y' m' d'
_ -> Nothing
-- | Group entries by month label (e.g. "March 2026").
groupEntries :: [CookLog.CookEntry] -> [(Text, [CookLog.CookEntry])]
groupEntries [] = []
groupEntries entries =
let monthKey d = T.pack $ Time.formatTime Time.defaultTimeLocale "%B %Y" d
groups = Map.fromListWith (++) [(monthKey (CookLog.ceCookedDate e), [e]) | e <- entries]
sortedMonths = reverse (Map.keys groups)
in [(m, Map.findWithDefault [] m groups) | m <- sortedMonths]
-- | Look up a recipe by filename (case-insensitive, .cook extension optional).
lookupRecipe :: FilePath -> Map FilePath Idx.RecipeInfo -> Maybe Idx.RecipeInfo
lookupRecipe target =