{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- | This module provides definitions for modeling and working with quantities
-- with fixed decimal points.
module Haspara.Quantity where

import Control.Monad.Except (MonadError (throwError))
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Encoding as Aeson.Encoding
import Data.Either (fromRight)
import Data.Proxy (Proxy (..))
import Data.Scientific (FPFormat (Fixed), Scientific, formatScientific)
import GHC.Generics (Generic)
import GHC.TypeLits (KnownNat, Nat, natVal, type (+))
import qualified Language.Haskell.TH.Syntax as TH
import qualified Numeric.Decimal as D
import Refined (NonNegative, Refined, unrefine)
import Refined.Unsafe (unsafeRefine)


-- * Data Definition


-- | Type encoding for quantity values with a given scaling (digits after the
-- decimal point).
--
-- >>> 42 :: Quantity 0
-- 42
-- >>> 42 :: Quantity 1
-- 42.0
-- >>> 42 :: Quantity 2
-- 42.00
-- >>> 41 + 1 :: Quantity 2
-- 42.00
-- >>> 43 - 1 :: Quantity 2
-- 42.00
-- >>> 2 * 3 * 7 :: Quantity 2
-- 42.00
-- >>> negate (-42) :: Quantity 2
-- 42.00
-- >>> abs (-42) :: Quantity 2
-- 42.00
-- >>> signum (-42) :: Quantity 2
-- -1.00
-- >>> fromInteger 42 :: Quantity 2
-- 42.00
-- >>> mkQuantity 0.415 :: Quantity 2
-- 0.42
-- >>> mkQuantity 0.425 :: Quantity 2
-- 0.42
-- >>> mkQuantityLossless 0.42 :: Either String (Quantity 2)
-- Right 0.42
-- >>> mkQuantityLossless 0.415 :: Either String (Quantity 2)
-- Left "Underflow while trying to create quantity: 0.415"
newtype Quantity (s :: Nat) = MkQuantity {forall (s :: Nat). Quantity s -> Decimal RoundHalfEven s Integer
unQuantity :: D.Decimal D.RoundHalfEven s Integer}
  deriving (Quantity s -> Quantity s -> Bool
(Quantity s -> Quantity s -> Bool)
-> (Quantity s -> Quantity s -> Bool) -> Eq (Quantity s)
forall (s :: Nat). Quantity s -> Quantity s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall (s :: Nat). Quantity s -> Quantity s -> Bool
== :: Quantity s -> Quantity s -> Bool
$c/= :: forall (s :: Nat). Quantity s -> Quantity s -> Bool
/= :: Quantity s -> Quantity s -> Bool
Eq, Eq (Quantity s)
Eq (Quantity s) =>
(Quantity s -> Quantity s -> Ordering)
-> (Quantity s -> Quantity s -> Bool)
-> (Quantity s -> Quantity s -> Bool)
-> (Quantity s -> Quantity s -> Bool)
-> (Quantity s -> Quantity s -> Bool)
-> (Quantity s -> Quantity s -> Quantity s)
-> (Quantity s -> Quantity s -> Quantity s)
-> Ord (Quantity s)
Quantity s -> Quantity s -> Bool
Quantity s -> Quantity s -> Ordering
Quantity s -> Quantity s -> Quantity s
forall (s :: Nat). Eq (Quantity s)
forall (s :: Nat). Quantity s -> Quantity s -> Bool
forall (s :: Nat). Quantity s -> Quantity s -> Ordering
forall (s :: Nat). Quantity s -> Quantity s -> Quantity s
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
$ccompare :: forall (s :: Nat). Quantity s -> Quantity s -> Ordering
compare :: Quantity s -> Quantity s -> Ordering
$c< :: forall (s :: Nat). Quantity s -> Quantity s -> Bool
< :: Quantity s -> Quantity s -> Bool
$c<= :: forall (s :: Nat). Quantity s -> Quantity s -> Bool
<= :: Quantity s -> Quantity s -> Bool
$c> :: forall (s :: Nat). Quantity s -> Quantity s -> Bool
> :: Quantity s -> Quantity s -> Bool
$c>= :: forall (s :: Nat). Quantity s -> Quantity s -> Bool
>= :: Quantity s -> Quantity s -> Bool
$cmax :: forall (s :: Nat). Quantity s -> Quantity s -> Quantity s
max :: Quantity s -> Quantity s -> Quantity s
$cmin :: forall (s :: Nat). Quantity s -> Quantity s -> Quantity s
min :: Quantity s -> Quantity s -> Quantity s
Ord, (forall x. Quantity s -> Rep (Quantity s) x)
-> (forall x. Rep (Quantity s) x -> Quantity s)
-> Generic (Quantity s)
forall (s :: Nat) x. Rep (Quantity s) x -> Quantity s
forall (s :: Nat) x. Quantity s -> Rep (Quantity s) x
forall x. Rep (Quantity s) x -> Quantity s
forall x. Quantity s -> Rep (Quantity s) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall (s :: Nat) x. Quantity s -> Rep (Quantity s) x
from :: forall x. Quantity s -> Rep (Quantity s) x
$cto :: forall (s :: Nat) x. Rep (Quantity s) x -> Quantity s
to :: forall x. Rep (Quantity s) x -> Quantity s
Generic, Integer -> Quantity s
Quantity s -> Quantity s
Quantity s -> Quantity s -> Quantity s
(Quantity s -> Quantity s -> Quantity s)
-> (Quantity s -> Quantity s -> Quantity s)
-> (Quantity s -> Quantity s -> Quantity s)
-> (Quantity s -> Quantity s)
-> (Quantity s -> Quantity s)
-> (Quantity s -> Quantity s)
-> (Integer -> Quantity s)
-> Num (Quantity s)
forall (s :: Nat). KnownNat s => Integer -> Quantity s
forall (s :: Nat). KnownNat s => Quantity s -> Quantity s
forall (s :: Nat).
KnownNat s =>
Quantity s -> Quantity s -> Quantity s
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: forall (s :: Nat).
KnownNat s =>
Quantity s -> Quantity s -> Quantity s
+ :: Quantity s -> Quantity s -> Quantity s
$c- :: forall (s :: Nat).
KnownNat s =>
Quantity s -> Quantity s -> Quantity s
- :: Quantity s -> Quantity s -> Quantity s
$c* :: forall (s :: Nat).
KnownNat s =>
Quantity s -> Quantity s -> Quantity s
* :: Quantity s -> Quantity s -> Quantity s
$cnegate :: forall (s :: Nat). KnownNat s => Quantity s -> Quantity s
negate :: Quantity s -> Quantity s
$cabs :: forall (s :: Nat). KnownNat s => Quantity s -> Quantity s
abs :: Quantity s -> Quantity s
$csignum :: forall (s :: Nat). KnownNat s => Quantity s -> Quantity s
signum :: Quantity s -> Quantity s
$cfromInteger :: forall (s :: Nat). KnownNat s => Integer -> Quantity s
fromInteger :: Integer -> Quantity s
Num)


-- | Type definition for unsigned 'Quantity' values.
type UnsignedQuantity s = Refined NonNegative (Quantity s)


-- | Orphan 'TH.Lift' instance for 'Quantity'.
--
-- TODO: Avoid having an orphan instance for @Decimal r s p@?
deriving instance TH.Lift (D.Decimal D.RoundHalfEven s Integer)


-- | 'TH.Lift' instance for 'Quantity'.
deriving instance TH.Lift (Quantity s)


-- | 'Aeson.FromJSON' instance for 'Quantity'.
--
-- >>> :set -XOverloadedStrings
-- >>> Aeson.decode "0.42" :: Maybe (Quantity 2)
-- Just 0.42
-- >>> Aeson.decode "0.415" :: Maybe (Quantity 2)
-- Just 0.42
-- >>> Aeson.decode "0.425" :: Maybe (Quantity 2)
-- Just 0.42
instance KnownNat s => Aeson.FromJSON (Quantity s) where
  parseJSON :: Value -> Parser (Quantity s)
parseJSON = String
-> (Scientific -> Parser (Quantity s))
-> Value
-> Parser (Quantity s)
forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
Aeson.withScientific String
"Quantity" (Quantity s -> Parser (Quantity s)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Quantity s -> Parser (Quantity s))
-> (Scientific -> Quantity s) -> Scientific -> Parser (Quantity s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Quantity s
forall (s :: Nat). KnownNat s => Scientific -> Quantity s
mkQuantity)


-- | 'Aeson.ToJSON' instance for 'Quantity'.
--
-- >>> Aeson.encode (mkQuantity 0.42 :: Quantity 2)
-- "0.42"
instance KnownNat s => Aeson.ToJSON (Quantity s) where
  toJSON :: Quantity s -> Value
toJSON = Scientific -> Value
Aeson.Number (Scientific -> Value)
-> (Quantity s -> Scientific) -> Quantity s -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decimal RoundHalfEven s Integer -> Scientific
forall p (s :: Nat) r.
(Integral p, KnownNat s) =>
Decimal r s p -> Scientific
D.toScientificDecimal (Decimal RoundHalfEven s Integer -> Scientific)
-> (Quantity s -> Decimal RoundHalfEven s Integer)
-> Quantity s
-> Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quantity s -> Decimal RoundHalfEven s Integer
forall (s :: Nat). Quantity s -> Decimal RoundHalfEven s Integer
unQuantity
  toEncoding :: Quantity s -> Encoding
toEncoding = Scientific -> Encoding
Aeson.Encoding.scientific (Scientific -> Encoding)
-> (Quantity s -> Scientific) -> Quantity s -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decimal RoundHalfEven s Integer -> Scientific
forall p (s :: Nat) r.
(Integral p, KnownNat s) =>
Decimal r s p -> Scientific
D.toScientificDecimal (Decimal RoundHalfEven s Integer -> Scientific)
-> (Quantity s -> Decimal RoundHalfEven s Integer)
-> Quantity s
-> Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quantity s -> Decimal RoundHalfEven s Integer
forall (s :: Nat). Quantity s -> Decimal RoundHalfEven s Integer
unQuantity


-- | Numeric arithmetic over 'Quantity' values.
--
-- >>> import Numeric.Decimal
-- >>> let a = Arith (mkQuantity 10) + Arith (mkQuantity 32) :: Arith (Quantity 2)
-- >>> arithMaybe a
-- Just 42.00
-- >>> arithM (41 + 1) :: Either SomeException (Quantity 2)
-- Right 42.00
-- >>> arithM (43 - 1) :: Either SomeException (Quantity 2)
-- Right 42.00
-- >>> arithM (2 * 3 * 7) :: Either SomeException (Quantity 2)
-- Right 42.00
-- >>> arithM (signum 42) :: Either SomeException (Quantity 2)
-- Right 1.00
-- >>> arithM (signum (-42)) :: Either SomeException (Quantity 2)
-- Right -1.00
-- >>> arithM (abs 42) :: Either SomeException (Quantity 2)
-- Right 42.00
-- >>> arithM (abs (-42)) :: Either SomeException (Quantity 2)
-- Right 42.00
-- >>> arithM (fromInteger 42) :: Either SomeException (Quantity 2)
-- Right 42.00
instance KnownNat s => Num (D.Arith (Quantity s)) where
  + :: Arith (Quantity s) -> Arith (Quantity s) -> Arith (Quantity s)
(+) = (Quantity s -> Quantity s -> Quantity s)
-> Arith (Quantity s) -> Arith (Quantity s) -> Arith (Quantity s)
forall a b c. (a -> b -> c) -> Arith a -> Arith b -> Arith c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Quantity s -> Quantity s -> Quantity s
forall a. Num a => a -> a -> a
(+)
  (-) = (Quantity s -> Quantity s -> Quantity s)
-> Arith (Quantity s) -> Arith (Quantity s) -> Arith (Quantity s)
forall a b c. (a -> b -> c) -> Arith a -> Arith b -> Arith c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (-)
  * :: Arith (Quantity s) -> Arith (Quantity s) -> Arith (Quantity s)
(*) = (Quantity s -> Quantity s -> Quantity s)
-> Arith (Quantity s) -> Arith (Quantity s) -> Arith (Quantity s)
forall a b c. (a -> b -> c) -> Arith a -> Arith b -> Arith c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Quantity s -> Quantity s -> Quantity s
forall a. Num a => a -> a -> a
(*)
  signum :: Arith (Quantity s) -> Arith (Quantity s)
signum = (Quantity s -> Quantity s)
-> Arith (Quantity s) -> Arith (Quantity s)
forall a b. (a -> b) -> Arith a -> Arith b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Quantity s -> Quantity s
forall a. Num a => a -> a
signum
  abs :: Arith (Quantity s) -> Arith (Quantity s)
abs = (Quantity s -> Quantity s)
-> Arith (Quantity s) -> Arith (Quantity s)
forall a b. (a -> b) -> Arith a -> Arith b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Quantity s -> Quantity s
forall a. Num a => a -> a
abs
  fromInteger :: Integer -> Arith (Quantity s)
fromInteger = Quantity s -> Arith (Quantity s)
forall a. a -> Arith a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Quantity s -> Arith (Quantity s))
-> (Integer -> Quantity s) -> Integer -> Arith (Quantity s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decimal RoundHalfEven s Integer -> Quantity s
forall (s :: Nat). Decimal RoundHalfEven s Integer -> Quantity s
MkQuantity (Decimal RoundHalfEven s Integer -> Quantity s)
-> (Integer -> Decimal RoundHalfEven s Integer)
-> Integer
-> Quantity s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Decimal RoundHalfEven s Integer
forall r (s :: Nat). KnownNat s => Integer -> Decimal r s Integer
D.fromIntegerDecimal


-- | Fractional arithmetic over 'Quantity' values.
--
-- >>> import Numeric.Decimal
-- >>> arithM (fromRational 0.42) :: Either SomeException (Quantity 2)
-- Right 0.42
-- >>> arithM (fromRational 0.415) :: Either SomeException (Quantity 2)
-- Left PrecisionLoss (83 % 200) to 2 decimal spaces
-- >>> arithM $ (fromRational 0.84) / (fromRational 2) :: Either SomeException (Quantity 2)
-- Right 0.42
-- >>> arithM $ (fromRational 0.42) / (fromRational 0) :: Either SomeException (Quantity 2)
-- Left divide by zero
-- >>> let a = 84 :: Quantity 2
-- >>> let b =  2 :: Quantity 2
-- >>> let c =  0 :: Quantity 2
-- >>> arithM (Arith a / Arith b) :: Either SomeException (Quantity 2)
-- Right 42.00
-- >>> arithM (Arith a / Arith b / Arith c) :: Either SomeException (Quantity 2)
-- Left divide by zero
instance KnownNat s => Fractional (D.Arith (Quantity s)) where
  Arith (Quantity s)
a / :: Arith (Quantity s) -> Arith (Quantity s) -> Arith (Quantity s)
/ Arith (Quantity s)
b = (Decimal RoundHalfEven s Integer -> Quantity s)
-> Arith (Decimal RoundHalfEven s Integer) -> Arith (Quantity s)
forall a b. (a -> b) -> Arith a -> Arith b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Decimal RoundHalfEven s Integer -> Quantity s
forall (s :: Nat). Decimal RoundHalfEven s Integer -> Quantity s
MkQuantity (Arith (Decimal RoundHalfEven s Integer) -> Arith (Quantity s))
-> Arith (Decimal RoundHalfEven s Integer) -> Arith (Quantity s)
forall a b. (a -> b) -> a -> b
$ (Quantity s -> Decimal RoundHalfEven s Integer)
-> Arith (Quantity s) -> Arith (Decimal RoundHalfEven s Integer)
forall a b. (a -> b) -> Arith a -> Arith b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Quantity s -> Decimal RoundHalfEven s Integer
forall (s :: Nat). Quantity s -> Decimal RoundHalfEven s Integer
unQuantity Arith (Quantity s)
a Arith (Decimal RoundHalfEven s Integer)
-> Arith (Decimal RoundHalfEven s Integer)
-> Arith (Decimal RoundHalfEven s Integer)
forall a. Fractional a => a -> a -> a
/ (Quantity s -> Decimal RoundHalfEven s Integer)
-> Arith (Quantity s) -> Arith (Decimal RoundHalfEven s Integer)
forall a b. (a -> b) -> Arith a -> Arith b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Quantity s -> Decimal RoundHalfEven s Integer
forall (s :: Nat). Quantity s -> Decimal RoundHalfEven s Integer
unQuantity Arith (Quantity s)
b
  fromRational :: Rational -> Arith (Quantity s)
fromRational = (Decimal RoundHalfEven s Integer -> Quantity s)
-> Arith (Decimal RoundHalfEven s Integer) -> Arith (Quantity s)
forall a b. (a -> b) -> Arith a -> Arith b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Decimal RoundHalfEven s Integer -> Quantity s
forall (s :: Nat). Decimal RoundHalfEven s Integer -> Quantity s
MkQuantity (Arith (Decimal RoundHalfEven s Integer) -> Arith (Quantity s))
-> (Rational -> Arith (Decimal RoundHalfEven s Integer))
-> Rational
-> Arith (Quantity s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Arith (Decimal RoundHalfEven s Integer)
forall (m :: * -> *) r (s :: Nat).
(MonadThrow m, KnownNat s) =>
Rational -> m (Decimal r s Integer)
D.fromRationalDecimalWithoutLoss


-- | 'Show' instance for 'Quantity'.
--
-- >>> show (42 :: Quantity 2)
-- "42.00"
-- >>> 42 :: Quantity 2
-- 42.00
instance KnownNat s => Show (Quantity s) where
  show :: Quantity s -> String
show = Decimal RoundHalfEven s Integer -> String
forall a. Show a => a -> String
show (Decimal RoundHalfEven s Integer -> String)
-> (Quantity s -> Decimal RoundHalfEven s Integer)
-> Quantity s
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quantity s -> Decimal RoundHalfEven s Integer
forall (s :: Nat). Quantity s -> Decimal RoundHalfEven s Integer
unQuantity


-- * Smart Constructors


-- | Constructs 'Quantity' values from 'Scientific' values in a lossy way.
--
-- This function uses 'mkQuantityAux' in case that the lossless attempt fails.
-- We could have used 'mkQuantityAux' directly. However, 'mkQuantityAux' is
-- doing too much (see 'roundScientific'). Therefore, we are first attempting a
-- lossless construction (see 'mkQuantityLossless') and we fallback to
-- 'mkQuantityAux' in case the lossless construction fails.
--
-- >>> mkQuantity 0 :: Quantity 0
-- 0
-- >>> mkQuantity 0 :: Quantity 1
-- 0.0
-- >>> mkQuantity 0 :: Quantity 2
-- 0.00
-- >>> mkQuantity 0.04 :: Quantity 1
-- 0.0
-- >>> mkQuantity 0.05 :: Quantity 1
-- 0.0
-- >>> mkQuantity 0.06 :: Quantity 1
-- 0.1
-- >>> mkQuantity 0.14 :: Quantity 1
-- 0.1
-- >>> mkQuantity 0.15 :: Quantity 1
-- 0.2
-- >>> mkQuantity 0.16 :: Quantity 1
-- 0.2
-- >>> mkQuantity 0.04 :: Quantity 2
-- 0.04
-- >>> mkQuantity 0.05 :: Quantity 2
-- 0.05
-- >>> mkQuantity 0.06 :: Quantity 2
-- 0.06
-- >>> mkQuantity 0.14 :: Quantity 2
-- 0.14
-- >>> mkQuantity 0.15 :: Quantity 2
-- 0.15
-- >>> mkQuantity 0.16 :: Quantity 2
-- 0.16
-- >>> mkQuantity 0.04 :: Quantity 3
-- 0.040
-- >>> mkQuantity 0.05 :: Quantity 3
-- 0.050
-- >>> mkQuantity 0.06 :: Quantity 3
-- 0.060
-- >>> mkQuantity 0.14 :: Quantity 3
-- 0.140
-- >>> mkQuantity 0.15 :: Quantity 3
-- 0.150
-- >>> mkQuantity 0.16 :: Quantity 3
-- 0.160
mkQuantity :: KnownNat s => Scientific -> Quantity s
mkQuantity :: forall (s :: Nat). KnownNat s => Scientific -> Quantity s
mkQuantity Scientific
s = case Scientific -> Either String (Quantity s)
forall (s :: Nat) (m :: * -> *).
(KnownNat s, MonadError String m) =>
Scientific -> m (Quantity s)
mkQuantityLossless Scientific
s of
  Left String
_ -> Scientific -> Quantity s
forall (s :: Nat). KnownNat s => Scientific -> Quantity s
mkQuantityAux Scientific
s
  Right Quantity s
dv -> Quantity s
dv


-- | Constructs 'Quantity' values from 'Scientific' values in a lossy way.
--
-- >>> mkQuantityLossless 0 :: Either String (Quantity 0)
-- Right 0
-- >>> mkQuantityLossless 0 :: Either String (Quantity 1)
-- Right 0.0
-- >>> mkQuantityLossless 0 :: Either String (Quantity 2)
-- Right 0.00
-- >>> mkQuantityLossless 0.04 :: Either String (Quantity 1)
-- Left "Underflow while trying to create quantity: 4.0e-2"
-- >>> mkQuantityLossless 0.05 :: Either String (Quantity 1)
-- Left "Underflow while trying to create quantity: 5.0e-2"
-- >>> mkQuantityLossless 0.06 :: Either String (Quantity 1)
-- Left "Underflow while trying to create quantity: 6.0e-2"
-- >>> mkQuantityLossless 0.14 :: Either String (Quantity 1)
-- Left "Underflow while trying to create quantity: 0.14"
-- >>> mkQuantityLossless 0.15 :: Either String (Quantity 1)
-- Left "Underflow while trying to create quantity: 0.15"
-- >>> mkQuantityLossless 0.16 :: Either String (Quantity 1)
-- Left "Underflow while trying to create quantity: 0.16"
-- >>> mkQuantityLossless 0.04 :: Either String (Quantity 2)
-- Right 0.04
-- >>> mkQuantityLossless 0.05 :: Either String (Quantity 2)
-- Right 0.05
-- >>> mkQuantityLossless 0.06 :: Either String (Quantity 2)
-- Right 0.06
-- >>> mkQuantityLossless 0.14 :: Either String (Quantity 2)
-- Right 0.14
-- >>> mkQuantityLossless 0.15 :: Either String (Quantity 2)
-- Right 0.15
-- >>> mkQuantityLossless 0.16 :: Either String (Quantity 2)
-- Right 0.16
-- >>> mkQuantityLossless 0.04 :: Either String (Quantity 3)
-- Right 0.040
-- >>> mkQuantityLossless 0.05 :: Either String (Quantity 3)
-- Right 0.050
-- >>> mkQuantityLossless 0.06 :: Either String (Quantity 3)
-- Right 0.060
-- >>> mkQuantityLossless 0.14 :: Either String (Quantity 3)
-- Right 0.140
-- >>> mkQuantityLossless 0.15 :: Either String (Quantity 3)
-- Right 0.150
-- >>> mkQuantityLossless 0.16 :: Either String (Quantity 3)
-- Right 0.160
mkQuantityLossless :: (KnownNat s, MonadError String m) => Scientific -> m (Quantity s)
mkQuantityLossless :: forall (s :: Nat) (m :: * -> *).
(KnownNat s, MonadError String m) =>
Scientific -> m (Quantity s)
mkQuantityLossless Scientific
s = (SomeException -> m (Quantity s))
-> (Decimal RoundHalfEven s Integer -> m (Quantity s))
-> Either SomeException (Decimal RoundHalfEven s Integer)
-> m (Quantity s)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (m (Quantity s) -> SomeException -> m (Quantity s)
forall a b. a -> b -> a
const (m (Quantity s) -> SomeException -> m (Quantity s))
-> m (Quantity s) -> SomeException -> m (Quantity s)
forall a b. (a -> b) -> a -> b
$ String -> m (Quantity s)
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String
"Underflow while trying to create quantity: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Scientific -> String
forall a. Show a => a -> String
show Scientific
s)) (Quantity s -> m (Quantity s)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Quantity s -> m (Quantity s))
-> (Decimal RoundHalfEven s Integer -> Quantity s)
-> Decimal RoundHalfEven s Integer
-> m (Quantity s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decimal RoundHalfEven s Integer -> Quantity s
forall (s :: Nat). Decimal RoundHalfEven s Integer -> Quantity s
MkQuantity) (Either SomeException (Decimal RoundHalfEven s Integer)
 -> m (Quantity s))
-> Either SomeException (Decimal RoundHalfEven s Integer)
-> m (Quantity s)
forall a b. (a -> b) -> a -> b
$ Scientific
-> Either SomeException (Decimal RoundHalfEven s Integer)
forall (m :: * -> *) r (s :: Nat).
(MonadThrow m, KnownNat s) =>
Scientific -> m (Decimal r s Integer)
D.fromScientificDecimal Scientific
s


-- * Utilities


-- | Rounds given quantity by @k@ digits.
--
-- >>> roundQuantity (mkQuantity 0.415 :: Quantity 3) :: Quantity 2
-- 0.42
-- >>> roundQuantity (mkQuantity 0.425 :: Quantity 3) :: Quantity 2
-- 0.42
roundQuantity :: KnownNat k => Quantity (n + k) -> Quantity n
roundQuantity :: forall (k :: Nat) (n :: Nat).
KnownNat k =>
Quantity (n + k) -> Quantity n
roundQuantity (MkQuantity Decimal RoundHalfEven (n + k) Integer
d) = Decimal RoundHalfEven n Integer -> Quantity n
forall (s :: Nat). Decimal RoundHalfEven s Integer -> Quantity s
MkQuantity (Decimal RoundHalfEven (n + k) Integer
-> Decimal RoundHalfEven n Integer
forall (k :: Nat) (n :: Nat).
KnownNat k =>
Decimal RoundHalfEven (n + k) Integer
-> Decimal RoundHalfEven n Integer
forall r p (k :: Nat) (n :: Nat).
(Round r p, KnownNat k) =>
Decimal r (n + k) p -> Decimal r n p
D.roundDecimal Decimal RoundHalfEven (n + k) Integer
d)


-- | Multiplies two quantities with different scales and rounds back to the scale of the frst operand.
--
-- >>> times (mkQuantity 0.42 :: Quantity 2) (mkQuantity 0.42 :: Quantity 2)
-- 0.18
times :: (KnownNat s, KnownNat k) => Quantity s -> Quantity k -> Quantity s
times :: forall (s :: Nat) (k :: Nat).
(KnownNat s, KnownNat k) =>
Quantity s -> Quantity k -> Quantity s
times Quantity s
q1 Quantity k
q2 = Quantity (s + k) -> Quantity s
forall (k :: Nat) (n :: Nat).
KnownNat k =>
Quantity (n + k) -> Quantity n
roundQuantity (Quantity s -> Quantity k -> Quantity (s + k)
forall (s :: Nat) (k :: Nat).
(KnownNat s, KnownNat k) =>
Quantity s -> Quantity k -> Quantity (s + k)
timesLossless Quantity s
q1 Quantity k
q2)


-- | Multiplies two quantities with different scales.
--
-- >>> timesLossless (mkQuantity 0.42 :: Quantity 2) (mkQuantity 0.42 :: Quantity 2)
-- 0.1764
timesLossless :: (KnownNat s, KnownNat k) => Quantity s -> Quantity k -> Quantity (s + k)
timesLossless :: forall (s :: Nat) (k :: Nat).
(KnownNat s, KnownNat k) =>
Quantity s -> Quantity k -> Quantity (s + k)
timesLossless (MkQuantity Decimal RoundHalfEven s Integer
d1) (MkQuantity Decimal RoundHalfEven k Integer
d2) = Decimal RoundHalfEven (s + k) Integer -> Quantity (s + k)
forall (s :: Nat). Decimal RoundHalfEven s Integer -> Quantity s
MkQuantity (Decimal RoundHalfEven s Integer
-> Decimal RoundHalfEven k Integer
-> Decimal RoundHalfEven (s + k) Integer
forall r (s1 :: Nat) (s2 :: Nat).
Decimal r s1 Integer
-> Decimal r s2 Integer -> Decimal r (s1 + s2) Integer
D.timesDecimal Decimal RoundHalfEven s Integer
d1 Decimal RoundHalfEven k Integer
d2)


-- | Divides two quantities with same scales with possible loss.
--
-- >>> divide (mkQuantity 10 :: Quantity 2) (mkQuantity 3 :: Quantity 2)
-- Just 3.33
-- >>> divide (mkQuantity 0.42 :: Quantity 2) (mkQuantity 0 :: Quantity 2)
-- Nothing
-- >>> divide (mkQuantity 0.42 :: Quantity 2) (mkQuantity 1 :: Quantity 2)
-- Just 0.42
-- >>> divide (mkQuantity 0.42 :: Quantity 2) (mkQuantity 0.42 :: Quantity 2)
-- Just 1.00
-- >>> divide (mkQuantity 0.42 :: Quantity 2) (mkQuantity 0.21 :: Quantity 2)
-- Just 2.00
-- >>> divide (mkQuantity 0.42 :: Quantity 2) (mkQuantity (-0.21) :: Quantity 2)
-- Just -2.00
divide :: KnownNat s => Quantity s -> Quantity s -> Maybe (Quantity s)
divide :: forall (s :: Nat).
KnownNat s =>
Quantity s -> Quantity s -> Maybe (Quantity s)
divide (MkQuantity Decimal RoundHalfEven s Integer
d1) (MkQuantity Decimal RoundHalfEven s Integer
d2) = Decimal RoundHalfEven s Integer -> Quantity s
forall (s :: Nat). Decimal RoundHalfEven s Integer -> Quantity s
MkQuantity (Decimal RoundHalfEven s Integer -> Quantity s)
-> Maybe (Decimal RoundHalfEven s Integer) -> Maybe (Quantity s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decimal RoundHalfEven s Integer
-> Decimal RoundHalfEven s Integer
-> Maybe (Decimal RoundHalfEven s Integer)
forall (m :: * -> *) (s :: Nat) r.
(MonadThrow m, KnownNat s, Round r Integer) =>
Decimal r s Integer
-> Decimal r s Integer -> m (Decimal r s Integer)
D.divideDecimalWithRounding Decimal RoundHalfEven s Integer
d1 Decimal RoundHalfEven s Integer
d2


-- | Divides two quantities with different scales with possible loss preserving
-- dividend's precision.
--
-- >>> divideL (mkQuantity 10 :: Quantity 1) (mkQuantity 3 :: Quantity 2)
-- Just 3.3
-- >>> divideL (mkQuantity 10 :: Quantity 2) (mkQuantity 3 :: Quantity 2)
-- Just 3.33
-- >>> divideL (mkQuantity 10 :: Quantity 3) (mkQuantity 3 :: Quantity 2)
-- Just 3.333
divideL :: (KnownNat s, KnownNat k) => Quantity s -> Quantity k -> Maybe (Quantity s)
divideL :: forall (s :: Nat) (k :: Nat).
(KnownNat s, KnownNat k) =>
Quantity s -> Quantity k -> Maybe (Quantity s)
divideL (MkQuantity Decimal RoundHalfEven s Integer
d1) Quantity k
d2 = Decimal RoundHalfEven s Integer -> Quantity s
forall (s :: Nat). Decimal RoundHalfEven s Integer -> Quantity s
MkQuantity (Decimal RoundHalfEven s Integer -> Quantity s)
-> Maybe (Decimal RoundHalfEven s Integer) -> Maybe (Quantity s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decimal RoundHalfEven s Integer
-> Decimal RoundHalfEven s Integer
-> Maybe (Decimal RoundHalfEven s Integer)
forall (m :: * -> *) (s :: Nat) r.
(MonadThrow m, KnownNat s, Round r Integer) =>
Decimal r s Integer
-> Decimal r s Integer -> m (Decimal r s Integer)
D.divideDecimalWithRounding Decimal RoundHalfEven s Integer
d1 (Quantity s -> Decimal RoundHalfEven s Integer
forall (s :: Nat). Quantity s -> Decimal RoundHalfEven s Integer
unQuantity (Quantity s -> Decimal RoundHalfEven s Integer)
-> Quantity s -> Decimal RoundHalfEven s Integer
forall a b. (a -> b) -> a -> b
$ Quantity s
1 Quantity s -> Quantity k -> Quantity s
forall (s :: Nat) (k :: Nat).
(KnownNat s, KnownNat k) =>
Quantity s -> Quantity k -> Quantity s
`times` Quantity k
d2)


-- | Divides two quantities with different scales with possible loss preserving
-- divisor's precision.
--
-- >>> divideR (mkQuantity 10 :: Quantity 2) (mkQuantity 3 :: Quantity 1)
-- Just 3.3
-- >>> divideR (mkQuantity 10 :: Quantity 2) (mkQuantity 3 :: Quantity 2)
-- Just 3.33
-- >>> divideR (mkQuantity 10 :: Quantity 2) (mkQuantity 3 :: Quantity 3)
-- Just 3.333
divideR :: (KnownNat s, KnownNat k) => Quantity s -> Quantity k -> Maybe (Quantity k)
divideR :: forall (s :: Nat) (k :: Nat).
(KnownNat s, KnownNat k) =>
Quantity s -> Quantity k -> Maybe (Quantity k)
divideR Quantity s
d1 (MkQuantity Decimal RoundHalfEven k Integer
d2) = Decimal RoundHalfEven k Integer -> Quantity k
forall (s :: Nat). Decimal RoundHalfEven s Integer -> Quantity s
MkQuantity (Decimal RoundHalfEven k Integer -> Quantity k)
-> Maybe (Decimal RoundHalfEven k Integer) -> Maybe (Quantity k)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decimal RoundHalfEven k Integer
-> Decimal RoundHalfEven k Integer
-> Maybe (Decimal RoundHalfEven k Integer)
forall (m :: * -> *) (s :: Nat) r.
(MonadThrow m, KnownNat s, Round r Integer) =>
Decimal r s Integer
-> Decimal r s Integer -> m (Decimal r s Integer)
D.divideDecimalWithRounding (Quantity k -> Decimal RoundHalfEven k Integer
forall (s :: Nat). Quantity s -> Decimal RoundHalfEven s Integer
unQuantity (Quantity k -> Decimal RoundHalfEven k Integer)
-> Quantity k -> Decimal RoundHalfEven k Integer
forall a b. (a -> b) -> a -> b
$ Quantity k
1 Quantity k -> Quantity s -> Quantity k
forall (s :: Nat) (k :: Nat).
(KnownNat s, KnownNat k) =>
Quantity s -> Quantity k -> Quantity s
`times` Quantity s
d1) Decimal RoundHalfEven k Integer
d2


-- | Divides two quantities with different scales with possible loss with a
-- target precision of result.
--
-- >>> :set -XTypeApplications
-- >>> divideD @0 (mkQuantity 10 :: Quantity 2) (mkQuantity 3 :: Quantity 2)
-- Just 3
-- >>> divideD @1 (mkQuantity 10 :: Quantity 2) (mkQuantity 3 :: Quantity 2)
-- Just 3.3
-- >>> divideD @2 (mkQuantity 10 :: Quantity 2) (mkQuantity 3 :: Quantity 2)
-- Just 3.33
-- >>> divideD @3 (mkQuantity 10 :: Quantity 2) (mkQuantity 3 :: Quantity 2)
-- Just 3.333
-- >>> divideD @8 (mkQuantity 1111 :: Quantity 2) (mkQuantity 3333 :: Quantity 12)
-- Just 0.33333333
divideD :: (KnownNat r, KnownNat s, KnownNat k) => Quantity s -> Quantity k -> Maybe (Quantity r)
divideD :: forall (r :: Nat) (s :: Nat) (k :: Nat).
(KnownNat r, KnownNat s, KnownNat k) =>
Quantity s -> Quantity k -> Maybe (Quantity r)
divideD Quantity s
d1 Quantity k
d2 = Decimal RoundHalfEven r Integer -> Quantity r
forall (s :: Nat). Decimal RoundHalfEven s Integer -> Quantity s
MkQuantity (Decimal RoundHalfEven r Integer -> Quantity r)
-> Maybe (Decimal RoundHalfEven r Integer) -> Maybe (Quantity r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decimal RoundHalfEven r Integer
-> Decimal RoundHalfEven r Integer
-> Maybe (Decimal RoundHalfEven r Integer)
forall (m :: * -> *) (s :: Nat) r.
(MonadThrow m, KnownNat s, Round r Integer) =>
Decimal r s Integer
-> Decimal r s Integer -> m (Decimal r s Integer)
D.divideDecimalWithRounding (Quantity r -> Decimal RoundHalfEven r Integer
forall (s :: Nat). Quantity s -> Decimal RoundHalfEven s Integer
unQuantity (Quantity r -> Decimal RoundHalfEven r Integer)
-> Quantity r -> Decimal RoundHalfEven r Integer
forall a b. (a -> b) -> a -> b
$ Quantity r
1 Quantity r -> Quantity s -> Quantity r
forall (s :: Nat) (k :: Nat).
(KnownNat s, KnownNat k) =>
Quantity s -> Quantity k -> Quantity s
`times` Quantity s
d1) (Quantity r -> Decimal RoundHalfEven r Integer
forall (s :: Nat). Quantity s -> Decimal RoundHalfEven s Integer
unQuantity (Quantity r -> Decimal RoundHalfEven r Integer)
-> Quantity r -> Decimal RoundHalfEven r Integer
forall a b. (a -> b) -> a -> b
$ Quantity r
1 Quantity r -> Quantity k -> Quantity r
forall (s :: Nat) (k :: Nat).
(KnownNat s, KnownNat k) =>
Quantity s -> Quantity k -> Quantity s
`times` Quantity k
d2)


-- | Returns the total of a list of unsigned quantities.
--
-- >>> sumUnsignedQuantity [] :: UnsignedQuantity 2
-- Refined 0.00
sumUnsignedQuantity
  :: KnownNat s
  => [UnsignedQuantity s]
  -> UnsignedQuantity s
sumUnsignedQuantity :: forall (s :: Nat).
KnownNat s =>
[UnsignedQuantity s] -> UnsignedQuantity s
sumUnsignedQuantity = Quantity s -> Refined NonNegative (Quantity s)
forall {k} (p :: k) x. Predicate p x => x -> Refined p x
unsafeRefine (Quantity s -> Refined NonNegative (Quantity s))
-> ([Refined NonNegative (Quantity s)] -> Quantity s)
-> [Refined NonNegative (Quantity s)]
-> Refined NonNegative (Quantity s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Quantity s] -> Quantity s
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Quantity s] -> Quantity s)
-> ([Refined NonNegative (Quantity s)] -> [Quantity s])
-> [Refined NonNegative (Quantity s)]
-> Quantity s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Refined NonNegative (Quantity s) -> Quantity s)
-> [Refined NonNegative (Quantity s)] -> [Quantity s]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Refined NonNegative (Quantity s) -> Quantity s
forall {k} (p :: k) x. Refined p x -> x
unrefine


-- | Returns the absolute value of the 'Quantity' as 'UnsignedQuantity'.
--
-- >>> abs (mkQuantity 0.42 :: Quantity 2)
-- 0.42
-- >>> abs (mkQuantity 0 :: Quantity 2)
-- 0.00
-- >>> abs (mkQuantity (-0.42) :: Quantity 2)
-- 0.42
absQuantity
  :: KnownNat s
  => Quantity s
  -> UnsignedQuantity s
absQuantity :: forall (s :: Nat). KnownNat s => Quantity s -> UnsignedQuantity s
absQuantity = Quantity s -> Refined NonNegative (Quantity s)
forall {k} (p :: k) x. Predicate p x => x -> Refined p x
unsafeRefine (Quantity s -> Refined NonNegative (Quantity s))
-> (Quantity s -> Quantity s)
-> Quantity s
-> Refined NonNegative (Quantity s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quantity s -> Quantity s
forall a. Num a => a -> a
abs


-- * Internal


-- | Auxiliary function for constructing 'Quantity' values.
--
-- See 'mkQuantity' why we need this function and why we haven't used it as the
-- direct implementation of 'mkQuantity'.
--
-- Call-sites should avoid using this function directly due to its performance
-- characteristics.
mkQuantityAux :: forall s. KnownNat s => Scientific -> Quantity s
mkQuantityAux :: forall (s :: Nat). KnownNat s => Scientific -> Quantity s
mkQuantityAux Scientific
x = Quantity s -> Either String (Quantity s) -> Quantity s
forall b a. b -> Either a b -> b
fromRight Quantity s
forall {a}. a
err (Either String (Quantity s) -> Quantity s)
-> Either String (Quantity s) -> Quantity s
forall a b. (a -> b) -> a -> b
$ Scientific -> Either String (Quantity s)
forall (s :: Nat) (m :: * -> *).
(KnownNat s, MonadError String m) =>
Scientific -> m (Quantity s)
mkQuantityLossless (Int -> Scientific -> Scientific
roundScientific Int
nof Scientific
x)
  where
    -- Get the term-level scaling for the target value:
    nof :: Int
nof = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy s -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy s
forall {k} (t :: k). Proxy t
Proxy :: Proxy s)

    -- This function should NOT fail in practice ever, but it can fail due to
    -- type signatures by right. We will let it error with a message for
    -- ourselves:
    err :: a
err = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"PROGRAMMING ERROR: Can not construct 'Quantity " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
nof String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"' with '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Scientific -> String
forall a. Show a => a -> String
show Scientific
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"' in a lossy way."


-- | Rounds a given scientific into a new scientific with given max digits after
-- decimal point.
--
-- This uses half-even rounding method.
--
-- >>> roundScientific 0 0.4
-- 0.0
-- >>> roundScientific 0 0.5
-- 0.0
-- >>> roundScientific 0 0.6
-- 1.0
-- >>> roundScientific 0 1.4
-- 1.0
-- >>> roundScientific 0 1.5
-- 2.0
-- >>> roundScientific 0 1.6
-- 2.0
-- >>> roundScientific 1 0.04
-- 0.0
-- >>> roundScientific 1 0.05
-- 0.0
-- >>> roundScientific 1 0.06
-- 0.1
-- >>> roundScientific 1 0.14
-- 0.1
-- >>> roundScientific 1 0.15
-- 0.2
-- >>> roundScientific 1 0.16
-- 0.2
-- >>> roundScientific 1 3.650
-- 3.6
-- >>> roundScientific 1 3.740
-- 3.7
-- >>> roundScientific 1 3.749
-- 3.7
-- >>> roundScientific 1 3.750
-- 3.8
-- >>> roundScientific 1 3.751
-- 3.8
-- >>> roundScientific 1  3.760
-- 3.8
-- >>> roundScientific 1 (-3.650)
-- -3.6
-- >>> roundScientific 1 (-3.740)
-- -3.7
-- >>> roundScientific 1 (-3.749)
-- -3.7
-- >>> roundScientific 1 (-3.750)
-- -3.8
-- >>> roundScientific 1 (-3.751)
-- -3.8
-- >>> roundScientific 1 (-3.760)
-- -3.8
--
-- TODO: Refactor to improve the performance of this function.
roundScientific :: Int -> Scientific -> Scientific
roundScientific :: Int -> Scientific -> Scientific
roundScientific = (String -> Scientific
forall a. Read a => String -> a
read (String -> Scientific)
-> (Scientific -> String) -> Scientific -> Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Scientific -> String) -> Scientific -> Scientific)
-> (Int -> Scientific -> String) -> Int -> Scientific -> Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FPFormat -> Maybe Int -> Scientific -> String
formatScientific FPFormat
Fixed (Maybe Int -> Scientific -> String)
-> (Int -> Maybe Int) -> Int -> Scientific -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Int
forall a. a -> Maybe a
Just