feat: add schemaOrgToCooklang conversion function

This commit is contained in:
2026-05-19 22:50:48 -04:00
parent 1addddd8fc
commit 3e55f0a7d2
2 changed files with 102 additions and 8 deletions
+64 -4
View File
@@ -17,7 +17,8 @@ import Data.Aeson (FromJSON (..), (.!=), (.:), (.:?))
import qualified Data.Aeson as A
import qualified Data.Aeson.KeyMap as KM
import Data.Aeson.Types (parseMaybe)
import Data.Maybe (fromMaybe, mapMaybe)
import Data.List.NonEmpty (NonEmpty ((:|)), fromList)
import Data.Maybe (catMaybes, fromMaybe, mapMaybe)
import Data.Text (Text)
import qualified Data.Text as T
@@ -213,12 +214,71 @@ parseSchemaOrgRecipe val = do
_ -> Nothing
-- ---------------------------------------------------------------------------
-- Stubs for future tasks
-- Conversion to Cooklang Recipe
-- ---------------------------------------------------------------------------
-- | Convert a SchemaOrgRecipe to a Cooklang Recipe. (Stub — will be implemented in Task 3)
-- | Convert a SchemaOrgRecipe to a Cooklang Recipe.
schemaOrgToCooklang :: SchemaOrgRecipe -> Either String Recipe
schemaOrgToCooklang _ = Left "Not yet implemented"
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 = soPersonName <$> soAuthor r
, metaCourse = soRecipeCategory r
, metaCuisine = soRecipeCuisine r
, metaTags = soKeywords r
, metaImage = case soImage r of
(img : _) -> Just (soImageObjectUrl 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 = concatMap (\t -> [StepText (", "), StepText t]) ings
step = Step items
in Section (Just "Ingredients") (SecStep step :| [])
buildMethodSection :: [SchemaOrgHowToStep] -> Maybe Section
buildMethodSection [] = Nothing
buildMethodSection steps =
let stepItems = 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
{- | Parse an ISO 8601 duration string into a Cooklang Duration.
Supports formats like PT20M, PT1H30M, P1DT2H, P1D.
+38 -4
View File
@@ -1,7 +1,8 @@
module Roux.SchemaOrgSpec (spec) where
import qualified Data.Aeson as A
import Data.CookLang (Duration (..))
import Data.Aeson (Value, decodeStrict)
import Data.CookLang (Duration (..), Metadata (..), Recipe (..))
import Data.List.NonEmpty (toList)
import Data.Maybe (fromJust, isJust)
import Data.Text (Text)
import qualified Data.Text as T
@@ -11,14 +12,14 @@ import Test.Hspec (Spec, describe, expectationFailure, it, shouldBe, shouldSatis
import Roux.SchemaOrg
-- | Extract the first schema.org Recipe JSON-LD from HTML.
tryDecode :: Text -> Maybe A.Value
tryDecode :: Text -> Maybe Value
tryDecode html =
case T.splitOn "<script type=\"application/ld+json" html of
(_before : rest : _) ->
-- Skip past the closing > of the opening script tag, which may have extra attributes
let afterOpenTag = T.drop 1 (T.dropWhile (/= '>') rest)
in case T.splitOn "</script>" afterOpenTag of
(jsonContent : _) -> A.decodeStrict (TE.encodeUtf8 (T.strip jsonContent))
(jsonContent : _) -> decodeStrict (TE.encodeUtf8 (T.strip jsonContent))
_ -> Nothing
_ -> Nothing
@@ -63,3 +64,36 @@ spec = describe "SchemaOrg" $ do
it "PT30M -> 30 minutes" $ chk "PT30M" (Just (Duration 30 (Just "minutes")))
it "empty string -> Nothing" $ chk "" Nothing
it "human-readable -> Nothing" $ chk "20 minutes" Nothing
describe "schemaOrgToCooklang" $ do
it "converts fried-rice schema.org recipe to Cooklang" $ do
html <- readFile "test-data/fried-rice.html"
let decoded = tryDecode (T.pack html)
recipe = parseSchemaOrgRecipe (fromJust decoded)
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"
metaTotalTime (recipeMetadata cook) `shouldBe` Just (Duration 20 (Just "minutes"))
metaTags (recipeMetadata cook) `shouldBe` ["egg", "rice", "vegetarian"]
metaDescription (recipeMetadata cook) `shouldSatisfy` isJust
let sections = toList (recipeSections cook)
length sections `shouldBe` 2
Left err -> fail err
Nothing -> fail "Failed to parse schema.org recipe"
it "converts carrot-risotto schema.org recipe to Cooklang" $ do
html <- readFile "test-data/carrot-risotto.html"
let decoded = tryDecode (T.pack html)
recipe = parseSchemaOrgRecipe (fromJust decoded)
case recipe of
Just r -> case schemaOrgToCooklang r of
Right cook -> do
metaTitle (recipeMetadata cook) `shouldBe` Just "Carrot Risotto With Chile Crisp"
metaAuthor (recipeMetadata cook) `shouldBe` Just "Alexa Weibel"
metaTags (recipeMetadata cook) `shouldSatisfy` (not . null)
Left err -> fail err
Nothing -> fail "Failed to parse schema.org recipe"