feat: add SchemaOrgRecipe types and FromJSON parsing

2026-05-19 22:44:03 -04:00
parent 09952f0c43
commit 9586afcb46
3 changed files with 278 additions and 0 deletions
@@ -0,0 +1,224 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Roux.SchemaOrg (
+    SchemaOrgRecipe (..),
+    SchemaOrgPerson (..),
+    SchemaOrgImageObject (..),
+    SchemaOrgHowToStep (..),
+    SchemaOrgNutrition (..),
+    parseSchemaOrgRecipe,
+    schemaOrgToCooklang,
+    parseISODuration,
+) where
+
+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.Text (Text)
+import qualified Data.Text as T
+
+import Data.CookLang
+
+-- ---------------------------------------------------------------------------
+-- Data types
+-- ---------------------------------------------------------------------------
+
+-- | A schema.org Recipe object.
+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)
+
+-- | A schema.org Person (recipe author).
+data SchemaOrgPerson = SchemaOrgPerson
+    { soPersonName :: !Text
+    }
+    deriving stock (Eq, Show)
+
+-- | A schema.org ImageObject (recipe image).
+data SchemaOrgImageObject = SchemaOrgImageObject
+    { soImageObjectUrl :: !Text
+    }
+    deriving stock (Eq, Show)
+
+-- | A schema.org HowToStep (one instruction step).
+data SchemaOrgHowToStep = SchemaOrgHowToStep
+    { sohsText :: !Text
+    , sohsName :: !(Maybe Text)
+    }
+    deriving stock (Eq, Show)
+
+-- | A schema.org NutritionInformation block.
+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)
+
+-- ---------------------------------------------------------------------------
+-- Helper functions for JSON quirks
+-- ---------------------------------------------------------------------------
+
+-- | 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
+            _ -> case KM.lookup "contentUrl" obj of
+                Just (A.String u) -> u
+                _ -> ""
+     in SchemaOrgImageObject url
+
+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
+        }
+
+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
+
+lookupText :: A.Key -> A.Object -> Maybe Text
+lookupText key obj = case KM.lookup key obj of
+    Just (A.String t) -> Just t
+    _ -> Nothing
+
+-- ---------------------------------------------------------------------------
+-- FromJSON instance
+-- ---------------------------------------------------------------------------
+
+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)
+
+-- | Parse a schema.org Recipe from a JSON Value, handling @type selection.
+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") -> parseMaybe parseJSON (A.Object obj)
+        _ -> Nothing
+
+-- ---------------------------------------------------------------------------
+-- Stubs for future tasks
+-- ---------------------------------------------------------------------------
+
+-- | Convert a SchemaOrgRecipe to a Cooklang Recipe. (Stub — will be implemented in Task 3)
+schemaOrgToCooklang :: SchemaOrgRecipe -> Either String Recipe
+schemaOrgToCooklang _ = Left "Not yet implemented"
+
+-- | Parse an ISO 8601 duration string. (Stub — will be implemented in Task 2)
+parseISODuration :: Text -> Maybe Duration
+parseISODuration _ = Nothing