feat: add schemaOrgToCooklang conversion function
This commit is contained in:
+64
-4
@@ -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.
|
||||
|
||||
@@ -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"
|
||||
|
||||
Reference in New Issue
Block a user