module Chez.Grater.Types where

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 { 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, (forall x. IngredientName -> Rep IngredientName x)
-> (forall x. Rep IngredientName x -> IngredientName)
-> Generic IngredientName
forall x. Rep IngredientName x -> IngredientName
forall x. IngredientName -> Rep IngredientName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IngredientName x -> IngredientName
$cfrom :: forall x. IngredientName -> Rep IngredientName x
Generic, 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, (forall x. RecipeName -> Rep RecipeName x)
-> (forall x. Rep RecipeName x -> RecipeName) -> Generic RecipeName
forall x. Rep RecipeName x -> RecipeName
forall x. RecipeName -> Rep RecipeName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RecipeName x -> RecipeName
$cfrom :: forall x. RecipeName -> Rep RecipeName x
Generic, 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 Fraction = Fraction
  { Fraction -> Int
fractionNumerator   :: Int
  , Fraction -> Int
fractionDenominator :: Int
  }
  deriving (Fraction -> Fraction -> Bool
(Fraction -> Fraction -> Bool)
-> (Fraction -> Fraction -> Bool) -> Eq Fraction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Fraction -> Fraction -> Bool
$c/= :: Fraction -> Fraction -> Bool
== :: Fraction -> Fraction -> Bool
$c== :: Fraction -> Fraction -> Bool
Eq, Int -> Fraction -> ShowS
[Fraction] -> ShowS
Fraction -> String
(Int -> Fraction -> ShowS)
-> (Fraction -> String) -> ([Fraction] -> ShowS) -> Show Fraction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Fraction] -> ShowS
$cshowList :: [Fraction] -> ShowS
show :: Fraction -> String
$cshow :: Fraction -> String
showsPrec :: Int -> Fraction -> ShowS
$cshowsPrec :: Int -> Fraction -> ShowS
Show, Eq Fraction
Eq Fraction
-> (Fraction -> Fraction -> Ordering)
-> (Fraction -> Fraction -> Bool)
-> (Fraction -> Fraction -> Bool)
-> (Fraction -> Fraction -> Bool)
-> (Fraction -> Fraction -> Bool)
-> (Fraction -> Fraction -> Fraction)
-> (Fraction -> Fraction -> Fraction)
-> Ord Fraction
Fraction -> Fraction -> Bool
Fraction -> Fraction -> Ordering
Fraction -> Fraction -> Fraction
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 :: Fraction -> Fraction -> Fraction
$cmin :: Fraction -> Fraction -> Fraction
max :: Fraction -> Fraction -> Fraction
$cmax :: Fraction -> Fraction -> Fraction
>= :: Fraction -> Fraction -> Bool
$c>= :: Fraction -> Fraction -> Bool
> :: Fraction -> Fraction -> Bool
$c> :: Fraction -> Fraction -> Bool
<= :: Fraction -> Fraction -> Bool
$c<= :: Fraction -> Fraction -> Bool
< :: Fraction -> Fraction -> Bool
$c< :: Fraction -> Fraction -> Bool
compare :: Fraction -> Fraction -> Ordering
$ccompare :: Fraction -> Fraction -> Ordering
$cp1Ord :: Eq Fraction
Ord)

data Quantity = Quantity
  { Quantity -> Maybe Int
quantityWhole    :: Maybe Int
  , Quantity -> Maybe Fraction
quantityFraction :: Maybe Fraction
  }
  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, 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, 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)

newtype Unit = Unit { Unit -> CI Text
unUnit :: CI Text }
  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, Value -> Parser [Unit]
Value -> Parser Unit
(Value -> Parser Unit) -> (Value -> Parser [Unit]) -> FromJSON Unit
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Unit]
$cparseJSONList :: Value -> Parser [Unit]
parseJSON :: Value -> Parser Unit
$cparseJSON :: Value -> Parser Unit
FromJSON, [Unit] -> Encoding
[Unit] -> Value
Unit -> Encoding
Unit -> Value
(Unit -> Value)
-> (Unit -> Encoding)
-> ([Unit] -> Value)
-> ([Unit] -> Encoding)
-> ToJSON Unit
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Unit] -> Encoding
$ctoEncodingList :: [Unit] -> Encoding
toJSONList :: [Unit] -> Value
$ctoJSONList :: [Unit] -> Value
toEncoding :: Unit -> Encoding
$ctoEncoding :: Unit -> Encoding
toJSON :: Unit -> Value
$ctoJSON :: Unit -> Value
ToJSON)

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, (forall x. Step -> Rep Step x)
-> (forall x. Rep Step x -> Step) -> Generic Step
forall x. Rep Step x -> Step
forall x. Step -> Rep Step x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Step x -> Step
$cfrom :: forall x. Step -> Rep Step x
Generic, Value -> Parser [Step]
Value -> Parser Step
(Value -> Parser Step) -> (Value -> Parser [Step]) -> FromJSON Step
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Step]
$cparseJSONList :: Value -> Parser [Step]
parseJSON :: Value -> Parser Step
$cparseJSON :: Value -> Parser Step
FromJSON, [Step] -> Encoding
[Step] -> Value
Step -> Encoding
Step -> Value
(Step -> Value)
-> (Step -> Encoding)
-> ([Step] -> Value)
-> ([Step] -> Encoding)
-> ToJSON Step
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Step] -> Encoding
$ctoEncodingList :: [Step] -> Encoding
toJSONList :: [Step] -> Value
$ctoJSONList :: [Step] -> Value
toEncoding :: Step -> Encoding
$ctoEncoding :: Step -> Encoding
toJSON :: Step -> Value
$ctoJSON :: Step -> Value
ToJSON)

