module Chez.Grater.Types where

import Chez.Grater.Internal.Prelude

import Chez.Grater.Internal.CI.Orphans ()
import Data.Aeson (FromJSON, ToJSON)

newtype IngredientName = IngredientName { IngredientName -> CI Text
unIngredientName :: CI Text }
  deriving (IngredientName -> IngredientName -> Bool
(IngredientName -> IngredientName -> Bool)
-> (IngredientName -> IngredientName -> Bool) -> Eq IngredientName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IngredientName -> IngredientName -> Bool
$c/= :: IngredientName -> IngredientName -> Bool
== :: IngredientName -> IngredientName -> Bool
$c== :: IngredientName -> IngredientName -> Bool
Eq, Eq IngredientName
Eq IngredientName
-> (IngredientName -> IngredientName -> Ordering)
-> (IngredientName -> IngredientName -> Bool)
-> (IngredientName -> IngredientName -> Bool)
-> (IngredientName -> IngredientName -> Bool)
-> (IngredientName -> IngredientName -> Bool)
-> (IngredientName -> IngredientName -> IngredientName)
-> (IngredientName -> IngredientName -> IngredientName)
-> Ord IngredientName
IngredientName -> IngredientName -> Bool
IngredientName -> IngredientName -> Ordering
IngredientName -> IngredientName -> IngredientName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IngredientName -> IngredientName -> IngredientName
$cmin :: IngredientName -> IngredientName -> IngredientName
max :: IngredientName -> IngredientName -> IngredientName
$cmax :: IngredientName -> IngredientName -> IngredientName
>= :: IngredientName -> IngredientName -> Bool
$c>= :: IngredientName -> IngredientName -> Bool
> :: IngredientName -> IngredientName -> Bool
$c> :: IngredientName -> IngredientName -> Bool
<= :: IngredientName -> IngredientName -> Bool
$c<= :: IngredientName -> IngredientName -> Bool
< :: IngredientName -> IngredientName -> Bool
$c< :: IngredientName -> IngredientName -> Bool
compare :: IngredientName -> IngredientName -> Ordering
$ccompare :: IngredientName -> IngredientName -> Ordering
$cp1Ord :: Eq IngredientName
Ord, Int -> IngredientName -> ShowS
[IngredientName] -> ShowS
IngredientName -> String
(Int -> IngredientName -> ShowS)
-> (IngredientName -> String)
-> ([IngredientName] -> ShowS)
-> Show IngredientName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IngredientName] -> ShowS
$cshowList :: [IngredientName] -> ShowS
show :: IngredientName -> String
$cshow :: IngredientName -> String
showsPrec :: Int -> IngredientName -> ShowS
$cshowsPrec :: Int -> IngredientName -> ShowS
Show, Value -> Parser [IngredientName]
Value -> Parser IngredientName
(Value -> Parser IngredientName)
-> (Value -> Parser [IngredientName]) -> FromJSON IngredientName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [IngredientName]
$cparseJSONList :: Value -> Parser [IngredientName]
parseJSON :: Value -> Parser IngredientName
$cparseJSON :: Value -> Parser IngredientName
FromJSON, [IngredientName] -> Encoding
[IngredientName] -> Value
IngredientName -> Encoding
IngredientName -> Value
(IngredientName -> Value)
-> (IngredientName -> Encoding)
-> ([IngredientName] -> Value)
-> ([IngredientName] -> Encoding)
-> ToJSON IngredientName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [IngredientName] -> Encoding
$ctoEncodingList :: [IngredientName] -> Encoding
toJSONList :: [IngredientName] -> Value
$ctoJSONList :: [IngredientName] -> Value
toEncoding :: IngredientName -> Encoding
$ctoEncoding :: IngredientName -> Encoding
toJSON :: IngredientName -> Value
$ctoJSON :: IngredientName -> Value
ToJSON)

