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(..), Unit(..))
import Data.Aeson (FromJSON, ToJSON)
import Data.Aeson.TH (deriveJSON)
data ReadableFraction = ReadableFraction
{ ReadableFraction -> Int
readableFractionNumerator :: Int
, ReadableFraction -> Int
readableFractionDenominator :: Int
}
deriving (ReadableFraction -> ReadableFraction -> Bool
(ReadableFraction -> ReadableFraction -> Bool)
-> (ReadableFraction -> ReadableFraction -> Bool)
-> Eq ReadableFraction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReadableFraction -> ReadableFraction -> Bool
$c/= :: ReadableFraction -> ReadableFraction -> Bool
== :: ReadableFraction -> ReadableFraction -> Bool
$c== :: ReadableFraction -> ReadableFraction -> Bool
Eq, Eq ReadableFraction
Eq ReadableFraction
-> (ReadableFraction -> ReadableFraction -> Ordering)
-> (ReadableFraction -> ReadableFraction -> Bool)
-> (ReadableFraction -> ReadableFraction -> Bool)
-> (ReadableFraction -> ReadableFraction -> Bool)
-> (ReadableFraction -> ReadableFraction -> Bool)
-> (ReadableFraction -> ReadableFraction -> ReadableFraction)
-> (ReadableFraction -> ReadableFraction -> ReadableFraction)
-> Ord ReadableFraction
ReadableFraction -> ReadableFraction -> Bool
ReadableFraction -> ReadableFraction -> Ordering
ReadableFraction -> ReadableFraction -> ReadableFraction
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 :: ReadableFraction -> ReadableFraction -> ReadableFraction
$cmin :: ReadableFraction -> ReadableFraction -> ReadableFraction
max :: ReadableFraction -> ReadableFraction -> ReadableFraction
$cmax :: ReadableFraction -> ReadableFraction -> ReadableFraction
>= :: ReadableFraction -> ReadableFraction -> Bool
$c>= :: ReadableFraction -> ReadableFraction -> Bool
> :: ReadableFraction -> ReadableFraction -> Bool
$c> :: ReadableFraction -> ReadableFraction -> Bool
<= :: ReadableFraction -> ReadableFraction -> Bool
$c<= :: ReadableFraction -> ReadableFraction -> Bool
< :: ReadableFraction -> ReadableFraction -> Bool
$c< :: ReadableFraction -> ReadableFraction -> Bool
compare :: ReadableFraction -> ReadableFraction -> Ordering
$ccompare :: ReadableFraction -> ReadableFraction -> Ordering
$cp1Ord :: Eq ReadableFraction
Ord, Int -> ReadableFraction -> ShowS
[ReadableFraction] -> ShowS
ReadableFraction -> String
(Int -> ReadableFraction -> ShowS)
-> (ReadableFraction -> String)
-> ([ReadableFraction] -> ShowS)
-> Show ReadableFraction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReadableFraction] -> ShowS
$cshowList :: [ReadableFraction] -> ShowS
show :: ReadableFraction -> String
$cshow :: ReadableFraction -> String
showsPrec :: Int -> ReadableFraction -> ShowS
$cshowsPrec :: Int -> ReadableFraction -> ShowS
Show)
data ReadableQuantity = ReadableQuantity
{ ReadableQuantity -> Maybe Int
readableQuantityWhole :: Maybe Int
, ReadableQuantity -> Maybe ReadableFraction
readableQuantityFraction :: Maybe ReadableFraction
}
deriving (ReadableQuantity -> ReadableQuantity -> Bool
(ReadableQuantity -> ReadableQuantity -> Bool)
-> (ReadableQuantity -> ReadableQuantity -> Bool)
-> Eq ReadableQuantity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReadableQuantity -> ReadableQuantity -> Bool
$c/= :: ReadableQuantity -> ReadableQuantity -> Bool
== :: ReadableQuantity -> ReadableQuantity -> Bool
$c== :: ReadableQuantity -> ReadableQuantity -> Bool
Eq, Eq ReadableQuantity
Eq ReadableQuantity
-> (ReadableQuantity -> ReadableQuantity -> Ordering)
-> (ReadableQuantity -> ReadableQuantity -> Bool)
-> (ReadableQuantity -> ReadableQuantity -> Bool)
-> (ReadableQuantity -> ReadableQuantity -> Bool)
-> (ReadableQuantity -> ReadableQuantity -> Bool)
-> (ReadableQuantity -> ReadableQuantity -> ReadableQuantity)
-> (ReadableQuantity -> ReadableQuantity -> ReadableQuantity)
-> Ord ReadableQuantity
ReadableQuantity -> ReadableQuantity -> Bool
ReadableQuantity -> ReadableQuantity -> Ordering
ReadableQuantity -> ReadableQuantity -> ReadableQuantity
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 :: ReadableQuantity -> ReadableQuantity -> ReadableQuantity
$cmin :: ReadableQuantity -> ReadableQuantity -> ReadableQuantity
max :: ReadableQuantity -> ReadableQuantity -> ReadableQuantity
$cmax :: ReadableQuantity -> ReadableQuantity -> ReadableQuantity
>= :: ReadableQuantity -> ReadableQuantity -> Bool
$c>= :: ReadableQuantity -> ReadableQuantity -> Bool
> :: ReadableQuantity -> ReadableQuantity -> Bool
$c> :: ReadableQuantity -> ReadableQuantity -> Bool
<= :: ReadableQuantity -> ReadableQuantity -> Bool
$c<= :: ReadableQuantity -> ReadableQuantity -> Bool
< :: ReadableQuantity -> ReadableQuantity -> Bool
$c< :: ReadableQuantity -> ReadableQuantity -> Bool
compare :: ReadableQuantity -> ReadableQuantity -> Ordering
$ccompare :: ReadableQuantity -> ReadableQuantity -> Ordering
$cp1Ord :: Eq ReadableQuantity
Ord, Int -> ReadableQuantity -> ShowS
[ReadableQuantity] -> ShowS
ReadableQuantity -> String
(Int -> ReadableQuantity -> ShowS)
-> (ReadableQuantity -> String)
-> ([ReadableQuantity] -> ShowS)
-> Show ReadableQuantity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReadableQuantity] -> ShowS
$cshowList :: [ReadableQuantity] -> ShowS
show :: ReadableQuantity -> String
$cshow :: ReadableQuantity -> String
showsPrec :: Int -> ReadableQuantity -> ShowS
$cshowsPrec :: Int -> ReadableQuantity -> ShowS
Show)
newtype ReadableUnit = ReadableUnit { ReadableUnit -> CI Text
unReadableUnit :: CI Text }
deriving (ReadableUnit -> ReadableUnit -> Bool
(ReadableUnit -> ReadableUnit -> Bool)
-> (ReadableUnit -> ReadableUnit -> Bool) -> Eq ReadableUnit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReadableUnit -> ReadableUnit -> Bool
$c/= :: ReadableUnit -> ReadableUnit -> Bool
== :: ReadableUnit -> ReadableUnit -> Bool
$c== :: ReadableUnit -> ReadableUnit -> Bool
Eq, Eq ReadableUnit
Eq ReadableUnit
-> (ReadableUnit -> ReadableUnit -> Ordering)
-> (ReadableUnit -> ReadableUnit -> Bool)
-> (ReadableUnit -> ReadableUnit -> Bool)
-> (ReadableUnit -> ReadableUnit -> Bool)
-> (ReadableUnit -> ReadableUnit -> Bool)
-> (ReadableUnit -> ReadableUnit -> ReadableUnit)
-> (ReadableUnit -> ReadableUnit -> ReadableUnit)
-> Ord ReadableUnit
ReadableUnit -> ReadableUnit -> Bool
ReadableUnit -> ReadableUnit -> Ordering
ReadableUnit -> ReadableUnit -> ReadableUnit
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 :: ReadableUnit -> ReadableUnit -> ReadableUnit
$cmin :: ReadableUnit -> ReadableUnit -> ReadableUnit
max :: ReadableUnit -> ReadableUnit -> ReadableUnit
$cmax :: ReadableUnit -> ReadableUnit -> ReadableUnit
>= :: ReadableUnit -> ReadableUnit -> Bool
$c>= :: ReadableUnit -> ReadableUnit -> Bool
> :: ReadableUnit -> ReadableUnit -> Bool
$c> :: ReadableUnit -> ReadableUnit -> Bool
<= :: ReadableUnit -> ReadableUnit -> Bool
$c<= :: ReadableUnit -> ReadableUnit -> Bool
< :: ReadableUnit -> ReadableUnit -> Bool
$c< :: ReadableUnit -> ReadableUnit -> Bool
compare :: ReadableUnit -> ReadableUnit -> Ordering
$ccompare :: ReadableUnit -> ReadableUnit -> Ordering
$cp1Ord :: Eq ReadableUnit
Ord, Int -> ReadableUnit -> ShowS
[ReadableUnit] -> ShowS
ReadableUnit -> String
(Int -> ReadableUnit -> ShowS)
-> (ReadableUnit -> String)
-> ([ReadableUnit] -> ShowS)
-> Show ReadableUnit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReadableUnit] -> ShowS
$cshowList :: [ReadableUnit] -> ShowS
show :: ReadableUnit -> String
$cshow :: ReadableUnit -> String
showsPrec :: Int -> ReadableUnit -> ShowS
$cshowsPrec :: Int -> ReadableUnit -> ShowS
Show, Value -> Parser [ReadableUnit]
Value -> Parser ReadableUnit
(Value -> Parser ReadableUnit)
-> (Value -> Parser [ReadableUnit]) -> FromJSON ReadableUnit
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ReadableUnit]
$cparseJSONList :: Value -> Parser [ReadableUnit]
parseJSON :: Value -> Parser ReadableUnit
$cparseJSON :: Value -> Parser ReadableUnit
FromJSON, [ReadableUnit] -> Encoding
[ReadableUnit] -> Value
ReadableUnit -> Encoding
ReadableUnit -> Value
(ReadableUnit -> Value)
-> (ReadableUnit -> Encoding)
-> ([ReadableUnit] -> Value)
-> ([ReadableUnit] -> Encoding)
-> ToJSON ReadableUnit
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ReadableUnit] -> Encoding
$ctoEncodingList :: [ReadableUnit] -> Encoding
toJSONList :: [ReadableUnit] -> Value
$ctoJSONList :: [ReadableUnit] -> Value
toEncoding :: ReadableUnit -> Encoding
$ctoEncoding :: ReadableUnit -> Encoding
toJSON :: ReadableUnit -> Value
$ctoJSON :: ReadableUnit -> Value
ToJSON)
deriveJSON (jsonOptions "readableFraction") ''ReadableFraction
deriveJSON (jsonOptions "readableQuantity") ''ReadableQuantity
mkReadableQuantity :: Quantity -> ReadableQuantity
mkReadableQuantity :: Quantity -> ReadableQuantity
mkReadableQuantity Quantity
q = case Quantity -> Maybe (Int, Double)
splitQuantity Quantity
q of
Maybe (Int, Double)
Nothing -> Maybe Int -> Maybe ReadableFraction -> ReadableQuantity
ReadableQuantity Maybe Int
forall a. Maybe a
Nothing Maybe ReadableFraction
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 ReadableFraction -> ReadableQuantity
ReadableQuantity (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
w) (ReadableFraction -> Maybe ReadableFraction
forall a. a -> Maybe a
Just (Int -> Int -> ReadableFraction
ReadableFraction Int
numerator Int
denominator))
(Bool
True, Just ((Double, Double)
_, (Int
numerator, Int
denominator))) -> Maybe Int -> Maybe ReadableFraction -> ReadableQuantity
ReadableQuantity Maybe Int
forall a. Maybe a
Nothing (ReadableFraction -> Maybe ReadableFraction
forall a. a -> Maybe a
Just (Int -> Int -> ReadableFraction
ReadableFraction Int
numerator Int
denominator))
(Bool
False, Maybe ((Double, Double), (Int, Int))
Nothing) -> Maybe Int -> Maybe ReadableFraction -> ReadableQuantity
ReadableQuantity (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
w) Maybe ReadableFraction
forall a. Maybe a
Nothing
(Bool
True, Maybe ((Double, Double), (Int, Int))
Nothing) -> Maybe Int -> Maybe ReadableFraction -> ReadableQuantity
ReadableQuantity Maybe Int
forall a. Maybe a
Nothing Maybe ReadableFraction
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 :: Quantity -> Maybe (Int, Double)
splitQuantity :: Quantity -> Maybe (Int, Double)
splitQuantity = \case
Quantity
QuantityMissing -> Maybe (Int, Double)
forall a. Maybe a
Nothing
Quantity 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)
mkReadableUnit :: Unit -> Maybe ReadableUnit
mkReadableUnit :: Unit -> Maybe ReadableUnit
mkReadableUnit = \case
Unit CI Text
x -> ReadableUnit -> Maybe ReadableUnit
forall a. a -> Maybe a
Just (CI Text -> ReadableUnit
ReadableUnit CI Text
x)
Unit
UnitMissing -> Maybe ReadableUnit
forall a. Maybe a
Nothing