jbrechtel/roux
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add implementation plan for schema.org JSON-LD recipe types

Browse Source
This commit is contained in:
James Brechtel
2026-05-19 22:37:08 -04:00
parent 7568f7725e
commit 09952f0c43
1 changed files with 679 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files
docs/plans/2026-05-19-schema-org-jsonld.md
+679
View File
@@ -0,0 +1,679 @@
# Schema.org JSON-LD Recipe Types Implementation Plan
> **For agentic workers:** REQUIRED SUB-SKILL: Use superpowers:subagent-driven-development (recommended) or superpowers:executing-plans to implement this plan task-by-task. Steps use checkbox (`- [ ]`) syntax for tracking.
**Goal:** Model schema.org Recipe JSON-LD as Haskell types with `FromJSON` instances and a conversion function to `Data.CookLang.Recipe`.
**Architecture:** New `Roux.SchemaOrg` module with three sections: types + FromJSON, ISO 8601 duration parsing, conversion to Cooklang Recipe. The NYT-specific `nytToCooklang` in `Roux.NYTimes` remains unchanged.
**Tech Stack:** Haskell (aeson, text), existing test data HTML files
---
### Task 1: Data types and `FromJSON` instances
**Files:**
- Create: `src/Roux/SchemaOrg.hs`
- Test: `test/Roux/SchemaOrgSpec.hs`
- [ ] **Step 1: Write failing test — verify JSON from test data parses**
Create the test file first:
```haskell
module Roux.SchemaOrgSpec (spec) where
import Data.Aeson (Value)
import qualified Data.Aeson as A
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8)
import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy)
import Roux.SchemaOrg
spec :: Spec
spec = describe "SchemaOrg" $ do
describe "parseSchemaOrgRecipe" $ do
it "parses fried-rice.html embedded JSON-LD" $ do
html <- readFile "test-data/fried-rice.html"
let decoded = decodeUtf8 <$> tryDecode (T.pack html)
decoded `shouldSatisfy` isJust
let recipe = parseSchemaOrgRecipe (fromJust decoded)
recipe `shouldSatisfy` isJust
let Just r = recipe
soName r `shouldBe` "Fried Rice"
soRecipeYield r `shouldBe` Just "4 to 6 servings"
soTotalTime r `shouldBe` Just "PT20M"
soRecipeCuisine r `shouldBe` Just "asian"
length (soRecipeIngredient r) `shouldBe` 14
length (soRecipeInstructions r) `shouldBe` 4
it "parses carrot-risotto.html embedded JSON-LD" $ do
html <- readFile "test-data/carrot-risotto.html"
let decoded = decodeUtf8 <$> tryDecode (T.pack html)
decoded `shouldSatisfy` isJust
let recipe = parseSchemaOrgRecipe (fromJust decoded)
recipe `shouldSatisfy` isJust
let Just r = recipe
soName r `shouldBe` "Carrot Risotto"
```
Add helpers at top of the test file:
```haskell
import Data.Maybe (fromJust, isJust)
-- | Extract the first schema.org Recipe JSON-LD from HTML.
tryDecode :: Text -> Maybe A.Value
tryDecode html =
case T.splitOn openTag html of
(_before : rest : _) ->
case T.splitOn "</script>" rest of
(jsonContent : _) -> A.decodeStrict (TE.encodeUtf8 (T.strip jsonContent))
_ -> Nothing
_ -> Nothing
where
openTag = "<script type=\"application/ld+json\">"
```
Add the test module to the test suite. Check `package.yaml` for how existing test modules are registered. The test file `test/Spec.hs` currently imports `Roux.NYTimesSpec` and `Roux.ParserSpec` — add `Roux.SchemaOrgSpec` similarly.
- [ ] **Step 2: Run test to verify it fails**
Run: `./hs stack test`
Expected: FAIL — module `Roux.SchemaOrg` not found, `Roux.SchemaOrgSpec` not found
- [ ] **Step 3: Register test module in test/Spec.hs**
Modify `test/Spec.hs` to add:
```haskell
import qualified Roux.SchemaOrgSpec
```
And add to the test group:
```haskell
schemaOrgTests <- testSpec "SchemaOrg" Roux.SchemaOrgSpec.spec
```
And add `schemaOrgTests` to the `testGroup`.
- [ ] **Step 4: Create `Roux.SchemaOrg` module with data types and `FromJSON` instances**
Create `src/Roux/SchemaOrg.hs`:
```haskell
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module Roux.SchemaOrg (
SchemaOrgRecipe (..),
SchemaOrgPerson (..),
SchemaOrgImageObject (..),
SchemaOrgHowToStep (..),
SchemaOrgNutrition (..),
parseSchemaOrgRecipe,
schemaOrgToCooklang,
parseISODuration,
) where
import Data.Aeson (FromJSON (..), Value (..), (.:), (.:?), (.!=))
import qualified Data.Aeson as A
import qualified Data.Aeson.KeyMap as KM
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Data.CookLang
-- ---------------------------------------------------------------------------
-- Types
-- ---------------------------------------------------------------------------
data SchemaOrgRecipe = SchemaOrgRecipe
{ soName :: !Text
, soDescription :: !(Maybe Text)
, soUrl :: !(Maybe Text)
, soTotalTime :: !(Maybe Text)
, soPrepTime :: !(Maybe Text)
, soCookTime :: !(Maybe Text)
, soRecipeYield :: !(Maybe Text)
, soRecipeCuisine :: !(Maybe Text)
, soRecipeCategory :: !(Maybe Text)
, soKeywords :: ![Text]
, soAuthor :: !(Maybe SchemaOrgPerson)
, soImage :: ![SchemaOrgImageObject]
, soDatePublished :: !(Maybe Text)
, soNutrition :: !(Maybe SchemaOrgNutrition)
, soRecipeIngredient :: ![Text]
, soRecipeInstructions :: ![SchemaOrgHowToStep]
}
deriving stock (Eq, Show, Generic)
data SchemaOrgPerson = SchemaOrgPerson
{ sopName :: !Text }
deriving stock (Eq, Show, Generic)
data SchemaOrgImageObject = SchemaOrgImageObject
{ soiUrl :: !Text }
deriving stock (Eq, Show, Generic)
data SchemaOrgHowToStep = SchemaOrgHowToStep
{ sohsText :: !Text
, sohsName :: !(Maybe Text)
}
deriving stock (Eq, Show, Generic)
data SchemaOrgNutrition = SchemaOrgNutrition
{ sonCalories :: !(Maybe Int)
, sonFatContent :: !(Maybe Text)
, sonCarbohydrateContent :: !(Maybe Text)
, sonProteinContent :: !(Maybe Text)
, sonSodiumContent :: !(Maybe Text)
, sonSugarContent :: !(Maybe Text)
, sonFiberContent :: !(Maybe Text)
, sonUnsaturatedFatContent :: !(Maybe Text)
, sonSaturatedFatContent :: !(Maybe Text)
, sonTransFatContent :: !(Maybe Text)
, sonCholesterolContent :: !(Maybe Text)
}
deriving stock (Eq, Show, Generic)
```
- [ ] **Step 5: Add custom `FromJSON` instances**
The schema.org JSON has several quirks that need custom parsing. Add these after the types:
```haskell
-- | Parse an optional text-or-array field as a single Text (first if array).
parseOptionalTextOrArray :: A.Object -> A.Key -> Maybe Text
parseOptionalTextOrArray obj key = case KM.lookup key obj of
Just (A.String t) -> Just t
Just (A.Array arr)
| (A.String t : _) <- foldr (:) [] arr -> Just t
_ -> Nothing
-- | Parse an optional text-or-array field as a list of Text.
parseOptionalTextList :: A.Object -> A.Key -> [Text]
parseOptionalTextList obj key = case KM.lookup key obj of
Just (A.String t) -> map T.strip (T.splitOn "," t)
Just (A.Array arr) -> mapMaybe (\case A.String t -> Just t; _ -> Nothing) (foldr (:) [] arr)
_ -> []
-- | Parse image: single URL string, single ImageObject dict, or array of ImageObject dicts.
parseImages :: A.Object -> A.Key -> [SchemaOrgImageObject]
parseImages obj key = case KM.lookup key obj of
Just (A.String url) -> [SchemaOrgImageObject url]
Just (A.Object inner) -> [parseImageObject inner]
Just (A.Array arr) -> mapMaybe (\case A.Object o -> Just (parseImageObject o); _ -> Nothing) (foldr (:) [] arr)
_ -> []
parseImageObject :: A.Object -> SchemaOrgImageObject
parseImageObject obj =
let url = case KM.lookup "url" obj of
Just (A.String u) -> u
-- Some use contentUrl instead of url
Just (A.String u) -> u
_ -> case KM.lookup "contentUrl" obj of
Just (A.String u) -> u
_ -> ""
in SchemaOrgImageObject url
```
Wait, there's a pattern match issue above. Let me correct:
```haskell
parseImageObject :: A.Object -> SchemaOrgImageObject
parseImageObject obj =
let url = case KM.lookup "url" obj of
Just (A.String u) -> u
_ -> case KM.lookup "contentUrl" obj of
Just (A.String u) -> u
_ -> ""
in SchemaOrgImageObject url
```
Now the main `FromJSON` instance for `SchemaOrgRecipe`:
```haskell
instance FromJSON SchemaOrgRecipe where
parseJSON = A.withObject "SchemaOrgRecipe" $ \obj ->
SchemaOrgRecipe
<$> obj .: "name"
<*> obj .:? "description"
<*> obj .:? "url"
<*> obj .:? "totalTime"
<*> obj .:? "prepTime"
<*> obj .:? "cookTime"
<*> obj .:? "recipeYield"
<*> pure (parseOptionalTextOrArray obj "recipeCuisine")
<*> pure (parseOptionalTextOrArray obj "recipeCategory")
<*> pure (parseOptionalTextList obj "keywords")
<*> pure (parsePerson obj)
<*> pure (parseImages obj "image")
<*> obj .:? "datePublished"
<*> pure (parseNutrition obj)
<*> obj .:? "recipeIngredient" .!= []
<*> pure (parseHowToSteps obj)
```
Helpers:
```haskell
parsePerson :: A.Object -> Maybe SchemaOrgPerson
parsePerson obj = case KM.lookup "author" obj of
Just (A.Object inner) ->
case KM.lookup "name" inner of
Just (A.String n) -> Just (SchemaOrgPerson n)
_ -> Nothing
_ -> Nothing
parseNutrition :: A.Object -> Maybe SchemaOrgNutrition
parseNutrition obj = case KM.lookup "nutrition" obj of
Just (A.Object inner) -> Just (parseNutritionObject inner)
_ -> Nothing
parseNutritionObject :: A.Object -> SchemaOrgNutrition
parseNutritionObject obj =
SchemaOrgNutrition
{ sonCalories = parseInt "calories" obj
, sonFatContent = lookupText "fatContent" obj
, sonCarbohydrateContent = lookupText "carbohydrateContent" obj
, sonProteinContent = lookupText "proteinContent" obj
, sonSodiumContent = lookupText "sodiumContent" obj
, sonSugarContent = lookupText "sugarContent" obj
, sonFiberContent = lookupText "fiberContent" obj
, sonUnsaturatedFatContent = lookupText "unsaturatedFatContent" obj
, sonSaturatedFatContent = lookupText "saturatedFatContent" obj
, sonTransFatContent = lookupText "transFatContent" obj
, sonCholesterolContent = lookupText "cholesterolContent" obj
}
parseHowToSteps :: A.Object -> [SchemaOrgHowToStep]
parseHowToSteps obj = case KM.lookup "recipeInstructions" obj of
Just (A.Object inner) -> [parseHowToStep inner]
Just (A.Array arr) -> mapMaybe (\case A.Object o -> Just (parseHowToStep o); _ -> Nothing) (foldr (:) [] arr)
_ -> []
parseHowToStep :: A.Object -> SchemaOrgHowToStep
parseHowToStep obj =
SchemaOrgHowToStep
{ sohsText = fromMaybe "" (lookupText "text" obj)
, sohsName = lookupText "name" obj
}
-- | Parse an int field (number values in JSON-LD).
parseInt :: A.Key -> A.Object -> Maybe Int
parseInt key obj = case KM.lookup key obj of
Just (A.Number n) -> Just (floor n)
Just (A.String t) ->
case reads (T.unpack t) of
[(n, "")] -> Just n
_ -> Nothing
_ -> Nothing
-- | Look up a text field.
lookupText :: A.Key -> A.Object -> Maybe Text
lookupText key obj = case KM.lookup key obj of
Just (A.String t) -> Just t
_ -> Nothing
```
- [ ] **Step 6: Add `parseSchemaOrgRecipe` entry point**
```haskell
-- | Parse a schema.org Recipe from an arbitrary JSON Value.
parseSchemaOrgRecipe :: A.Value -> Maybe SchemaOrgRecipe
parseSchemaOrgRecipe val = case A.parseMaybe parseJSON val of
Just r -> Just r
Nothing -> case val of
A.Array arr -> case foldr (:) [] arr of
(A.Object obj : _) -> parseFromObject obj
_ -> Nothing
A.Object obj -> parseFromObject obj
_ -> Nothing
where
parseFromObject obj = case KM.lookup "@type" obj of
Just (A.String "Recipe") -> A.parseMaybe parseJSON (A.Object obj)
_ -> Nothing
```
Actually, this is getting complex. Let me simplify:
```haskell
-- | Parse a schema.org Recipe from a JSON Value.
parseSchemaOrgRecipe :: A.Value -> Maybe SchemaOrgRecipe
parseSchemaOrgRecipe val = do
obj <- case val of
A.Object o -> Just o
A.Array arr -> case foldr (:) [] arr of
(A.Object o : _) -> Just o
_ -> Nothing
_ -> Nothing
case KM.lookup "@type" obj of
Just (A.String "Recipe") -> A.parseMaybe parseJSON (A.Object obj)
_ -> Nothing
```
- [ ] **Step 7: Build and test**
Run: `./hs stack build`
Expected: Compiles successfully.
Run: `./hs stack test`
Expected: Tests should pass if the JSON-LD parses correctly. If not, debug the parsing.
- [ ] **Step 8: Remove unused imports**
Check for any unused imports flagged by `-Werror` and clean them up.
- [ ] **Step 9: Commit**
```bash
git add src/Roux/SchemaOrg.hs test/Roux/SchemaOrgSpec.hs test/Spec.hs
git commit -m "feat: add SchemaOrgRecipe types and FromJSON parsing"
```
---
### Task 2: ISO 8601 duration parsing
**Files:**
- Modify: `src/Roux/SchemaOrg.hs` — add `parseISODuration`
- [ ] **Step 1: Add `parseISODuration` function**
Add to `src/Roux/SchemaOrg.hs`:
```haskell
-- | Parse an ISO 8601 duration string into a Cooklang Duration.
-- Supports formats like PT20M, PT1H30M, P1DT2H, PT1H, PT30M, P1D.
parseISODuration :: Text -> Maybe Duration
parseISODuration t
| not ("P" `T.isPrefixOf` t) = Nothing
| otherwise = do
let rest = T.drop 1 t -- drop the P
(daysStr, afterDays) = T.break (== 'T') rest
days = if T.null daysStr then 0 else parseNumber daysStr
timePart = T.drop 1 afterDays -- drop the T
(hours, minutes, seconds) = parseTimeComponent timePart
totalMinutes = fromIntegral days * 24 * 60 + fromIntegral hours * 60 + fromIntegral minutes
if totalMinutes > 0
then Just (Duration (toRational (totalMinutes :: Int)) (Just "minutes"))
else Nothing
where
parseNumber :: Text -> Int
parseNumber = fromMaybe 0 . fmap (floor :: Double -> Int) . readMaybe . T.unpack
parseTimeComponent :: Text -> (Int, Int, Int)
parseTimeComponent tc =
let (hours, rest1) = parseUnit "H" tc
(minutes, rest2) = parseUnit "M" rest1
(seconds, _) = parseUnit "S" rest2
in (hours, minutes, seconds)
parseUnit :: Text -> Text -> (Int, Text)
parseUnit unit tc =
let (numStr, after) = T.break (\c -> c == 'H' || c == 'M' || c == 'S') tc
in case T.uncons after of
Just (c, rest) | T.singleton c == unit ->
(fromMaybe 0 (readMaybe (T.unpack numStr)), rest)
_ -> (0, tc)
```
Add the import for `readMaybe` at the top if it's not already imported (from `Text.Read` or from `Roux.NYTimes`' local `readMaybe`). Since `readMaybe` is defined locally in `Roux.NYTimes`, define it locally here too:
```haskell
readMaybe :: (Read a) => String -> Maybe a
readMaybe s = case reads s of
[(x, "")] -> Just x
_ -> Nothing
```
- [ ] **Step 2: Add test for duration parsing**
Add to `test/Roux/SchemaOrgSpec.hs` in the SchemaOrg describe block:
```haskell
describe "parseISODuration" $ do
let chk input expected = it (T.unpack input <> " -> " <> show expected) $
parseISODuration input `shouldBe` expected
chk "PT20M" (Just (Duration 20 (Just "minutes")))
chk "PT1H" (Just (Duration 60 (Just "minutes")))
chk "PT1H30M" (Just (Duration 90 (Just "minutes")))
chk "P1D" (Just (Duration 1440 (Just "minutes")))
chk "P1DT2H" (Just (Duration 1560 (Just "minutes")))
chk "" Nothing
chk "20 minutes" Nothing
```
- [ ] **Step 3: Build and test**
Run: `./hs stack build && ./hs stack test`
- [ ] **Step 4: Commit**
```bash
git add src/Roux/SchemaOrg.hs test/Roux/SchemaOrgSpec.hs
git commit -m "feat: add parseISODuration for ISO 8601 duration parsing"
```
---
### Task 3: Conversion function `schemaOrgToCooklang`
**Files:**
- Modify: `src/Roux/SchemaOrg.hs` — add `schemaOrgToCooklang`
- [ ] **Step 1: Add test for conversion**
Add to `test/Roux/SchemaOrgSpec.hs`:
```haskell
describe "schemaOrgToCooklang" $ do
it "converts fried-rice schema.org recipe to Cooklang" $ do
html <- readFile "test-data/fried-rice.html"
let decoded = decodeUtf8 <$> tryDecode (T.pack html)
recipe = fromJust decoded >>= parseSchemaOrgRecipe
case recipe of
Just r -> case schemaOrgToCooklang r of
Right cook -> do
metaTitle (recipeMetadata cook) `shouldBe` Just "Fried Rice"
metaSource (recipeMetadata cook) `shouldBe` Just "https://cooking.nytimes.com/recipes/12177-fried-rice"
metaCourse (recipeMetadata cook) `shouldBe` Just "one pot, side dish"
metaCuisine (recipeMetadata cook) `shouldBe` Just "asian"
metaTags (recipeMetadata cook) `shouldContain` ["egg", "rice", "vegetarian"]
metaDescription (recipeMetadata cook) `shouldSatisfy` isJust
let sections = recipeSections cook
length (NE.toList sections) `shouldBe` 2 -- ingredients + method
Left err -> fail (T.unpack err)
Nothing -> fail "Failed to parse schema.org recipe"
```
Add imports at top:
```haskell
import qualified Data.List.NonEmpty as NE
```
- [ ] **Step 2: Implement `schemaOrgToCooklang`**
Add to `src/Roux/SchemaOrg.hs`, after the types and helpers:
```haskell
-- | Convert a SchemaOrgRecipe to a Cooklang Recipe.
schemaOrgToCooklang :: SchemaOrgRecipe -> Either String Recipe
schemaOrgToCooklang r =
Right Recipe
{ recipeMetadata = buildMetadata r
, recipeSections = buildSections r
}
buildMetadata :: SchemaOrgRecipe -> Metadata
buildMetadata r =
emptyMetadata
{ metaTitle = Just (soName r)
, metaDescription = soDescription r
, metaSource = soUrl r
, metaTotalTime = soTotalTime r >>= parseISODuration
, metaPrepTime = soPrepTime r >>= parseISODuration
, metaCookTime = soCookTime r >>= parseISODuration
, metaServings = parseServings =<< soRecipeYield r
, metaAuthor = sopName <$> soAuthor r
, metaCourse = soRecipeCategory r
, metaCuisine = soRecipeCuisine r
, metaTags = soKeywords r
, metaImage = case soImage r of
(img : _) -> Just (soiUrl img)
[] -> Nothing
}
buildSections :: SchemaOrgRecipe -> NonEmpty Section
buildSections r =
let ingSection = buildIngredientSection (soRecipeIngredient r)
methodSection = buildMethodSection (soRecipeInstructions r)
sections = catMaybes [Just ingSection, methodSection]
in case sections of
(s : ss) -> s :| ss
[] -> Section Nothing (SecStep (Step []) :| []) :| []
buildIngredientSection :: [Text] -> Section
buildIngredientSection ings
| null ings = Section Nothing (SecStep (Step []) :| [])
| otherwise =
let items = map (\t -> StepText (", " <> t)) ings
step = Step items
in Section (Just "Ingredients") (SecStep step :| [])
buildMethodSection :: [SchemaOrgHowToStep] -> Maybe Section
buildMethodSection [] = Nothing
buildMethodSection steps =
let stepItems = map (\[s] -> s) (map (\s -> [SecStep (Step [StepText (sohsText s)])]) steps)
in Just (Section (Just "Method") (fromList stepItems))
-- | Parse a servings string like "4 to 6 servings".
parseServings :: Text -> Maybe (Int, Maybe Text)
parseServings t =
case T.words t of
(numStr : rest) -> do
n <- readMaybe (T.unpack numStr)
let unit = case rest of
(_ : _) -> Just (T.intercalate " " rest)
[] -> Nothing
Just (n, unit)
_ -> Nothing
```
Add `catMaybes` to imports if not already imported:
```haskell
import Data.Maybe (catMaybes, fromMaybe, mapMaybe)
```
Add `NE.fromList` — make sure `Data.List.NonEmpty` is imported, add `fromList`:
```haskell
import Data.List.NonEmpty (NonEmpty ((:|)), fromList)
```
- [ ] **Step 3: Build and test**
Run: `./hs stack build`
Expected: Compiles successfully.
Run: `./hs stack test`
Expected: All tests pass.
- [ ] **Step 4: Verify `readMaybe` is defined**
Check that `readMaybe` is defined in SchemaOrg.hs (it's used by `parseISODuration` and `parseServings`). Add the local definition if needed:
```haskell
readMaybe :: (Read a) => String -> Maybe a
readMaybe s = case reads s of
[(x, "")] -> Just x
_ -> Nothing
```
- [ ] **Step 5: Commit**
```bash
git add src/Roux/SchemaOrg.hs test/Roux/SchemaOrgSpec.hs
git commit -m "feat: add schemaOrgToCooklang conversion function"
```
---
### Task 4: Wire up re-exports in `Roux.hs`
**Files:**
- Modify: `src/Roux.hs`
- [ ] **Step 1: Add SchemaOrg to re-exports**
Current `src/Roux.hs`:
```haskell
module Roux (
app,
module X,
) where
import Data.CookLang as X
import Roux.Server (app)
```
Add:
```haskell
import Roux.SchemaOrg as X
```
- [ ] **Step 2: Build and test**
Run: `./hs stack build`
Expected: Compiles successfully.
- [ ] **Step 3: Commit**
```bash
git add src/Roux.hs
git commit -m "feat: re-export SchemaOrg types from Roux module"
```
---
### Task 5: Fourmolu formatting and final build
**Files:**
- All modified files
- [ ] **Step 1: Format all Haskell sources**
```bash
cd /work/personal/roux/roux-main
./hs fourmolu -i src/Roux/SchemaOrg.hs src/Roux.hs test/Roux/SchemaOrgSpec.hs test/Spec.hs
```
- [ ] **Step 2: Full build and test**
```bash
./hs stack build && ./hs stack test
```
Expected: All tests pass.
- [ ] **Step 3: Fix ownership if needed**
```bash
find src test -user root -ls 2>/dev/null && sudo chown -R $(id -u):$(id -g) src test || true
```
- [ ] **Step 4: Commit any formatting changes**
```bash
git add -A
git commit -m "chore: format code with fourmolu"
```