chez-grater 0.0.2 → 0.0.3

raw patch · 8 files changed

+198/−114 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• chez-grater.cabal +2/−1
• src/Chez/Grater.hs +2/−7
• src/Chez/Grater/Parser.hs +40/−28
• src/Chez/Grater/Readable/Types.hs +78/−0
• src/Chez/Grater/Types.hs +36/−55
• test/Chez/Grater/Gen.hs +29/−10
• test/Chez/Grater/ParsedIngredients.hs +9/−11
• test/Chez/GraterSpec.hs +2/−2

@@ -1,6 +1,6 @@ cabal-version: 3.0 name:          chez-grater-version:       0.0.2+version:       0.0.3 author:        Dan Fithian maintainer:    Dan Fithian copyright:     2022 Dan Fithian@@ -65,6 +65,7 @@       Chez.Grater.Manager       Chez.Grater.Parser       Chez.Grater.Parser.Types+      Chez.Grater.Readable.Types       Chez.Grater.Scraper       Chez.Grater.Scraper.Site       Chez.Grater.Scraper.Types

@@ -8,7 +8,6 @@   ( ScrapedRecipeName(..), ScrapeMetaWrapper, ScrapedIngredient, ScrapedStep, Scrapers   ) import Chez.Grater.Types (RecipeName(..), Ingredient, Step)-import Control.Monad ((>=>)) import Network.HTTP.Client (Manager) import Network.URI (URI) @@ -20,9 +19,5 @@ scrapeAndParseUrl :: Scrapers -> Manager -> URI -> IO (RecipeName, [Ingredient], [Step], ScrapeMetaWrapper) scrapeAndParseUrl = scrape   (RecipeName . unScrapedRecipeName)-  (nonempty "ingredients" parseScrapedIngredients)-  (nonempty "steps" parseScrapedSteps)-  where-    nonempty typ ma = ma >=> \case-      [] -> Left $ "No " <> typ <> " found"-      xs -> Right xs+  parseScrapedIngredients+  parseScrapedSteps

