{-# 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.Applicative (liftA2)
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
forall (s :: Nat). Quantity s -> Quantity s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: 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
Eq, 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
min :: Quantity s -> Quantity s -> Quantity s
$cmin :: forall (s :: Nat). Quantity s -> Quantity s -> Quantity s
max :: Quantity s -> Quantity s -> Quantity s
$cmax :: forall (s :: Nat). Quantity s -> Quantity s -> Quantity s
>= :: 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
$c< :: forall (s :: Nat). Quantity s -> Quantity s -> Bool
compare :: Quantity s -> Quantity s -> Ordering
$ccompare :: forall (s :: Nat). Quantity s -> Quantity s -> Ordering
Ord, forall (s :: Nat) x. Rep (Quantity s) x -> Quantity s
forall (s :: Nat) x. Quantity s -> Rep (Quantity s) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall (s :: Nat) x. Rep (Quantity s) x -> Quantity s
$cfrom :: forall (s :: Nat) x. Quantity s -> Rep (Quantity s) x
Generic, Integer -> Quantity s
Quantity s -> Quantity s
Quantity s -> Quantity s -> 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
fromInteger :: Integer -> Quantity s
$cfromInteger :: forall (s :: Nat). KnownNat s => Integer -> Quantity s
signum :: Quantity s -> Quantity s
$csignum :: forall (s :: Nat). KnownNat s => Quantity s -> Quantity s
abs :: Quantity s -> Quantity s
$cabs :: forall (s :: Nat). KnownNat s => Quantity s -> Quantity s
negate :: Quantity s -> Quantity s
$cnegate :: forall (s :: Nat). KnownNat 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
$c+ :: forall (s :: Nat).
KnownNat s =>
Quantity s -> Quantity s -> 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 = forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
Aeson.withScientific String
"Quantity" (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p (s :: Nat) r.
(Integral p, KnownNat s) =>
Decimal r s p -> Scientific
D.toScientificDecimal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Nat). Quantity s -> Decimal RoundHalfEven s Integer
unQuantity
  toEncoding :: Quantity s -> Encoding
toEncoding = Scientific -> Encoding
Aeson.Encoding.scientific forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p (s :: Nat) r.
(Integral p, KnownNat s) =>
Decimal r s p -> Scientific
D.toScientificDecimal forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)
(+) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Num a => a -> a -> a
(+)
  (-) = 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)
(*) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Num a => a -> a -> a
(*)
  signum :: Arith (Quantity s) -> Arith (Quantity s)
signum = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Num a => a -> a
signum
  abs :: Arith (Quantity s) -> Arith (Quantity s)
abs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Num a => a -> a
abs
  fromInteger :: Integer -> Arith (Quantity s)
fromInteger = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Nat). Decimal RoundHalfEven s Integer -> Quantity s
MkQuantity forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (s :: Nat). Decimal RoundHalfEven s Integer -> Quantity s
MkQuantity forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (s :: Nat). Quantity s -> Decimal RoundHalfEven s Integer
unQuantity Arith (Quantity s)
a forall a. Fractional a => a -> a -> a
/ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (s :: Nat). Quantity s -> Decimal RoundHalfEven s Integer
unQuantity Arith (Quantity s)
b
  fromRational :: Rational -> Arith (Quantity s)
fromRational = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (s :: Nat). Decimal RoundHalfEven s Integer -> Quantity s
MkQuantity forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall (s :: Nat) (m :: * -> *).
(KnownNat s, MonadError String m) =>
Scientific -> m (Quantity s)
mkQuantityLossless Scientific
s of
  Left String
_ -> 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 = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String
"Underflow while trying to create quantity: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Scientific
s)) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Nat). Decimal RoundHalfEven s Integer -> Quantity s
MkQuantity) forall a b. (a -> b) -> a -> b
$ 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) = forall (s :: Nat). Decimal RoundHalfEven s Integer -> Quantity s
MkQuantity (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 = forall (k :: Nat) (n :: Nat).
KnownNat k =>
Quantity (n + k) -> Quantity n
roundQuantity (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) = forall (s :: Nat). Decimal RoundHalfEven s Integer -> Quantity s
MkQuantity (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) = forall (s :: Nat). Decimal RoundHalfEven s Integer -> Quantity s
MkQuantity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall (s :: Nat). Decimal RoundHalfEven s Integer -> Quantity s
MkQuantity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 (forall (s :: Nat). Quantity s -> Decimal RoundHalfEven s Integer
unQuantity forall a b. (a -> b) -> a -> b
$ Quantity s
1 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) = forall (s :: Nat). Decimal RoundHalfEven s Integer -> Quantity s
MkQuantity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 (forall (s :: Nat). Quantity s -> Decimal RoundHalfEven s Integer
unQuantity forall a b. (a -> b) -> a -> b
$ Quantity k
1 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 = forall (s :: Nat). Decimal RoundHalfEven s Integer -> Quantity s
MkQuantity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 (forall (s :: Nat). Quantity s -> Decimal RoundHalfEven s Integer
unQuantity forall a b. (a -> b) -> a -> b
$ Quantity r
1 forall (s :: Nat) (k :: Nat).
(KnownNat s, KnownNat k) =>
Quantity s -> Quantity k -> Quantity s
`times` Quantity s
d1) (forall (s :: Nat). Quantity s -> Decimal RoundHalfEven s Integer
unQuantity forall a b. (a -> b) -> a -> b
$ Quantity r
1 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 = forall p x. Predicate p x => x -> Refined p x
unsafeRefine forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall p 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 = forall p x. Predicate p x => x -> Refined p x
unsafeRefine forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall b a. b -> Either a b -> b
fromRight forall {a}. a
err forall a b. (a -> b) -> a -> b
$ 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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (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 = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"PROGRAMMING ERROR: Can not construct 'Quantity " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
nof forall a. Semigroup a => a -> a -> a
<> String
"' with '" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Scientific
x 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 = (forall a. Read a => String -> a
read forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FPFormat -> Maybe Int -> Scientific -> String
formatScientific FPFormat
Fixed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just