newtype RecipeName = RecipeName { RecipeName -> Text
unRecipeName :: Text }
  deriving (RecipeName -> RecipeName -> Bool
(RecipeName -> RecipeName -> Bool)
-> (RecipeName -> RecipeName -> Bool) -> Eq RecipeName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RecipeName -> RecipeName -> Bool
$c/= :: RecipeName -> RecipeName -> Bool
== :: RecipeName -> RecipeName -> Bool
$c== :: RecipeName -> RecipeName -> Bool
Eq, Eq RecipeName
Eq RecipeName
-> (RecipeName -> RecipeName -> Ordering)
-> (RecipeName -> RecipeName -> Bool)
-> (RecipeName -> RecipeName -> Bool)
-> (RecipeName -> RecipeName -> Bool)
-> (RecipeName -> RecipeName -> Bool)
-> (RecipeName -> RecipeName -> RecipeName)
-> (RecipeName -> RecipeName -> RecipeName)
-> Ord RecipeName
RecipeName -> RecipeName -> Bool
RecipeName -> RecipeName -> Ordering
RecipeName -> RecipeName -> RecipeName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RecipeName -> RecipeName -> RecipeName
$cmin :: RecipeName -> RecipeName -> RecipeName
max :: RecipeName -> RecipeName -> RecipeName
$cmax :: RecipeName -> RecipeName -> RecipeName
>= :: RecipeName -> RecipeName -> Bool
$c>= :: RecipeName -> RecipeName -> Bool
> :: RecipeName -> RecipeName -> Bool
$c> :: RecipeName -> RecipeName -> Bool
<= :: RecipeName -> RecipeName -> Bool
$c<= :: RecipeName -> RecipeName -> Bool
< :: RecipeName -> RecipeName -> Bool
$c< :: RecipeName -> RecipeName -> Bool
compare :: RecipeName -> RecipeName -> Ordering
$ccompare :: RecipeName -> RecipeName -> Ordering
$cp1Ord :: Eq RecipeName
Ord, Int -> RecipeName -> ShowS
[RecipeName] -> ShowS
RecipeName -> String
(Int -> RecipeName -> ShowS)
-> (RecipeName -> String)
-> ([RecipeName] -> ShowS)
-> Show RecipeName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RecipeName] -> ShowS
$cshowList :: [RecipeName] -> ShowS
show :: RecipeName -> String
$cshow :: RecipeName -> String
showsPrec :: Int -> RecipeName -> ShowS
$cshowsPrec :: Int -> RecipeName -> ShowS
Show, Value -> Parser [RecipeName]
Value -> Parser RecipeName
(Value -> Parser RecipeName)
-> (Value -> Parser [RecipeName]) -> FromJSON RecipeName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [RecipeName]
$cparseJSONList :: Value -> Parser [RecipeName]
parseJSON :: Value -> Parser RecipeName
$cparseJSON :: Value -> Parser RecipeName
FromJSON, [RecipeName] -> Encoding
[RecipeName] -> Value
RecipeName -> Encoding
RecipeName -> Value
(RecipeName -> Value)
-> (RecipeName -> Encoding)
-> ([RecipeName] -> Value)
-> ([RecipeName] -> Encoding)
-> ToJSON RecipeName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [RecipeName] -> Encoding
$ctoEncodingList :: [RecipeName] -> Encoding
toJSONList :: [RecipeName] -> Value
$ctoJSONList :: [RecipeName] -> Value
toEncoding :: RecipeName -> Encoding
$ctoEncoding :: RecipeName -> Encoding
toJSON :: RecipeName -> Value
$ctoJSON :: RecipeName -> Value
ToJSON)

