jbrechtel
9e15126374
- Replace native checkbox with appearance:none custom styling - Unchecked: transparent bg, terracotta border - Checked: terracotta background, dark checkmark (✓) in #3D2C1E - Same styling for both ingredient rows and method steps
555 lines
25 KiB
Haskell
555 lines
25 KiB
Haskell
{-# OPTIONS_GHC -Wno-name-shadowing #-}
|
|
|
|
{- | HTML rendering for the Roux web interface.
|
|
|
|
Uses blaze-html directly. Styling via Pico CSS.
|
|
|
|
Blaze-html re-exports many common names (title, meta, step, a, b, …)
|
|
so name-shadowing is unavoidable with local bindings.
|
|
-}
|
|
module Roux.Html (
|
|
SortMode (..),
|
|
indexPage,
|
|
recipePage,
|
|
urlEncode,
|
|
urlDecode,
|
|
) where
|
|
|
|
import Control.Monad (unless)
|
|
import Data.ByteString.Lazy (ByteString)
|
|
import Data.Function ((&))
|
|
import Data.List (sortOn)
|
|
import qualified Data.List.NonEmpty as NE
|
|
import Data.Maybe (catMaybes, fromMaybe, mapMaybe)
|
|
import Data.Ratio (denominator, numerator)
|
|
import Data.Text (Text)
|
|
import qualified Data.Text as T
|
|
import qualified Text.Blaze.Html.Renderer.Utf8 as R
|
|
import Text.Blaze.Html5 as H
|
|
import Text.Blaze.Html5.Attributes as A
|
|
|
|
import qualified Roux.RecipeIndex as Idx
|
|
import Roux.Types
|
|
|
|
-- ---------------------------------------------------------------------------
|
|
-- Sort mode for the index page
|
|
-- ---------------------------------------------------------------------------
|
|
|
|
-- | How to group or sort recipes on the index page.
|
|
data SortMode
|
|
= AlphaSort
|
|
| TagSort
|
|
| CourseSort
|
|
deriving stock (Eq, Show)
|
|
|
|
-- ---------------------------------------------------------------------------
|
|
-- Helpers used throughout
|
|
-- ---------------------------------------------------------------------------
|
|
|
|
-- | Pair a label with a value if present.
|
|
pairWith :: a -> Maybe b -> Maybe (a, b)
|
|
pairWith _ Nothing = Nothing
|
|
pairWith a (Just b) = Just (a, b)
|
|
|
|
-- | Format a quantity for display.
|
|
showQuantity :: Quantity -> Text
|
|
showQuantity q =
|
|
let amt = quantityAmount q
|
|
amount = case denominator amt of
|
|
1 -> T.pack (show (numerator amt))
|
|
_ -> T.pack (show (toDouble amt))
|
|
prefix = if quantityFixed q then "=" else ""
|
|
unit = maybe "" ("%" <>) (quantityUnit q)
|
|
in prefix <> amount <> unit
|
|
|
|
-- ---------------------------------------------------------------------------
|
|
-- Page shell
|
|
-- ---------------------------------------------------------------------------
|
|
|
|
-- | Wrap content in a full HTML5 page with custom styling.
|
|
page :: Text -> Html -> ByteString
|
|
page title content =
|
|
R.renderHtml $
|
|
H.docTypeHtml $ do
|
|
H.head $ do
|
|
H.meta ! A.charset "utf-8"
|
|
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 $
|
|
H.toHtml $
|
|
T.unlines
|
|
[ "@import url('https://fonts.googleapis.com/css2?family=Pompiere&family=Quicksand:wght@300..700&display=swap');"
|
|
, ""
|
|
, ":root { --roux-bg: #F5EFE0; --roux-text: #3D2C1E; --roux-accent: #B85C38; }"
|
|
, ".pompiere { font-family: \"Pompiere\", cursive; font-weight: 400; font-style: normal; }"
|
|
, ".quicksand { font-family: \"Quicksand\", sans-serif; font-optical-sizing: auto; font-style: normal; }"
|
|
, ""
|
|
, "body { background: var(--roux-bg); color: var(--roux-text); font-family: \"Quicksand\", sans-serif; }"
|
|
, "main.container { padding-top: 1.5rem; }"
|
|
, "h1, h3 { font-family: \"Pompiere\", cursive; }"
|
|
, "h1 { font-size: 2rem; font-weight: 500; margin: 0 0 0.5rem; line-height: 1.15; color: var(--roux-text); }"
|
|
, "h2 { font-family: \"Quicksand\", sans-serif; font-size: 0.7rem; font-weight: 600; margin: 0 0 1rem; letter-spacing: 0.05em; text-transform: uppercase; color: var(--roux-accent); }"
|
|
, "h3 { 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; appearance: none; -webkit-appearance: none; width: 16px; height: 16px; border: 1.5px solid rgba(184,92,56,0.5); border-radius: 3px; background: transparent; cursor: pointer; flex-shrink: 0; position: relative; }"
|
|
, ".roux-ingredient-row input:checked { background: var(--roux-accent); border-color: var(--roux-accent); }"
|
|
, ".roux-ingredient-row input:checked::after { content: '✓'; position: absolute; top: 50%; left: 50%; transform: translate(-50%,-50%); font-size: 12px; font-weight: 700; color: #3D2C1E; line-height: 1; }"
|
|
, ".roux-ingredient-row .name { font-size: 0.9rem; line-height: 1.5; color: var(--roux-text); transition: opacity 0.15s; }"
|
|
, ".roux-ingredient-row .qty { font-size: 0.8rem; color: var(--roux-accent); margin-right: 4px; }"
|
|
, ".roux-ingredient-row:has(input:checked) { opacity: 0.45; }"
|
|
, ""
|
|
, ".roux-step { display: flex; align-items: flex-start; gap: 12px; padding: 8px 0; transition: opacity 0.15s; }"
|
|
, ".roux-step input { margin-top: 6px; appearance: none; -webkit-appearance: none; width: 16px; height: 16px; border: 1.5px solid rgba(184,92,56,0.5); border-radius: 3px; background: transparent; cursor: pointer; flex-shrink: 0; position: relative; }"
|
|
, ".roux-step input:checked { background: var(--roux-accent); border-color: var(--roux-accent); }"
|
|
, ".roux-step input:checked::after { content: '✓'; position: absolute; top: 50%; left: 50%; transform: translate(-50%,-50%); font-size: 12px; font-weight: 700; color: #3D2C1E; line-height: 1; }"
|
|
, ".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:has(input:checked) { opacity: 0.45; }"
|
|
, ""
|
|
, ".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
|
|
|
|
-- ---------------------------------------------------------------------------
|
|
-- Index page
|
|
-- ---------------------------------------------------------------------------
|
|
|
|
-- | Render the recipe index page.
|
|
indexPage :: SortMode -> [Idx.RecipeInfo] -> ByteString
|
|
indexPage mode recipes =
|
|
page "Roux — Recipes" $ 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
|
|
let good = filter (isRight . Idx.riRecipe) recipes
|
|
case mode of
|
|
AlphaSort -> renderAlpha good
|
|
TagSort -> renderByTags good
|
|
CourseSort -> renderByCourse good
|
|
-- Show parse errors separately
|
|
let bad = filter (isLeft . Idx.riRecipe) recipes
|
|
unless (null bad) $ do
|
|
H.h3 "Unparseable recipes"
|
|
H.ul $ mapM_ (H.li . H.toHtml . Idx.riTitle) bad
|
|
|
|
-- | A navigation link for a sort mode, highlighted when active.
|
|
sortLink :: Text -> SortMode -> Text -> SortMode -> Html
|
|
sortLink label linkMode url currentMode =
|
|
if linkMode == currentMode
|
|
then H.a ! A.href (H.toValue url) ! A.role "button" ! A.class_ "contrast outline" $ H.toHtml label
|
|
else H.a ! A.href (H.toValue url) $ H.toHtml label
|
|
|
|
-- | Render recipes sorted alphabetically by title.
|
|
renderAlpha :: [Idx.RecipeInfo] -> Html
|
|
renderAlpha recipes
|
|
| null recipes = H.p "No recipes found."
|
|
| otherwise =
|
|
let sorted = sortOn alphaSortKey recipes
|
|
in H.ul ! A.class_ "roux-recipes" $ mapM_ (recipeItem . Idx.riFilename) sorted
|
|
|
|
-- | Render recipes grouped by tags.
|
|
renderByTags :: [Idx.RecipeInfo] -> Html
|
|
renderByTags recipes = do
|
|
let tags = collectTags recipes
|
|
if null tags
|
|
then H.p "No tagged recipes."
|
|
else mapM_ renderTagGroup tags
|
|
where
|
|
collectTags rs =
|
|
let entries = mapMaybe tagEntries rs
|
|
allTags = concat entries
|
|
uniqueTags = sortOn Prelude.id (nubOrd allTags)
|
|
in [(tag, filter (hasTag tag) rs) | tag <- uniqueTags]
|
|
tagEntries r = case Idx.riRecipe r of
|
|
Right recipe ->
|
|
let tags = metaTags (recipeMetadata recipe)
|
|
in if null tags then Nothing else Just tags
|
|
Left _ -> Nothing
|
|
hasTag tag r = case Idx.riRecipe r of
|
|
Right recipe -> tag `elem` metaTags (recipeMetadata recipe)
|
|
Left _ -> False
|
|
|
|
-- | Render recipes grouped by course/category.
|
|
renderByCourse :: [Idx.RecipeInfo] -> Html
|
|
renderByCourse recipes = do
|
|
let groups = collectCourses recipes
|
|
if null groups
|
|
then H.p "No recipes with course metadata."
|
|
else mapM_ renderCourseGroup groups
|
|
where
|
|
collectCourses rs =
|
|
let entries = mapMaybe courseEntry rs
|
|
uniqueCourses = sortOn Prelude.id (nubOrd (Prelude.map fst entries))
|
|
in [(course, [r | r <- rs, courseOf r == Just course]) | course <- uniqueCourses]
|
|
courseEntry r = case Idx.riRecipe r of
|
|
Right recipe -> (,) <$> metaCourse (recipeMetadata recipe) <*> pure ()
|
|
Left _ -> Nothing
|
|
courseOf r = case Idx.riRecipe r of
|
|
Right recipe -> metaCourse (recipeMetadata recipe)
|
|
Left _ -> Nothing
|
|
|
|
-- | Render a group of recipes under a tag heading.
|
|
renderTagGroup :: (Text, [Idx.RecipeInfo]) -> Html
|
|
renderTagGroup (tag, rs) = do
|
|
H.h3 $ H.toHtml tag
|
|
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 ! A.class_ "roux-recipes" $ mapM_ (recipeItem . Idx.riFilename) rs
|
|
|
|
-- | Render a single recipe link on the index page.
|
|
recipeItem :: FilePath -> Html
|
|
recipeItem fp =
|
|
H.li $
|
|
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
|
|
-- ---------------------------------------------------------------------------
|
|
|
|
-- | Render a full recipe detail page.
|
|
recipePage :: Idx.RecipeInfo -> ByteString
|
|
recipePage info =
|
|
case Idx.riRecipe info of
|
|
Left err ->
|
|
page "Parse Error" $ do
|
|
H.nav $ H.ul $ H.li $ H.a ! A.href "/" $ "← Back"
|
|
H.h2 "Parse Error"
|
|
H.p $ H.toHtml (Idx.riTitle info <> ": " <> T.pack err)
|
|
Right recipe ->
|
|
page (titleText recipe) $
|
|
renderRecipe recipe
|
|
|
|
-- | Render the body of a recipe page (no page shell).
|
|
renderRecipe :: Recipe -> Html
|
|
renderRecipe recipe = do
|
|
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)
|
|
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 bar
|
|
-- ---------------------------------------------------------------------------
|
|
|
|
-- | Render the horizontal metadata bar (serves, prep, cook, total).
|
|
renderMetaBar :: Metadata -> Html
|
|
renderMetaBar meta = do
|
|
let items =
|
|
catMaybes
|
|
[ 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 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 $
|
|
mapM_ (\t -> H.span ! A.class_ "tag" $ H.toHtml t) tags
|
|
|
|
-- | Format servings info.
|
|
showServings :: (Int, Maybe Text) -> Text
|
|
showServings (n, Nothing) = T.pack (show n)
|
|
showServings (n, Just unit) = T.pack (show n) <> " " <> unit
|
|
|
|
-- | Format a duration.
|
|
showDuration :: Duration -> Text
|
|
showDuration d =
|
|
let amt = durationAmount d
|
|
amount = case denominator amt of
|
|
1 -> T.pack (show (numerator amt))
|
|
_ -> T.pack (show (toDouble amt))
|
|
unit = fromMaybe "" (durationUnit d)
|
|
in T.strip (amount <> " " <> unit)
|
|
|
|
-- | Roughly convert Rational to Double for display.
|
|
toDouble :: Rational -> Double
|
|
toDouble r = fromIntegral (numerator r) / fromIntegral (denominator r)
|
|
|
|
-- ---------------------------------------------------------------------------
|
|
-- Ingredients column
|
|
-- ---------------------------------------------------------------------------
|
|
|
|
-- | 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 ()
|
|
H.div $ mapM_ renderIngredientRow ings
|
|
|
|
-- | 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
|
|
|
|
-- | Collect unique ingredients from a single section.
|
|
collectSectionIngredients :: Section -> [(Text, Maybe Quantity)]
|
|
collectSectionIngredients section =
|
|
let ings =
|
|
NE.toList (sectionBody section)
|
|
>>= bodyItemSteps
|
|
>>= unStep
|
|
>>= \case
|
|
StepIngredient i -> [i]
|
|
_ -> []
|
|
in dedupFirst ings []
|
|
|
|
-- | Deduplicate ingredients by name, keeping first occurrence.
|
|
dedupFirst :: [Ingredient] -> [(Text, Maybe Quantity)] -> [(Text, Maybe Quantity)]
|
|
dedupFirst [] acc = reverse acc
|
|
dedupFirst (i : rest) acc =
|
|
if any ((== ingName i) . fst) 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]
|
|
bodyItemSteps _ = []
|
|
|
|
-- ---------------------------------------------------------------------------
|
|
-- URL encoding
|
|
-- ---------------------------------------------------------------------------
|
|
|
|
-- | Percent-encode a filename for use in a URL path segment.
|
|
urlEncode :: FilePath -> Text
|
|
urlEncode = T.pack . concatMap encodeChar
|
|
where
|
|
encodeChar c
|
|
| c == ' ' = "%20"
|
|
| c == '#' = "%23"
|
|
| c == '%' = "%25"
|
|
| otherwise = [c]
|
|
|
|
-- | Percent-decode a URL path segment back to a filename.
|
|
urlDecode :: Text -> FilePath
|
|
urlDecode t = concat (go [] (T.group t))
|
|
where
|
|
go acc [] = reverse acc
|
|
go acc (s : rest)
|
|
| s == "%20" = go (" " : acc) rest
|
|
| s == "%23" = go ("#" : acc) rest
|
|
| s == "%25" = go ("%" : acc) rest
|
|
| otherwise = go (T.unpack s : acc) rest
|
|
|
|
-- ---------------------------------------------------------------------------
|
|
-- Misc helpers
|
|
-- ---------------------------------------------------------------------------
|
|
|
|
-- | Extract base filename without directory components.
|
|
takeBaseName :: FilePath -> String
|
|
takeBaseName = reverse . takeWhile (/= '/') . reverse
|
|
|
|
-- | Check if an 'Either' is 'Left'.
|
|
isLeft :: Either a b -> Bool
|
|
isLeft (Left _) = True
|
|
isLeft _ = False
|
|
|
|
-- | Check if an 'Either' is 'Right'.
|
|
isRight :: Either a b -> Bool
|
|
isRight = not . isLeft
|
|
|
|
{- | Remove duplicate elements from a list while preserving order of first
|
|
occurrence.
|
|
-}
|
|
nubOrd :: (Eq a) => [a] -> [a]
|
|
nubOrd = go []
|
|
where
|
|
go _ [] = []
|
|
go seen (x : xs)
|
|
| x `elem` seen = go seen xs
|
|
| otherwise = x : go (x : seen) xs
|