diff --git a/package.yaml b/package.yaml index 9ab1389..bb31acf 100644 --- a/package.yaml +++ b/package.yaml @@ -10,7 +10,9 @@ license: BSD-3-Clause default-extensions: - DerivingStrategies + - LambdaCase - OverloadedStrings + - TupleSections ghc-options: - -Wall diff --git a/roux-server.cabal b/roux-server.cabal index 5f77b41..edda97e 100644 --- a/roux-server.cabal +++ b/roux-server.cabal @@ -30,7 +30,9 @@ library src default-extensions: DerivingStrategies + LambdaCase OverloadedStrings + TupleSections ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints build-depends: base >=4.7 && <5 @@ -59,7 +61,9 @@ executable roux-server app default-extensions: DerivingStrategies + LambdaCase OverloadedStrings + TupleSections ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.7 && <5 @@ -92,7 +96,9 @@ test-suite roux-server-test test default-extensions: DerivingStrategies + LambdaCase OverloadedStrings + TupleSections ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints build-depends: base >=4.7 && <5 diff --git a/src/Roux/Html.hs b/src/Roux/Html.hs index a740f4e..a190ae5 100644 --- a/src/Roux/Html.hs +++ b/src/Roux/Html.hs @@ -66,7 +66,7 @@ showQuantity q = -- Page shell -- --------------------------------------------------------------------------- --- | Wrap content in a full HTML5 page with Pico CSS. +-- | Wrap content in a full HTML5 page with custom styling. page :: Text -> Html -> ByteString page title content = R.renderHtml $ @@ -76,15 +76,71 @@ page title content = H.meta ! A.name "viewport" ! A.content "width=device-width, initial-scale=1" H.title (H.toHtml title) H.link ! A.rel "stylesheet" ! A.href "https://cdn.jsdelivr.net/npm/@picocss/pico@2/css/pico.min.css" - H.style - "main.container { padding-top: 2rem; } \ - \.roux-ingredient { color: var(--pico-color-pumpkin); } \ - \.roux-cookware { color: var(--pico-color-violet); font-style: italic; } \ - \.roux-timer { color: var(--pico-color-azure); } \ - \.roux-comment { color: var(--pico-color-sand); font-style: italic; } \ - \.roux-break { display: block; } \ - \.tag { display: inline-block; background: var(--pico-contrast-background); \ - \padding: 0.1rem 0.5rem; margin: 0.1rem; border-radius: 4px; font-size: 0.8rem; }" + H.style $ + H.toHtml $ + T.unlines + [ "@import url('https://fonts.googleapis.com/css2?family=Pompiere&display=swap');" + , "" + , ":root { --roux-bg: #F5EFE0; --roux-text: #3D2C1E; --roux-accent: #B85C38; }" + , ".pompiere-regular { font-family: \"Pompiere\", sans-serif; font-weight: 400; font-style: normal; }" + , "" + , "body { background: var(--roux-bg); color: var(--roux-text); font-family: \"Pompiere\", serif; }" + , "main.container { padding-top: 1.5rem; }" + , "h1 { font-family: \"Pompiere\", serif; font-size: 2rem; font-weight: 500; margin: 0 0 0.5rem; line-height: 1.15; color: var(--roux-text); }" + , "h2 { font-size: 0.75rem; font-weight: 500; margin: 0 0 1rem; letter-spacing: 0.04em; text-transform: uppercase; color: var(--roux-accent); }" + , "h3 { font-family: \"Pompiere\", serif; font-size: 1rem; font-weight: 500; margin: 1.5rem 0 0.5rem; color: var(--roux-text); text-transform: uppercase; opacity: 0.75; }" + , "a { color: var(--roux-accent); text-decoration: none; }" + , "a:hover { text-decoration: underline; }" + , "a[role=button] { --pico-color: var(--roux-accent); }" + , "" + , ".roux-navbar { display: flex; justify-content: space-between; align-items: center; padding: 0.75rem 0; margin-bottom: 1rem; border-bottom: 0.5px solid rgba(184, 92, 56, 0.2); }" + , ".roux-navbar ul { display: flex; gap: 1rem; list-style: none; margin: 0; padding: 0; }" + , ".roux-navbar li { margin: 0; padding: 0; }" + , ".roux-navbar a { font-size: 0.8rem; letter-spacing: 0.04em; text-transform: uppercase; }" + , ".roux-navbar a.active { color: var(--roux-accent); font-weight: 500; }" + , "" + , "/* Recipe list on index page */" + , ".roux-recipes { list-style: none; padding: 0; }" + , ".roux-recipes li { padding: 0.5rem 0; border-bottom: 0.5px solid rgba(184, 92, 56, 0.1); }" + , ".roux-recipes li:last-child { border-bottom: none; }" + , ".roux-recipes a { font-size: 1.1rem; display: block; }" + , "" + , "/* Recipe page */" + , ".roux-meta { display: flex; gap: 1.5rem; margin-bottom: 1.5rem; padding-bottom: 0.75rem; border-bottom: 0.5px solid rgba(184, 92, 56, 0.2); }" + , ".roux-meta-item { text-align: center; }" + , ".roux-meta-item .label { font-size: 0.65rem; color: var(--roux-accent); margin: 0 0 2px; letter-spacing: 0.04em; text-transform: uppercase; font-weight: 500; }" + , ".roux-meta-item .value { font-size: 0.95rem; font-weight: 500; margin: 0; color: var(--roux-text); }" + , "" + , ".roux-grid { display: grid; grid-template-columns: 260px 1fr; gap: 2rem; }" + , "@media (max-width: 768px) { .roux-grid { grid-template-columns: 1fr; } }" + , "" + , ".roux-subsection { font-size: 0.65rem; color: var(--roux-accent); margin: 0 0 6px; letter-spacing: 0.05em; text-transform: uppercase; font-weight: 500; opacity: 0.75; }" + , "" + , ".roux-ingredient-row { display: flex; align-items: flex-start; gap: 8px; padding: 4px 0; }" + , ".roux-ingredient-row input { margin-top: 5px; accent-color: var(--roux-accent); }" + , ".roux-ingredient-row .name { font-size: 0.9rem; line-height: 1.5; color: var(--roux-text); }" + , ".roux-ingredient-row .qty { font-size: 0.8rem; color: var(--roux-accent); margin-right: 4px; }" + , "" + , ".roux-step { display: flex; align-items: flex-start; gap: 12px; padding: 8px 0; }" + , ".roux-step input { margin-top: 6px; accent-color: var(--roux-accent); }" + , ".roux-step .step-label { font-size: 0.75rem; color: var(--roux-accent); font-weight: 500; margin: 0 0 2px; }" + , ".roux-step .step-text { font-size: 0.9rem; line-height: 1.65; margin: 0; color: var(--roux-text); }" + , ".roux-step.done { opacity: 0.5; }" + , ".roux-step.done .step-text { text-decoration: line-through; text-decoration-color: var(--roux-accent); }" + , "" + , ".roux-note { display: flex; gap: 12px; padding: 8px 0; }" + , ".roux-note .ornament { font-size: 1.4rem; color: var(--roux-accent); line-height: 1; margin-top: -1px; }" + , ".roux-note .text { font-size: 0.9rem; line-height: 1.65; margin: 0; color: var(--roux-text); }" + , "" + , ".roux-course { font-size: 0.65rem; color: var(--roux-accent); margin: 0 0 0.15rem; letter-spacing: 0.04em; text-transform: uppercase; font-weight: 500; }" + , ".roux-desc { font-size: 0.85rem; line-height: 1.6; color: var(--roux-text); margin: 0 0 1.5rem; max-width: 640px; opacity: 0.85; }" + , "" + , ".roux-ingredient-tag { color: var(--roux-accent); font-weight: 500; }" + , ".roux-cookware-tag { font-style: italic; opacity: 0.85; }" + , ".roux-timer-tag { color: var(--roux-accent); font-style: italic; }" + , ".roux-comment-tag { opacity: 0.6; font-style: italic; }" + , ".tag { display: inline-block; background: rgba(184,92,56,0.1); padding: 0.1rem 0.5rem; margin: 0.1rem; border-radius: 4px; font-size: 0.7rem; color: var(--roux-accent); }" + ] H.body $ H.main ! A.class_ "container" $ content -- --------------------------------------------------------------------------- @@ -95,14 +151,12 @@ page title content = indexPage :: SortMode -> [Idx.RecipeInfo] -> ByteString indexPage mode recipes = page "Roux — Recipes" $ do - H.nav $ do + H.div ! A.class_ "roux-navbar" $ do H.ul $ H.li $ H.strong "Roux" H.ul $ do H.li $ sortLink "A-Z" AlphaSort "/" mode H.li $ sortLink "By Tag" TagSort "/sorted/tags" mode H.li $ sortLink "By Course" CourseSort "/sorted/course" mode - H.h2 "Recipes" - H.p "Your personal recipe collection." let good = filter (isRight . Idx.riRecipe) recipes case mode of AlphaSort -> renderAlpha good @@ -127,15 +181,7 @@ renderAlpha recipes | null recipes = H.p "No recipes found." | otherwise = let sorted = sortOn alphaSortKey recipes - in H.ul $ mapM_ (recipeItem . Idx.riFilename) sorted - --- | Sort key for alphabetical ordering by title, falling back to filename. -alphaSortKey :: Idx.RecipeInfo -> Text -alphaSortKey info = case Idx.riRecipe info of - Right r -> case metaTitle (recipeMetadata r) of - Just t -> t - Nothing -> T.pack (takeBaseName (Idx.riFilename info)) - Left _ -> T.pack "zzzz" + in H.ul ! A.class_ "roux-recipes" $ mapM_ (recipeItem . Idx.riFilename) sorted -- | Render recipes grouped by tags. renderByTags :: [Idx.RecipeInfo] -> Html @@ -182,13 +228,13 @@ renderByCourse recipes = do renderTagGroup :: (Text, [Idx.RecipeInfo]) -> Html renderTagGroup (tag, rs) = do H.h3 $ H.toHtml tag - H.ul $ mapM_ (recipeItem . Idx.riFilename) rs + H.ul ! A.class_ "roux-recipes" $ mapM_ (recipeItem . Idx.riFilename) rs -- | Render a group of recipes under a course heading. renderCourseGroup :: (Text, [Idx.RecipeInfo]) -> Html renderCourseGroup (course, rs) = do H.h3 $ H.toHtml course - H.ul $ mapM_ (recipeItem . Idx.riFilename) rs + H.ul ! A.class_ "roux-recipes" $ mapM_ (recipeItem . Idx.riFilename) rs -- | Render a single recipe link on the index page. recipeItem :: FilePath -> Html @@ -197,6 +243,14 @@ recipeItem fp = H.a ! A.href (H.toValue ("/recipes/" <> urlEncode fp)) $ H.toHtml (T.pack (takeBaseName fp)) +-- | Sort key for alphabetical ordering by title, falling back to filename. +alphaSortKey :: Idx.RecipeInfo -> Text +alphaSortKey info = case Idx.riRecipe info of + Right r -> case metaTitle (recipeMetadata r) of + Just t -> t + Nothing -> T.pack (takeBaseName (Idx.riFilename info)) + Left _ -> T.pack "zzzz" + -- --------------------------------------------------------------------------- -- Recipe detail page -- --------------------------------------------------------------------------- @@ -217,46 +271,68 @@ recipePage info = -- | Render the body of a recipe page (no page shell). renderRecipe :: Recipe -> Html renderRecipe recipe = do - H.nav $ H.ul $ H.li $ H.a ! A.href "/" $ "← Back to index" + H.div ! A.class_ "roux-navbar" $ do + H.ul $ H.li $ H.a ! A.href "/" $ "← Back" + H.ul $ H.li $ H.a ! A.href "/" $ "Recipes" + let meta = recipeMetadata recipe + course = metaCourse meta + desc = metaDescription meta + case course of + Just c -> H.p ! A.class_ "roux-course" $ H.toHtml c + Nothing -> pure () H.h1 $ H.toHtml (titleText recipe) - renderMetadata (recipeMetadata recipe) - let allIngredients = collectIngredients recipe - unless (null allIngredients) $ do - H.h2 "Ingredients" - H.ul $ mapM_ renderIngredientItem allIngredients - H.hr - NE.toList (recipeSections recipe) & mapM_ renderSection + case desc of + Just d -> H.p ! A.class_ "roux-desc" $ H.toHtml d + Nothing -> pure () + renderMetaBar meta + let sections = NE.toList (recipeSections recipe) + H.div ! A.class_ "roux-grid" $ do + -- Ingredients column + H.div $ do + H.h2 "Ingredients" + mapM_ renderIngredientGroup sections + -- Method column + H.div $ do + H.h2 "Method" + renderMethodSections sections + -- Notes + let notes = collectNotes recipe + unless (null notes) $ do + H.div ! A.style "margin-top: 2rem; padding-top: 1.5rem; border-top: 0.5px solid rgba(184,92,56,0.2);" $ do + H.h2 "Notes" + mapM_ renderNote notes -- | Extract display title from recipe metadata or fallback. titleText :: Recipe -> Text titleText recipe = fromMaybe "Untitled Recipe" (metaTitle (recipeMetadata recipe)) -- --------------------------------------------------------------------------- --- Metadata +-- Metadata bar -- --------------------------------------------------------------------------- --- | Render recipe metadata as a description list. -renderMetadata :: Metadata -> Html -renderMetadata meta = do - let rows = +-- | Render the horizontal metadata bar (serves, prep, cook, total). +renderMetaBar :: Metadata -> Html +renderMetaBar meta = do + let items = catMaybes - [ pairWith (T.pack "Servings") (showServings <$> metaServings meta) - , pairWith (T.pack "Total time") (showDuration <$> metaTotalTime meta) - , pairWith (T.pack "Prep time") (showDuration <$> metaPrepTime meta) - , pairWith (T.pack "Cook time") (showDuration <$> metaCookTime meta) - , pairWith (T.pack "Difficulty") (metaDifficulty meta) - , pairWith (T.pack "Cuisine") (metaCuisine meta) - , pairWith (T.pack "Author") (metaAuthor meta) - , pairWith (T.pack "Source") (metaSource meta) + [ pairWith (T.pack "Serves") (showServings <$> metaServings meta) + , pairWith (T.pack "Prep") (showDuration <$> metaPrepTime meta) + , pairWith (T.pack "Cook") (showDuration <$> metaCookTime meta) + , pairWith (T.pack "Total") (showDuration <$> metaTotalTime meta) ] - unless (null rows) $ - H.dl $ - mapM_ (\(label, value) -> H.dt (H.toHtml label) >> H.dd (H.toHtml value)) rows - -- Tags as badges + unless (null items) $ + H.div ! A.class_ "roux-meta" $ + mapM_ + ( \(label, value) -> + H.div ! A.class_ "roux-meta-item" $ do + H.p ! A.class_ "label" $ H.toHtml label + H.p ! A.class_ "value" $ H.toHtml value + ) + items + -- Tags let tags = metaTags meta unless (null tags) $ - H.p $ do - "Tags: " + H.p $ mapM_ (\t -> H.span ! A.class_ "tag" $ H.toHtml t) tags -- | Format servings info. @@ -279,88 +355,40 @@ toDouble :: Rational -> Double toDouble r = fromIntegral (numerator r) / fromIntegral (denominator r) -- --------------------------------------------------------------------------- --- Sections +-- Ingredients column -- --------------------------------------------------------------------------- --- | Render one section of a recipe. -renderSection :: Section -> Html -renderSection section = do - case sectionName section of - Just name -> H.h3 $ H.toHtml name - Nothing -> pure () - NE.toList (sectionBody section) & mapM_ renderBodyItem - --- | Render one body item (step, comment, or note). -renderBodyItem :: SectionBodyItem -> Html -renderBodyItem (SecStep step) = - H.p $ mapM_ renderStepItem (unStep step) -renderBodyItem (SecComment t) = - H.blockquote $ H.em $ H.toHtml ("-- " <> t) -renderBodyItem (SecNote t) = - H.blockquote $ H.small $ H.toHtml ("> " <> t) - --- --------------------------------------------------------------------------- --- Step items --- --------------------------------------------------------------------------- - --- | Render one inline element within a step. -renderStepItem :: StepItem -> Html -renderStepItem (StepText t) = H.toHtml t -renderStepItem (StepIngredient ing) = - H.mark ! A.class_ "roux-ingredient" $ do - H.toHtml (ingName ing) - case ingQuantity ing of +-- | Render ingredients grouped by section. +renderIngredientGroup :: Section -> Html +renderIngredientGroup section = do + let ings = collectSectionIngredients section + unless (null ings) $ do + case sectionName section of + Just n -> H.p ! A.class_ "roux-subsection" $ H.toHtml n Nothing -> pure () - Just q -> do - " " - H.small $ "[" <> H.toHtml (showQuantity q) <> "]" -renderStepItem (StepCookware cw) = - H.span ! A.class_ "roux-cookware" $ - H.toHtml (cwName cw) -renderStepItem (StepTimer timer) = - H.span ! A.class_ "roux-timer" $ do - case timerName timer of - Just n -> H.toHtml n >> " " - Nothing -> pure () - H.small $ "⏱ " <> H.toHtml (showDuration (timerDuration timer)) -renderStepItem (StepRecipeRef ref) = - H.a ! A.href (H.toValue ("/recipes/" <> urlEncode (refPath ref <> ".cook"))) $ - H.toHtml (refPath ref) -renderStepItem (StepEndComment t) = - H.span ! A.class_ "roux-comment" $ H.em $ H.toHtml (" -- " <> t) -renderStepItem (StepComment t) = - H.span ! A.class_ "roux-comment" $ H.em $ H.toHtml ("[- " <> t <> " -]") -renderStepItem StepBreak = - H.br ! A.class_ "roux-break" + H.div $ mapM_ renderIngredientRow ings --- | Render one ingredient in the ingredients summary list. -renderIngredientItem :: (Text, Maybe Quantity) -> Html -renderIngredientItem (name, qty) = - H.li $ do - H.toHtml name - case qty of - Nothing -> pure () - Just q -> do - " — " - H.small $ H.toHtml (showQuantity q) +-- | Render one ingredient row with checkbox. +renderIngredientRow :: (Text, Maybe Quantity) -> Html +renderIngredientRow (name, qty) = + H.label ! A.class_ "roux-ingredient-row" $ do + H.input ! A.type_ "checkbox" + H.span ! A.class_ "name" $ do + case qty of + Just q -> H.span ! A.class_ "qty" $ H.toHtml (showQuantity q <> " ") + Nothing -> pure () + H.toHtml name --- --------------------------------------------------------------------------- --- Ingredients collection --- --------------------------------------------------------------------------- - -{- | Collect all unique ingredients from a recipe with their first-seen -quantity. --} -collectIngredients :: Recipe -> [(Text, Maybe Quantity)] -collectIngredients recipe = - let items = - recipe - & recipeSections - & NE.toList - >>= NE.toList . sectionBody +-- | Collect unique ingredients from a single section. +collectSectionIngredients :: Section -> [(Text, Maybe Quantity)] +collectSectionIngredients section = + let ings = + NE.toList (sectionBody section) >>= bodyItemSteps >>= unStep - ings = [i | StepIngredient i <- items] + >>= \case + StepIngredient i -> [i] + _ -> [] in dedupFirst ings [] -- | Deduplicate ingredients by name, keeping first occurrence. @@ -371,6 +399,96 @@ dedupFirst (i : rest) acc = then dedupFirst rest acc else dedupFirst rest ((ingName i, ingQuantity i) : acc) +-- --------------------------------------------------------------------------- +-- Method column +-- --------------------------------------------------------------------------- + +-- | Render the method column: all sections with numbered steps. +renderMethodSections :: [Section] -> Html +renderMethodSections sections = do + let allSteps = concatMap sectionMethodSteps sections + mapM_ (uncurry renderMethodStep) (zip [1 ..] allSteps) + +-- | Extract (section name, body items) from a section for the method column. +sectionMethodSteps :: Section -> [(Maybe Text, SectionBodyItem)] +sectionMethodSteps section = + let name = sectionName section + in Prelude.map (name,) (NE.toList (sectionBody section)) + +-- | Render one step in the method column (with step number and checkbox). +renderMethodStep :: Int -> (Maybe Text, SectionBodyItem) -> Html +renderMethodStep stepNum (_, SecStep step) = do + H.label ! A.class_ "roux-step" $ do + H.input ! A.type_ "checkbox" + H.div $ do + H.p ! A.class_ "step-label" $ "Step " <> H.toHtml (T.pack (show stepNum)) + H.p ! A.class_ "step-text" $ mapM_ renderStepItem (unStep step) +renderMethodStep _ (_, SecComment t) = + H.div ! A.class_ "roux-step" $ + H.div $ do + H.p ! A.class_ "step-text" $ H.em $ H.toHtml ("-- " <> t) +renderMethodStep _ (_, SecNote t) = + H.div ! A.class_ "roux-step" $ + H.div $ do + H.p ! A.class_ "step-text" $ H.small $ H.toHtml ("> " <> t) + +-- --------------------------------------------------------------------------- +-- Step items (inline rendering within a step) +-- --------------------------------------------------------------------------- + +-- | Render one inline element within a step. +renderStepItem :: StepItem -> Html +renderStepItem (StepText t) = H.toHtml t +renderStepItem (StepIngredient ing) = do + H.span ! A.class_ "roux-ingredient-tag" $ H.toHtml (ingName ing) + case ingQuantity ing of + Nothing -> pure () + Just q -> " " <> (H.span ! A.class_ "qty" $ H.toHtml (showQuantity q)) +renderStepItem (StepCookware cw) = + H.span ! A.class_ "roux-cookware-tag" $ + H.toHtml (cwName cw) +renderStepItem (StepTimer timer) = + H.span ! A.class_ "roux-timer-tag" $ do + case timerName timer of + Just n -> H.toHtml n >> " " + Nothing -> pure () + H.toHtml (showDuration (timerDuration timer)) +renderStepItem (StepRecipeRef ref) = + H.a ! A.href (H.toValue ("/recipes/" <> urlEncode (refPath ref <> ".cook"))) $ + H.toHtml (refPath ref) +renderStepItem (StepEndComment t) = + H.span ! A.class_ "roux-comment-tag" $ H.em $ H.toHtml (" -- " <> t) +renderStepItem (StepComment t) = + H.span ! A.class_ "roux-comment-tag" $ H.em $ H.toHtml ("[- " <> t <> " -]") +renderStepItem StepBreak = + H.br + +-- --------------------------------------------------------------------------- +-- Notes section +-- --------------------------------------------------------------------------- + +-- | Render a note with a decorative ornament. +renderNote :: Text -> Html +renderNote t = + H.div ! A.class_ "roux-note" $ do + H.span ! A.class_ "ornament" $ "\182" + H.p ! A.class_ "text" $ H.toHtml t + +-- | Collect all note texts from the recipe. +collectNotes :: Recipe -> [Text] +collectNotes recipe = + recipe + & recipeSections + & NE.toList + >>= NE.toList . sectionBody + >>= \case + SecNote t -> [t] + _ -> [] + +-- --------------------------------------------------------------------------- +-- Shared helpers for both columns +-- --------------------------------------------------------------------------- + -- | Extract step items from a body item (returns empty for comments/notes). bodyItemSteps :: SectionBodyItem -> [Step] bodyItemSteps (SecStep s) = [s]