Add NYTimes recipe extraction from __NEXT_DATA__ JSON tag

- Add Roux.NYTimes module with:
  - extractNextData: finds <script id="__NEXT_DATA__"> tag in HTML
    and parses its JSON content via aeson
  - parseNYTRecipe: maps NYTimes recipe JSON structure into a
    typed intermediate representation (NYTRecipe, NYTIngredientGroup,
    NYTIngredientItem, NYTStepGroup, NYTStepItem)
- Supports all NYTimes Cooking data: title, URL, total time, yield,
  topnote, ingredient groups (with section names), step groups
- Add aeson to dependencies
- Add 4 tests: extraction + parsing for both fried-rice and
  carrot-risotto example HTML files
- Wire NYTimesSpec into test runner

package.yaml

@@ -28,6 +28,7 @@ ghc-options:
 
 dependencies:
   - base >= 4.7 && < 5
+  - aeson
   - blaze-html
   - blaze-markup
   - bytestring

roux-server.cabal

@@ -18,6 +18,7 @@ library
   exposed-modules:
       Roux
       Roux.Html
+      Roux.NYTimes
       Roux.Parser
       Roux.RecipeIndex
       Roux.Server
@@ -35,7 +36,8 @@ library
       TupleSections
   ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
   build-depends:
-      base >=4.7 && <5
+      aeson
+    , base >=4.7 && <5
     , blaze-html
     , blaze-markup
     , bytestring
@@ -66,7 +68,8 @@ executable check-recipes
       TupleSections
   ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
   build-depends:
-      base >=4.7 && <5
+      aeson
+    , base >=4.7 && <5
     , blaze-html
     , blaze-markup
     , bytestring
@@ -98,7 +101,8 @@ executable roux-server
       TupleSections
   ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
   build-depends:
-      base >=4.7 && <5
+      aeson
+    , base >=4.7 && <5
     , blaze-html
     , blaze-markup
     , bytestring
@@ -120,6 +124,7 @@ test-suite roux-server-test
   type: exitcode-stdio-1.0
   main-is: Spec.hs
   other-modules:
+      Roux.NYTimesSpec
       Roux.ParserSpec
       Paths_roux_server
   autogen-modules:
@@ -133,7 +138,8 @@ test-suite roux-server-test
       TupleSections
   ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
   build-depends:
-      base >=4.7 && <5
+      aeson
+    , base >=4.7 && <5
     , blaze-html
     , blaze-markup
     , bytestring

src/Roux/NYTimes.hs

