From c6a9c2dee4a2a53ba0141b09abc8f58188e32aec Mon Sep 17 00:00:00 2001 From: James Brechtel Date: Mon, 25 May 2026 22:00:45 -0400 Subject: [PATCH] feat: wire up cook log DB at server startup --- src/Roux/Html.hs | 123 +++++++++++++++++++++++++++++++++++++++++++-- src/Roux/Server.hs | 85 ++++++++++++++++++++++++++++--- 2 files changed, 196 insertions(+), 12 deletions(-) diff --git a/src/Roux/Html.hs b/src/Roux/Html.hs index 936ff9c..d2c0298 100644 --- a/src/Roux/Html.hs +++ b/src/Roux/Html.hs @@ -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) diff --git a/src/Roux/Server.hs b/src/Roux/Server.hs index 5e7ad99..e47f105 100644 --- a/src/Roux/Server.hs +++ b/src/Roux/Server.hs @@ -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 =