-- |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(..), 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