data Quantity
  = Quantity Double
  | QuantityMissing
  deriving (Quantity -> Quantity -> Bool
(Quantity -> Quantity -> Bool)
-> (Quantity -> Quantity -> Bool) -> Eq Quantity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Quantity -> Quantity -> Bool
$c/= :: Quantity -> Quantity -> Bool
== :: Quantity -> Quantity -> Bool
$c== :: Quantity -> Quantity -> Bool
Eq, Eq Quantity
Eq Quantity
-> (Quantity -> Quantity -> Ordering)
-> (Quantity -> Quantity -> Bool)
-> (Quantity -> Quantity -> Bool)
-> (Quantity -> Quantity -> Bool)
-> (Quantity -> Quantity -> Bool)
-> (Quantity -> Quantity -> Quantity)
-> (Quantity -> Quantity -> Quantity)
-> Ord Quantity
Quantity -> Quantity -> Bool
Quantity -> Quantity -> Ordering
Quantity -> Quantity -> Quantity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Quantity -> Quantity -> Quantity
$cmin :: Quantity -> Quantity -> Quantity
max :: Quantity -> Quantity -> Quantity
$cmax :: Quantity -> Quantity -> Quantity
>= :: Quantity -> Quantity -> Bool
$c>= :: Quantity -> Quantity -> Bool
> :: Quantity -> Quantity -> Bool
$c> :: Quantity -> Quantity -> Bool
<= :: Quantity -> Quantity -> Bool
$c<= :: Quantity -> Quantity -> Bool
< :: Quantity -> Quantity -> Bool
$c< :: Quantity -> Quantity -> Bool
compare :: Quantity -> Quantity -> Ordering
$ccompare :: Quantity -> Quantity -> Ordering
$cp1Ord :: Eq Quantity
Ord, Int -> Quantity -> ShowS
[Quantity] -> ShowS
Quantity -> String
(Int -> Quantity -> ShowS)
-> (Quantity -> String) -> ([Quantity] -> ShowS) -> Show Quantity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Quantity] -> ShowS
$cshowList :: [Quantity] -> ShowS
show :: Quantity -> String
$cshow :: Quantity -> String
showsPrec :: Int -> Quantity -> ShowS
$cshowsPrec :: Int -> Quantity -> ShowS
Show)

data Unit
  = Unit (CI Text)
  | UnitMissing
  deriving (Unit -> Unit -> Bool
(Unit -> Unit -> Bool) -> (Unit -> Unit -> Bool) -> Eq Unit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Unit -> Unit -> Bool
$c/= :: Unit -> Unit -> Bool
== :: Unit -> Unit -> Bool
$c== :: Unit -> Unit -> Bool
Eq, Eq Unit
Eq Unit
-> (Unit -> Unit -> Ordering)
-> (Unit -> Unit -> Bool)
-> (Unit -> Unit -> Bool)
-> (Unit -> Unit -> Bool)
-> (Unit -> Unit -> Bool)
-> (Unit -> Unit -> Unit)
-> (Unit -> Unit -> Unit)
-> Ord Unit
Unit -> Unit -> Bool
Unit -> Unit -> Ordering
Unit -> Unit -> Unit
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Unit -> Unit -> Unit
$cmin :: Unit -> Unit -> Unit
max :: Unit -> Unit -> Unit
$cmax :: Unit -> Unit -> Unit
>= :: Unit -> Unit -> Bool
$c>= :: Unit -> Unit -> Bool
> :: Unit -> Unit -> Bool
$c> :: Unit -> Unit -> Bool
<= :: Unit -> Unit -> Bool
$c<= :: Unit -> Unit -> Bool
< :: Unit -> Unit -> Bool
$c< :: Unit -> Unit -> Bool
compare :: Unit -> Unit -> Ordering
$ccompare :: Unit -> Unit -> Ordering
$cp1Ord :: Eq Unit
Ord, Int -> Unit -> ShowS
[Unit] -> ShowS
Unit -> String
(Int -> Unit -> ShowS)
-> (Unit -> String) -> ([Unit] -> ShowS) -> Show Unit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Unit] -> ShowS
$cshowList :: [Unit] -> ShowS
show :: Unit -> String
$cshow :: Unit -> String
showsPrec :: Int -> Unit -> ShowS
$cshowsPrec :: Int -> Unit -> ShowS
Show)