@@ -0,0 +1,207 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+{- | Extractor for NYTimes Cooking recipe data from HTML pages.
+
+NYTimes recipe pages embed the recipe data in a @<script id="__NEXT_DATA__">@
+tag as JSON.  This module extracts that JSON and parses it into a
+structured intermediate representation.
+-}
+module Roux.NYTimes (
+    NYTRecipe (..),
+    NYTIngredientGroup (..),
+    NYTIngredientItem (..),
+    NYTStepGroup (..),
+    NYTStepItem (..),
+    extractNextData,
+    parseNYTRecipe,
+) where
+
+import Data.Aeson (Value (..))
+import qualified Data.Aeson as A
+import Data.Aeson.Key (Key)
+import qualified Data.Aeson.KeyMap as KM
+import Data.Maybe (mapMaybe)
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+
+-- ---------------------------------------------------------------------------
+-- Intermediate data types
+-- ---------------------------------------------------------------------------
+
+data NYTRecipe = NYTRecipe
+    { nytTitle :: !Text
+    , nytUrl :: !(Maybe Text)
+    , nytTotalTime :: !(Maybe Text)
+    , nytRecipeYield :: !(Maybe Text)
+    , nytTopnote :: !(Maybe Text)
+    , nytIngredientGroups :: ![NYTIngredientGroup]
+    , nytStepGroups :: ![NYTStepGroup]
+    }
+    deriving stock (Eq, Show)
+
+data NYTIngredientGroup = NYTIngredientGroup
+    { nytGroupName :: !Text
+    , nytIngredients :: ![NYTIngredientItem]
+    }
+    deriving stock (Eq, Show)
+
+data NYTIngredientItem = NYTIngredientItem
+    { nytIngredientText :: !Text
+    , nytIngredientQuantity :: !Text
+    }
+    deriving stock (Eq, Show)
+
+data NYTStepGroup = NYTStepGroup
+    { nytStepGroupName :: !Text
+    , nytSteps :: ![NYTStepItem]
+    }
+    deriving stock (Eq, Show)
+
+data NYTStepItem = NYTStepItem
+    { nytStepNumber :: !Int
+    , nytStepDescription :: !Text
+    }
+    deriving stock (Eq, Show)
+
+-- ---------------------------------------------------------------------------
+-- JSON extraction from HTML
+-- ---------------------------------------------------------------------------
+
+-- | Extract the JSON value from the @<script id="__NEXT_DATA__">@ tag.
+extractNextData :: Text -> Maybe A.Value
+extractNextData html =
+    case T.splitOn openTag html of
+        (_before : rest : _) ->
+            case T.splitOn closeTag rest of
+                (jsonContent : _) -> A.decodeStrict (TE.encodeUtf8 (T.strip jsonContent))
+                _ -> Nothing
+        _ -> Nothing
+  where
+    openTag = "<script id=\"__NEXT_DATA__\" type=\"application/json\">"
+    closeTag = "</script>"
+
+-- ---------------------------------------------------------------------------
+-- JSON parsing
+-- ---------------------------------------------------------------------------
+
+parseNYTRecipe :: A.Value -> Maybe NYTRecipe
+parseNYTRecipe val = do
+    obj <- asObject val
+    props <- asObject =<< lookupObj "props" obj
+    pageProps <- asObject =<< lookupObj "pageProps" props
+    recipe <- asObject =<< lookupObj "recipe" pageProps
+
+    title <- lookupText "title" recipe
+    let url = lookupMaybeText "fullUrl" recipe
+        topnote = lookupMaybeText "topnote" recipe
+        totalTime = lookupMaybeText "totalTime" recipe
+        recipeYield = lookupMaybeText "recipeYield" recipe
+
+    let ingredientGroups = case lookupMaybeArr "ingredients" recipe of
+            Just ings -> mapMaybe parseIngredientGroup ings
+            Nothing -> []
+        stepGroups = case lookupMaybeArr "steps" recipe of
+            Just steps -> mapMaybe parseStepGroup steps
+            Nothing -> []
+
+    Just
+        NYTRecipe
+            { nytTitle = title
+            , nytUrl = url
+            , nytTotalTime = totalTime
+            , nytRecipeYield = recipeYield
+            , nytTopnote = topnote
+            , nytIngredientGroups = ingredientGroups
+            , nytStepGroups = stepGroups
+            }
+
+parseIngredientGroup :: Value -> Maybe NYTIngredientGroup
+parseIngredientGroup val = do
+    obj <- asObject val
+    let name = fromMaybe "" (lookupMaybeText "name" obj)
+    items <- lookupArr "ingredients" obj
+    Just
+        NYTIngredientGroup
+            { nytGroupName = name
+            , nytIngredients = mapMaybe parseIngredientItem items
+            }
+
+parseIngredientItem :: Value -> Maybe NYTIngredientItem
+parseIngredientItem val = do
+    obj <- asObject val
+    text <- lookupText "text" obj
+    let quantity = fromMaybe "" (lookupMaybeText "quantity" obj)
+    Just
+        NYTIngredientItem
+            { nytIngredientText = text
+            , nytIngredientQuantity = quantity
+            }
+
+parseStepGroup :: Value -> Maybe NYTStepGroup
+parseStepGroup val = do
+    obj <- asObject val
+    let name = fromMaybe "" (lookupMaybeText "name" obj)
+    items <- lookupArr "steps" obj
+    Just
+        NYTStepGroup
+            { nytStepGroupName = name
+            , nytSteps = mapMaybe parseStepItem items
+            }
+
+parseStepItem :: Value -> Maybe NYTStepItem
+parseStepItem val = do
+    obj <- asObject val
+    num <- lookupInt "number" obj
+    desc <- lookupText "description" obj
+    Just
+        NYTStepItem
+            { nytStepNumber = num
+            , nytStepDescription = desc
+            }
+
+-- ---------------------------------------------------------------------------
+-- Helpers for navigating Aeson values
+-- ---------------------------------------------------------------------------
+
+asObject :: Value -> Maybe A.Object
+asObject (A.Object o) = Just o
+asObject _ = Nothing
+
+-- | Look up a required object value.
+lookupObj :: Key -> A.Object -> Maybe Value
+lookupObj = KM.lookup
+
+-- | Look up a required text field.
+lookupText :: Key -> A.Object -> Maybe Text
+lookupText k obj = case KM.lookup k obj of
+    Just (A.String t) -> Just t
+    _ -> Nothing
+
+-- | Look up an optional text field (missing or null returns Nothing).
+lookupMaybeText :: Key -> A.Object -> Maybe Text
+lookupMaybeText k obj = case KM.lookup k obj of
+    Just (A.String t) -> Just t
+    _ -> Nothing
+
+-- | Look up a required int field.
+lookupInt :: Key -> A.Object -> Maybe Int
+lookupInt k obj = case KM.lookup k obj of
+    Just (A.Number n) -> Just (floor n)
+    _ -> Nothing
+
+-- | Look up a required array field.
+lookupArr :: Key -> A.Object -> Maybe [Value]
+lookupArr k obj = case KM.lookup k obj of
+    Just (A.Array arr) -> Just (foldr (:) [] arr)
+    _ -> Nothing
+
+-- | Look up an optional array field.
+lookupMaybeArr :: Key -> A.Object -> Maybe [Value]
+lookupMaybeArr k obj = case KM.lookup k obj of
+    Just (A.Array arr) -> Just (foldr (:) [] arr)
+    _ -> Nothing
+
+fromMaybe :: a -> Maybe a -> a
+fromMaybe def Nothing = def
+fromMaybe _ (Just x) = x

