module Chez.Grater where

import Chez.Grater.Internal.Prelude

import Chez.Grater.Parser (parseScrapedIngredients, parseScrapedSteps)
import Chez.Grater.Scraper (scrape)
import Chez.Grater.Scraper.Types
  ( ScrapedRecipeName(..), ScrapeMetaWrapper, ScrapedIngredient, ScrapedStep, Scrapers
  )
import Chez.Grater.Types (RecipeName(..), Ingredient, Step)
import Network.HTTP.Client (Manager)
import Network.URI (URI)

-- |Scrape a URL without parsing it.
scrapeUrl :: Scrapers -> Manager -> URI -> IO (ScrapedRecipeName, [ScrapedIngredient], [ScrapedStep], ScrapeMetaWrapper)
scrapeUrl :: Scrapers
-> Manager
-> URI
-> IO
     (ScrapedRecipeName, [ScrapedIngredient], [ScrapedStep],
      ScrapeMetaWrapper)
scrapeUrl = (ScrapedRecipeName -> ScrapedRecipeName)
-> ([ScrapedIngredient] -> Either Text [ScrapedIngredient])
-> ([ScrapedStep] -> Either Text [ScrapedStep])
-> Scrapers
-> Manager
-> URI
-> IO
     (ScrapedRecipeName, [ScrapedIngredient], [ScrapedStep],
      ScrapeMetaWrapper)
forall a b c.
(ScrapedRecipeName -> a)
-> ([ScrapedIngredient] -> Either Text [b])
-> ([ScrapedStep] -> Either Text [c])
-> Scrapers
-> Manager
-> URI
-> IO (a, [b], [c], ScrapeMetaWrapper)
scrape ScrapedRecipeName -> ScrapedRecipeName
forall a. a -> a
id [ScrapedIngredient] -> Either Text [ScrapedIngredient]
forall a b. b -> Either a b
Right [ScrapedStep] -> Either Text [ScrapedStep]
forall a b. b -> Either a b
Right

-- |Scrape a URL and also parse it.
scrapeAndParseUrl :: Scrapers -> Manager -> URI -> IO (RecipeName, [Ingredient], [Step], ScrapeMetaWrapper)
scrapeAndParseUrl :: Scrapers
-> Manager
-> URI
-> IO (RecipeName, [Ingredient], [Step], ScrapeMetaWrapper)
scrapeAndParseUrl = (ScrapedRecipeName -> RecipeName)
-> ([ScrapedIngredient] -> Either Text [Ingredient])
-> ([ScrapedStep] -> Either Text [Step])
-> Scrapers
-> Manager
-> URI
-> IO (RecipeName, [Ingredient], [Step], ScrapeMetaWrapper)
forall a b c.
(ScrapedRecipeName -> a)
-> ([ScrapedIngredient] -> Either Text [b])
-> ([ScrapedStep] -> Either Text [c])
-> Scrapers
-> Manager
-> URI
-> IO (a, [b], [c], ScrapeMetaWrapper)
scrape
  (Text -> RecipeName
RecipeName (Text -> RecipeName)
-> (ScrapedRecipeName -> Text) -> ScrapedRecipeName -> RecipeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScrapedRecipeName -> Text
unScrapedRecipeName)
  [ScrapedIngredient] -> Either Text [Ingredient]
parseScrapedIngredients
  [ScrapedStep] -> Either Text [Step]
parseScrapedSteps