newtype Step = Step { Step -> Text
unStep :: Text }
  deriving (Step -> Step -> Bool
(Step -> Step -> Bool) -> (Step -> Step -> Bool) -> Eq Step
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Step -> Step -> Bool
$c/= :: Step -> Step -> Bool
== :: Step -> Step -> Bool
$c== :: Step -> Step -> Bool
Eq, Eq Step
Eq Step
-> (Step -> Step -> Ordering)
-> (Step -> Step -> Bool)
-> (Step -> Step -> Bool)
-> (Step -> Step -> Bool)
-> (Step -> Step -> Bool)
-> (Step -> Step -> Step)
-> (Step -> Step -> Step)
-> Ord Step
Step -> Step -> Bool
Step -> Step -> Ordering
Step -> Step -> Step
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Step -> Step -> Step
$cmin :: Step -> Step -> Step
max :: Step -> Step -> Step
$cmax :: Step -> Step -> Step
>= :: Step -> Step -> Bool
$c>= :: Step -> Step -> Bool
> :: Step -> Step -> Bool
$c> :: Step -> Step -> Bool
<= :: Step -> Step -> Bool
$c<= :: Step -> Step -> Bool
< :: Step -> Step -> Bool
$c< :: Step -> Step -> Bool
compare :: Step -> Step -> Ordering
$ccompare :: Step -> Step -> Ordering
$cp1Ord :: Eq Step
Ord, Int -> Step -> ShowS
[Step] -> ShowS
Step -> String
(Int -> Step -> ShowS)
-> (Step -> String) -> ([Step] -> ShowS) -> Show Step
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Step] -> ShowS
$cshowList :: [Step] -> ShowS
show :: Step -> String
$cshow :: Step -> String
showsPrec :: Int -> Step -> ShowS
$cshowsPrec :: Int -> Step -> ShowS
Show)

data Ingredient = Ingredient
  { Ingredient -> IngredientName
ingredientName     :: IngredientName
  , Ingredient -> Quantity
ingredientQuantity :: Quantity
  , Ingredient -> Unit
ingredientUnit     :: Unit
  }
  deriving (Ingredient -> Ingredient -> Bool
(Ingredient -> Ingredient -> Bool)
-> (Ingredient -> Ingredient -> Bool) -> Eq Ingredient
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ingredient -> Ingredient -> Bool
$c/= :: Ingredient -> Ingredient -> Bool
== :: Ingredient -> Ingredient -> Bool
$c== :: Ingredient -> Ingredient -> Bool
Eq, Eq Ingredient
Eq Ingredient
-> (Ingredient -> Ingredient -> Ordering)
-> (Ingredient -> Ingredient -> Bool)
-> (Ingredient -> Ingredient -> Bool)
-> (Ingredient -> Ingredient -> Bool)
-> (Ingredient -> Ingredient -> Bool)
-> (Ingredient -> Ingredient -> Ingredient)
-> (Ingredient -> Ingredient -> Ingredient)
-> Ord Ingredient
Ingredient -> Ingredient -> Bool
Ingredient -> Ingredient -> Ordering
Ingredient -> Ingredient -> Ingredient
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Ingredient -> Ingredient -> Ingredient
$cmin :: Ingredient -> Ingredient -> Ingredient
max :: Ingredient -> Ingredient -> Ingredient
$cmax :: Ingredient -> Ingredient -> Ingredient
>= :: Ingredient -> Ingredient -> Bool
$c>= :: Ingredient -> Ingredient -> Bool
> :: Ingredient -> Ingredient -> Bool
$c> :: Ingredient -> Ingredient -> Bool
<= :: Ingredient -> Ingredient -> Bool
$c<= :: Ingredient -> Ingredient -> Bool
< :: Ingredient -> Ingredient -> Bool
$c< :: Ingredient -> Ingredient -> Bool
compare :: Ingredient -> Ingredient -> Ordering
$ccompare :: Ingredient -> Ingredient -> Ordering
$cp1Ord :: Eq Ingredient
Ord, Int -> Ingredient -> ShowS
[Ingredient] -> ShowS
Ingredient -> String
(Int -> Ingredient -> ShowS)
-> (Ingredient -> String)
-> ([Ingredient] -> ShowS)
-> Show Ingredient
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ingredient] -> ShowS
$cshowList :: [Ingredient] -> ShowS
show :: Ingredient -> String
$cshow :: Ingredient -> String
showsPrec :: Int -> Ingredient -> ShowS
$cshowsPrec :: Int -> Ingredient -> ShowS
Show)

quantityToValue :: Quantity -> Double
quantityToValue :: Quantity -> Double
quantityToValue = \case
  Quantity Double
x -> Double
x
  Quantity
QuantityMissing -> Double
1

pinch, teaspoon, tablespoon, cup, ounce, box, pound, splash, sprinkle, whole
  , milliliter, liter, milligram, gram :: Unit
