Recipe page restyled to match mockup design

- Add Pompiere font from Google Fonts
- Color theme: #F5EFE0 (bg), #3D2C1E (text), #B85C38 (accent)
- Two-column layout (ingredients | method) matching mockup
- Horizontal metadata bar: Serves, Prep, Cook, Total
- Course badge and description paragraph
- Ingredients: checkbox rows with quantity prefix, grouped by section
- Method: numbered steps with checkboxes
- Notes: ¶ ornament + paragraph style
- Index page: styled navbar with sort mode buttons
- Index page: styled recipe list with separators
- Custom CSS via internal stylesheet (no Pico CSS override except
  link for reset/utility classes)
- Add LambdaCase and TupleSections to default extensions
- All 26 tests passing, hlint clean
This commit is contained in:
2026-05-19 09:54:08 -04:00
parent b0926ee60d
commit d1582e9034
3 changed files with 252 additions and 126 deletions
+2
View File
@@ -10,7 +10,9 @@ license: BSD-3-Clause
default-extensions: default-extensions:
- DerivingStrategies - DerivingStrategies
- LambdaCase
- OverloadedStrings - OverloadedStrings
- TupleSections
ghc-options: ghc-options:
- -Wall - -Wall
+6
View File
@@ -30,7 +30,9 @@ library
src src
default-extensions: default-extensions:
DerivingStrategies DerivingStrategies
LambdaCase
OverloadedStrings OverloadedStrings
TupleSections
ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
build-depends: build-depends:
base >=4.7 && <5 base >=4.7 && <5
@@ -59,7 +61,9 @@ executable roux-server
app app
default-extensions: default-extensions:
DerivingStrategies DerivingStrategies
LambdaCase
OverloadedStrings 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 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: build-depends:
base >=4.7 && <5 base >=4.7 && <5
@@ -92,7 +96,9 @@ test-suite roux-server-test
test test
default-extensions: default-extensions:
DerivingStrategies DerivingStrategies
LambdaCase
OverloadedStrings OverloadedStrings
TupleSections
ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
build-depends: build-depends:
base >=4.7 && <5 base >=4.7 && <5
+244 -126
View File
@@ -66,7 +66,7 @@ showQuantity q =
-- Page shell -- 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 :: Text -> Html -> ByteString
page title content = page title content =
R.renderHtml $ R.renderHtml $
@@ -76,15 +76,71 @@ page title content =
H.meta ! A.name "viewport" ! A.content "width=device-width, initial-scale=1" H.meta ! A.name "viewport" ! A.content "width=device-width, initial-scale=1"
H.title (H.toHtml title) 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.link ! A.rel "stylesheet" ! A.href "https://cdn.jsdelivr.net/npm/@picocss/pico@2/css/pico.min.css"
H.style H.style $
"main.container { padding-top: 2rem; } \ H.toHtml $
\.roux-ingredient { color: var(--pico-color-pumpkin); } \ T.unlines
\.roux-cookware { color: var(--pico-color-violet); font-style: italic; } \ [ "@import url('https://fonts.googleapis.com/css2?family=Pompiere&display=swap');"
\.roux-timer { color: var(--pico-color-azure); } \ , ""
\.roux-comment { color: var(--pico-color-sand); font-style: italic; } \ , ":root { --roux-bg: #F5EFE0; --roux-text: #3D2C1E; --roux-accent: #B85C38; }"
\.roux-break { display: block; } \ , ".pompiere-regular { font-family: \"Pompiere\", sans-serif; font-weight: 400; font-style: normal; }"
\.tag { display: inline-block; background: var(--pico-contrast-background); \ , ""
\padding: 0.1rem 0.5rem; margin: 0.1rem; border-radius: 4px; font-size: 0.8rem; }" , "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 H.body $ H.main ! A.class_ "container" $ content
-- --------------------------------------------------------------------------- -- ---------------------------------------------------------------------------
@@ -95,14 +151,12 @@ page title content =
indexPage :: SortMode -> [Idx.RecipeInfo] -> ByteString indexPage :: SortMode -> [Idx.RecipeInfo] -> ByteString
indexPage mode recipes = indexPage mode recipes =
page "Roux — Recipes" $ do page "Roux — Recipes" $ do
H.nav $ do H.div ! A.class_ "roux-navbar" $ do
H.ul $ H.li $ H.strong "Roux" H.ul $ H.li $ H.strong "Roux"
H.ul $ do H.ul $ do
H.li $ sortLink "A-Z" AlphaSort "/" mode H.li $ sortLink "A-Z" AlphaSort "/" mode
H.li $ sortLink "By Tag" TagSort "/sorted/tags" mode H.li $ sortLink "By Tag" TagSort "/sorted/tags" mode
H.li $ sortLink "By Course" CourseSort "/sorted/course" 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 let good = filter (isRight . Idx.riRecipe) recipes
case mode of case mode of
AlphaSort -> renderAlpha good AlphaSort -> renderAlpha good
@@ -127,15 +181,7 @@ renderAlpha recipes
| null recipes = H.p "No recipes found." | null recipes = H.p "No recipes found."
| otherwise = | otherwise =
let sorted = sortOn alphaSortKey recipes let sorted = sortOn alphaSortKey recipes
in H.ul $ mapM_ (recipeItem . Idx.riFilename) sorted in H.ul ! A.class_ "roux-recipes" $ 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"
-- | Render recipes grouped by tags. -- | Render recipes grouped by tags.
renderByTags :: [Idx.RecipeInfo] -> Html renderByTags :: [Idx.RecipeInfo] -> Html
@@ -182,13 +228,13 @@ renderByCourse recipes = do
renderTagGroup :: (Text, [Idx.RecipeInfo]) -> Html renderTagGroup :: (Text, [Idx.RecipeInfo]) -> Html
renderTagGroup (tag, rs) = do renderTagGroup (tag, rs) = do
H.h3 $ H.toHtml tag 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. -- | Render a group of recipes under a course heading.
renderCourseGroup :: (Text, [Idx.RecipeInfo]) -> Html renderCourseGroup :: (Text, [Idx.RecipeInfo]) -> Html
renderCourseGroup (course, rs) = do renderCourseGroup (course, rs) = do
H.h3 $ H.toHtml course 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. -- | Render a single recipe link on the index page.
recipeItem :: FilePath -> Html recipeItem :: FilePath -> Html
@@ -197,6 +243,14 @@ recipeItem fp =
H.a ! A.href (H.toValue ("/recipes/" <> urlEncode fp)) $ H.a ! A.href (H.toValue ("/recipes/" <> urlEncode fp)) $
H.toHtml (T.pack (takeBaseName 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 -- Recipe detail page
-- --------------------------------------------------------------------------- -- ---------------------------------------------------------------------------
@@ -217,46 +271,68 @@ recipePage info =
-- | Render the body of a recipe page (no page shell). -- | Render the body of a recipe page (no page shell).
renderRecipe :: Recipe -> Html renderRecipe :: Recipe -> Html
renderRecipe recipe = do 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) H.h1 $ H.toHtml (titleText recipe)
renderMetadata (recipeMetadata recipe) case desc of
let allIngredients = collectIngredients recipe Just d -> H.p ! A.class_ "roux-desc" $ H.toHtml d
unless (null allIngredients) $ do Nothing -> pure ()
H.h2 "Ingredients" renderMetaBar meta
H.ul $ mapM_ renderIngredientItem allIngredients let sections = NE.toList (recipeSections recipe)
H.hr H.div ! A.class_ "roux-grid" $ do
NE.toList (recipeSections recipe) & mapM_ renderSection -- 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. -- | Extract display title from recipe metadata or fallback.
titleText :: Recipe -> Text titleText :: Recipe -> Text
titleText recipe = fromMaybe "Untitled Recipe" (metaTitle (recipeMetadata recipe)) titleText recipe = fromMaybe "Untitled Recipe" (metaTitle (recipeMetadata recipe))
-- --------------------------------------------------------------------------- -- ---------------------------------------------------------------------------
-- Metadata -- Metadata bar
-- --------------------------------------------------------------------------- -- ---------------------------------------------------------------------------
-- | Render recipe metadata as a description list. -- | Render the horizontal metadata bar (serves, prep, cook, total).
renderMetadata :: Metadata -> Html renderMetaBar :: Metadata -> Html
renderMetadata meta = do renderMetaBar meta = do
let rows = let items =
catMaybes catMaybes
[ pairWith (T.pack "Servings") (showServings <$> metaServings meta) [ pairWith (T.pack "Serves") (showServings <$> metaServings meta)
, pairWith (T.pack "Total time") (showDuration <$> metaTotalTime meta) , pairWith (T.pack "Prep") (showDuration <$> metaPrepTime meta)
, pairWith (T.pack "Prep time") (showDuration <$> metaPrepTime meta) , pairWith (T.pack "Cook") (showDuration <$> metaCookTime meta)
, pairWith (T.pack "Cook time") (showDuration <$> metaCookTime meta) , pairWith (T.pack "Total") (showDuration <$> metaTotalTime 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)
] ]
unless (null rows) $ unless (null items) $
H.dl $ H.div ! A.class_ "roux-meta" $
mapM_ (\(label, value) -> H.dt (H.toHtml label) >> H.dd (H.toHtml value)) rows mapM_
-- Tags as badges ( \(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 let tags = metaTags meta
unless (null tags) $ unless (null tags) $
H.p $ do H.p $
"Tags: "
mapM_ (\t -> H.span ! A.class_ "tag" $ H.toHtml t) tags mapM_ (\t -> H.span ! A.class_ "tag" $ H.toHtml t) tags
-- | Format servings info. -- | Format servings info.
@@ -279,88 +355,40 @@ toDouble :: Rational -> Double
toDouble r = fromIntegral (numerator r) / fromIntegral (denominator r) toDouble r = fromIntegral (numerator r) / fromIntegral (denominator r)
-- --------------------------------------------------------------------------- -- ---------------------------------------------------------------------------
-- Sections -- Ingredients column
-- --------------------------------------------------------------------------- -- ---------------------------------------------------------------------------
-- | Render one section of a recipe. -- | Render ingredients grouped by section.
renderSection :: Section -> Html renderIngredientGroup :: Section -> Html
renderSection section = do renderIngredientGroup section = do
case sectionName section of let ings = collectSectionIngredients section
Just name -> H.h3 $ H.toHtml name unless (null ings) $ do
Nothing -> pure () case sectionName section of
NE.toList (sectionBody section) & mapM_ renderBodyItem Just n -> H.p ! A.class_ "roux-subsection" $ H.toHtml n
-- | 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
Nothing -> pure () Nothing -> pure ()
Just q -> do H.div $ mapM_ renderIngredientRow ings
" "
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"
-- | Render one ingredient in the ingredients summary list. -- | Render one ingredient row with checkbox.
renderIngredientItem :: (Text, Maybe Quantity) -> Html renderIngredientRow :: (Text, Maybe Quantity) -> Html
renderIngredientItem (name, qty) = renderIngredientRow (name, qty) =
H.li $ do H.label ! A.class_ "roux-ingredient-row" $ do
H.toHtml name H.input ! A.type_ "checkbox"
case qty of H.span ! A.class_ "name" $ do
Nothing -> pure () case qty of
Just q -> do Just q -> H.span ! A.class_ "qty" $ H.toHtml (showQuantity q <> " ")
"" Nothing -> pure ()
H.small $ H.toHtml (showQuantity q) H.toHtml name
-- --------------------------------------------------------------------------- -- | Collect unique ingredients from a single section.
-- Ingredients collection collectSectionIngredients :: Section -> [(Text, Maybe Quantity)]
-- --------------------------------------------------------------------------- collectSectionIngredients section =
let ings =
{- | Collect all unique ingredients from a recipe with their first-seen NE.toList (sectionBody section)
quantity.
-}
collectIngredients :: Recipe -> [(Text, Maybe Quantity)]
collectIngredients recipe =
let items =
recipe
& recipeSections
& NE.toList
>>= NE.toList . sectionBody
>>= bodyItemSteps >>= bodyItemSteps
>>= unStep >>= unStep
ings = [i | StepIngredient i <- items] >>= \case
StepIngredient i -> [i]
_ -> []
in dedupFirst ings [] in dedupFirst ings []
-- | Deduplicate ingredients by name, keeping first occurrence. -- | Deduplicate ingredients by name, keeping first occurrence.
@@ -371,6 +399,96 @@ dedupFirst (i : rest) acc =
then dedupFirst rest acc then dedupFirst rest acc
else dedupFirst rest ((ingName i, ingQuantity i) : 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). -- | Extract step items from a body item (returns empty for comments/notes).
bodyItemSteps :: SectionBodyItem -> [Step] bodyItemSteps :: SectionBodyItem -> [Step]
bodyItemSteps (SecStep s) = [s] bodyItemSteps (SecStep s) = [s]