diff --git a/src/Roux/Html.hs b/src/Roux/Html.hs
index 5305c71..7047c39 100644
--- a/src/Roux/Html.hs
+++ b/src/Roux/Html.hs
@@ -1,12 +1,25 @@
+{-# OPTIONS_GHC -Wno-name-shadowing #-}
+
{- | HTML rendering for the Roux web interface.
-Uses blaze-html directly. Styling via Pico CSS (inlined in the page).
+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 (
indexPage,
+ recipePage,
+ urlEncode,
+ urlDecode,
) where
+import Control.Monad (unless)
import Data.ByteString.Lazy (ByteString)
+import Data.Function ((&))
+import qualified Data.List.NonEmpty as NE
+import Data.Maybe (catMaybes)
+import Data.Ratio (denominator, numerator)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Text.Blaze.Html.Renderer.Utf8 as R
@@ -14,35 +27,266 @@ import Text.Blaze.Html5 as H
import Text.Blaze.Html5.Attributes as A
import qualified Roux.RecipeIndex as Idx
+import Roux.Types
--- | Render the recipe index page.
-indexPage :: [Idx.RecipeInfo] -> ByteString
-indexPage recipes =
+-- ---------------------------------------------------------------------------
+-- 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 "" (\u -> "%" <> u) (quantityUnit q)
+ in prefix <> amount <> unit
+
+-- ---------------------------------------------------------------------------
+-- Page shell
+-- ---------------------------------------------------------------------------
+
+-- | Wrap content in a full HTML5 page with Pico CSS.
+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 "Roux — Recipes"
+ 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.body $ do
- H.main ! A.class_ "container" $ do
- H.h1 "Roux"
- H.p "Your personal recipe collection."
- H.h2 "Recipes"
- H.ul $ mapM_ recipeItem recipes
+ 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.body $ H.main ! A.class_ "container" $ content
--- | Render a single recipe list item.
-recipeItem :: Idx.RecipeInfo -> Html
-recipeItem info =
- H.li $ case Idx.riRecipe info of
- Left _err ->
- H.span ! A.class_ "error" $ do
- H.toHtml (Idx.riTitle info)
- " (parse error)"
- Right _recipe ->
- H.a ! A.href (H.toValue ("/recipes/" <> urlEncode (Idx.riFilename info))) $
- H.toHtml (Idx.riTitle info)
+-- ---------------------------------------------------------------------------
+-- Index page
+-- ---------------------------------------------------------------------------
+
+-- | Render the recipe index page.
+indexPage :: [Idx.RecipeInfo] -> ByteString
+indexPage recipes =
+ page "Roux — Recipes" $ do
+ H.nav $ H.ul $ H.li $ H.strong "Roux"
+ H.h2 "Recipes"
+ H.p "Your personal recipe collection."
+ case filter (isRight . Idx.riRecipe) recipes of
+ [] -> H.p "No recipes found."
+ good ->
+ H.ul $ mapM_ (recipeItem . Idx.riFilename) good
+ -- Show parse errors separately
+ let bad = filter (isLeft . Idx.riRecipe) recipes
+ unless (null bad) $ do
+ H.h3 "Unparseable recipes"
+ H.ul $ mapM_ (\r -> H.li $ H.toHtml (Idx.riTitle r)) bad
+
+-- | 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))
+
+-- ---------------------------------------------------------------------------
+-- 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.nav $ H.ul $ H.li $ H.a ! A.href "/" $ "← Back to index"
+ 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
+
+-- | Extract display title from recipe metadata or fallback.
+titleText :: Recipe -> Text
+titleText recipe =
+ case metaTitle (recipeMetadata recipe) of
+ Just t -> t
+ Nothing -> "Untitled Recipe"
+
+-- ---------------------------------------------------------------------------
+-- Metadata
+-- ---------------------------------------------------------------------------
+
+-- | Render recipe metadata as a description list.
+renderMetadata :: Metadata -> Html
+renderMetadata meta = do
+ let rows =
+ 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)
+ ]
+ unless (null rows) $
+ H.dl $
+ mapM_ (\(label, value) -> H.dt (H.toHtml label) >> H.dd (H.toHtml value)) rows
+ -- Tags as badges
+ let tags = metaTags meta
+ unless (null tags) $
+ H.p $ do
+ "Tags: "
+ 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 = maybe "" Prelude.id (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)
+
+-- ---------------------------------------------------------------------------
+-- Sections
+-- ---------------------------------------------------------------------------
+
+-- | 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
+ 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"
+
+-- | 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)
+
+-- ---------------------------------------------------------------------------
+-- 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
+ >>= bodyItemSteps
+ >>= unStep
+ ings = [i | StepIngredient i <- items]
+ 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)
+
+-- | 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
@@ -53,3 +297,31 @@ urlEncode = T.pack . concatMap encodeChar
| 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
diff --git a/src/Roux/Parser.hs b/src/Roux/Parser.hs
index 6389c9e..493760d 100644
--- a/src/Roux/Parser.hs
+++ b/src/Roux/Parser.hs
@@ -128,6 +128,10 @@ pLineBreak = do
_ <- P.newline
return StepBreak
+-- | Characters allowed in recipe reference paths.
+pPathChar :: Parser Char
+pPathChar = P.alphaNum P.<|> P.oneOf "./-_"
+
-- | Recipe reference: @./path/to/recipe{quantity}
pRecipeRef :: Parser StepItem
pRecipeRef = do
@@ -135,7 +139,7 @@ pRecipeRef = do
-- Consume @ and store ./ as part of the path
_ <- P.char '.'
_ <- P.char '/'
- path <- P.many (P.noneOf "{(\n\\")
+ path <- P.many pPathChar
mqty <- P.optionMaybe (P.between (P.char '{') (P.char '}') pQuantityBody)
return (StepRecipeRef (RecipeRef ("./" <> path) (join mqty)))
@@ -147,6 +151,14 @@ pIngredient = do
prep <- P.optionMaybe (P.try pPreparation)
return (StepIngredient (Ingredient (T.pack name) qty (fmap T.strip prep)))
+-- | Characters allowed in names that may include spaces (before braces).
+pMultiNameChar :: Parser Char
+pMultiNameChar = P.alphaNum P.<|> P.oneOf " .-'"
+
+-- | Characters allowed in single-word names (no braces).
+pSingleNameChar :: Parser Char
+pSingleNameChar = P.alphaNum P.<|> P.oneOf ".-'"
+
{- | Parse a name optionally followed by @{quantity}@ braces.
Used by ingredients. First tries a multi-word name with braces
@@ -156,14 +168,14 @@ pNameWithQuantity :: Parser ([Char], Maybe Quantity)
pNameWithQuantity =
P.try
( do
- name <- P.many (P.noneOf "{(\n\\")
+ name <- P.many pMultiNameChar
_ <- P.char '{'
qty <- pQuantityBody
_ <- P.char '}'
return (name, qty)
)
P.<|> do
- name <- P.many1 (P.alphaNum P.<|> P.oneOf ".-'")
+ name <- P.many1 pSingleNameChar
return (name, Nothing)
{- | Parse a name optionally followed by empty @{}@ braces.
@@ -174,12 +186,12 @@ pNameWithBraces :: Parser [Char]
pNameWithBraces =
P.try
( do
- name <- P.many (P.noneOf "{(\n\\")
+ name <- P.many pMultiNameChar
_ <- P.char '{'
_ <- P.char '}'
return name
)
- P.<|> P.many1 (P.alphaNum P.<|> P.oneOf ".-'")
+ P.<|> P.many1 pSingleNameChar
-- | Parse preparation text inside parentheses: @name(diced)
pPreparation :: Parser Text
diff --git a/src/Roux/Server.hs b/src/Roux/Server.hs
index be97d70..812f5bb 100644
--- a/src/Roux/Server.hs
+++ b/src/Roux/Server.hs
@@ -1,7 +1,8 @@
+{-# LANGUAGE OverloadedStrings #-}
+
{- | WAI application for the Roux recipe server.
-Handles HTTP requests directly via wai — no framework. Currently serves
-a single index page listing all discovered recipes.
+Handles HTTP requests directly via wai — no framework.
-}
module Roux.Server (
app,
@@ -9,6 +10,9 @@ module Roux.Server (
import Control.Monad (when)
import Data.ByteString.Lazy (ByteString)
+import Data.Char (toLower)
+import Data.List (find)
+import Data.Text (Text)
import qualified Network.HTTP.Types as HTTP
import qualified Network.Wai as Wai
@@ -31,7 +35,6 @@ app recipeDir = do
when (errs > 0) $
putStrLn $
"[roux] " <> show errs <> " had parse errors"
- -- Return the application; recipes are captured in the closure.
pure (handleRequest recipes)
-- | Route an incoming request to the appropriate handler.
@@ -39,8 +42,30 @@ handleRequest :: [Idx.RecipeInfo] -> Wai.Application
handleRequest recipes request respond =
case Wai.pathInfo request of
[] -> respond (htmlResponse (Html.indexPage recipes))
+ ["recipes", rawPath] ->
+ case lookupRecipe (urlDecodePath rawPath) recipes of
+ Just info -> respond (htmlResponse (Html.recipePage info))
+ Nothing -> respond notFound
_ -> respond notFound
+-- | Look up a recipe by filename (case-insensitive, .cook extension optional).
+lookupRecipe :: FilePath -> [Idx.RecipeInfo] -> Maybe Idx.RecipeInfo
+lookupRecipe target recipes =
+ let normalised = map toLower (stripCookExt target)
+ in find (\(Idx.RecipeInfo fp _ _) -> map toLower (stripCookExt fp) == normalised) recipes
+
+-- | Strip the .cook extension if present.
+stripCookExt :: FilePath -> FilePath
+stripCookExt fp
+ | ".cook" `isSuffixOf` fp = take (length fp - 5) fp
+ | otherwise = fp
+ where
+ isSuffixOf suffix s = suffix == drop (length s - length suffix) s
+
+-- | Decode a percent-encoded URL path segment to a FilePath.
+urlDecodePath :: Text -> FilePath
+urlDecodePath = Html.urlDecode
+
-- | Build a 200 HTML response.
htmlResponse :: ByteString -> Wai.Response
htmlResponse body =