@@ -7,9 +7,8 @@   ) import Chez.Grater.Scraper.Types (ScrapedIngredient(..), ScrapedStep(..)) import Chez.Grater.Types-  ( Ingredient(..), IngredientName(..), Quantity(..), Step(..), Unit(..), box, cup, emptyQuantity-  , gram, liter, milligram, milliliter, mkQuantity, ounce, pinch, pound, splash, sprinkle-  , tablespoon, teaspoon, whole+  ( Ingredient(..), IngredientName(..), Quantity(..), Step(..), Unit(..), box, cup, gram, liter+  , milligram, milliliter, ounce, pinch, pound, splash, sprinkle, tablespoon, teaspoon, whole   ) import Data.Char (isAlpha, isDigit, isSpace) import Data.Function (fix)@@ -58,7 +57,7 @@   ]  quantityAliasTable :: Map (CI Text) Quantity-quantityAliasTable = fmap mkQuantity . Map.fromList $+quantityAliasTable = Map.fromList $   [ ("half dozen", 6)   , ("dozen", 12)   , ("quarter", 0.25)@@ -81,16 +80,16 @@ scrubIngredientName :: ParsedIngredientName -> IngredientName scrubIngredientName = IngredientName . unParsedIngredientName -scrubUnit :: ParsedUnit -> Maybe Unit+scrubUnit :: ParsedUnit -> Unit scrubUnit = \case-  ParsedUnit x -> Just $ Map.findWithDefault (Unit x) x unitAliasTable-  ParsedUnitMissing -> Nothing+  ParsedUnit x -> Map.findWithDefault (Unit x) x unitAliasTable+  ParsedUnitMissing -> UnitMissing  scrubQuantity :: ParsedQuantity -> Quantity scrubQuantity = \case-  ParsedQuantity q -> mkQuantity q-  ParsedQuantityWord w -> Map.findWithDefault emptyQuantity w quantityAliasTable-  ParsedQuantityMissing -> emptyQuantity+  ParsedQuantity q -> Quantity q+  ParsedQuantityWord w -> Map.findWithDefault QuantityMissing w quantityAliasTable+  ParsedQuantityMissing -> QuantityMissing  scrubIngredient :: ParsedIngredient -> Ingredient scrubIngredient ParsedIngredient {..} = Ingredient@@ -179,38 +178,51 @@ runParser :: Atto.Parser a -> Text -> Either String a runParser parser x = Atto.parseOnly parser (Text.strip (sanitize x)) +requireNonEmpty :: Text -> [a] -> Either Text [a]+requireNonEmpty typ = \case+  [] -> Left $ "No " <> typ <> " found"+  xs -> Right xs+ -- |Parse scraped ingredients. parseScrapedIngredients :: [ScrapedIngredient] -> Either Text [Ingredient]-parseScrapedIngredients xs = left (const "Failed to parse ingredients") . fmap (nubOrd . fmap scrubIngredient . catMaybes) . for xs $ \case-  ScrapedIngredient raw | Text.null raw -> pure Nothing-  ScrapedIngredient raw -> Just <$> runParser ingredientP raw+parseScrapedIngredients xs = do+  let parseOne = \case+        ScrapedIngredient raw | Text.null raw -> pure Nothing+        ScrapedIngredient raw -> Just <$> runParser ingredientP raw+  ingredients <- left (const "Failed to parse ingredients")+    . fmap (nubOrd . fmap scrubIngredient . catMaybes)+    $ for xs parseOne+  requireNonEmpty "ingredients" ingredients  -- |Parse raw ingredients, i.e. ones we know should be separated by newlines. parseRawIngredients :: Text -> Either Text [Ingredient] parseRawIngredients content = do-  either (const $ Left "Failed to parse ingredients") (pure . fmap scrubIngredient)+  ingredients <- either (const $ Left "Failed to parse ingredients") (pure . fmap scrubIngredient)     . traverse (runParser ingredientP)     . filter (not . Text.null)     . Text.lines     $ content+  requireNonEmpty "ingredients" ingredients  -- |Passive ingredient parser which separates on newlines. mkIngredients :: Text -> [Ingredient] mkIngredients =-  fmap (\str -> Ingredient (IngredientName (CI.mk str)) emptyQuantity Nothing) . Text.lines+  fmap (\str -> Ingredient (IngredientName (CI.mk str)) QuantityMissing UnitMissing) . Text.lines  -- |Parse scraped steps. parseScrapedSteps :: [ScrapedStep] -> Either Text [Step]-parseScrapedSteps = \case-  [ScrapedStep single] | "1." `Text.isPrefixOf` single -> flip fix (filter (not . Text.null) . Text.words . Text.drop 2 $ single, (1 :: Int), []) $ \f -> \case-    ([], _, parsed) -> Right $ reverse parsed-    (toParse, ordinal, parsed) ->-      let nextOrdinal = tshow (ordinal + 1) <> "."-          (next, rest) = span (not . Text.isSuffixOf nextOrdinal) toParse-      in case rest of-        x:xs -> case Text.stripSuffix nextOrdinal x of-          Just y -> f (xs, ordinal + 1, (Step (Text.unwords (next <> [y]))):parsed)-          Nothing -> f (xs, ordinal + 1, (Step (Text.unwords next)):parsed)-        [] -> f ([], ordinal + 1, (Step (Text.unwords next)):parsed)-  [ScrapedStep single] -> Right $ fmap (Step . Text.unwords . filter (not . Text.null) . Text.words) . filter (not . Text.null) . fmap Text.strip . Text.lines $ single-  xs -> Right $ fmap (\(ScrapedStep step) -> Step . Text.unwords . filter (not . Text.null) . Text.words $ step) xs+parseScrapedSteps xs = do+  steps <- case xs of+    [ScrapedStep single] | "1." `Text.isPrefixOf` single -> flip fix (filter (not . Text.null) . Text.words . Text.drop 2 $ single, (1 :: Int), []) $ \f -> \case+      ([], _, parsed) -> Right $ reverse parsed+      (toParse, ordinal, parsed) ->+        let nextOrdinal = tshow (ordinal + 1) <> "."+            (next, rest) = span (not . Text.isSuffixOf nextOrdinal) toParse+        in case rest of+          y:ys -> case Text.stripSuffix nextOrdinal y of+            Just z -> f (ys, ordinal + 1, (Step (Text.unwords (next <> [z]))):parsed)+            Nothing -> f (ys, ordinal + 1, (Step (Text.unwords next)):parsed)+          [] -> f ([], ordinal + 1, (Step (Text.unwords next)):parsed)+    [ScrapedStep single] -> Right $ fmap (Step . Text.unwords . filter (not . Text.null) . Text.words) . filter (not . Text.null) . fmap Text.strip . Text.lines $ single+    _ -> Right $ fmap (\(ScrapedStep step) -> Step . Text.unwords . filter (not . Text.null) . Text.words $ step) xs+  requireNonEmpty "steps" steps

@@ -0,0 +1,78 @@+-- |Description: Types and instances for instances for humans to read.+module Chez.Grater.Readable.Types where++import Chez.Grater.Internal.Prelude++import Chez.Grater.Internal.CI.Orphans ()+import Chez.Grater.Internal.Json (jsonOptions)+import Chez.Grater.Types (Quantity(..), IngredientName)+import Data.Aeson (FromJSON, ToJSON)+import Data.Aeson.TH (deriveJSON)+import GHC.Generics (Generic)++data ReadableFraction = ReadableFraction+  { readableFractionNumerator   :: Int+  , readableFractionDenominator :: Int+  }+  deriving (Eq, Ord, Show)++data ReadableQuantity = ReadableQuantity+  { readableQuantityWhole    :: Maybe Int+  , readableQuantityFraction :: Maybe ReadableFraction+  }+  deriving (Eq, Ord, Show)++newtype ReadableUnit = ReadableUnit { unReadableUnit :: CI Text }+  deriving (Eq, Ord, Show, FromJSON, ToJSON)++data ReadableIngredient = ReadableIngredient+  { readableIngredientName     :: IngredientName+  , readableIngredientQuantity :: ReadableQuantity+  , readableIngredientUnit     :: Maybe ReadableUnit+  }+  deriving (Eq, Ord, Show)++newtype ReadableStep = ReadableStep { unReadableStep :: Text }+  deriving (Eq, Ord, Show, Generic, FromJSON, ToJSON)++deriveJSON (jsonOptions "readableFraction") ''ReadableFraction+deriveJSON (jsonOptions "readableQuantity") ''ReadableQuantity+deriveJSON (jsonOptions "readableIngredient") ''ReadableIngredient++mkReadableQuantity :: Quantity -> ReadableQuantity+mkReadableQuantity q = case splitQuantity q of+  Nothing -> ReadableQuantity Nothing Nothing+  Just (w, d) ->+    case (w == 0, find (\((lo, hi), _) -> lo <= d && d <= hi) knownQuantities) of+      (False, Just (_, (numerator, denominator))) -> ReadableQuantity (Just w) (Just (ReadableFraction numerator denominator))+      (True, Just (_, (numerator, denominator))) -> ReadableQuantity Nothing (Just (ReadableFraction numerator denominator))+      (False, Nothing) -> ReadableQuantity (Just w) Nothing+      (True, Nothing) -> ReadableQuantity Nothing Nothing++  where++    quantityPrecision :: Double+    quantityPrecision = 0.01++    quarter = 0.25+    third = 1 / 3+    half = 0.5+    twoThird = 2 / 3+    threeQuarter = 0.75++    knownQuantities :: [((Double, Double), (Int, Int))]+    knownQuantities =+      [ ((quarter - quantityPrecision, quarter + quantityPrecision), (1, 4))+      , ((third - quantityPrecision, third + quantityPrecision), (1, 3))+      , ((half - quantityPrecision, half + quantityPrecision), (1, 2))+      , ((twoThird - quantityPrecision, twoThird + quantityPrecision), (2, 3))+      , ((threeQuarter - quantityPrecision, threeQuarter + quantityPrecision), (3, 4))+      ]++    splitQuantity :: Quantity -> Maybe (Int, Double)+    splitQuantity = \case+      QuantityMissing -> Nothing+      Quantity q2 ->+        case abs (fromIntegral (round q2 :: Int) - q2) < quantityPrecision of+          True -> Just (round q2, 0.0)+          False -> let w = truncate q2 in Just (w, q2 - fromIntegral w)

@@ -3,45 +3,38 @@ import Chez.Grater.Internal.Prelude  import Chez.Grater.Internal.CI.Orphans ()-import Chez.Grater.Internal.Json (jsonOptions) import Data.Aeson (FromJSON, ToJSON)-import Data.Aeson.TH (deriveJSON)-import GHC.Generics (Generic)  newtype IngredientName = IngredientName { unIngredientName :: CI Text }-  deriving (Eq, Ord, Show, Generic, FromJSON, ToJSON)+  deriving (Eq, Ord, Show, FromJSON, ToJSON)  newtype RecipeName = RecipeName { unRecipeName :: Text }-  deriving (Eq, Ord, Show, Generic, FromJSON, ToJSON)--data Fraction = Fraction-  { fractionNumerator   :: Int-  , fractionDenominator :: Int-  }-  deriving (Eq, Show, Ord)+  deriving (Eq, Ord, Show, FromJSON, ToJSON) -data Quantity = Quantity-  { quantityWhole    :: Maybe Int-  , quantityFraction :: Maybe Fraction-  }-  deriving (Eq, Show, Ord)+data Quantity+  = Quantity Double+  | QuantityMissing+  deriving (Eq, Ord, Show) -newtype Unit = Unit { unUnit :: CI Text }-  deriving (Eq, Ord, Show, FromJSON, ToJSON)+data Unit+  = Unit (CI Text)+  | UnitMissing+  deriving (Eq, Ord, Show)  newtype Step = Step { unStep :: Text }-  deriving (Eq, Ord, Show, Generic, FromJSON, ToJSON)+  deriving (Eq, Ord, Show)  data Ingredient = Ingredient   { ingredientName     :: IngredientName   , ingredientQuantity :: Quantity-  , ingredientUnit     :: Maybe Unit+  , ingredientUnit     :: Unit   }   deriving (Eq, Ord, Show) -deriveJSON (jsonOptions "fraction") ''Fraction-deriveJSON (jsonOptions "quantity") ''Quantity-deriveJSON (jsonOptions "Ingredient") ''Ingredient+quantityToValue :: Quantity -> Double+quantityToValue = \case+  Quantity x -> x+  QuantityMissing -> 1  pinch, teaspoon, tablespoon, cup, ounce, box, pound, splash, sprinkle, whole   , milliliter, liter, milligram, gram :: Unit@@ -60,41 +53,29 @@ milligram = Unit "mg" gram = Unit "g" -emptyQuantity :: Quantity-emptyQuantity = Quantity Nothing Nothing+instance Num Quantity where+  QuantityMissing + QuantityMissing = QuantityMissing+  x + y = Quantity $ quantityToValue x + quantityToValue y -mkQuantity :: Double -> Quantity-mkQuantity q = case splitQuantity q of-  Nothing -> Quantity Nothing Nothing-  Just (w, d) ->-    case (w == 0, find (\((lo, hi), _) -> lo <= d && d <= hi) knownQuantities) of-      (False, Just (_, (numerator, denominator))) -> Quantity (Just w) (Just (Fraction numerator denominator))-      (True, Just (_, (numerator, denominator))) -> Quantity Nothing (Just (Fraction numerator denominator))-      (False, Nothing) -> Quantity (Just w) Nothing-      (True, Nothing) -> Quantity Nothing Nothing+  QuantityMissing * QuantityMissing = QuantityMissing+  x * y = Quantity $ quantityToValue x * quantityToValue y -  where+  abs = \case+    Quantity x -> Quantity $ abs x+    QuantityMissing -> QuantityMissing -    quantityPrecision :: Double-    quantityPrecision = 0.01+  signum = \case+    Quantity x -> Quantity $ signum x+    QuantityMissing -> QuantityMissing -    quarter = 0.25-    third = 1 / 3-    half = 0.5-    twoThird = 2 / 3-    threeQuarter = 0.75+  fromInteger = Quantity . fromInteger -    knownQuantities :: [((Double, Double), (Int, Int))]-    knownQuantities =-      [ ((quarter - quantityPrecision, quarter + quantityPrecision), (1, 4))-      , ((third - quantityPrecision, third + quantityPrecision), (1, 3))-      , ((half - quantityPrecision, half + quantityPrecision), (1, 2))-      , ((twoThird - quantityPrecision, twoThird + quantityPrecision), (2, 3))-      , ((threeQuarter - quantityPrecision, threeQuarter + quantityPrecision), (3, 4))-      ]+  negate = \case+    Quantity x -> Quantity $ negate x+    QuantityMissing -> QuantityMissing -    splitQuantity :: Double -> Maybe (Int, Double)-    splitQuantity q2 =-      case abs (fromIntegral (round q2 :: Int) - q2) < quantityPrecision of-        True -> Just (round q2, 0.0)-        False -> let w = truncate q2 in Just (w, q2 - fromIntegral w)+instance Fractional Quantity where+  fromRational = Quantity . fromRational++  QuantityMissing / QuantityMissing = QuantityMissing+  x / y = Quantity $ quantityToValue x / quantityToValue y

@@ -6,6 +6,7 @@ import qualified Data.CaseInsensitive as CI import qualified Data.Text as Text +import Chez.Grater.Readable.Types import Chez.Grater.Types  maybeGen :: Gen a -> Gen (Maybe a)@@ -41,24 +42,42 @@ arbitraryInt :: Gen Int arbitraryInt = abs <$> arbitrary -arbitraryFraction :: Gen Fraction-arbitraryFraction = Fraction-  <$> arbitraryInt-  <*> ((+1) <$> arbitraryInt)- arbitraryQuantity :: Gen Quantity-arbitraryQuantity = Quantity-  <$> maybeGen arbitraryInt-  <*> maybeGen arbitraryFraction+arbitraryQuantity = oneof+  [ pure QuantityMissing+  , Quantity <$> arbitraryDouble+  ] -arbitraryUnit :: Gen (Maybe Unit)-arbitraryUnit = maybeGen (Unit <$> arbitraryCi)+arbitraryUnit :: Gen Unit+arbitraryUnit = oneof+  [ pure UnitMissing+  , Unit <$> arbitraryCi+  ]  arbitraryIngredient :: Gen Ingredient arbitraryIngredient = Ingredient   <$> arbitraryIngredientName   <*> arbitraryQuantity   <*> arbitraryUnit++arbitraryReadableFraction :: Gen ReadableFraction+arbitraryReadableFraction = ReadableFraction+  <$> arbitraryInt+  <*> ((+1) <$> arbitraryInt)++arbitraryReadableQuantity :: Gen ReadableQuantity+arbitraryReadableQuantity = ReadableQuantity+  <$> maybeGen arbitraryInt+  <*> maybeGen arbitraryReadableFraction++arbitraryReadableUnit :: Gen ReadableUnit+arbitraryReadableUnit = ReadableUnit <$> arbitraryCi++arbitraryReadableIngredient :: Gen ReadableIngredient+arbitraryReadableIngredient = ReadableIngredient+  <$> arbitraryIngredientName+  <*> arbitraryReadableQuantity+  <*> maybeGen arbitraryReadableUnit  arbitraryStep :: Gen Step arbitraryStep = Step

@@ -2,9 +2,7 @@  import Chez.Grater.Internal.Prelude -import Chez.Grater.Types-  ( Ingredient(..), IngredientName(..), Step(..), Unit(..), emptyQuantity, mkQuantity-  )+import Chez.Grater.Types (Ingredient(..), IngredientName(..), Quantity(..), Step(..), Unit(..)) import qualified Data.CaseInsensitive as CI  allParsedIngredients :: [[Ingredient]]@@ -19,29 +17,29 @@ pureIngredient :: Double -> Text -> Text -> Ingredient pureIngredient q u i = Ingredient   { ingredientName = IngredientName $ CI.mk i-  , ingredientQuantity = mkQuantity q-  , ingredientUnit = Just . Unit . CI.mk $ u+  , ingredientQuantity = Quantity q+  , ingredientUnit = Unit $ CI.mk u   }  pureIngredientNoQuantity :: Text -> Text -> Ingredient pureIngredientNoQuantity u i = Ingredient   { ingredientName = IngredientName $ CI.mk i-  , ingredientQuantity = emptyQuantity-  , ingredientUnit = Just . Unit . CI.mk $ u+  , ingredientQuantity = QuantityMissing+  , ingredientUnit = Unit $ CI.mk u   }  pureIngredientNoUnit :: Double -> Text -> Ingredient pureIngredientNoUnit q i = Ingredient   { ingredientName = IngredientName $ CI.mk i-  , ingredientQuantity = mkQuantity q-  , ingredientUnit = Nothing+  , ingredientQuantity = Quantity q+  , ingredientUnit = UnitMissing   }  pureIngredientName :: Text -> Ingredient pureIngredientName i = Ingredient   { ingredientName = IngredientName $ CI.mk i-  , ingredientQuantity = emptyQuantity-  , ingredientUnit = Nothing+  , ingredientQuantity = QuantityMissing+  , ingredientUnit = UnitMissing   }  allRecipesIngredients :: [Ingredient]

@@ -13,7 +13,7 @@ import Chez.Grater.Scraper.Types () import Chez.Grater.TestEnv (Env(..)) import Chez.Grater.Types-  ( Ingredient(..), IngredientName(..), RecipeName(..), Step(..), emptyQuantity+  ( Ingredient(..), IngredientName(..), Quantity(..), RecipeName(..), Step(..), Unit(..)   ) import Control.Monad (when) import Data.List (intercalate)@@ -66,7 +66,7 @@   lessThanThreePrefixes ingredients   steps `shouldSatisfy` (\xs -> length xs >= requiredSteps)   where-    hasQuantityAndUnit Ingredient {..} = if requireOneQuantityUnit then ingredientQuantity /= emptyQuantity && ingredientUnit /= Nothing else True+    hasQuantityAndUnit Ingredient {..} = if requireOneQuantityUnit then ingredientQuantity /= QuantityMissing && ingredientUnit /= UnitMissing else True     duplicates = (< allowedDuplicates) . length . filter ((> 1) . length . snd) . Map.toList . foldr (\x@Ingredient {..} -> Map.insertWith (<>) ingredientName [x]) mempty     lessThanThreePrefixes xs = do       let names = ingredientName <$> xs