test/Roux/NYTimesSpec.hs

@@ -0,0 +1,76 @@
+module Roux.NYTimesSpec (spec) where
+
+import qualified Data.Text.IO as TIO
+import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy)
+
+import Roux.NYTimes
+
+spec :: Spec
+spec = do
+    describe "extractNextData" $ do
+        it "extracts JSON from fried-rice.html" $ do
+            html <- TIO.readFile "test-data/fried-rice.html"
+            let result = extractNextData html
+            result `shouldSatisfy` isJust
+
+        it "extracts JSON from carrot-risotto.html" $ do
+            html <- TIO.readFile "test-data/carrot-risotto.html"
+            let result = extractNextData html
+            result `shouldSatisfy` isJust
+
+    describe "parseNYTRecipe" $ do
+        it "parses fried-rice.html recipe correctly" $ do
+            html <- TIO.readFile "test-data/fried-rice.html"
+            let result = do
+                    val <- extractNextData html
+                    parseNYTRecipe val
+            case result of
+                Nothing -> error "failed to parse fried-rice recipe"
+                Just recipe -> do
+                    nytTitle recipe `shouldBe` "Fried Rice"
+                    nytUrl recipe `shouldBe` Just "https://cooking.nytimes.com/recipes/12177-fried-rice"
+                    nytTotalTime recipe `shouldBe` Just "20 minutes"
+                    nytRecipeYield recipe `shouldBe` Just "4 to 6 servings"
+                    nytTopnote recipe `shouldSatisfy` isJust
+                    length (nytIngredientGroups recipe) `shouldBe` 1
+                    case nytIngredientGroups recipe of
+                        [group] -> do
+                            length (nytIngredients group) `shouldBe` 14
+                            case nytIngredients group of
+                                (firstIng : _) -> do
+                                    nytIngredientText firstIng `shouldBe` "tablespoons neutral oil, like canola or grapeseed"
+                                    nytIngredientQuantity firstIng `shouldBe` "3"
+                                [] -> error "empty ingredient group"
+                        _ -> error "expected 1 ingredient group"
+                    case nytStepGroups recipe of
+                        [stepGroup] -> do
+                            length (nytSteps stepGroup) `shouldBe` 4
+                            case nytSteps stepGroup of
+                                (firstStep : _) -> nytStepNumber firstStep `shouldBe` 1
+                                [] -> error "empty step group"
+                        _ -> error "expected 1 step group"
+
+        it "parses carrot-risotto.html recipe correctly" $ do
+            html <- TIO.readFile "test-data/carrot-risotto.html"
+            let result = do
+                    val <- extractNextData html
+                    parseNYTRecipe val
+            case result of
+                Nothing -> error "failed to parse carrot-risotto recipe"
+                Just recipe -> do
+                    nytTitle recipe `shouldBe` "Carrot Risotto With Chile Crisp"
+                    nytUrl recipe `shouldBe` Just "https://cooking.nytimes.com/recipes/1024086-carrot-risotto-with-chile-crisp"
+                    nytTotalTime recipe `shouldBe` Just "30 minutes"
+                    nytRecipeYield recipe `shouldBe` Just "4 servings"
+                    length (nytIngredientGroups recipe) `shouldBe` 1
+                    case nytIngredientGroups recipe of
+                        [group] -> length (nytIngredients group) `shouldBe` 11
+                        _ -> error "expected 1 ingredient group"
+                    case nytStepGroups recipe of
+                        [stepGroup] -> length (nytSteps stepGroup) `shouldBe` 7
+                        _ -> error "expected 1 step group"
+
+-- | Check if a Maybe value is Just.
+isJust :: Maybe a -> Bool
+isJust (Just _) = True
+isJust Nothing = False

test/Spec.hs

@@ -3,13 +3,16 @@ module Main (main) where
 import Test.Tasty (defaultMain, testGroup)
 import Test.Tasty.Hspec (testSpec)
 
+import qualified Roux.NYTimesSpec
 import qualified Roux.ParserSpec
 
 main :: IO ()
 main = do
     parserTests <- testSpec "Parser" Roux.ParserSpec.spec
+    nytTests <- testSpec "NYTimes" Roux.NYTimesSpec.spec
     defaultMain $
         testGroup
             "roux-server"
             [ parserTests
+            , nytTests
             ]