pinch :: Unit
pinch = CI Text -> Unit
Unit CI Text
"pinch"
teaspoon :: Unit
teaspoon = CI Text -> Unit
Unit CI Text
"tsp"
tablespoon :: Unit
tablespoon = CI Text -> Unit
Unit CI Text
"tbsp"
cup :: Unit
cup = CI Text -> Unit
Unit CI Text
"cup"
ounce :: Unit
ounce = CI Text -> Unit
Unit CI Text
"oz"
box :: Unit
box = CI Text -> Unit
Unit CI Text
"box"
pound :: Unit
pound = CI Text -> Unit
Unit CI Text
"pound"
splash :: Unit
splash = CI Text -> Unit
Unit CI Text
"splash"
sprinkle :: Unit
sprinkle = CI Text -> Unit
Unit CI Text
"sprinkle"
whole :: Unit
whole = CI Text -> Unit
Unit CI Text
"whole"
milliliter :: Unit
milliliter = CI Text -> Unit
Unit CI Text
"ml"
liter :: Unit
liter = CI Text -> Unit
Unit CI Text
"l"
milligram :: Unit
milligram = CI Text -> Unit
Unit CI Text
"mg"
gram :: Unit
gram = CI Text -> Unit
Unit CI Text
"g"

instance Num Quantity where
  Quantity
QuantityMissing + :: Quantity -> Quantity -> Quantity
+ Quantity
QuantityMissing = Quantity
QuantityMissing
  Quantity
x + Quantity
y = Double -> Quantity
Quantity (Double -> Quantity) -> Double -> Quantity
forall a b. (a -> b) -> a -> b
$ Quantity -> Double
quantityToValue Quantity
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Quantity -> Double
quantityToValue Quantity
y

  Quantity
QuantityMissing * :: Quantity -> Quantity -> Quantity
* Quantity
QuantityMissing = Quantity
QuantityMissing
  Quantity
x * Quantity
y = Double -> Quantity
Quantity (Double -> Quantity) -> Double -> Quantity
forall a b. (a -> b) -> a -> b
$ Quantity -> Double
quantityToValue Quantity
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Quantity -> Double
quantityToValue Quantity
y

  abs :: Quantity -> Quantity
abs = \case
    Quantity Double
x -> Double -> Quantity
Quantity (Double -> Quantity) -> Double -> Quantity
forall a b. (a -> b) -> a -> b
$ Double -> Double
forall a. Num a => a -> a
abs Double
x
    Quantity
QuantityMissing -> Quantity
QuantityMissing

  signum :: Quantity -> Quantity
signum = \case
    Quantity Double
x -> Double -> Quantity
Quantity (Double -> Quantity) -> Double -> Quantity
forall a b. (a -> b) -> a -> b
$ Double -> Double
forall a. Num a => a -> a
signum Double
x
    Quantity
QuantityMissing -> Quantity
QuantityMissing

  fromInteger :: Integer -> Quantity
fromInteger = Double -> Quantity
Quantity (Double -> Quantity) -> (Integer -> Double) -> Integer -> Quantity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Double
forall a. Num a => Integer -> a
fromInteger

  negate :: Quantity -> Quantity
negate = \case
    Quantity Double
x -> Double -> Quantity
Quantity (Double -> Quantity) -> Double -> Quantity
forall a b. (a -> b) -> a -> b
$ Double -> Double
forall a. Num a => a -> a
negate Double
x
    Quantity
QuantityMissing -> Quantity
QuantityMissing

instance Fractional Quantity where
  fromRational :: Rational -> Quantity
fromRational = Double -> Quantity
Quantity (Double -> Quantity)
-> (Rational -> Double) -> Rational -> Quantity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
forall a. Fractional a => Rational -> a
fromRational

  Quantity
QuantityMissing / :: Quantity -> Quantity -> Quantity
/ Quantity
QuantityMissing = Quantity
QuantityMissing
  Quantity
x / Quantity
y = Double -> Quantity
Quantity (Double -> Quantity) -> Double -> Quantity
forall a b. (a -> b) -> a -> b
$ Quantity -> Double
quantityToValue Quantity
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Quantity -> Double
quantityToValue Quantity
y