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
  )
import Chez.Grater.Types (RecipeName(..), Ingredient, Step)
import Control.Monad ((>=>))
import Network.HTTP.Client (Manager)
import Network.URI (URI)

-- |Scrape a URL without parsing it.
scrapeUrl :: Manager -> URI -> IO (ScrapedRecipeName, [ScrapedIngredient], [ScrapedStep], ScrapeMetaWrapper)
scrapeUrl :: Manager
-> URI
-> IO
     (ScrapedRecipeName, [ScrapedIngredient], [ScrapedStep],
      ScrapeMetaWrapper)
scrapeUrl = (ScrapedRecipeName -> ScrapedRecipeName)
-> ([ScrapedIngredient] -> Either Text [ScrapedIngredient])
-> ([ScrapedStep] -> Either Text [ScrapedStep])
-> Manager
-> URI
-> IO
     (ScrapedRecipeName, [ScrapedIngredient], [ScrapedStep],
      ScrapeMetaWrapper)
forall a b c.
(ScrapedRecipeName -> a)
-> ([ScrapedIngredient] -> Either Text [b])
-> ([ScrapedStep] -> Either Text [c])
-> 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 :: Manager -> URI -> IO (RecipeName, [Ingredient], [Step], ScrapeMetaWrapper)
scrapeAndParseUrl :: Manager
-> URI -> IO (RecipeName, [Ingredient], [Step], ScrapeMetaWrapper)
scrapeAndParseUrl = (ScrapedRecipeName -> RecipeName)
-> ([ScrapedIngredient] -> Either Text [Ingredient])
-> ([ScrapedStep] -> Either Text [Step])
-> Manager
-> URI
-> IO (RecipeName, [Ingredient], [Step], ScrapeMetaWrapper)
forall a b c.
(ScrapedRecipeName -> a)
-> ([ScrapedIngredient] -> Either Text [b])
-> ([ScrapedStep] -> Either Text [c])
-> 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)
  (Text
-> ([ScrapedIngredient] -> Either Text [Ingredient])
-> [ScrapedIngredient]
-> Either Text [Ingredient]
forall a a a.
(Semigroup a, IsString a) =>
a -> (a -> Either a [a]) -> a -> Either a [a]
nonempty Text
"ingredients" [ScrapedIngredient] -> Either Text [Ingredient]
parseScrapedIngredients)
  (Text
-> ([ScrapedStep] -> Either Text [Step])
-> [ScrapedStep]
-> Either Text [Step]
forall a a a.
(Semigroup a, IsString a) =>
a -> (a -> Either a [a]) -> a -> Either a [a]
nonempty Text
"steps" [ScrapedStep] -> Either Text [Step]
parseScrapedSteps)
  where
    nonempty :: a -> (a -> Either a [a]) -> a -> Either a [a]
nonempty a
typ a -> Either a [a]
ma = a -> Either a [a]
ma (a -> Either a [a]) -> ([a] -> Either a [a]) -> a -> Either a [a]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \case
      [] -> a -> Either a [a]
forall a b. a -> Either a b
Left (a -> Either a [a]) -> a -> Either a [a]
forall a b. (a -> b) -> a -> b
$ a
"No " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
typ a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
" found"
      [a]
xs -> [a] -> Either a [a]
forall a b. b -> Either a b
Right [a]
xs