Add YAML front matter parsing and use metadata titles in UI

- Add extractFrontMatter: parses YAML front matter (---...---) into
  a Metadata value, returns remaining body for Cooklang parsing
- Add parseYamlLines: extracts known keys (title, author, source,
  difficulty, cuisine, course, diet, tags, image, description)
  into canonical Metadata fields
- Add parseTagList: handles both [tag1, tag2] and tag1, tag2 formats
- Index page recipeItem now takes RecipeInfo and displays riTitle
  (from metadata) instead of raw filename
- All three sort modes (alpha, tag, course) use title-aware display
- OlivierSalad example shows its metadata title correctly
This commit is contained in:
2026-05-19 10:15:14 -04:00
parent 9e15126374
commit 5eafbbe14c
3 changed files with 92 additions and 10 deletions
+1
View File
@@ -1,5 +1,6 @@
--- ---
title: Olivier Salad title: Olivier Salad
tags: salad, side
--- ---
-- TODO add source -- TODO add source
+7 -7
View File
@@ -187,7 +187,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 ! A.class_ "roux-recipes" $ mapM_ (recipeItem . Idx.riFilename) sorted in H.ul ! A.class_ "roux-recipes" $ mapM_ recipeItem sorted
-- | Render recipes grouped by tags. -- | Render recipes grouped by tags.
renderByTags :: [Idx.RecipeInfo] -> Html renderByTags :: [Idx.RecipeInfo] -> Html
@@ -234,20 +234,20 @@ 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 ! A.class_ "roux-recipes" $ mapM_ (recipeItem . Idx.riFilename) rs H.ul ! A.class_ "roux-recipes" $ mapM_ recipeItem 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 ! A.class_ "roux-recipes" $ mapM_ (recipeItem . Idx.riFilename) rs H.ul ! A.class_ "roux-recipes" $ mapM_ recipeItem rs
-- | Render a single recipe link on the index page. -- | Render a single recipe link on the index page.
recipeItem :: FilePath -> Html recipeItem :: Idx.RecipeInfo -> Html
recipeItem fp = recipeItem info =
H.li $ H.li $
H.a ! A.href (H.toValue ("/recipes/" <> urlEncode fp)) $ H.a ! A.href (H.toValue ("/recipes/" <> urlEncode (Idx.riFilename info))) $
H.toHtml (T.pack (takeBaseName fp)) H.toHtml (Idx.riTitle info)
-- | Sort key for alphabetical ordering by title, falling back to filename. -- | Sort key for alphabetical ordering by title, falling back to filename.
alphaSortKey :: Idx.RecipeInfo -> Text alphaSortKey :: Idx.RecipeInfo -> Text
+84 -3
View File
@@ -11,6 +11,8 @@ module Roux.Parser (
import Control.Monad (join) import Control.Monad (join)
import Data.Char (isDigit) import Data.Char (isDigit)
import Data.List.NonEmpty (NonEmpty ((:|))) import Data.List.NonEmpty (NonEmpty ((:|)))
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Text.Parsec as P import qualified Text.Parsec as P
@@ -40,15 +42,94 @@ data RawBlock
parseCookFile :: Text -> Either String Recipe parseCookFile :: Text -> Either String Recipe
parseCookFile input = parseCookFile input =
let trimmed = T.strip input let trimmed = T.strip input
rawBlocks = splitByBlankLines trimmed (meta, body) = extractFrontMatter trimmed
rawBlocks = splitByBlankLines body
nonEmpty = filter (not . T.null) rawBlocks nonEmpty = filter (not . T.null) rawBlocks
in case nonEmpty of in case nonEmpty of
[] -> [] ->
Right emptyRecipe Right emptyRecipe{recipeMetadata = meta}
blocks -> blocks ->
case traverse classifyBlock blocks of case traverse classifyBlock blocks of
Left err -> Left err Left err -> Left err
Right items -> Right (buildRecipe items) Right items ->
Right (buildRecipe items){recipeMetadata = meta}
-- ---------------------------------------------------------------------------
-- YAML front matter
-- ---------------------------------------------------------------------------
{- | Extract YAML front matter (between @---@ … @---@ delimiters) from the
start of a file, returning (metadata, remaining_body). If no front matter
is found, returns (emptyMetadata, input).
-}
extractFrontMatter :: Text -> (Metadata, Text)
extractFrontMatter input =
case T.stripPrefix "---\n" (T.stripStart input) of
Just afterOpen ->
case T.breakOn "\n---" afterOpen of
(yamlBlock, rest)
| not (T.null yamlBlock) ->
let meta = parseYamlLines yamlBlock
-- Skip the closing --- and any following newline
body = T.stripStart (T.drop 4 rest)
in (meta, body)
_ -> (emptyMetadata, input)
Nothing -> (emptyMetadata, input)
{- | Parse simple YAML key-value lines into a 'Metadata' value.
Supports @key: value@ pairs. Known keys are mapped to canonical fields;
unknown keys go into 'metaCustom'.
-}
parseYamlLines :: Text -> Metadata
parseYamlLines yaml =
let pairs = mapMaybe parseYamlLine (T.lines yaml)
pairMap = Map.fromList pairs
in Metadata
{ metaTitle = Map.lookup "title" pairMap
, metaServings = do
s <- Map.lookup "servings" pairMap
case reads (T.unpack s) of
[(n, "")] -> Just (n, Nothing)
_ -> Nothing
, metaAuthor = Map.lookup "author" pairMap
, metaSource = Map.lookup "source" pairMap
, metaTotalTime = Nothing
, metaPrepTime = Nothing
, metaCookTime = Nothing
, metaDifficulty = Map.lookup "difficulty" pairMap
, metaCuisine = Map.lookup "cuisine" pairMap
, metaCourse = case Map.lookup "course" pairMap of
Just c -> Just c
Nothing -> Map.lookup "category" pairMap
, metaDiet = maybe [] parseTagList (Map.lookup "diet" pairMap)
, metaTags = maybe [] parseTagList (Map.lookup "tags" pairMap)
, metaImage = case Map.lookup "image" pairMap of
Just i -> Just i
Nothing -> Map.lookup "picture" pairMap
, metaDescription = case Map.lookup "description" pairMap of
Just d -> Just d
Nothing -> Map.lookup "introduction" pairMap
, metaCustom = Map.empty
}
-- | Parse a single @key: value@ line.
parseYamlLine :: Text -> Maybe (Text, Text)
parseYamlLine line =
case T.break (== ':') line of
(key, rest)
| not (T.null key) ->
let value = T.strip (T.drop 1 rest)
in Just (T.strip (T.toLower key), value)
| otherwise -> Nothing
-- | Parse a YAML tag list: @[tag1, tag2]@ or @tag1, tag2@.
parseTagList :: Text -> [Text]
parseTagList t =
let stripped = T.strip t
content = case T.stripPrefix "[" stripped of
Just rest -> fromMaybe rest (T.stripSuffix "]" (T.strip rest))
Nothing -> stripped
in map T.strip (T.splitOn "," content)
-- --------------------------------------------------------------------------- -- ---------------------------------------------------------------------------
-- File-level structure -- File-level structure