data Ingredient = Ingredient
  { Ingredient -> IngredientName
ingredientName     :: IngredientName
  , Ingredient -> Quantity
ingredientQuantity :: Quantity
  , Ingredient -> Maybe Unit
ingredientUnit     :: Maybe 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)

deriveJSON (jsonOptions "fraction") ''Fraction
deriveJSON (jsonOptions "quantity") ''Quantity
deriveJSON (jsonOptions "Ingredient") ''Ingredient

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"

emptyQuantity :: Quantity
emptyQuantity :: Quantity
emptyQuantity = Maybe Int -> Maybe Fraction -> Quantity
Quantity Maybe Int
forall a. Maybe a
Nothing Maybe Fraction
forall a. Maybe a
Nothing

mkQuantity :: Double -> Quantity
mkQuantity :: Double -> Quantity
mkQuantity Double
q = case Double -> Maybe (Int, Double)
splitQuantity Double
q of
  Maybe (Int, Double)
Nothing -> Maybe Int -> Maybe Fraction -> Quantity
Quantity Maybe Int
forall a. Maybe a
Nothing Maybe Fraction
forall a. Maybe a
Nothing
  Just (Int
w, Double
d) ->
    case (Int
w Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0, (((Double, Double), (Int, Int)) -> Bool)
-> [((Double, Double), (Int, Int))]
-> Maybe ((Double, Double), (Int, Int))
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\((Double
lo, Double
hi), (Int, Int)
_) -> Double
lo Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
d Bool -> Bool -> Bool
&& Double
d Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
hi) [((Double, Double), (Int, Int))]
knownQuantities) of
      (Bool
False, Just ((Double, Double)
_, (Int
numerator, Int
denominator))) -> Maybe Int -> Maybe Fraction -> Quantity
Quantity (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
w) (Fraction -> Maybe Fraction
forall a. a -> Maybe a
Just (Int -> Int -> Fraction
Fraction Int
numerator Int
denominator))
      (Bool
True, Just ((Double, Double)
_, (Int
numerator, Int
denominator))) -> Maybe Int -> Maybe Fraction -> Quantity
Quantity Maybe Int
forall a. Maybe a
Nothing (Fraction -> Maybe Fraction
forall a. a -> Maybe a
Just (Int -> Int -> Fraction
Fraction Int
numerator Int
denominator))
      (Bool
False, Maybe ((Double, Double), (Int, Int))
Nothing) -> Maybe Int -> Maybe Fraction -> Quantity
Quantity (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
w) Maybe Fraction
forall a. Maybe a
Nothing
      (Bool
True, Maybe ((Double, Double), (Int, Int))
Nothing) -> Maybe Int -> Maybe Fraction -> Quantity
Quantity Maybe Int
forall a. Maybe a
Nothing Maybe Fraction
forall a. Maybe a
Nothing

  where

    quantityPrecision :: Double
    quantityPrecision :: Double
quantityPrecision = Double
0.01

    quarter :: p
quarter = p
0.25
    third :: a
third = a
1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
3
    half :: p
half = p
0.5
    twoThird :: a
twoThird = a
2 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
3
    threeQuarter :: p
threeQuarter = p
0.75

    knownQuantities :: [((Double, Double), (Int, Int))]
    knownQuantities :: [((Double, Double), (Int, Int))]
knownQuantities =
      [ ((Double
forall p. Fractional p => p
quarter Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
quantityPrecision, Double
forall p. Fractional p => p
quarter Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
quantityPrecision), (Int
1, Int
4))
      , ((Double
forall p. Fractional p => p
third Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
quantityPrecision, Double
forall p. Fractional p => p
third Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
quantityPrecision), (Int
1, Int
3))
      , ((Double
forall p. Fractional p => p
half Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
quantityPrecision, Double
forall p. Fractional p => p
half Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
quantityPrecision), (Int
1, Int
2))
      , ((Double
forall p. Fractional p => p
twoThird Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
quantityPrecision, Double
forall p. Fractional p => p
twoThird Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
quantityPrecision), (Int
2, Int
3))
      , ((Double
forall p. Fractional p => p
threeQuarter Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
quantityPrecision, Double
forall p. Fractional p => p
threeQuarter Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
quantityPrecision), (Int
3, Int
4))
      ]

    splitQuantity :: Double -> Maybe (Int, Double)
    splitQuantity :: Double -> Maybe (Int, Double)
splitQuantity Double
q2 =
      case Double -> Double
forall a. Num a => a -> a
abs (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round Double
q2 :: Int) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
q2) Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
quantityPrecision of
        Bool
True -> (Int, Double) -> Maybe (Int, Double)
forall a. a -> Maybe a
Just (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round Double
q2, Double
0.0)
        Bool
False -> let w :: Int
w = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
q2 in (Int, Double) -> Maybe (Int, Double)
forall a. a -> Maybe a
Just (Int
w, Double
q2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w)