{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_HADDOCK hide #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- | This is an internal module. You may use stuff exported from here, but we
-- can't guarantee their stability.
module Money.Internal
 ( -- * Dense monetary values
   Dense
 , denseCurrency
 , denseCurrency'
 , dense
 , dense'
 , denseFromDiscrete
 , denseFromDecimal
 , denseToDecimal
   -- * Discrete monetary values
 , Discrete
 , Discrete'
 , discrete
 , discreteCurrency
 , discreteCurrency'
 , discreteFromDense
 , discreteFromDecimal
 , discreteToDecimal
   -- * Currency scales
 , Scale
 , scaleFromRational
 , scaleToRational
 , scale
 , UnitScale
 , CurrencyScale
 , GoodScale
 , ErrScaleNonCanonical
   -- * Currency exchange
 , ExchangeRate
 , exchangeRate
 , exchangeRate'
 , exchange
 , exchangeRateFromDecimal
 , exchangeRateToDecimal
 , exchangeRateToRational
 , exchangeRateRecip
   -- * Serializable representations
 , SomeDense
 , toSomeDense
 , mkSomeDense
 , mkSomeDense'
 , fromSomeDense
 , withSomeDense
 , someDenseToDecimal
 , someDenseCurrency
 , someDenseCurrency'
 , someDenseAmount
 , SomeDiscrete
 , toSomeDiscrete
 , mkSomeDiscrete
 , mkSomeDiscrete'
 , fromSomeDiscrete
 , withSomeDiscrete
 , someDiscreteToDecimal
 , someDiscreteCurrency
 , someDiscreteCurrency'
 , someDiscreteScale
 , someDiscreteAmount
 , SomeExchangeRate
 , toSomeExchangeRate
 , mkSomeExchangeRate
 , mkSomeExchangeRate'
 , fromSomeExchangeRate
 , withSomeExchangeRate
 , someExchangeRateToDecimal
 , someExchangeRateSrcCurrency
 , someExchangeRateSrcCurrency'
 , someExchangeRateDstCurrency
 , someExchangeRateDstCurrency'
 , someExchangeRateRate
 -- * Rationals
 , rationalToDecimal
 , rationalFromDecimal
 -- * Miscellaneous
 , Approximation(Round, Floor, Ceiling, Truncate, HalfEven, HalfAwayFromZero)
 , approximate
 -- ** Decimal config
 , DecimalConf(..)
 , defaultDecimalConf
 -- *** Separators
 , Separators
 , mkSeparators
 , separatorsComma
 , separatorsCommaDot
 , separatorsCommaNarrownbsp
 , separatorsCommaNbsp
 , separatorsCommaThinsp
 , separatorsCommaSpace
 , separatorsDot
 , separatorsDotComma
 , separatorsDotNarrownbsp
 , separatorsDotThinsp
 , separatorsDotNbsp
 , separatorsDotSpace
 ) where

import Control.Applicative ((<|>), empty)
import Control.Category (Category((.), id))
import Control.DeepSeq (NFData)
import Control.Monad (guard, when)
import qualified Data.AdditiveGroup as AG
import qualified Data.Binary as Binary
import qualified Data.Char as Char
import Data.Constraint (Dict(Dict))
import Data.Functor (($>))
import Data.Foldable (for_)
import Data.Hashable (Hashable)
import qualified Data.List as List
import Data.Maybe (catMaybes, isJust, fromJust)
import Data.Monoid ((<>))
import Data.Proxy (Proxy(..))
import Data.Ratio ((%), numerator, denominator)
import qualified Data.Text as T
import qualified Data.VectorSpace as VS
import Data.Word (Word8)
import GHC.Exts (Constraint)
import qualified GHC.Generics as GHC
import GHC.TypeLits
  (Symbol, SomeSymbol(..), Nat, SomeNat(..), CmpNat, KnownSymbol, KnownNat,
   natVal, someNatVal, symbolVal, someSymbolVal)
import qualified GHC.TypeLits as GHC
import Numeric.Natural (Natural)
import Prelude hiding ((.), id)
import qualified Test.QuickCheck as QC
import qualified Text.ParserCombinators.ReadPrec as ReadPrec
import qualified Text.ParserCombinators.ReadP as ReadP
import Text.Printf (printf)
import qualified Text.Read as Read
import Unsafe.Coerce (unsafeCoerce)


--------------------------------------------------------------------------------
-- | 'Dense' represents a dense monetary value for @currency@ (usually a
-- ISO-4217 currency code, but not necessarily) as a rational number.
--
-- While monetary values associated with a particular currency are
-- discrete (e.g., an exact number of coins and bills), you can still treat
-- monetary values as dense while operating on them. For example, the half
-- of @USD 3.41@ is @USD 1.705@, which is not an amount that can't be
-- represented as a number of USD cents (the smallest unit that can
-- represent USD amounts). Nevertheless, if you do manage to represent @USD
-- 1.705@ somehow, and you eventually multiply @USD 1.705@ by @4@ for
-- example, then you end up with @USD 6.82@, which is again a value
-- representable as USD cents. In other words, 'Dense' monetary values
-- allow us to perform precise calculations deferring the conversion to a
-- 'Discrete' monetary values as much as posible. Once you are ready to
-- approximate a 'Dense' value to a 'Discrete' value you can use one
-- 'discreteFromDense'. Otherwise, using 'toRational' you can obtain a
-- precise 'Rational' representation.

-- Construct 'Dense' monetary values using 'dense', 'dense'',
-- 'denseFromDiscrete', 'denseFromDecimal'.
--
-- /WARNING/ if you want to treat a dense monetary value as a /Real/ number
-- like 'Float' or 'Double', then you are on your own. We can only
-- guarantee lossless manipulation of rational values, so you will need to
-- convert back and forth betwen the 'Rational' representation for 'Dense'
-- and your (likely lossy) representation for /Real/ numbers.
newtype Dense (currency :: Symbol) = Dense Rational
  deriving (Dense currency -> Dense currency -> Bool
(Dense currency -> Dense currency -> Bool)
-> (Dense currency -> Dense currency -> Bool)
-> Eq (Dense currency)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (currency :: Symbol).
Dense currency -> Dense currency -> Bool
/= :: Dense currency -> Dense currency -> Bool
$c/= :: forall (currency :: Symbol).
Dense currency -> Dense currency -> Bool
== :: Dense currency -> Dense currency -> Bool
$c== :: forall (currency :: Symbol).
Dense currency -> Dense currency -> Bool
Eq, Eq (Dense currency)
Eq (Dense currency)
-> (Dense currency -> Dense currency -> Ordering)
-> (Dense currency -> Dense currency -> Bool)
-> (Dense currency -> Dense currency -> Bool)
-> (Dense currency -> Dense currency -> Bool)
-> (Dense currency -> Dense currency -> Bool)
-> (Dense currency -> Dense currency -> Dense currency)
-> (Dense currency -> Dense currency -> Dense currency)
-> Ord (Dense currency)
Dense currency -> Dense currency -> Bool
Dense currency -> Dense currency -> Ordering
Dense currency -> Dense currency -> Dense currency
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
forall (currency :: Symbol). Eq (Dense currency)
forall (currency :: Symbol).
Dense currency -> Dense currency -> Bool
forall (currency :: Symbol).
Dense currency -> Dense currency -> Ordering
forall (currency :: Symbol).
Dense currency -> Dense currency -> Dense currency
min :: Dense currency -> Dense currency -> Dense currency
$cmin :: forall (currency :: Symbol).
Dense currency -> Dense currency -> Dense currency
max :: Dense currency -> Dense currency -> Dense currency
$cmax :: forall (currency :: Symbol).
Dense currency -> Dense currency -> Dense currency
>= :: Dense currency -> Dense currency -> Bool
$c>= :: forall (currency :: Symbol).
Dense currency -> Dense currency -> Bool
> :: Dense currency -> Dense currency -> Bool
$c> :: forall (currency :: Symbol).
Dense currency -> Dense currency -> Bool
<= :: Dense currency -> Dense currency -> Bool
$c<= :: forall (currency :: Symbol).
Dense currency -> Dense currency -> Bool
< :: Dense currency -> Dense currency -> Bool
$c< :: forall (currency :: Symbol).
Dense currency -> Dense currency -> Bool
compare :: Dense currency -> Dense currency -> Ordering
$ccompare :: forall (currency :: Symbol).
Dense currency -> Dense currency -> Ordering
$cp1Ord :: forall (currency :: Symbol). Eq (Dense currency)
Ord, Num (Dense currency)
Ord (Dense currency)
Num (Dense currency)
-> Ord (Dense currency)
-> (Dense currency -> Rational)
-> Real (Dense currency)
Dense currency -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
forall (currency :: Symbol). Num (Dense currency)
forall (currency :: Symbol). Ord (Dense currency)
forall (currency :: Symbol). Dense currency -> Rational
toRational :: Dense currency -> Rational
$ctoRational :: forall (currency :: Symbol). Dense currency -> Rational
$cp2Real :: forall (currency :: Symbol). Ord (Dense currency)
$cp1Real :: forall (currency :: Symbol). Num (Dense currency)
Real, (forall x. Dense currency -> Rep (Dense currency) x)
-> (forall x. Rep (Dense currency) x -> Dense currency)
-> Generic (Dense currency)
forall x. Rep (Dense currency) x -> Dense currency
forall x. Dense currency -> Rep (Dense currency) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (currency :: Symbol) x.
Rep (Dense currency) x -> Dense currency
forall (currency :: Symbol) x.
Dense currency -> Rep (Dense currency) x
$cto :: forall (currency :: Symbol) x.
Rep (Dense currency) x -> Dense currency
$cfrom :: forall (currency :: Symbol) x.
Dense currency -> Rep (Dense currency) x
GHC.Generic)

-- | Notice that multiplication of 'Dense' values doesn't make sense:
--
-- @
-- ('*') :: 'Dense' currency -> 'Dense' currency -> 'Dense' currency
-- @
--
-- How is '*' implemented, then? It behaves as the /scalar multiplication/ of a
-- 'Dense' amount by a 'Rational' scalar. That is, you can think of '*' as
-- having one of the the following types:
--
-- @
-- ('*') :: 'Rational' -> 'Dense' currency -> 'Dense' currency
-- @
--
-- @
-- ('*') :: 'Dense' currency -> 'Rational' -> 'Dense' currency@
-- @
--
-- That is:
--
-- @
-- 'dense'' (1 '%' 4) '*' 'dense'' (1 '%' 2)  ==  'dense'' (1 '%' 8)
-- @
--
-- In fact, '*' functions exactly as 'Data.VectorSpace.*^' from the
-- 'Data.VectorSpace' instance.
--
-- @
-- ('*')  ==  ('Data.VectorSpace.*^')
-- @
--
-- @
-- ('*')  ==  'flip' ('Data.VectorSpace.*^')
-- @
deriving instance Num (Dense currency)

type family ErrFractionalDense :: Constraint where
  ErrFractionalDense
    = GHC.TypeError
      (('GHC.Text "The ") 'GHC.:<>:
       ('GHC.ShowType Dense) 'GHC.:<>:
       ('GHC.Text " type is deliberately not an instance of ") 'GHC.:<>:
       ('GHC.ShowType Fractional) 'GHC.:$$:
       ('GHC.Text "because functions like 'recip' and '/' can diverge.") 'GHC.:$$:
       ('GHC.Text "Temporarily convert the ") 'GHC.:<>:
       ('GHC.ShowType Dense) 'GHC.:<>:
       ('GHC.Text " value to a ") 'GHC.:<>:
       ('GHC.ShowType Rational) 'GHC.:$$:
       ('GHC.Text " if you know what you are doing."))

instance ErrFractionalDense => Fractional (Dense currency) where
  fromRational :: Rational -> Dense currency
fromRational = Rational -> Dense currency
forall a. HasCallStack => a
undefined
  recip :: Dense currency -> Dense currency
recip = Dense currency -> Dense currency
forall a. HasCallStack => a
undefined

-- |
-- @
-- > 'show' ('dense'' (1 '%' 3) :: 'Dense' \"USD\")
-- \"Dense \\\"USD\\\" 1%3\"
-- @
instance forall currency. KnownSymbol currency => Show (Dense currency) where
  showsPrec :: Int -> Dense currency -> ShowS
showsPrec Int
n = \(Dense Rational
r0) ->
    let c :: String
c = Proxy currency -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy currency
forall k (t :: k). Proxy t
Proxy :: Proxy currency)
    in Bool -> ShowS -> ShowS
showParen (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
         String -> ShowS
showString String
"Dense " ShowS -> ShowS -> ShowS
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> String -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 String
c ShowS -> ShowS -> ShowS
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
         Int -> Integer -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 (Rational -> Integer
forall a. Ratio a -> a
numerator Rational
r0) ShowS -> ShowS -> ShowS
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> ShowS
showChar Char
'%' ShowS -> ShowS -> ShowS
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
         Int -> Integer -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 (Rational -> Integer
forall a. Ratio a -> a
denominator Rational
r0)

instance forall currency. KnownSymbol currency => Read (Dense currency) where
  readPrec :: ReadPrec (Dense currency)
readPrec = ReadPrec (Dense currency) -> ReadPrec (Dense currency)
forall a. ReadPrec a -> ReadPrec a
Read.parens (ReadPrec (Dense currency) -> ReadPrec (Dense currency))
-> ReadPrec (Dense currency) -> ReadPrec (Dense currency)
forall a b. (a -> b) -> a -> b
$ do
    let c :: String
c = Proxy currency -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy currency
forall k (t :: k). Proxy t
Proxy :: Proxy currency)
    String
_ <- ReadP String -> ReadPrec String
forall a. ReadP a -> ReadPrec a
ReadPrec.lift (String -> ReadP String
ReadP.string (String
"Dense " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" "))
    ReadPrec (Dense currency)
-> (Dense currency -> ReadPrec (Dense currency))
-> Maybe (Dense currency)
-> ReadPrec (Dense currency)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ReadPrec (Dense currency)
forall (f :: * -> *) a. Alternative f => f a
empty Dense currency -> ReadPrec (Dense currency)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Dense currency) -> ReadPrec (Dense currency))
-> ReadPrec (Maybe (Dense currency)) -> ReadPrec (Dense currency)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Rational -> Maybe (Dense currency))
-> ReadPrec Rational -> ReadPrec (Maybe (Dense currency))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rational -> Maybe (Dense currency)
forall (currency :: Symbol). Rational -> Maybe (Dense currency)
dense ReadPrec Rational
forall a. Read a => ReadPrec a
Read.readPrec

-- | Build a 'Dense' monetary value from a 'Rational' value.
--
-- For example, if you want to represent @USD 12.52316@, then you can use:
--
-- @
-- 'dense' (125316 '%' 10000)
-- @
--
-- Notice that 'dense' returns 'Nothing' in case the given 'Rational''s
-- denominator is zero, which although unlikely, it is possible if the
-- 'Rational' was unsafely constructed. When dealing with hardcoded or trusted
-- 'Rational' values, you can use 'dense'' instead of 'dense' which unsafely
-- constructs a 'Dense'.
dense :: Rational -> Maybe (Dense currency)
dense :: Rational -> Maybe (Dense currency)
dense = \Rational
r ->
  if Rational -> Integer
forall a. Ratio a -> a
denominator Rational
r Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0
  then Dense currency -> Maybe (Dense currency)
forall a. a -> Maybe a
Just (Rational -> Dense currency
forall (currency :: Symbol). Rational -> Dense currency
Dense Rational
r)
  else Maybe (Dense currency)
forall a. Maybe a
Nothing
{-# INLINE dense #-}

-- | Unsafely build a 'Dense' monetary value from a 'Rational' value. Contrary
-- to 'dense', this function *crashes* if the given 'Rational' has zero as a
-- denominator, which is something very unlikely to happen unless the given
-- 'Rational' was itself unsafely constructed. Other than that, 'dense' and
-- 'dense'' behave the same.
--
-- Prefer to use 'dense' when dealing with 'Rational' inputs from untrusted
-- sources.
--
-- @
-- 'denominator' x /= 0
--   ⇒ 'dense' x == 'Just' ('dense'' x)
-- @
--
-- @
-- 'denominator' x == 0
--   ⇒ 'undefined' == 'dense'' x
-- @
dense' :: Rational -> Dense currency
dense' :: Rational -> Dense currency
dense' = \Rational
r ->
  if Rational -> Integer
forall a. Ratio a -> a
denominator Rational
r Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0
  then Rational -> Dense currency
forall (currency :: Symbol). Rational -> Dense currency
Dense Rational
r
  else String -> Dense currency
forall a. HasCallStack => String -> a
error String
"dense': malformed Rational given (denominator is zero)."
{-# INLINABLE dense' #-}

-- | 'Dense' currency identifier.
--
-- @
-- > 'denseCurrency' ('dense'' 4 :: 'Dense' \"USD\")
-- \"USD\"
-- @
denseCurrency :: KnownSymbol currency => Dense currency -> T.Text
denseCurrency :: Dense currency -> Text
denseCurrency = String -> Text
T.pack (String -> Text)
-> (Dense currency -> String) -> Dense currency -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Dense currency -> String
forall (currency :: Symbol).
KnownSymbol currency =>
Dense currency -> String
denseCurrency'
{-# INLINE denseCurrency #-}

-- | Like 'denseCurrency' but returns 'String'.
denseCurrency' :: KnownSymbol currency => Dense currency -> String
denseCurrency' :: Dense currency -> String
denseCurrency' = Dense currency -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal
{-# INLINE denseCurrency' #-}

-- | 'Discrete' represents a discrete monetary value for a @currency@ expresed
-- as an integer amount of a particular @unit@. For example, with @currency ~
-- \"USD\"@ and @unit ~ \"cent\"@ you can represent United States Dollars to
-- their full extent.
--
-- @currency@ is usually a ISO-4217 currency code, but not necessarily.
--
-- Construct 'Discrete' values using 'discrete', 'fromIntegral', 'fromInteger',
-- 'discreteFromDense', 'discreteFromDecimal'.
--
-- For example, if you want to represent @GBP 21.05@, where the smallest
-- represetable unit for a GBP (United Kingdom Pound) is the /penny/, and 100
-- /pennies/ equal 1 GBP (i.e., @'UnitScale' \"GBP\" \"penny\" ~ '(100, 1)@), then
-- you can use:
--
-- @
-- 'discrete' 2105 :: 'Discrete' \"GBP\" \"penny\"
-- @
--
-- Because @2105 / 100 == 21.05@.
type Discrete (currency :: Symbol) (unit :: Symbol)
  = Discrete' currency (UnitScale currency unit)

-- | 'Discrete'' represents a discrete monetary value for a @currency@ expresed
-- as amount of @scale@, which is a rational number expressed as @(numerator,
-- denominator)@.
--
-- You'll be using 'Discrete' instead of 'Discrete'' most of the time, which
-- mentions the unit name (such as /cent/ or /centavo/) instead of explicitely
-- mentioning the unit scale.
newtype Discrete' (currency :: Symbol) (scale :: (Nat, Nat))
  = Discrete Integer

deriving instance GoodScale scale => Eq (Discrete' currency scale)
deriving instance GoodScale scale => Ord (Discrete' currency scale)
deriving instance GoodScale scale => Enum (Discrete' currency scale)
deriving instance GoodScale scale => Real (Discrete' currency scale)
deriving instance GoodScale scale => Integral (Discrete' currency scale)
deriving instance GoodScale scale => GHC.Generic (Discrete' currency scale)

-- | Notice that multiplication of 'Discrete'' values doesn't make sense:
--
-- @
-- ('*') :: 'Discrete'' currency scale -> 'Discrete'' currency scale -> 'Discrete'' currency scale
-- @
--
-- How is '*' implemented, then? It behaves as the /scalar multiplication/ of a
-- 'Discrete'' amount by an 'Integer' scalar. That is, you can think of '*' as
-- having one of the the following types:
--
-- @
-- ('*') :: 'Integer' -> 'Discrete'' currency scale -> 'Discrete'' currency scale
-- @
--
-- @
-- ('*') :: 'Discrete'' currency scale -> 'Integer' -> 'Discrete'' currency scale@
-- @
--
-- That is:
--
-- @
-- 'discrete' 2 '*' 'discrete' 4  ==  'discrete' 8
-- @
--
-- In fact, '*' functions exactly as 'Data.VectorSpace.*^' from the
-- 'Data.VectorSpace' instance.
--
-- @
-- ('*')  ==  ('Data.VectorSpace.*^')
-- @
--
-- @
-- ('*')  ==  'flip' ('Data.VectorSpace.*^')
-- @
deriving instance GoodScale scale => Num (Discrete' currency scale)

-- |
-- @
-- > 'show' ('discrete' 123 :: 'Discrete' \"USD\" \"cent\")
-- \"Discrete \\\"USD\\\" 100%1 123\"
-- @
instance forall currency scale.
  ( KnownSymbol currency, GoodScale scale
  ) => Show (Discrete' currency scale) where
  showsPrec :: Int -> Discrete' currency scale -> ShowS
showsPrec Int
n = \d0 :: Discrete' currency scale
d0@(Discrete Integer
i0) ->
    let c :: String
c = Proxy currency -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy currency
forall k (t :: k). Proxy t
Proxy :: Proxy currency) :: String
        rs :: Rational
rs = Scale -> Rational
scaleToRational (Discrete' currency scale -> Scale
forall (proxy :: (Nat, Nat) -> *) (scale :: (Nat, Nat)).
GoodScale scale =>
proxy scale -> Scale
scale Discrete' currency scale
d0) :: Rational
    in Bool -> ShowS -> ShowS
showParen (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
         String -> ShowS
showString String
"Discrete " ShowS -> ShowS -> ShowS
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.  Int -> String -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 String
c ShowS -> ShowS -> ShowS
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
         Int -> Integer -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 (Rational -> Integer
forall a. Ratio a -> a
numerator Rational
rs) ShowS -> ShowS -> ShowS
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> ShowS
showChar Char
'%' ShowS -> ShowS -> ShowS
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
         Int -> Integer -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 (Rational -> Integer
forall a. Ratio a -> a
denominator Rational
rs) ShowS -> ShowS -> ShowS
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
         Int -> Integer -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 Integer
i0

instance forall currency scale.
  ( KnownSymbol currency, GoodScale scale
  ) => Read (Discrete' currency scale) where
  readPrec :: ReadPrec (Discrete' currency scale)
readPrec = ReadPrec (Discrete' currency scale)
-> ReadPrec (Discrete' currency scale)
forall a. ReadPrec a -> ReadPrec a
Read.parens (ReadPrec (Discrete' currency scale)
 -> ReadPrec (Discrete' currency scale))
-> ReadPrec (Discrete' currency scale)
-> ReadPrec (Discrete' currency scale)
forall a b. (a -> b) -> a -> b
$ do
    let c :: String
c = Proxy currency -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy currency
forall k (t :: k). Proxy t
Proxy :: Proxy currency) :: String
        rs :: Rational
rs = Scale -> Rational
scaleToRational (Proxy scale -> Scale
forall (proxy :: (Nat, Nat) -> *) (scale :: (Nat, Nat)).
GoodScale scale =>
proxy scale -> Scale
scale (Proxy scale
forall k (t :: k). Proxy t
Proxy :: Proxy scale)) :: Rational
    String
_ <- ReadP String -> ReadPrec String
forall a. ReadP a -> ReadPrec a
ReadPrec.lift (String -> ReadP String
ReadP.string ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
           [ String
"Discrete ", ShowS
forall a. Show a => a -> String
show String
c, String
" "
           , Integer -> String
forall a. Show a => a -> String
show (Rational -> Integer
forall a. Ratio a -> a
numerator Rational
rs), String
"%"
           , Integer -> String
forall a. Show a => a -> String
show (Rational -> Integer
forall a. Ratio a -> a
denominator Rational
rs), String
" "
           ]))
    (Integer -> Discrete' currency scale)
-> ReadPrec Integer -> ReadPrec (Discrete' currency scale)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Discrete' currency scale
forall (currency :: Symbol) (scale :: (Nat, Nat)).
Integer -> Discrete' currency scale
Discrete ReadPrec Integer
forall a. Read a => ReadPrec a
Read.readPrec

type family ErrFractionalDiscrete :: Constraint where
  ErrFractionalDiscrete
    = GHC.TypeError
        (('GHC.Text "The ") 'GHC.:<>:
         ('GHC.ShowType Discrete') 'GHC.:<>:
         ('GHC.Text " type is deliberately not a ") 'GHC.:<>:
         ('GHC.ShowType Fractional) 'GHC.:$$:
         ('GHC.Text "instance. Convert the ") 'GHC.:<>:
         ('GHC.ShowType Discrete') 'GHC.:<>:
         ('GHC.Text " value to a ") 'GHC.:<>:
         ('GHC.ShowType Dense) 'GHC.:$$:
         ('GHC.Text "value and use the ") 'GHC.:<>:
         ('GHC.ShowType Fractional) 'GHC.:<>:
         ('GHC.Text " features on it instead."))

instance
  ( ErrFractionalDiscrete
  , GoodScale scale
  ) => Fractional (Discrete' currency scale) where
  fromRational :: Rational -> Discrete' currency scale
fromRational = Rational -> Discrete' currency scale
forall a. HasCallStack => a
undefined
  recip :: Discrete' currency scale -> Discrete' currency scale
recip = Discrete' currency scale -> Discrete' currency scale
forall a. HasCallStack => a
undefined

-- | Construct a 'Discrete' value.
discrete :: GoodScale scale => Integer -> Discrete' currency scale
discrete :: Integer -> Discrete' currency scale
discrete = Integer -> Discrete' currency scale
forall (currency :: Symbol) (scale :: (Nat, Nat)).
Integer -> Discrete' currency scale
Discrete
{-# INLINE discrete #-}


-- | Convert currency 'Discrete' monetary value into a 'Dense' monetary
-- value.
denseFromDiscrete
  :: GoodScale scale
  => Discrete' currency scale
  -> Dense currency -- ^
denseFromDiscrete :: Discrete' currency scale -> Dense currency
denseFromDiscrete = \c :: Discrete' currency scale
c@(Discrete Integer
i) ->
  Rational -> Dense currency
forall (currency :: Symbol). Rational -> Dense currency
Dense (Integer -> Rational
forall a. Num a => Integer -> a
fromInteger Integer
i Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Scale -> Rational
scaleToRational (Discrete' currency scale -> Scale
forall (proxy :: (Nat, Nat) -> *) (scale :: (Nat, Nat)).
GoodScale scale =>
proxy scale -> Scale
scale Discrete' currency scale
c))
{-# INLINE denseFromDiscrete #-}

-- | 'Discrete' currency identifier.
--
-- @
-- > 'discreteCurrency' ('discrete' 4 :: 'Discrete' \"USD\" \"cent\")
-- \"USD\"
-- @
discreteCurrency
  :: (KnownSymbol currency, GoodScale scale)
  => Discrete' currency scale
  -> T.Text -- ^
discreteCurrency :: Discrete' currency scale -> Text
discreteCurrency = String -> Text
T.pack (String -> Text)
-> (Discrete' currency scale -> String)
-> Discrete' currency scale
-> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Discrete' currency scale -> String
forall (currency :: Symbol) (scale :: (Nat, Nat)).
(KnownSymbol currency, GoodScale scale) =>
Discrete' currency scale -> String
discreteCurrency'
{-# INLINE discreteCurrency #-}

-- | Like 'discreteCurrency' but returns 'String'.
discreteCurrency'
  :: forall currency scale
  .  (KnownSymbol currency, GoodScale scale)
  => Discrete' currency scale
  -> String -- ^
discreteCurrency' :: Discrete' currency scale -> String
discreteCurrency' = \Discrete' currency scale
_ -> Proxy currency -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy currency
forall k (t :: k). Proxy t
Proxy @currency)
{-# INLINE discreteCurrency' #-}

-- | Method for approximating a fractional number to an integer number.
data Approximation
  = Round
  -- ^ Approximate @x@ to the nearest integer, or to the nearest even integer if
  -- @x@ is equidistant between two integers.
  | Floor
  -- ^ Approximate @x@ to the nearest integer less than or equal to @x@.
  | Ceiling
  -- ^ Approximate @x@ to the nearest integer greater than or equal to @x@.
  | Truncate
  -- ^ Approximate @x@ to the nearest integer betwen @0@ and @x@, inclusive.
  | HalfEven
  -- ^ Approximate @x@ to the nearest even integer, when equidistant from the
  -- nearest two integers. This is also known as “Bankers Rounding”.
  | HalfAwayFromZero
  -- ^ Approximate @x@ to the nearest integer, or to the nearest integer away
  -- from zero if @x@ is equidistant between to integers. This is known
  -- as “kaufmännisches Runden” in German speaking countries.
  deriving (Approximation -> Approximation -> Bool
(Approximation -> Approximation -> Bool)
-> (Approximation -> Approximation -> Bool) -> Eq Approximation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Approximation -> Approximation -> Bool
$c/= :: Approximation -> Approximation -> Bool
== :: Approximation -> Approximation -> Bool
$c== :: Approximation -> Approximation -> Bool
Eq, Eq Approximation
Eq Approximation
-> (Approximation -> Approximation -> Ordering)
-> (Approximation -> Approximation -> Bool)
-> (Approximation -> Approximation -> Bool)
-> (Approximation -> Approximation -> Bool)
-> (Approximation -> Approximation -> Bool)
-> (Approximation -> Approximation -> Approximation)
-> (Approximation -> Approximation -> Approximation)
-> Ord Approximation
Approximation -> Approximation -> Bool
Approximation -> Approximation -> Ordering
Approximation -> Approximation -> Approximation
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 :: Approximation -> Approximation -> Approximation
$cmin :: Approximation -> Approximation -> Approximation
max :: Approximation -> Approximation -> Approximation
$cmax :: Approximation -> Approximation -> Approximation
>= :: Approximation -> Approximation -> Bool
$c>= :: Approximation -> Approximation -> Bool
> :: Approximation -> Approximation -> Bool
$c> :: Approximation -> Approximation -> Bool
<= :: Approximation -> Approximation -> Bool
$c<= :: Approximation -> Approximation -> Bool
< :: Approximation -> Approximation -> Bool
$c< :: Approximation -> Approximation -> Bool
compare :: Approximation -> Approximation -> Ordering
$ccompare :: Approximation -> Approximation -> Ordering
$cp1Ord :: Eq Approximation
Ord, Int -> Approximation -> ShowS
[Approximation] -> ShowS
Approximation -> String
(Int -> Approximation -> ShowS)
-> (Approximation -> String)
-> ([Approximation] -> ShowS)
-> Show Approximation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Approximation] -> ShowS
$cshowList :: [Approximation] -> ShowS
show :: Approximation -> String
$cshow :: Approximation -> String
showsPrec :: Int -> Approximation -> ShowS
$cshowsPrec :: Int -> Approximation -> ShowS
Show, ReadPrec [Approximation]
ReadPrec Approximation
Int -> ReadS Approximation
ReadS [Approximation]
(Int -> ReadS Approximation)
-> ReadS [Approximation]
-> ReadPrec Approximation
-> ReadPrec [Approximation]
-> Read Approximation
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Approximation]
$creadListPrec :: ReadPrec [Approximation]
readPrec :: ReadPrec Approximation
$creadPrec :: ReadPrec Approximation
readList :: ReadS [Approximation]
$creadList :: ReadS [Approximation]
readsPrec :: Int -> ReadS Approximation
$creadsPrec :: Int -> ReadS Approximation
Read, (forall x. Approximation -> Rep Approximation x)
-> (forall x. Rep Approximation x -> Approximation)
-> Generic Approximation
forall x. Rep Approximation x -> Approximation
forall x. Approximation -> Rep Approximation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Approximation x -> Approximation
$cfrom :: forall x. Approximation -> Rep Approximation x
GHC.Generic)

approximate :: Approximation -> Rational -> Integer
{-# INLINE approximate #-}
approximate :: Approximation -> Rational -> Integer
approximate = \case
  Approximation
Round -> Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round
  Approximation
Floor -> Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor
  Approximation
Ceiling -> Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
ceiling
  Approximation
Truncate -> Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate
  Approximation
HalfEven -> Rational -> Integer
halfEven
  Approximation
HalfAwayFromZero -> Rational -> Integer
halfAwayFromZero

-- | Approximate to the nearest even integer, when equidistant from the nearest
-- two integers. This is also known as “Bankers Rounding”.
halfEven :: Rational -> Integer
{-# INLINABLE halfEven #-}
halfEven :: Rational -> Integer
halfEven = \Rational
r ->                          --    1.5    -1.5
  let Integer
tr  :: Integer  = Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate Rational
r        --    1.0    -1.0
      Rational
rr  :: Rational = Integer -> Rational
forall a. Real a => a -> Rational
toRational Integer
tr Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
r --   -0.5     0.5
  in if | Rational -> Rational
forall a. Num a => a -> a
abs Rational
rr Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
1Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
2 -> Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round Rational
r
        | Integer -> Bool
forall a. Integral a => a -> Bool
even Integer
tr -> Integer
tr
        | Bool
otherwise -> Integer
tr Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer -> Integer
forall a. Num a => a -> a
signum Integer
tr

-- | Approximate @x@ to the nearest integer, or to the nearest integer away
-- from zero if @x@ is equidistant between to integers. This is known
-- as “kaufmännisches Runden” in German speaking countries.

halfAwayFromZero :: Rational -> Integer
{-# INLINABLE halfAwayFromZero #-}
halfAwayFromZero :: Rational -> Integer
halfAwayFromZero = \Rational
r ->                   --    1.5    -1.5
  let Integer
s   :: Integer  = Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Rational -> Rational
forall a. Num a => a -> a
signum Rational
r)
      Rational
ar  :: Rational = Rational -> Rational
forall a. Num a => a -> a
abs Rational
r              --    1.5     1.5
      Integer
tr  :: Integer  = Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate Rational
ar        --    1.0     1.0
      Rational
rr  :: Rational = Rational
ar Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Integer -> Rational
forall a. Real a => a -> Rational
toRational Integer
tr --    0.5     0.5
  in if | Rational
rr Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
1Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
2  -> Integer
s Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
tr
        | Bool
otherwise -> Integer
s Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
tr Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)

-- | Approximate a 'Dense' value @x@ to the nearest value fully representable a
-- given @scale@.
--
-- If the given 'Dense' doesn't fit entirely in the @scale@, then a non-zero
-- 'Dense' reminder is returned alongside the 'Discrete' approximation.
--
-- Proof that 'discreteFromDense' doesn't lose money:
--
-- @
-- x == case 'discreteFromDense' a x of
--         (y, z) -> 'denseFromDiscrete' y + z
-- @
discreteFromDense
  :: forall currency scale
  .  GoodScale scale
  => Approximation
  -- ^ Approximation to use if necessary in order to fit the 'Dense' amount in
  -- the requested @scale@.
  -> Dense currency
  -> (Discrete' currency scale, Dense currency)
discreteFromDense :: Approximation
-> Dense currency -> (Discrete' currency scale, Dense currency)
discreteFromDense Approximation
a = \Dense currency
c0 ->
  let !r0 :: Rational
r0 = Dense currency -> Rational
forall a. Real a => a -> Rational
toRational Dense currency
c0 :: Rational
      !r1 :: Rational
r1 = Scale -> Rational
scaleToRational (Proxy scale -> Scale
forall (proxy :: (Nat, Nat) -> *) (scale :: (Nat, Nat)).
GoodScale scale =>
proxy scale -> Scale
scale (Proxy scale
forall k (t :: k). Proxy t
Proxy :: Proxy scale)) :: Rational
      !i2 :: Integer
i2 = Approximation -> Rational -> Integer
approximate Approximation
a (Rational
r0 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
r1) :: Integer
      !r2 :: Rational
r2 = Integer -> Rational
forall a. Num a => Integer -> a
fromInteger Integer
i2 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
r1 :: Rational
      !d2 :: Discrete' currency scale
d2 = Integer -> Discrete' currency scale
forall (currency :: Symbol) (scale :: (Nat, Nat)).
Integer -> Discrete' currency scale
Discrete Integer
i2
      !rest :: Dense currency
rest = Rational -> Dense currency
forall (currency :: Symbol). Rational -> Dense currency
Dense (Rational
r0 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
r2)
  in (Discrete' currency scale
d2, Dense currency
rest)
{-# INLINABLE discreteFromDense #-}

--------------------------------------------------------------------------------

-- | This is the term-level representation of the “scale” we represent as
-- @('Nat', 'Nat')@ elsewhere in the type system (e.g., in 'GoodScale' or
-- 'UnitScale').
--
-- See 'UnitScale' for a detailed description.
newtype Scale = Scale Rational
  deriving (Scale -> Scale -> Bool
(Scale -> Scale -> Bool) -> (Scale -> Scale -> Bool) -> Eq Scale
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Scale -> Scale -> Bool
$c/= :: Scale -> Scale -> Bool
== :: Scale -> Scale -> Bool
$c== :: Scale -> Scale -> Bool
Eq, Eq Scale
Eq Scale
-> (Scale -> Scale -> Ordering)
-> (Scale -> Scale -> Bool)
-> (Scale -> Scale -> Bool)
-> (Scale -> Scale -> Bool)
-> (Scale -> Scale -> Bool)
-> (Scale -> Scale -> Scale)
-> (Scale -> Scale -> Scale)
-> Ord Scale
Scale -> Scale -> Bool
Scale -> Scale -> Ordering
Scale -> Scale -> Scale
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 :: Scale -> Scale -> Scale
$cmin :: Scale -> Scale -> Scale
max :: Scale -> Scale -> Scale
$cmax :: Scale -> Scale -> Scale
>= :: Scale -> Scale -> Bool
$c>= :: Scale -> Scale -> Bool
> :: Scale -> Scale -> Bool
$c> :: Scale -> Scale -> Bool
<= :: Scale -> Scale -> Bool
$c<= :: Scale -> Scale -> Bool
< :: Scale -> Scale -> Bool
$c< :: Scale -> Scale -> Bool
compare :: Scale -> Scale -> Ordering
$ccompare :: Scale -> Scale -> Ordering
$cp1Ord :: Eq Scale
Ord, Int -> Scale -> ShowS
[Scale] -> ShowS
Scale -> String
(Int -> Scale -> ShowS)
-> (Scale -> String) -> ([Scale] -> ShowS) -> Show Scale
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Scale] -> ShowS
$cshowList :: [Scale] -> ShowS
show :: Scale -> String
$cshow :: Scale -> String
showsPrec :: Int -> Scale -> ShowS
$cshowsPrec :: Int -> Scale -> ShowS
Show, (forall x. Scale -> Rep Scale x)
-> (forall x. Rep Scale x -> Scale) -> Generic Scale
forall x. Rep Scale x -> Scale
forall x. Scale -> Rep Scale x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Scale x -> Scale
$cfrom :: forall x. Scale -> Rep Scale x
GHC.Generic)

-- | Construct a 'Scale' from a positive, non-zero rational number.
scaleFromRational :: Rational -> Maybe Scale
{-# INLINE scaleFromRational #-}
scaleFromRational :: Rational -> Maybe Scale
scaleFromRational Rational
r = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Rational -> Integer
forall a. Ratio a -> a
denominator Rational
r Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0 Bool -> Bool -> Bool
&& Rational
r Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
0)
  Scale -> Maybe Scale
forall a. a -> Maybe a
Just (Rational -> Scale
Scale (Integer -> Integer
forall a. Num a => a -> a
abs (Rational -> Integer
forall a. Ratio a -> a
numerator Rational
r) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer -> Integer
forall a. Num a => a -> a
abs (Rational -> Integer
forall a. Ratio a -> a
denominator Rational
r)))

-- | Obtain the 'Rational' representation of a 'Scale'.
scaleToRational :: Scale -> Rational
{-# INLINE scaleToRational #-}
scaleToRational :: Scale -> Rational
scaleToRational (Scale Rational
r) = Rational
r

-- | @'UnitScale' currency unit@ is an rational number (expressed as @'(numerator,
-- denominator)@) indicating how many pieces of @unit@ fit in @currency@.
--
-- @currency@ is usually a ISO-4217 currency code, but not necessarily.
--
-- The resulting @('Nat', 'Nat')@, which is the type-level representation for
-- what at the term-level we call 'Scale', will determine how to convert a
-- 'Dense' value into a 'Discrete' value and vice-versa.
--
-- For example, there are 100 USD cents in 1 USD, so the scale for this
-- relationship is:
--
-- @
-- type instance 'UnitScale' \"USD\" \"cent\" = '(100, 1)
-- @
--
-- As another example, there is 1 dollar in USD, so the scale for this
-- relationship is:
--
-- @
-- type instance 'UnitScale' \"USD\" \"dollar\" = '(1, 1)
-- @
--
-- When using 'Discrete' values to represent money, it will be impossible to
-- represent an amount of @currency@ smaller than @unit@. So, if you decide to
-- use @UnitScale \"USD\" \"dollar\"@ as your scale, you will not be able to
-- represent values such as USD 3.50 or USD 21.87 becacuse they are not exact
-- multiples of a dollar.
--
-- For some monetary values, such as precious metals, there is no smallest
-- representable unit, since you can repeatedly split the precious metal many
-- times before it stops being a precious metal. Nevertheless, for practical
-- purposes we can make a sane arbitrary choice of smallest unit. For example,
-- the base unit for XAU (Gold) is the /troy ounce/, which is too big to be
-- considered the smallest unit, but we can arbitrarily choose the /milligrain/
-- as our smallest unit, which is about as heavy as a single grain of table salt
-- and should be sufficiently precise for all monetary practical purposes. A
-- /troy ounce/ equals 480000 /milligrains/.
--
-- @
-- type instance 'UnitScale' \"XAU\" \"milligrain\" = '(480000, 1)
-- @
--
-- You can use other units such as /milligrams/ for measuring XAU, for example.
-- However, since the amount of /milligrams/ in a /troy ounce/ (31103.477) is
-- not integral, we need to use rational with a denominator different than 1 to
-- express it.
--
-- @
-- type instance 'UnitScale' \"XAU\" \"milligram\" = '(31103477, 1000)
-- @
--
-- If you try to obtain the 'UnitScale' of a @currency@ without an obvious smallest
-- representable @unit@, like XAU, you will get a compile error.
type family UnitScale (currency :: Symbol) (unit :: Symbol) :: (Nat, Nat)

-- | If there exists a canonical smallest 'Scale' that can fully represent the
-- @currency@ in all its denominations, then @'CurrencyScale' currency@ will
-- return such 'Scale'. For example, @'CurrencyScale' \"USD\"@ evaluates to
-- @'UnitScale' \"USD\" \"cent\"@.
--
-- @
-- type instance 'CurrencyScale' \"USD\" = 'UnitScale' \"USD\" \"cent\"
-- @
--
-- If the @currency@ doesn't have a canonical smallest 'Scale', then
-- @'CurrencyScale' currency@ shall be left undefined or fail to compile with a
-- 'GHC.TypeError'. For example @'CurrencyScale' \"XAU\"@ fails with
-- @'ErrScaleNonCanonical' \"XAU\"@.
type family CurrencyScale (currency :: Symbol) :: (Nat, Nat)

-- | A friendly 'GHC.TypeError' to use for a @currency@ that doesn't have a
-- canonical small unit.
type family ErrScaleNonCanonical (currency :: Symbol) :: k where
  ErrScaleNonCanonical c = GHC.TypeError
    ( 'GHC.Text c 'GHC.:<>:
      'GHC.Text " is not a currency with a canonical smallest unit," 'GHC.:$$:
      'GHC.Text "be explicit about the currency unit you want to use." )

-- | Constraints to a scale (like the one returned by @'UnitScale' currency unit@)
-- expected to always be satisfied. In particular, the scale is always
-- guaranteed to be a positive rational number ('GHC.Real.infinity' and
-- 'GHC.Real.notANumber' are forbidden by 'GoodScale').
type GoodScale (scale :: (Nat, Nat))
   = ( CmpNat 0 (Fst scale) ~ 'LT
     , CmpNat 0 (Snd scale) ~ 'LT
     , KnownNat (Fst scale)
     , KnownNat (Snd scale)
     )

-- | If the specified @num@ and @den@ satisfy the expectations of 'GoodScale' at
-- the type level, then construct a proof for 'GoodScale'.
mkGoodScale
  :: forall num den
  .  (KnownNat num, KnownNat den)
  => Maybe (Dict (GoodScale '(num, den)))
mkGoodScale :: Maybe (Dict (GoodScale '(num, den)))
mkGoodScale =
  let n :: Integer
n = Proxy num -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy num
forall k (t :: k). Proxy t
Proxy :: Proxy num)
      d :: Integer
d = Proxy den -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy den
forall k (t :: k). Proxy t
Proxy :: Proxy den)
  in if (Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0) Bool -> Bool -> Bool
&& (Integer
d Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0)
     then Dict
  (CmpNat 0 num ~ 'LT, CmpNat 0 den ~ 'LT, KnownNat num,
   KnownNat den)
-> Maybe
     (Dict
        (CmpNat 0 num ~ 'LT, CmpNat 0 den ~ 'LT, KnownNat num,
         KnownNat den))
forall a. a -> Maybe a
Just (Dict ('LT ~ 'LT, 'LT ~ 'LT, KnownNat num, KnownNat den)
-> Dict
     (CmpNat 0 num ~ 'LT, CmpNat 0 den ~ 'LT, KnownNat num,
      KnownNat den)
forall a b. a -> b
unsafeCoerce (Dict ('LT ~ 'LT, 'LT ~ 'LT, KnownNat num, KnownNat den)
forall (a :: Constraint). a => Dict a
Dict :: Dict ('LT ~ 'LT, 'LT ~ 'LT,
                                            KnownNat num, KnownNat den)))
     else Maybe (Dict (GoodScale '(num, den)))
forall a. Maybe a
Nothing
{-# INLINABLE mkGoodScale #-}

-- | Term-level representation of a currrency @scale@.
--
-- For example, the 'Scale' for @\"USD\"@ in @\"cent\"@s is @100/1@. We can
-- obtain a term-level representation for it using any of the following:
--
-- @
-- > 'scale' ('Proxy' :: 'Proxy' ('UnitScale' \"USD\" \"cent\"))
-- 'Scale' (100 '%' 1)
-- @
--
-- @
-- > 'scale' ('Proxy' :: 'CurrencyScale' \"USD\")
-- 'Scale' (100 '%' 1)
-- @
--
-- @
-- > 'scale' (x :: 'Discrete' \"USD\" \"cent\")
-- 'Scale' (100 '%' 1)
-- @
--
-- The returned 'Rational' is statically guaranteed to be a positive number.
scale :: forall proxy scale. GoodScale scale => proxy scale -> Scale -- ^
scale :: proxy scale -> Scale
scale = \proxy scale
_ -> Rational -> Scale
Scale (Proxy (Fst scale) -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy (Fst scale)
forall k (t :: k). Proxy t
Proxy :: Proxy (Fst scale)) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%
                     Proxy (Snd scale) -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy (Snd scale)
forall k (t :: k). Proxy t
Proxy :: Proxy (Snd scale)))
{-# INLINE scale #-}

--------------------------------------------------------------------------------

-- | Exchange rate for converting monetary values of currency @src@ into
-- monetary values of currency @dst@ by multiplying for it.
--
-- For example, if in order to convert USD to GBP we have to multiply by 1.2345,
-- then we can represent this situaion using:
--
-- @
-- 'exchangeRate' (12345 '%' 10000) :: 'Maybe' ('ExchangeRate' \"USD\" \"GBP\")
-- @
newtype ExchangeRate (src :: Symbol) (dst :: Symbol) = ExchangeRate Rational
  deriving (ExchangeRate src dst -> ExchangeRate src dst -> Bool
(ExchangeRate src dst -> ExchangeRate src dst -> Bool)
-> (ExchangeRate src dst -> ExchangeRate src dst -> Bool)
-> Eq (ExchangeRate src dst)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (src :: Symbol) (dst :: Symbol).
ExchangeRate src dst -> ExchangeRate src dst -> Bool
/= :: ExchangeRate src dst -> ExchangeRate src dst -> Bool
$c/= :: forall (src :: Symbol) (dst :: Symbol).
ExchangeRate src dst -> ExchangeRate src dst -> Bool
== :: ExchangeRate src dst -> ExchangeRate src dst -> Bool
$c== :: forall (src :: Symbol) (dst :: Symbol).
ExchangeRate src dst -> ExchangeRate src dst -> Bool
Eq, Eq (ExchangeRate src dst)
Eq (ExchangeRate src dst)
-> (ExchangeRate src dst -> ExchangeRate src dst -> Ordering)
-> (ExchangeRate src dst -> ExchangeRate src dst -> Bool)
-> (ExchangeRate src dst -> ExchangeRate src dst -> Bool)
-> (ExchangeRate src dst -> ExchangeRate src dst -> Bool)
-> (ExchangeRate src dst -> ExchangeRate src dst -> Bool)
-> (ExchangeRate src dst
    -> ExchangeRate src dst -> ExchangeRate src dst)
-> (ExchangeRate src dst
    -> ExchangeRate src dst -> ExchangeRate src dst)
-> Ord (ExchangeRate src dst)
ExchangeRate src dst -> ExchangeRate src dst -> Bool
ExchangeRate src dst -> ExchangeRate src dst -> Ordering
ExchangeRate src dst
-> ExchangeRate src dst -> ExchangeRate src dst
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
forall (src :: Symbol) (dst :: Symbol). Eq (ExchangeRate src dst)
forall (src :: Symbol) (dst :: Symbol).
ExchangeRate src dst -> ExchangeRate src dst -> Bool
forall (src :: Symbol) (dst :: Symbol).
ExchangeRate src dst -> ExchangeRate src dst -> Ordering
forall (src :: Symbol) (dst :: Symbol).
ExchangeRate src dst
-> ExchangeRate src dst -> ExchangeRate src dst
min :: ExchangeRate src dst
-> ExchangeRate src dst -> ExchangeRate src dst
$cmin :: forall (src :: Symbol) (dst :: Symbol).
ExchangeRate src dst
-> ExchangeRate src dst -> ExchangeRate src dst
max :: ExchangeRate src dst
-> ExchangeRate src dst -> ExchangeRate src dst
$cmax :: forall (src :: Symbol) (dst :: Symbol).
ExchangeRate src dst
-> ExchangeRate src dst -> ExchangeRate src dst
>= :: ExchangeRate src dst -> ExchangeRate src dst -> Bool
$c>= :: forall (src :: Symbol) (dst :: Symbol).
ExchangeRate src dst -> ExchangeRate src dst -> Bool
> :: ExchangeRate src dst -> ExchangeRate src dst -> Bool
$c> :: forall (src :: Symbol) (dst :: Symbol).
ExchangeRate src dst -> ExchangeRate src dst -> Bool
<= :: ExchangeRate src dst -> ExchangeRate src dst -> Bool
$c<= :: forall (src :: Symbol) (dst :: Symbol).
ExchangeRate src dst -> ExchangeRate src dst -> Bool
< :: ExchangeRate src dst -> ExchangeRate src dst -> Bool
$c< :: forall (src :: Symbol) (dst :: Symbol).
ExchangeRate src dst -> ExchangeRate src dst -> Bool
compare :: ExchangeRate src dst -> ExchangeRate src dst -> Ordering
$ccompare :: forall (src :: Symbol) (dst :: Symbol).
ExchangeRate src dst -> ExchangeRate src dst -> Ordering
$cp1Ord :: forall (src :: Symbol) (dst :: Symbol). Eq (ExchangeRate src dst)
Ord, (forall x. ExchangeRate src dst -> Rep (ExchangeRate src dst) x)
-> (forall x. Rep (ExchangeRate src dst) x -> ExchangeRate src dst)
-> Generic (ExchangeRate src dst)
forall x. Rep (ExchangeRate src dst) x -> ExchangeRate src dst
forall x. ExchangeRate src dst -> Rep (ExchangeRate src dst) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (src :: Symbol) (dst :: Symbol) x.
Rep (ExchangeRate src dst) x -> ExchangeRate src dst
forall (src :: Symbol) (dst :: Symbol) x.
ExchangeRate src dst -> Rep (ExchangeRate src dst) x
$cto :: forall (src :: Symbol) (dst :: Symbol) x.
Rep (ExchangeRate src dst) x -> ExchangeRate src dst
$cfrom :: forall (src :: Symbol) (dst :: Symbol) x.
ExchangeRate src dst -> Rep (ExchangeRate src dst) x
GHC.Generic)


-- | Composition of 'ExchangeRate's multiplies exchange rates together:
--
-- @
-- 'exchangeRateToRational' x * 'exchangeRateToRational' y  ==  'exchangeRateToRational' (x . y)
-- @
--
-- Identity:
--
-- @
-- x  ==  x . id  ==  id . x
-- @
--
-- Associativity:
--
-- @
-- x . y . z  ==  x . (y . z)  ==  (x . y) . z
-- @
--
-- Conmutativity (provided the types allow for composition):
--
-- @
-- x . y  ==  y . x
-- @
--
-- Reciprocal:
--
-- @
-- 1  ==  'exchangeRateToRational' (x . 'exchangeRateRecip' x)
-- @
instance Category ExchangeRate where
  id :: ExchangeRate a a
id = Rational -> ExchangeRate a a
forall (src :: Symbol) (dst :: Symbol).
Rational -> ExchangeRate src dst
ExchangeRate Rational
1
  {-# INLINE id #-}
  ExchangeRate Rational
a . :: ExchangeRate b c -> ExchangeRate a b -> ExchangeRate a c
. ExchangeRate Rational
b = Rational -> ExchangeRate a c
forall (src :: Symbol) (dst :: Symbol).
Rational -> ExchangeRate src dst
ExchangeRate (Rational
a Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
b)
  {-# INLINE (.) #-}

-- |
-- @
-- > 'show' ('exchangeRate' (5 '%' 7) :: 'Maybe' ('ExchangeRate' \"USD\" \"JPY\"))@
-- Just \"ExchangeRate \\\"USD\\\" \\\"JPY\\\" 5%7\"
-- @
instance forall src dst.
  ( KnownSymbol src, KnownSymbol dst
  ) => Show (ExchangeRate src dst) where
  showsPrec :: Int -> ExchangeRate src dst -> ShowS
showsPrec Int
n = \(ExchangeRate Rational
r0) ->
    let s :: String
s = Proxy src -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy src
forall k (t :: k). Proxy t
Proxy :: Proxy src)
        d :: String
d = Proxy dst -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy dst
forall k (t :: k). Proxy t
Proxy :: Proxy dst)
    in Bool -> ShowS -> ShowS
showParen (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
         String -> ShowS
showString String
"ExchangeRate " ShowS -> ShowS -> ShowS
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> String -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 String
s ShowS -> ShowS -> ShowS
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
         Int -> String -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 String
d ShowS -> ShowS -> ShowS
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
         Int -> Integer -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 (Rational -> Integer
forall a. Ratio a -> a
numerator Rational
r0) ShowS -> ShowS -> ShowS
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> ShowS
showChar Char
'%' ShowS -> ShowS -> ShowS
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
         Int -> Integer -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 (Rational -> Integer
forall a. Ratio a -> a
denominator Rational
r0)

instance forall src dst.
  ( KnownSymbol src, KnownSymbol dst
  ) => Read (ExchangeRate (src :: Symbol) (dst :: Symbol)) where
  readPrec :: ReadPrec (ExchangeRate src dst)
readPrec = ReadPrec (ExchangeRate src dst) -> ReadPrec (ExchangeRate src dst)
forall a. ReadPrec a -> ReadPrec a
Read.parens (ReadPrec (ExchangeRate src dst)
 -> ReadPrec (ExchangeRate src dst))
-> ReadPrec (ExchangeRate src dst)
-> ReadPrec (ExchangeRate src dst)
forall a b. (a -> b) -> a -> b
$ do
    let s :: String
s = Proxy src -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy src
forall k (t :: k). Proxy t
Proxy :: Proxy src)
        d :: String
d = Proxy dst -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy dst
forall k (t :: k). Proxy t
Proxy :: Proxy dst)
    String
_ <- ReadP String -> ReadPrec String
forall a. ReadP a -> ReadPrec a
ReadPrec.lift (String -> ReadP String
ReadP.string
            (String
"ExchangeRate " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" "))
    ReadPrec (ExchangeRate src dst)
-> (ExchangeRate src dst -> ReadPrec (ExchangeRate src dst))
-> Maybe (ExchangeRate src dst)
-> ReadPrec (ExchangeRate src dst)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ReadPrec (ExchangeRate src dst)
forall (f :: * -> *) a. Alternative f => f a
empty ExchangeRate src dst -> ReadPrec (ExchangeRate src dst)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ExchangeRate src dst) -> ReadPrec (ExchangeRate src dst))
-> ReadPrec (Maybe (ExchangeRate src dst))
-> ReadPrec (ExchangeRate src dst)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Rational -> Maybe (ExchangeRate src dst))
-> ReadPrec Rational -> ReadPrec (Maybe (ExchangeRate src dst))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rational -> Maybe (ExchangeRate src dst)
forall (src :: Symbol) (dst :: Symbol).
Rational -> Maybe (ExchangeRate src dst)
exchangeRate ReadPrec Rational
forall a. Read a => ReadPrec a
Read.readPrec


-- | Obtain a 'Rational' representation of the 'ExchangeRate'.
--
-- This 'Rational' is guaranteed to be a positive number.
exchangeRateToRational :: ExchangeRate src dst -> Rational
exchangeRateToRational :: ExchangeRate src dst -> Rational
exchangeRateToRational = \(ExchangeRate Rational
r0) -> Rational
r0
{-# INLINE exchangeRateToRational #-}

-- | Safely construct an 'ExchangeRate' from a *positive* 'Rational' number.
--
-- If the given 'Rational' is non-positive, returns 'Nothing'.
exchangeRate :: Rational -> Maybe (ExchangeRate src dst)
exchangeRate :: Rational -> Maybe (ExchangeRate src dst)
exchangeRate = \Rational
r ->
  if Rational -> Integer
forall a. Ratio a -> a
denominator Rational
r Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0 Bool -> Bool -> Bool
&& Rational
r Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
0
  then ExchangeRate src dst -> Maybe (ExchangeRate src dst)
forall a. a -> Maybe a
Just (Rational -> ExchangeRate src dst
forall (src :: Symbol) (dst :: Symbol).
Rational -> ExchangeRate src dst
ExchangeRate Rational
r)
  else Maybe (ExchangeRate src dst)
forall a. Maybe a
Nothing
{-# INLINE exchangeRate #-}

-- | Unsafely build an 'ExchageRate' monetary value from a 'Rational' value.
-- Contrary to 'exchangeRate', this function *crashes* if the given 'Rational'
-- a value has zero as a denominator or when it is negative, with the former
-- case being something very unlikely to happen unless the given 'Rational'
-- was itself unsafely constructed. Other than that, 'exchangeRate' and
-- 'exchangeRate'' behave the same.
--
-- Prefer to use 'exchangeRate' when dealing with 'Rational' inputs from
-- untrusted sources.
--
-- @
-- 'denominator' x /= 0 && x > 0
--   ⇒ 'exchangeRate' x == 'Just' ('exchangeRate'' x)
-- @
--
-- @
-- 'denominator' x == 0 || x <= 0
--   ⇒ 'undefined' == 'exchangeRate'' x
-- @
exchangeRate' :: Rational -> ExchangeRate src dst
exchangeRate' :: Rational -> ExchangeRate src dst
exchangeRate' = \Rational
r ->
  if Rational -> Integer
forall a. Ratio a -> a
denominator Rational
r Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0 Bool -> Bool -> Bool
&& Rational
r Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
0
  then Rational -> ExchangeRate src dst
forall (src :: Symbol) (dst :: Symbol).
Rational -> ExchangeRate src dst
ExchangeRate Rational
r
  else if Rational -> Integer
forall a. Ratio a -> a
denominator Rational
r Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
       then String -> ExchangeRate src dst
forall a. HasCallStack => String -> a
error String
"exchangeRate': malformed Rational given (denominator is zero)."
       else String -> ExchangeRate src dst
forall a. HasCallStack => String -> a
error String
"exchangeRate': malformed Rational given (is negative)."
{-# INLINABLE exchangeRate' #-}

-- | Reciprocal 'ExchangeRate'.
--
-- This function retuns the reciprocal or multiplicative inverse of the given
-- 'ExchangeRate', leading to the following identity law:
--
-- @
-- 'exchangeRateRecip' . 'exchangeRateRecip'   ==  'id'
-- @
--
-- Note: If 'ExchangeRate' had a 'Fractional' instance, then 'exchangeRateRecip'
-- would be the implementation of 'recip'.
exchangeRateRecip :: ExchangeRate a b -> ExchangeRate b a
exchangeRateRecip :: ExchangeRate a b -> ExchangeRate b a
exchangeRateRecip = \(ExchangeRate Rational
x) ->
   Rational -> ExchangeRate b a
forall (src :: Symbol) (dst :: Symbol).
Rational -> ExchangeRate src dst
ExchangeRate (Rational
1 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
x)   -- 'exchangeRate' guarantees that @x@ isn't zero.
{-# INLINE exchangeRateRecip #-}

-- | Apply the 'ExchangeRate' to the given @'Dense' src@ monetary value.
--
-- Identity law:
--
-- @
-- 'exchange' ('exchangeRateRecip' x) . 'exchange' x  ==  'id'
-- @
--
-- Use the /Identity law/ for reasoning about going back and forth between @src@
-- and @dst@ in order to manage any leftovers that might not be representable as
-- a 'Discrete' monetary value of @src@.
exchange :: ExchangeRate src dst -> Dense src -> Dense dst
exchange :: ExchangeRate src dst -> Dense src -> Dense dst
exchange (ExchangeRate Rational
r) = \(Dense Rational
s) -> Rational -> Dense dst
forall (currency :: Symbol). Rational -> Dense currency
Dense (Rational
r Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
s)
{-# INLINE exchange #-}

--------------------------------------------------------------------------------
-- SomeDense

-- | A monomorphic representation of 'Dense' that is easier to serialize and
-- deserialize than 'Dense' in case you don't know the type indexes involved.
--
-- If you are trying to construct a value of this type from some raw input, then
-- you will need to use the 'mkSomeDense' function.
--
-- In order to be able to effectively serialize a 'SomeDense' value, you
-- need to serialize the following three values (which are the eventual
-- arguments to 'mkSomeDense'):
--
-- * 'someDenseCurrency'
-- * 'someDenseAmount'
data SomeDense = SomeDense
  { SomeDense -> String
_someDenseCurrency          :: !String
    -- ^ This is a 'String' rather than 'T.Text' because it makes it easier for
    -- us to derive serialization instances maintaining backwards compatiblity
    -- with pre-0.6 versions of this library, when 'String' was the prefered
    -- string type, and not 'T.Text'.
  , SomeDense -> Rational
_someDenseAmount            :: !Rational
  } deriving (SomeDense -> SomeDense -> Bool
(SomeDense -> SomeDense -> Bool)
-> (SomeDense -> SomeDense -> Bool) -> Eq SomeDense
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SomeDense -> SomeDense -> Bool
$c/= :: SomeDense -> SomeDense -> Bool
== :: SomeDense -> SomeDense -> Bool
$c== :: SomeDense -> SomeDense -> Bool
Eq, Int -> SomeDense -> ShowS
[SomeDense] -> ShowS
SomeDense -> String
(Int -> SomeDense -> ShowS)
-> (SomeDense -> String)
-> ([SomeDense] -> ShowS)
-> Show SomeDense
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SomeDense] -> ShowS
$cshowList :: [SomeDense] -> ShowS
show :: SomeDense -> String
$cshow :: SomeDense -> String
showsPrec :: Int -> SomeDense -> ShowS
$cshowsPrec :: Int -> SomeDense -> ShowS
Show, (forall x. SomeDense -> Rep SomeDense x)
-> (forall x. Rep SomeDense x -> SomeDense) -> Generic SomeDense
forall x. Rep SomeDense x -> SomeDense
forall x. SomeDense -> Rep SomeDense x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SomeDense x -> SomeDense
$cfrom :: forall x. SomeDense -> Rep SomeDense x
GHC.Generic)

-- | __WARNING__ This instance does not compare monetary amounts across
-- different currencies, it just helps you sort 'SomeDense' values in case you
-- need to put them in a 'Data.Set.Set' or similar.
deriving instance Ord SomeDense

-- | Currency name.
someDenseCurrency :: SomeDense -> T.Text
someDenseCurrency :: SomeDense -> Text
someDenseCurrency = String -> Text
T.pack (String -> Text) -> (SomeDense -> String) -> SomeDense -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SomeDense -> String
someDenseCurrency'
{-# INLINE someDenseCurrency #-}

-- | Like 'someDenseCurrency' but returns 'String'.
someDenseCurrency' :: SomeDense -> String
someDenseCurrency' :: SomeDense -> String
someDenseCurrency' = SomeDense -> String
_someDenseCurrency
{-# INLINE someDenseCurrency' #-}

-- | Currency unit amount.
someDenseAmount :: SomeDense -> Rational
someDenseAmount :: SomeDense -> Rational
someDenseAmount = SomeDense -> Rational
_someDenseAmount
{-# INLINE someDenseAmount #-}

-- | Build a 'SomeDense' from raw values.
--
-- This function is intended for deserialization purposes. You need to convert
-- this 'SomeDense' value to a 'Dense' value in order to do any arithmetic
-- operation on the monetary value.
mkSomeDense
  :: T.Text   -- ^ Currency. ('someDenseCurrency')
  -> Rational -- ^ Amount. ('someDenseAmount')
  -> Maybe SomeDense
{-# INLINE mkSomeDense #-}
mkSomeDense :: Text -> Rational -> Maybe SomeDense
mkSomeDense = \Text
c Rational
r -> String -> Rational -> Maybe SomeDense
mkSomeDense' (Text -> String
T.unpack Text
c) Rational
r

-- | Like 'mkSomeDense' but takes 'String' rather than 'T.Text'.
mkSomeDense' :: String -> Rational -> Maybe SomeDense
{-# INLINABLE mkSomeDense' #-}
mkSomeDense' :: String -> Rational -> Maybe SomeDense
mkSomeDense' = \String
c Rational
r ->
  if (Rational -> Integer
forall a. Ratio a -> a
denominator Rational
r Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0)
  then SomeDense -> Maybe SomeDense
forall a. a -> Maybe a
Just (String -> Rational -> SomeDense
SomeDense String
c Rational
r)
  else Maybe SomeDense
forall a. Maybe a
Nothing

-- | Convert a 'Dense' to a 'SomeDense' for ease of serialization.
toSomeDense :: KnownSymbol currency => Dense currency -> SomeDense
toSomeDense :: Dense currency -> SomeDense
toSomeDense = \(Dense Rational
r0 :: Dense currency) ->
  String -> Rational -> SomeDense
SomeDense (Proxy currency -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy currency
forall k (t :: k). Proxy t
Proxy @currency)) Rational
r0
{-# INLINE toSomeDense #-}

-- | Attempt to convert a 'SomeDense' to a 'Dense', provided you know the target
-- @currency@.
fromSomeDense
  :: forall currency
  .  KnownSymbol currency
  => SomeDense
  -> Maybe (Dense currency)  -- ^
fromSomeDense :: SomeDense -> Maybe (Dense currency)
fromSomeDense = \SomeDense
dr ->
  if (SomeDense -> String
_someDenseCurrency SomeDense
dr String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Proxy currency -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy currency
forall k (t :: k). Proxy t
Proxy :: Proxy currency))
  then Dense currency -> Maybe (Dense currency)
forall a. a -> Maybe a
Just (Rational -> Dense currency
forall (currency :: Symbol). Rational -> Dense currency
Dense (SomeDense -> Rational
someDenseAmount SomeDense
dr))
  else Maybe (Dense currency)
forall a. Maybe a
Nothing
{-# INLINABLE fromSomeDense #-}

-- | Convert a 'SomeDense' to a 'Dense' without knowing the target @currency@.
--
-- Notice that @currency@ here can't leave its intended scope unless you can
-- prove equality with some other type at the outer scope, but in that case you
-- would be better off using 'fromSomeDense' directly.
withSomeDense
  :: SomeDense
  -> (forall currency. KnownSymbol currency => Dense currency -> r)
  -> r  -- ^
withSomeDense :: SomeDense
-> (forall (currency :: Symbol).
    KnownSymbol currency =>
    Dense currency -> r)
-> r
withSomeDense SomeDense
dr = \forall (currency :: Symbol).
KnownSymbol currency =>
Dense currency -> r
f ->
   case String -> SomeSymbol
someSymbolVal (SomeDense -> String
_someDenseCurrency SomeDense
dr) of
      SomeSymbol (Proxy n
Proxy :: Proxy currency) ->
         Dense n -> r
forall (currency :: Symbol).
KnownSymbol currency =>
Dense currency -> r
f (Rational -> Dense n
forall (currency :: Symbol). Rational -> Dense currency
Dense (SomeDense -> Rational
someDenseAmount SomeDense
dr) :: Dense currency)
{-# INLINABLE withSomeDense #-}

--------------------------------------------------------------------------------
-- SomeDiscrete

-- | A monomorphic representation of 'Discrete' that is easier to serialize and
-- deserialize than 'Discrete' in case you don't know the type indexes involved.
--
-- If you are trying to construct a value of this type from some raw input, then
-- you will need to use the 'mkSomeDiscrete' function.
--
-- In order to be able to effectively serialize a 'SomeDiscrete' value, you need
-- to serialize the following four values (which are the eventual arguments to
-- 'mkSomeDiscrete'):
--
-- * 'someDiscreteCurrency'
-- * 'someDiscreteScale'
-- * 'someDiscreteAmount'
data SomeDiscrete = SomeDiscrete
  { SomeDiscrete -> String
_someDiscreteCurrency :: !String
    -- ^ Currency name.
    --
    -- This is a 'String' rather than 'T.Text' because it makes it easier for
    -- us to derive serialization instances maintaining backwards compatiblity
    -- with pre-0.6 versions of this library, when 'String' was the prefered
    -- string type, and not 'T.Text'.
  , SomeDiscrete -> Scale
_someDiscreteScale    :: !Scale
  , SomeDiscrete -> Integer
_someDiscreteAmount   :: !Integer  -- ^ Amount of unit.
  } deriving (SomeDiscrete -> SomeDiscrete -> Bool
(SomeDiscrete -> SomeDiscrete -> Bool)
-> (SomeDiscrete -> SomeDiscrete -> Bool) -> Eq SomeDiscrete
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SomeDiscrete -> SomeDiscrete -> Bool
$c/= :: SomeDiscrete -> SomeDiscrete -> Bool
== :: SomeDiscrete -> SomeDiscrete -> Bool
$c== :: SomeDiscrete -> SomeDiscrete -> Bool
Eq, Int -> SomeDiscrete -> ShowS
[SomeDiscrete] -> ShowS
SomeDiscrete -> String
(Int -> SomeDiscrete -> ShowS)
-> (SomeDiscrete -> String)
-> ([SomeDiscrete] -> ShowS)
-> Show SomeDiscrete
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SomeDiscrete] -> ShowS
$cshowList :: [SomeDiscrete] -> ShowS
show :: SomeDiscrete -> String
$cshow :: SomeDiscrete -> String
showsPrec :: Int -> SomeDiscrete -> ShowS
$cshowsPrec :: Int -> SomeDiscrete -> ShowS
Show, (forall x. SomeDiscrete -> Rep SomeDiscrete x)
-> (forall x. Rep SomeDiscrete x -> SomeDiscrete)
-> Generic SomeDiscrete
forall x. Rep SomeDiscrete x -> SomeDiscrete
forall x. SomeDiscrete -> Rep SomeDiscrete x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SomeDiscrete x -> SomeDiscrete
$cfrom :: forall x. SomeDiscrete -> Rep SomeDiscrete x
GHC.Generic)

-- | __WARNING__ This instance does not compare monetary amounts across
-- different currencies, it just helps you sort 'SomeDiscrete' values in case
-- you need to put them in a 'Data.Set.Set' or similar.
deriving instance Ord SomeDiscrete

-- | Currency name.
someDiscreteCurrency :: SomeDiscrete -> T.Text
someDiscreteCurrency :: SomeDiscrete -> Text
someDiscreteCurrency = String -> Text
T.pack (String -> Text)
-> (SomeDiscrete -> String) -> SomeDiscrete -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SomeDiscrete -> String
someDiscreteCurrency'
{-# INLINE someDiscreteCurrency #-}

-- | Like 'someDiscreteCurrency' but returns 'String'.
someDiscreteCurrency' :: SomeDiscrete -> String
someDiscreteCurrency' :: SomeDiscrete -> String
someDiscreteCurrency' = SomeDiscrete -> String
_someDiscreteCurrency
{-# INLINE someDiscreteCurrency' #-}

-- | Positive, non-zero.
someDiscreteScale :: SomeDiscrete -> Scale
someDiscreteScale :: SomeDiscrete -> Scale
someDiscreteScale = SomeDiscrete -> Scale
_someDiscreteScale
{-# INLINE someDiscreteScale #-}

-- | Amount of currency unit.
someDiscreteAmount :: SomeDiscrete -> Integer
someDiscreteAmount :: SomeDiscrete -> Integer
someDiscreteAmount = SomeDiscrete -> Integer
_someDiscreteAmount
{-# INLINE someDiscreteAmount #-}

-- | Build a 'SomeDiscrete' from raw values.
--
-- This function is intended for deserialization purposes. You need to convert
-- this 'SomeDiscrete' value to a 'Discrete' vallue in order to do any
-- arithmetic operation on the monetary value.
mkSomeDiscrete
  :: T.Text   -- ^ Currency name. ('someDiscreteCurrency')
  -> Scale    -- ^ Scale. Positive, non-zero. ('someDiscreteScale')
  -> Integer  -- ^ Amount of unit. ('someDiscreteAmount')
  -> SomeDiscrete
{-# INLINE mkSomeDiscrete #-}
mkSomeDiscrete :: Text -> Scale -> Integer -> SomeDiscrete
mkSomeDiscrete = \Text
c Scale
s Integer
a -> String -> Scale -> Integer -> SomeDiscrete
mkSomeDiscrete' (Text -> String
T.unpack Text
c) Scale
s Integer
a

-- | Like 'mkSomeDiscrete' but takes 'String' rather than 'T.Text'.
mkSomeDiscrete' :: String -> Scale -> Integer -> SomeDiscrete
{-# INLINABLE mkSomeDiscrete' #-}
mkSomeDiscrete' :: String -> Scale -> Integer -> SomeDiscrete
mkSomeDiscrete' = String -> Scale -> Integer -> SomeDiscrete
SomeDiscrete

-- | Convert a 'Discrete' to a 'SomeDiscrete' for ease of serialization.
toSomeDiscrete
  :: (KnownSymbol currency, GoodScale scale)
  => Discrete' currency scale
  -> SomeDiscrete -- ^
toSomeDiscrete :: Discrete' currency scale -> SomeDiscrete
toSomeDiscrete = \(Discrete Integer
i0 :: Discrete' currency scale) ->
  let c :: String
c = Proxy currency -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy currency
forall k (t :: k). Proxy t
Proxy :: Proxy currency)
      n :: Integer
n = Proxy (Fst scale) -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy (Fst scale)
forall k (t :: k). Proxy t
Proxy :: Proxy (Fst scale))
      d :: Integer
d = Proxy (Snd scale) -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy (Snd scale)
forall k (t :: k). Proxy t
Proxy :: Proxy (Snd scale))
  in String -> Scale -> Integer -> SomeDiscrete
SomeDiscrete String
c (Rational -> Scale
Scale (Integer
n Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
d)) Integer
i0
{-# INLINABLE toSomeDiscrete #-}

-- | Attempt to convert a 'SomeDiscrete' to a 'Discrete', provided you know the
-- target @currency@ and @unit@.
fromSomeDiscrete
  :: forall currency scale
  .  (KnownSymbol currency, GoodScale scale)
  => SomeDiscrete
  -> Maybe (Discrete' currency scale)  -- ^
fromSomeDiscrete :: SomeDiscrete -> Maybe (Discrete' currency scale)
fromSomeDiscrete = \SomeDiscrete
dr ->
   if (SomeDiscrete -> String
_someDiscreteCurrency SomeDiscrete
dr String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Proxy currency -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy currency
forall k (t :: k). Proxy t
Proxy @currency)) Bool -> Bool -> Bool
&&
      (SomeDiscrete -> Scale
someDiscreteScale SomeDiscrete
dr Scale -> Scale -> Bool
forall a. Eq a => a -> a -> Bool
== Proxy scale -> Scale
forall (proxy :: (Nat, Nat) -> *) (scale :: (Nat, Nat)).
GoodScale scale =>
proxy scale -> Scale
scale (Proxy scale
forall k (t :: k). Proxy t
Proxy @scale))
   then Discrete' currency scale -> Maybe (Discrete' currency scale)
forall a. a -> Maybe a
Just (Integer -> Discrete' currency scale
forall (currency :: Symbol) (scale :: (Nat, Nat)).
Integer -> Discrete' currency scale
Discrete (SomeDiscrete -> Integer
someDiscreteAmount SomeDiscrete
dr))
   else Maybe (Discrete' currency scale)
forall a. Maybe a
Nothing
{-# INLINABLE fromSomeDiscrete #-}

-- | Convert a 'SomeDiscrete' to a 'Discrete' without knowing the target
-- @currency@ and @unit@.
--
-- Notice that @currency@ and @unit@ here can't leave its intended scope unless
-- you can prove equality with some other type at the outer scope, but in that
-- case you would be better off using 'fromSomeDiscrete' directly.
--
-- Notice that you may need to add an explicit type to the result of this
-- function in order to keep the compiler happy.
withSomeDiscrete
  :: forall r
  .  SomeDiscrete
  -> ( forall currency scale.
         ( KnownSymbol currency
         , GoodScale scale
         ) => Discrete' currency scale
           -> r )
  -> r  -- ^
withSomeDiscrete :: SomeDiscrete
-> (forall (currency :: Symbol) (scale :: (Nat, Nat)).
    (KnownSymbol currency, GoodScale scale) =>
    Discrete' currency scale -> r)
-> r
withSomeDiscrete SomeDiscrete
dr = \forall (currency :: Symbol) (scale :: (Nat, Nat)).
(KnownSymbol currency, GoodScale scale) =>
Discrete' currency scale -> r
f ->
  let Rational
rscale :: Rational = Scale -> Rational
scaleToRational (SomeDiscrete -> Scale
someDiscreteScale SomeDiscrete
dr)
  in case String -> SomeSymbol
someSymbolVal (SomeDiscrete -> String
_someDiscreteCurrency SomeDiscrete
dr) of
       SomeSymbol (Proxy n
Proxy :: Proxy currency) ->
         case Integer -> Maybe SomeNat
someNatVal (Rational -> Integer
forall a. Ratio a -> a
numerator Rational
rscale) of
           Maybe SomeNat
Nothing -> String -> r
forall a. HasCallStack => String -> a
error String
"withSomeDiscrete: impossible: numerator < 0"
           Just (SomeNat (Proxy n
Proxy :: Proxy num)) ->
             case Integer -> Maybe SomeNat
someNatVal (Rational -> Integer
forall a. Ratio a -> a
denominator Rational
rscale) of
               Maybe SomeNat
Nothing -> String -> r
forall a. HasCallStack => String -> a
error String
"withSomeDiscrete: impossible: denominator < 0"
               Just (SomeNat (Proxy n
Proxy :: Proxy den)) ->
                 case Maybe (Dict (GoodScale '(n, n)))
forall (num :: Nat) (den :: Nat).
(KnownNat num, KnownNat den) =>
Maybe (Dict (GoodScale '(num, den)))
mkGoodScale of
                   Maybe (Dict (GoodScale '(n, n)))
Nothing -> String -> r
forall a. HasCallStack => String -> a
error String
"withSomeDiscrete: impossible: mkGoodScale"
                   Just (Dict :: Dict (GoodScale '(num, den))) ->
                     Discrete' n '(n, n) -> r
forall (currency :: Symbol) (scale :: (Nat, Nat)).
(KnownSymbol currency, GoodScale scale) =>
Discrete' currency scale -> r
f (Integer -> Discrete' n '(n, n)
forall (currency :: Symbol) (scale :: (Nat, Nat)).
Integer -> Discrete' currency scale
Discrete (SomeDiscrete -> Integer
someDiscreteAmount SomeDiscrete
dr)
                          :: Discrete' currency '(num, den))
{-# INLINABLE withSomeDiscrete #-}

--------------------------------------------------------------------------------
-- SomeExchangeRate

-- | A monomorphic representation of 'ExchangeRate' that is easier to serialize
-- and deserialize than 'ExchangeRate' in case you don't know the type indexes
-- involved.
--
-- If you are trying to construct a value of this type from some raw input, then
-- you will need to use the 'mkSomeExchangeRate' function.
--
-- In order to be able to effectively serialize an 'SomeExchangeRate' value, you
-- need to serialize the following four values (which are the eventual arguments
-- to 'mkSomeExchangeRate'):
--
-- * 'someExchangeRateSrcCurrency'
-- * 'someExchangeRateDstCurrency'
-- * 'someExchangeRateRate'
data SomeExchangeRate = SomeExchangeRate
  { SomeExchangeRate -> String
_someExchangeRateSrcCurrency     :: !String
    -- ^ This is a 'String' rather than 'T.Text' because it makes it easier for
    -- us to derive serialization instances maintaining backwards compatiblity
    -- with pre-0.6 versions of this library, when 'String' was the prefered
    -- string type, and not 'T.Text'.
  , SomeExchangeRate -> String
_someExchangeRateDstCurrency     :: !String
    -- ^ This is a 'String' rather than 'T.Text' because it makes it easier for
    -- us to derive serialization instances maintaining backwards compatiblity
    -- with pre-0.6 versions of this library, when 'String' was the prefered
    -- string type, and not 'T.Text'.
  , SomeExchangeRate -> Rational
_someExchangeRateRate            :: !Rational -- ^ Positive, non-zero.
  } deriving (SomeExchangeRate -> SomeExchangeRate -> Bool
(SomeExchangeRate -> SomeExchangeRate -> Bool)
-> (SomeExchangeRate -> SomeExchangeRate -> Bool)
-> Eq SomeExchangeRate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SomeExchangeRate -> SomeExchangeRate -> Bool
$c/= :: SomeExchangeRate -> SomeExchangeRate -> Bool
== :: SomeExchangeRate -> SomeExchangeRate -> Bool
$c== :: SomeExchangeRate -> SomeExchangeRate -> Bool
Eq, Int -> SomeExchangeRate -> ShowS
[SomeExchangeRate] -> ShowS
SomeExchangeRate -> String
(Int -> SomeExchangeRate -> ShowS)
-> (SomeExchangeRate -> String)
-> ([SomeExchangeRate] -> ShowS)
-> Show SomeExchangeRate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SomeExchangeRate] -> ShowS
$cshowList :: [SomeExchangeRate] -> ShowS
show :: SomeExchangeRate -> String
$cshow :: SomeExchangeRate -> String
showsPrec :: Int -> SomeExchangeRate -> ShowS
$cshowsPrec :: Int -> SomeExchangeRate -> ShowS
Show, (forall x. SomeExchangeRate -> Rep SomeExchangeRate x)
-> (forall x. Rep SomeExchangeRate x -> SomeExchangeRate)
-> Generic SomeExchangeRate
forall x. Rep SomeExchangeRate x -> SomeExchangeRate
forall x. SomeExchangeRate -> Rep SomeExchangeRate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SomeExchangeRate x -> SomeExchangeRate
$cfrom :: forall x. SomeExchangeRate -> Rep SomeExchangeRate x
GHC.Generic)

-- | __WARNING__ This instance does not compare rates across different currency
-- pairs (whatever that means), it just helps you sort 'SomeExchangeRate' values
-- in case you need to put them in a 'Data.Set.Set' or similar.
deriving instance Ord SomeExchangeRate

-- | Source currency name.
someExchangeRateSrcCurrency :: SomeExchangeRate -> T.Text
someExchangeRateSrcCurrency :: SomeExchangeRate -> Text
someExchangeRateSrcCurrency = String -> Text
T.pack (String -> Text)
-> (SomeExchangeRate -> String) -> SomeExchangeRate -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SomeExchangeRate -> String
someExchangeRateSrcCurrency'
{-# INLINE someExchangeRateSrcCurrency #-}

-- | Like 'someExchangeRateSrcCurrency' but returns 'String'.
someExchangeRateSrcCurrency' :: SomeExchangeRate -> String
someExchangeRateSrcCurrency' :: SomeExchangeRate -> String
someExchangeRateSrcCurrency' = SomeExchangeRate -> String
_someExchangeRateSrcCurrency
{-# INLINE someExchangeRateSrcCurrency' #-}

-- | Destination currency name.
someExchangeRateDstCurrency :: SomeExchangeRate -> T.Text
someExchangeRateDstCurrency :: SomeExchangeRate -> Text
someExchangeRateDstCurrency = String -> Text
T.pack (String -> Text)
-> (SomeExchangeRate -> String) -> SomeExchangeRate -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SomeExchangeRate -> String
_someExchangeRateDstCurrency
{-# INLINE someExchangeRateDstCurrency #-}

-- | Like 'someExchangeRateDstCurrency' but returns 'String'.
someExchangeRateDstCurrency' :: SomeExchangeRate -> String
someExchangeRateDstCurrency' :: SomeExchangeRate -> String
someExchangeRateDstCurrency' = SomeExchangeRate -> String
_someExchangeRateDstCurrency
{-# INLINE someExchangeRateDstCurrency' #-}

-- | Exchange rate. Positive, non-zero.
someExchangeRateRate :: SomeExchangeRate -> Rational
someExchangeRateRate :: SomeExchangeRate -> Rational
someExchangeRateRate = SomeExchangeRate -> Rational
_someExchangeRateRate
{-# INLINE someExchangeRateRate #-}

-- | Build a 'SomeExchangeRate' from raw values.
--
-- This function is intended for deserialization purposes. You need to convert
-- this 'SomeExchangeRate' value to a 'ExchangeRate' value in order to do any
-- arithmetic operation with the exchange rate.
mkSomeExchangeRate
  :: T.Text   -- ^ Source currency name. ('someExchangeRateSrcCurrency')
  -> T.Text   -- ^ Destination currency name. ('someExchangeRateDstCurrency')
  -> Rational -- ^ Exchange rate . Positive, non-zero. ('someExchangeRateRate')
  -> Maybe SomeExchangeRate
{-# INLINE mkSomeExchangeRate #-}
mkSomeExchangeRate :: Text -> Text -> Rational -> Maybe SomeExchangeRate
mkSomeExchangeRate = \Text
src Text
dst Rational
r ->
  String -> String -> Rational -> Maybe SomeExchangeRate
mkSomeExchangeRate' (Text -> String
T.unpack Text
src) (Text -> String
T.unpack Text
dst) Rational
r

-- | Like 'mkSomeExchangeRate' but takes 'String' rather than 'T.Text'.
mkSomeExchangeRate' :: String -> String -> Rational -> Maybe SomeExchangeRate
{-# INLINABLE mkSomeExchangeRate' #-}
mkSomeExchangeRate' :: String -> String -> Rational -> Maybe SomeExchangeRate
mkSomeExchangeRate' = \String
src String
dst Rational
r ->
  if (Rational -> Integer
forall a. Ratio a -> a
denominator Rational
r Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0) Bool -> Bool -> Bool
&& (Rational
r Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
0)
  then SomeExchangeRate -> Maybe SomeExchangeRate
forall a. a -> Maybe a
Just (String -> String -> Rational -> SomeExchangeRate
SomeExchangeRate String
src String
dst Rational
r)
  else Maybe SomeExchangeRate
forall a. Maybe a
Nothing

-- | Convert a 'ExchangeRate' to a 'SomeDiscrete' for ease of serialization.
toSomeExchangeRate
  :: (KnownSymbol src, KnownSymbol dst)
  => ExchangeRate src dst
  -> SomeExchangeRate -- ^
toSomeExchangeRate :: ExchangeRate src dst -> SomeExchangeRate
toSomeExchangeRate = \(ExchangeRate Rational
r0 :: ExchangeRate src dst) ->
  let src :: String
src = Proxy src -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy src
forall k (t :: k). Proxy t
Proxy :: Proxy src)
      dst :: String
dst = Proxy dst -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy dst
forall k (t :: k). Proxy t
Proxy :: Proxy dst)
  in String -> String -> Rational -> SomeExchangeRate
SomeExchangeRate String
src String
dst Rational
r0
{-# INLINABLE toSomeExchangeRate #-}

-- | Attempt to convert a 'SomeExchangeRate' to a 'ExchangeRate', provided you
-- know the target @src@ and @dst@ types.
fromSomeExchangeRate
  :: forall src dst
  .  (KnownSymbol src, KnownSymbol dst)
  => SomeExchangeRate
  -> Maybe (ExchangeRate src dst)  -- ^
fromSomeExchangeRate :: SomeExchangeRate -> Maybe (ExchangeRate src dst)
fromSomeExchangeRate = \SomeExchangeRate
x ->
   if (SomeExchangeRate -> String
_someExchangeRateSrcCurrency SomeExchangeRate
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Proxy src -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy src
forall k (t :: k). Proxy t
Proxy @src)) Bool -> Bool -> Bool
&&
      (SomeExchangeRate -> String
_someExchangeRateDstCurrency SomeExchangeRate
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Proxy dst -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy dst
forall k (t :: k). Proxy t
Proxy @dst))
   then ExchangeRate src dst -> Maybe (ExchangeRate src dst)
forall a. a -> Maybe a
Just (Rational -> ExchangeRate src dst
forall (src :: Symbol) (dst :: Symbol).
Rational -> ExchangeRate src dst
ExchangeRate (SomeExchangeRate -> Rational
someExchangeRateRate SomeExchangeRate
x))
   else Maybe (ExchangeRate src dst)
forall a. Maybe a
Nothing
{-# INLINABLE fromSomeExchangeRate #-}

-- | Convert a 'SomeExchangeRate' to a 'ExchangeRate' without knowing the target
-- @currency@ and @unit@.
--
-- Notice that @src@ and @dst@ here can't leave its intended scope unless
-- you can prove equality with some other type at the outer scope, but in that
-- case you would be better off using 'fromSomeExchangeRate' directly.
withSomeExchangeRate
  :: SomeExchangeRate
  -> ( forall src dst.
         ( KnownSymbol src
         , KnownSymbol dst
         ) => ExchangeRate src dst
           -> r )
  -> r  -- ^
withSomeExchangeRate :: SomeExchangeRate
-> (forall (src :: Symbol) (dst :: Symbol).
    (KnownSymbol src, KnownSymbol dst) =>
    ExchangeRate src dst -> r)
-> r
withSomeExchangeRate SomeExchangeRate
x = \forall (src :: Symbol) (dst :: Symbol).
(KnownSymbol src, KnownSymbol dst) =>
ExchangeRate src dst -> r
f ->
  case String -> SomeSymbol
someSymbolVal (SomeExchangeRate -> String
_someExchangeRateSrcCurrency SomeExchangeRate
x) of
    SomeSymbol (Proxy n
Proxy :: Proxy src) ->
      case String -> SomeSymbol
someSymbolVal (SomeExchangeRate -> String
_someExchangeRateDstCurrency SomeExchangeRate
x) of
        SomeSymbol (Proxy n
Proxy :: Proxy dst) ->
          ExchangeRate n n -> r
forall (src :: Symbol) (dst :: Symbol).
(KnownSymbol src, KnownSymbol dst) =>
ExchangeRate src dst -> r
f (Rational -> ExchangeRate n n
forall (src :: Symbol) (dst :: Symbol).
Rational -> ExchangeRate src dst
ExchangeRate (SomeExchangeRate -> Rational
someExchangeRateRate SomeExchangeRate
x) :: ExchangeRate src dst)
{-# INLINABLE withSomeExchangeRate #-}

--------------------------------------------------------------------------------
-- Miscellaneous

type family Fst (ab :: (ka, kb)) :: ka where Fst '(a,b) = a
type family Snd (ab :: (ka, kb)) :: ka where Snd '(a,b) = b

--------------------------------------------------------------------------------
-- vector-space instances

instance AG.AdditiveGroup (Dense currency) where
  zeroV :: Dense currency
zeroV = Rational -> Dense currency
forall (currency :: Symbol). Rational -> Dense currency
Dense Rational
forall v. AdditiveGroup v => v
AG.zeroV
  {-# INLINE zeroV #-}
  Dense Rational
a ^+^ :: Dense currency -> Dense currency -> Dense currency
^+^ Dense Rational
b = Rational -> Dense currency
forall (currency :: Symbol). Rational -> Dense currency
Dense (Rational -> Dense currency) -> Rational -> Dense currency
forall a b. (a -> b) -> a -> b
$! (Rational
a Rational -> Rational -> Rational
forall v. AdditiveGroup v => v -> v -> v
AG.^+^ Rational
b)
  {-# INLINE (^+^) #-}
  negateV :: Dense currency -> Dense currency
negateV (Dense Rational
a) = Rational -> Dense currency
forall (currency :: Symbol). Rational -> Dense currency
Dense (Rational -> Dense currency) -> Rational -> Dense currency
forall a b. (a -> b) -> a -> b
$! (Rational -> Rational
forall v. AdditiveGroup v => v -> v
AG.negateV Rational
a)
  {-# INLINE negateV #-}
  Dense Rational
a ^-^ :: Dense currency -> Dense currency -> Dense currency
^-^ Dense Rational
b = Rational -> Dense currency
forall (currency :: Symbol). Rational -> Dense currency
Dense (Rational -> Dense currency) -> Rational -> Dense currency
forall a b. (a -> b) -> a -> b
$! (Rational
a Rational -> Rational -> Rational
forall v. AdditiveGroup v => v -> v -> v
AG.^-^ Rational
b)
  {-# INLINE (^-^) #-}

-- | __WARNING__ a scalar with a zero denominator will cause 'VS.*^' to crash.
instance VS.VectorSpace (Dense currency) where
  type Scalar (Dense currency) = Rational
  Scalar (Dense currency)
s *^ :: Scalar (Dense currency) -> Dense currency -> Dense currency
*^ Dense Rational
a =
    if Rational -> Integer
forall a. Ratio a -> a
denominator Rational
Scalar (Dense currency)
s Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0
    then Rational -> Dense currency
forall (currency :: Symbol). Rational -> Dense currency
Dense (Rational -> Dense currency) -> Rational -> Dense currency
forall a b. (a -> b) -> a -> b
$! Scalar Rational
Scalar (Dense currency)
s Scalar Rational -> Rational -> Rational
forall v. VectorSpace v => Scalar v -> v -> v
VS.*^ Rational
a
    else String -> Dense currency
forall a. HasCallStack => String -> a
error String
"(*^)': malformed Rational given (denominator is zero)."
  {-# INLINE (*^) #-}

instance GoodScale scale => AG.AdditiveGroup (Discrete' currency scale) where
  zeroV :: Discrete' currency scale
zeroV = Integer -> Discrete' currency scale
forall (currency :: Symbol) (scale :: (Nat, Nat)).
Integer -> Discrete' currency scale
Discrete Integer
forall v. AdditiveGroup v => v
AG.zeroV
  {-# INLINE zeroV #-}
  Discrete Integer
a ^+^ :: Discrete' currency scale
-> Discrete' currency scale -> Discrete' currency scale
^+^ Discrete Integer
b = Integer -> Discrete' currency scale
forall (currency :: Symbol) (scale :: (Nat, Nat)).
Integer -> Discrete' currency scale
Discrete (Integer -> Discrete' currency scale)
-> Integer -> Discrete' currency scale
forall a b. (a -> b) -> a -> b
$! (Integer
a Integer -> Integer -> Integer
forall v. AdditiveGroup v => v -> v -> v
AG.^+^ Integer
b)
  {-# INLINE (^+^) #-}
  negateV :: Discrete' currency scale -> Discrete' currency scale
negateV (Discrete Integer
a) = Integer -> Discrete' currency scale
forall (currency :: Symbol) (scale :: (Nat, Nat)).
Integer -> Discrete' currency scale
Discrete (Integer -> Discrete' currency scale)
-> Integer -> Discrete' currency scale
forall a b. (a -> b) -> a -> b
$! (Integer -> Integer
forall v. AdditiveGroup v => v -> v
AG.negateV Integer
a)
  {-# INLINE negateV #-}
  Discrete Integer
a ^-^ :: Discrete' currency scale
-> Discrete' currency scale -> Discrete' currency scale
^-^ Discrete Integer
b = Integer -> Discrete' currency scale
forall (currency :: Symbol) (scale :: (Nat, Nat)).
Integer -> Discrete' currency scale
Discrete (Integer -> Discrete' currency scale)
-> Integer -> Discrete' currency scale
forall a b. (a -> b) -> a -> b
$! (Integer
a Integer -> Integer -> Integer
forall v. AdditiveGroup v => v -> v -> v
AG.^-^ Integer
b)
  {-# INLINE (^-^) #-}

instance GoodScale scale => VS.VectorSpace (Discrete' currency scale) where
  type Scalar (Discrete' currency scale) = Integer
  Scalar (Discrete' currency scale)
s *^ :: Scalar (Discrete' currency scale)
-> Discrete' currency scale -> Discrete' currency scale
*^ Discrete Integer
a = Integer -> Discrete' currency scale
forall (currency :: Symbol) (scale :: (Nat, Nat)).
Integer -> Discrete' currency scale
Discrete (Integer -> Discrete' currency scale)
-> Integer -> Discrete' currency scale
forall a b. (a -> b) -> a -> b
$! (Scalar Integer
Scalar (Discrete' currency scale)
s Scalar Integer -> Integer -> Integer
forall v. VectorSpace v => Scalar v -> v -> v
VS.*^ Integer
a)
  {-# INLINE (*^) #-}

--------------------------------------------------------------------------------
-- Extra instances: hashable
instance Hashable Approximation
instance Hashable (Dense currency)
instance Hashable SomeDense
instance GoodScale scale => Hashable (Discrete' currency scale)
instance Hashable SomeDiscrete
instance Hashable (ExchangeRate src dst)
instance Hashable SomeExchangeRate
instance Hashable Scale

--------------------------------------------------------------------------------
-- Extra instances: deepseq
instance NFData Approximation
instance NFData (Dense currency)
instance NFData SomeDense
instance GoodScale scale => NFData (Discrete' currency scale)
instance NFData SomeDiscrete
instance NFData (ExchangeRate src dst)
instance NFData SomeExchangeRate
instance NFData Scale

--------------------------------------------------------------------------------
-- Extra instances: binary

-- | Compatible with 'SomeDense'.
instance (KnownSymbol currency) => Binary.Binary (Dense currency) where
  put :: Dense currency -> Put
put = SomeDense -> Put
forall t. Binary t => t -> Put
Binary.put (SomeDense -> Put)
-> (Dense currency -> SomeDense) -> Dense currency -> Put
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Dense currency -> SomeDense
forall (currency :: Symbol).
KnownSymbol currency =>
Dense currency -> SomeDense
toSomeDense
  get :: Get (Dense currency)
get = Get (Dense currency)
-> (Dense currency -> Get (Dense currency))
-> Maybe (Dense currency)
-> Get (Dense currency)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Get (Dense currency)
forall (f :: * -> *) a. Alternative f => f a
empty Dense currency -> Get (Dense currency)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Dense currency) -> Get (Dense currency))
-> Get (Maybe (Dense currency)) -> Get (Dense currency)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (SomeDense -> Maybe (Dense currency))
-> Get SomeDense -> Get (Maybe (Dense currency))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SomeDense -> Maybe (Dense currency)
forall (currency :: Symbol).
KnownSymbol currency =>
SomeDense -> Maybe (Dense currency)
fromSomeDense Get SomeDense
forall t. Binary t => Get t
Binary.get

-- | Compatible with 'SomeDiscrete'.
instance
  ( KnownSymbol currency, GoodScale scale
  ) => Binary.Binary (Discrete' currency scale) where
  put :: Discrete' currency scale -> Put
put = SomeDiscrete -> Put
forall t. Binary t => t -> Put
Binary.put (SomeDiscrete -> Put)
-> (Discrete' currency scale -> SomeDiscrete)
-> Discrete' currency scale
-> Put
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Discrete' currency scale -> SomeDiscrete
forall (currency :: Symbol) (scale :: (Nat, Nat)).
(KnownSymbol currency, GoodScale scale) =>
Discrete' currency scale -> SomeDiscrete
toSomeDiscrete
  get :: Get (Discrete' currency scale)
get = Get (Discrete' currency scale)
-> (Discrete' currency scale -> Get (Discrete' currency scale))
-> Maybe (Discrete' currency scale)
-> Get (Discrete' currency scale)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Get (Discrete' currency scale)
forall (f :: * -> *) a. Alternative f => f a
empty Discrete' currency scale -> Get (Discrete' currency scale)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Discrete' currency scale)
 -> Get (Discrete' currency scale))
-> Get (Maybe (Discrete' currency scale))
-> Get (Discrete' currency scale)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (SomeDiscrete -> Maybe (Discrete' currency scale))
-> Get SomeDiscrete -> Get (Maybe (Discrete' currency scale))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SomeDiscrete -> Maybe (Discrete' currency scale)
forall (currency :: Symbol) (scale :: (Nat, Nat)).
(KnownSymbol currency, GoodScale scale) =>
SomeDiscrete -> Maybe (Discrete' currency scale)
fromSomeDiscrete Get SomeDiscrete
forall t. Binary t => Get t
Binary.get

-- | Compatible with 'SomeExchangeRate'.
instance
  ( KnownSymbol src, KnownSymbol dst
  ) => Binary.Binary (ExchangeRate src dst) where
  put :: ExchangeRate src dst -> Put
put = SomeExchangeRate -> Put
forall t. Binary t => t -> Put
Binary.put (SomeExchangeRate -> Put)
-> (ExchangeRate src dst -> SomeExchangeRate)
-> ExchangeRate src dst
-> Put
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ExchangeRate src dst -> SomeExchangeRate
forall (src :: Symbol) (dst :: Symbol).
(KnownSymbol src, KnownSymbol dst) =>
ExchangeRate src dst -> SomeExchangeRate
toSomeExchangeRate
  get :: Get (ExchangeRate src dst)
get = Get (ExchangeRate src dst)
-> (ExchangeRate src dst -> Get (ExchangeRate src dst))
-> Maybe (ExchangeRate src dst)
-> Get (ExchangeRate src dst)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Get (ExchangeRate src dst)
forall (f :: * -> *) a. Alternative f => f a
empty ExchangeRate src dst -> Get (ExchangeRate src dst)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ExchangeRate src dst) -> Get (ExchangeRate src dst))
-> Get (Maybe (ExchangeRate src dst)) -> Get (ExchangeRate src dst)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (SomeExchangeRate -> Maybe (ExchangeRate src dst))
-> Get SomeExchangeRate -> Get (Maybe (ExchangeRate src dst))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SomeExchangeRate -> Maybe (ExchangeRate src dst)
forall (src :: Symbol) (dst :: Symbol).
(KnownSymbol src, KnownSymbol dst) =>
SomeExchangeRate -> Maybe (ExchangeRate src dst)
fromSomeExchangeRate Get SomeExchangeRate
forall t. Binary t => Get t
Binary.get

-- | Compatible with 'Dense'.
instance Binary.Binary SomeDense where
  put :: SomeDense -> Put
put = \(SomeDense String
c Rational
r) -> do
    String -> Put
forall t. Binary t => t -> Put
Binary.put String
c
    Integer -> Put
forall t. Binary t => t -> Put
Binary.put (Rational -> Integer
forall a. Ratio a -> a
numerator Rational
r)
    Integer -> Put
forall t. Binary t => t -> Put
Binary.put (Rational -> Integer
forall a. Ratio a -> a
denominator Rational
r)
  get :: Get SomeDense
get = Get SomeDense
-> (SomeDense -> Get SomeDense) -> Maybe SomeDense -> Get SomeDense
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Get SomeDense
forall (f :: * -> *) a. Alternative f => f a
empty SomeDense -> Get SomeDense
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe SomeDense -> Get SomeDense)
-> Get (Maybe SomeDense) -> Get SomeDense
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
    String
c :: String <- Get String
forall t. Binary t => Get t
Binary.get
    Integer
n :: Integer <- Get Integer
forall t. Binary t => Get t
Binary.get
    Integer
d :: Integer <- Get Integer
forall t. Binary t => Get t
Binary.get
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
d Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0) (String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"denominator is zero")
    Maybe SomeDense -> Get (Maybe SomeDense)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Rational -> Maybe SomeDense
mkSomeDense' String
c (Integer
n Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
d))

instance Binary.Binary Scale where
  put :: Scale -> Put
put = \Scale
s ->
    let r :: Rational
r = Scale -> Rational
scaleToRational Scale
s
    in Integer -> Put
forall t. Binary t => t -> Put
Binary.put (Rational -> Integer
forall a. Ratio a -> a
numerator Rational
r) Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<>
       Integer -> Put
forall t. Binary t => t -> Put
Binary.put (Rational -> Integer
forall a. Ratio a -> a
denominator Rational
r)
  get :: Get Scale
get = Get Scale -> (Scale -> Get Scale) -> Maybe Scale -> Get Scale
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Get Scale
forall (f :: * -> *) a. Alternative f => f a
empty Scale -> Get Scale
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Scale -> Get Scale) -> Get (Maybe Scale) -> Get Scale
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
    Integer
n :: Integer <- Get Integer
forall t. Binary t => Get t
Binary.get
    Integer
d :: Integer <- Get Integer
forall t. Binary t => Get t
Binary.get
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
d Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0) (String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"denominator is zero")
    Maybe Scale -> Get (Maybe Scale)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rational -> Maybe Scale
scaleFromRational (Integer
n Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
d))

-- | Compatible with 'Discrete'.
instance Binary.Binary SomeDiscrete where
  put :: SomeDiscrete -> Put
put = \(SomeDiscrete String
c Scale
s Integer
a) ->
    -- We go through String for backwards compatibility.
    String -> Put
forall t. Binary t => t -> Put
Binary.put String
c Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<>
    Scale -> Put
forall t. Binary t => t -> Put
Binary.put Scale
s Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<>
    Integer -> Put
forall t. Binary t => t -> Put
Binary.put Integer
a
  get :: Get SomeDiscrete
get = do
    String
c :: String <- Get String
forall t. Binary t => Get t
Binary.get
    Scale
s :: Scale <- Get Scale
forall t. Binary t => Get t
Binary.get
    Integer
a :: Integer <- Get Integer
forall t. Binary t => Get t
Binary.get
    SomeDiscrete -> Get SomeDiscrete
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Scale -> Integer -> SomeDiscrete
mkSomeDiscrete' String
c Scale
s Integer
a)

-- | Compatible with 'ExchangeRate'.
instance Binary.Binary SomeExchangeRate where
  put :: SomeExchangeRate -> Put
put = \(SomeExchangeRate String
src String
dst Rational
r) -> do
    String -> Put
forall t. Binary t => t -> Put
Binary.put String
src
    String -> Put
forall t. Binary t => t -> Put
Binary.put String
dst
    Integer -> Put
forall t. Binary t => t -> Put
Binary.put (Rational -> Integer
forall a. Ratio a -> a
numerator Rational
r)
    Integer -> Put
forall t. Binary t => t -> Put
Binary.put (Rational -> Integer
forall a. Ratio a -> a
denominator Rational
r)
  get :: Get SomeExchangeRate
get = Get SomeExchangeRate
-> (SomeExchangeRate -> Get SomeExchangeRate)
-> Maybe SomeExchangeRate
-> Get SomeExchangeRate
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Get SomeExchangeRate
forall (f :: * -> *) a. Alternative f => f a
empty SomeExchangeRate -> Get SomeExchangeRate
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe SomeExchangeRate -> Get SomeExchangeRate)
-> Get (Maybe SomeExchangeRate) -> Get SomeExchangeRate
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
    String
src :: String <- Get String
forall t. Binary t => Get t
Binary.get
    String
dst :: String <- Get String
forall t. Binary t => Get t
Binary.get
    Integer
n :: Integer <- Get Integer
forall t. Binary t => Get t
Binary.get
    Integer
d :: Integer <- Get Integer
forall t. Binary t => Get t
Binary.get
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
d Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0) (String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"denominator is zero")
    Maybe SomeExchangeRate -> Get (Maybe SomeExchangeRate)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> String -> Rational -> Maybe SomeExchangeRate
mkSomeExchangeRate' String
src String
dst (Integer
n Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
d))

--------------------------------------------------------------------------------
-- Decimal rendering

-- | Render a 'Dense' monetary amount as a decimal number in a potentially lossy
-- manner.
--
-- @
-- > 'denseToDecimal' 'defaultDecimalConf' 'Round'
--      ('dense'' (123456 '%' 100) :: 'Dense' \"USD\")
-- \"1234.56\"
-- @
denseToDecimal
  :: DecimalConf -- ^ Config to use for rendering the decimal number.
  -> Approximation
  -- ^ Approximation to use if necessary in order to fit the 'Dense' amount in
  -- as many decimal numbers as requested.
  -> Dense currency -- ^ The monetary amount to render.
  -> T.Text
{-# INLINABLE denseToDecimal #-}
denseToDecimal :: DecimalConf -> Approximation -> Dense currency -> Text
denseToDecimal DecimalConf
dc Approximation
a = \(Dense Rational
r0) ->
  DecimalConf -> Approximation -> Rational -> Text
rationalToDecimal DecimalConf
dc Approximation
a Rational
r0

-- | Like 'denseToDecimal', but takes a 'SomeDense' as input.
someDenseToDecimal
  :: DecimalConf -- ^ Config to use for rendering the decimal number.
  -> Approximation
  -- ^ Approximation to use if necessary in order to fit the 'SomeDense' amount
  -- in as many decimal numbers as requested.
  -> SomeDense -- ^ The monetary amount to render.
  -> T.Text
{-# INLINABLE someDenseToDecimal #-}
someDenseToDecimal :: DecimalConf -> Approximation -> SomeDense -> Text
someDenseToDecimal DecimalConf
dc Approximation
a = \SomeDense
sd ->
  SomeDense
-> (forall (currency :: Symbol).
    KnownSymbol currency =>
    Dense currency -> Text)
-> Text
forall r.
SomeDense
-> (forall (currency :: Symbol).
    KnownSymbol currency =>
    Dense currency -> r)
-> r
withSomeDense SomeDense
sd (DecimalConf -> Approximation -> Dense currency -> Text
forall (currency :: Symbol).
DecimalConf -> Approximation -> Dense currency -> Text
denseToDecimal DecimalConf
dc Approximation
a)

-- | Render a 'Discrete'' monetary amount as a decimal number in a potentially
-- lossy manner.
--
-- This is simply a convenient wrapper around 'denseToDecimal':
--
-- @
-- 'discreteToDecimal' ds a (dis :: 'Discrete'' currency scale)
--     == 'denseToDecimal' ds a ('denseFromDiscrete' dis :: 'Dense' currency)
-- @
--
-- In particular, the @scale@ in @'Discrete'' currency scale@ has no influence
-- over the scale in which the decimal number is rendered. Change the scale
-- with 'decimalConf_scale' in order to modify that behavior.
--
-- Please refer to 'denseToDecimal' for further documentation.
discreteToDecimal
  :: GoodScale scale
  => DecimalConf -- ^ Config to use for rendering the decimal number.
  -> Approximation
  -- ^ Approximation to use if necessary in order to fit the 'Discrete' amount
  -- in as many decimal numbers as requested.
  -> Discrete' currency scale
  -- ^ The monetary amount to render.
  -> T.Text
{-# INLINABLE discreteToDecimal #-}
discreteToDecimal :: DecimalConf -> Approximation -> Discrete' currency scale -> Text
discreteToDecimal DecimalConf
dc Approximation
a = \Discrete' currency scale
dns ->
  DecimalConf -> Approximation -> Dense currency -> Text
forall (currency :: Symbol).
DecimalConf -> Approximation -> Dense currency -> Text
denseToDecimal DecimalConf
dc Approximation
a (Discrete' currency scale -> Dense currency
forall (scale :: (Nat, Nat)) (currency :: Symbol).
GoodScale scale =>
Discrete' currency scale -> Dense currency
denseFromDiscrete Discrete' currency scale
dns)

-- | Like 'discreteToDecimal', but takes a 'SomeDiscrete' as input.
someDiscreteToDecimal
  :: DecimalConf -- ^ Config to use for rendering the decimal number.
  -> Approximation
  -- ^ Approximation to use if necessary in order to fit the 'SomeDiscrete'
  -- amount in as many decimal numbers as requested.
  -> SomeDiscrete -- ^ The monetary amount to render.
  -> T.Text
{-# INLINABLE someDiscreteToDecimal #-}
someDiscreteToDecimal :: DecimalConf -> Approximation -> SomeDiscrete -> Text
someDiscreteToDecimal DecimalConf
dc Approximation
a = \SomeDiscrete
sd ->
  SomeDiscrete
-> (forall (currency :: Symbol) (scale :: (Nat, Nat)).
    (KnownSymbol currency, GoodScale scale) =>
    Discrete' currency scale -> Text)
-> Text
forall r.
SomeDiscrete
-> (forall (currency :: Symbol) (scale :: (Nat, Nat)).
    (KnownSymbol currency, GoodScale scale) =>
    Discrete' currency scale -> r)
-> r
withSomeDiscrete SomeDiscrete
sd (DecimalConf -> Approximation -> Discrete' currency scale -> Text
forall (scale :: (Nat, Nat)) (currency :: Symbol).
GoodScale scale =>
DecimalConf -> Approximation -> Discrete' currency scale -> Text
discreteToDecimal DecimalConf
dc Approximation
a)

-- | Render a 'ExchangeRate' as a decimal number in a potentially lossy manner.
--
-- @
-- > 'exchangeRateToDecimal' 'defaultDecimalConf' 'Round'
--       '<$>' ('exchangeRate' (123456 '%' 100) :: 'Maybe' ('ExchangeRate' \"USD\" \"EUR\"))
-- Just \"1,234.56\"
-- @
exchangeRateToDecimal
  :: DecimalConf -- ^ Config to use for rendering the decimal number.
  -> Approximation
  -- ^ Approximation to use if necessary in order to fit the 'ExchangeRate'
  -- amount in as many decimal numbers as requested.
  -> ExchangeRate src dst -- ^ The 'ExchangeRate' to render.
  -> T.Text
{-# INLINABLE exchangeRateToDecimal #-}
exchangeRateToDecimal :: DecimalConf -> Approximation -> ExchangeRate src dst -> Text
exchangeRateToDecimal DecimalConf
dc Approximation
a = \(ExchangeRate Rational
r0) ->
  DecimalConf -> Approximation -> Rational -> Text
rationalToDecimal DecimalConf
dc Approximation
a Rational
r0

-- | Like 'exchangeRateToDecimal', but takes a 'SomeExchangeRate' as input.
someExchangeRateToDecimal
  :: DecimalConf -- ^ Config to use for rendering the decimal number.
  -> Approximation
  -- ^ Approximation to use if necessary in order to fit the 'SomeExchangeRate'
  -- amount in as many decimal numbers as requested.
  -> SomeExchangeRate -- ^ The 'SomeExchangeRate' to render.
  -> T.Text
{-# INLINABLE someExchangeRateToDecimal #-}
someExchangeRateToDecimal :: DecimalConf -> Approximation -> SomeExchangeRate -> Text
someExchangeRateToDecimal DecimalConf
dc Approximation
a = \SomeExchangeRate
ser ->
  SomeExchangeRate
-> (forall (src :: Symbol) (dst :: Symbol).
    (KnownSymbol src, KnownSymbol dst) =>
    ExchangeRate src dst -> Text)
-> Text
forall r.
SomeExchangeRate
-> (forall (src :: Symbol) (dst :: Symbol).
    (KnownSymbol src, KnownSymbol dst) =>
    ExchangeRate src dst -> r)
-> r
withSomeExchangeRate SomeExchangeRate
ser (DecimalConf -> Approximation -> ExchangeRate src dst -> Text
forall (src :: Symbol) (dst :: Symbol).
DecimalConf -> Approximation -> ExchangeRate src dst -> Text
exchangeRateToDecimal DecimalConf
dc Approximation
a)

--------------------------------------------------------------------------------

-- | Decimal and thousands separators used when rendering or parsing a decimal
-- number.
--
-- Use 'mkSeparators' to construct.
data Separators = Separators Char (Maybe Char)
  deriving (Separators -> Separators -> Bool
(Separators -> Separators -> Bool)
-> (Separators -> Separators -> Bool) -> Eq Separators
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Separators -> Separators -> Bool
$c/= :: Separators -> Separators -> Bool
== :: Separators -> Separators -> Bool
$c== :: Separators -> Separators -> Bool
Eq, Int -> Separators -> ShowS
[Separators] -> ShowS
Separators -> String
(Int -> Separators -> ShowS)
-> (Separators -> String)
-> ([Separators] -> ShowS)
-> Show Separators
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Separators] -> ShowS
$cshowList :: [Separators] -> ShowS
show :: Separators -> String
$cshow :: Separators -> String
showsPrec :: Int -> Separators -> ShowS
$cshowsPrec :: Int -> Separators -> ShowS
Show)

-- | Construct 'Separators' to use with in 'DecimalConf'.
--
-- The separators can't be an ASCII digit nor control character, and they must
-- be different from each other.
mkSeparators
  :: Char
  -- ^ Decimal separator (i.e., the @\'.\'@ in @1,234.56789@)
  -> Maybe Char
  -- ^ Thousands separator for the integer part, if any (i.e., the @\',\'@ in
  -- @1,234.56789@).
  -> Maybe Separators
mkSeparators :: Char -> Maybe Char -> Maybe Separators
mkSeparators Char
ds Maybe Char
yts = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Char -> Bool
Char.isDigit Char
ds Bool -> Bool -> Bool
|| Char -> Bool
Char.isControl Char
ds))
  Maybe Char -> (Char -> Maybe ()) -> Maybe ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Char
yts ((Char -> Maybe ()) -> Maybe ()) -> (Char -> Maybe ()) -> Maybe ()
forall a b. (a -> b) -> a -> b
$ \Char
ts ->
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Char
ts Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
ds Bool -> Bool -> Bool
|| Char -> Bool
Char.isDigit Char
ts Bool -> Bool -> Bool
|| Char -> Bool
Char.isControl Char
ts))
  Separators -> Maybe Separators
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> Maybe Char -> Separators
Separators Char
ds Maybe Char
yts)

-- | @1234567,89@
separatorsComma :: Separators
separatorsComma :: Separators
separatorsComma = Char -> Maybe Char -> Separators
Separators Char
',' Maybe Char
forall a. Maybe a
Nothing

-- | @1.234.567,89@
separatorsCommaDot :: Separators
separatorsCommaDot :: Separators
separatorsCommaDot = Char -> Maybe Char -> Separators
Separators Char
',' (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'.')

-- | @1 234 567,89@
--
-- The whitespace is Unicode's /NARROW NO-BREAK SPACE/ (U+202f, 8239,
-- @'\8239'@).
separatorsCommaNarrownbsp :: Separators
separatorsCommaNarrownbsp :: Separators
separatorsCommaNarrownbsp = Char -> Maybe Char -> Separators
Separators Char
',' (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\8239')

-- | @1 234 567,89@
--
-- The whitespace is Unicode's /NO-BREAK SPACE/ (U+00a0, 160, @'\160'@).
separatorsCommaNbsp :: Separators
separatorsCommaNbsp :: Separators
separatorsCommaNbsp = Char -> Maybe Char -> Separators
Separators Char
',' (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\160')

-- | @1 234 567,89@
--
-- The whitespace is Unicode's /THIN SPACE/ (U+2009, 8201, @'\8201'@).
separatorsCommaThinsp :: Separators
separatorsCommaThinsp :: Separators
separatorsCommaThinsp = Char -> Maybe Char -> Separators
Separators Char
',' (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\8201')

-- | @1 234 567,89@
--
-- The whitespace is ASCII's /SPC/ (U+0020, 32, @'\32'@).
separatorsCommaSpace :: Separators
separatorsCommaSpace :: Separators
separatorsCommaSpace = Char -> Maybe Char -> Separators
Separators Char
',' (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\32')

-- | @1234567.89@
separatorsDot :: Separators
separatorsDot :: Separators
separatorsDot = Char -> Maybe Char -> Separators
Separators Char
'.' Maybe Char
forall a. Maybe a
Nothing

-- | @1,234,567.89@
separatorsDotComma :: Separators
separatorsDotComma :: Separators
separatorsDotComma = Char -> Maybe Char -> Separators
Separators Char
'.' (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
',')

-- | @1 234 567.89@
--
-- The whitespace is Unicode's /NARROW NO-BREAK SPACE/ (U+202f, 8239,
-- @'\8239'@).
separatorsDotNarrownbsp :: Separators
separatorsDotNarrownbsp :: Separators
separatorsDotNarrownbsp = Char -> Maybe Char -> Separators
Separators Char
'.' (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\8239')

-- | @1 234 567.89@
--
-- The whitespace is Unicode's /THIN SPACE/ (U+2009, 8201, @'\8201'@).
separatorsDotThinsp :: Separators
separatorsDotThinsp :: Separators
separatorsDotThinsp = Char -> Maybe Char -> Separators
Separators Char
'.' (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\8201')

-- | @1 234 567.89@
--
-- The whitespace is Unicode's /NO-BREAK SPACE/ (U+00a0, 160, @'\160'@).
separatorsDotNbsp :: Separators
separatorsDotNbsp :: Separators
separatorsDotNbsp = Char -> Maybe Char -> Separators
Separators Char
'.' (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\160')

-- | @1 234 567.89@
--
-- The whitespace is ASCII's /SPACE/ (U+0020, 32, @'\32'@).
separatorsDotSpace :: Separators
separatorsDotSpace :: Separators
separatorsDotSpace = Char -> Maybe Char -> Separators
Separators Char
'.' (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\32')

--------------------------------------------------------------------------------

-- | Config to use when rendering or parsing decimal numbers.
--
-- See 'defaultDecimalConf'.
data DecimalConf = DecimalConf
  { DecimalConf -> Separators
decimalConf_separators :: !Separators
  -- ^ Decimal and thousands separators to use when rendering the decimal number.
  -- Construct one with 'mkSeparators', or pick a ready made one like
  -- 'separatorsDot' or 'separatorsDotNarrownbsp'.
  , DecimalConf -> Bool
decimalConf_leadingPlus :: !Bool
  -- ^ Whether to render a leading @\'+\'@ sign in case the amount is positive.
  , DecimalConf -> Word8
decimalConf_digits :: !Word8
  -- ^ Number of decimal numbers to render, if any.
  , DecimalConf -> Scale
decimalConf_scale :: !Scale
  -- ^ Scale used to when rendering the decimal number. This is useful if, for
  -- example, you want to render a “number of cents” rather than a “number of
  -- dollars” as the whole part of the decimal number when rendering a USD
  -- amount. It's particularly useful when rendering currencies such as XAU,
  -- where one might prefer to render amounts as a number of grams, rather than
  -- as a number of troy-ounces.
  --
  -- /Set this to @1@ if you don't care./
  --
  -- For example, when rendering render @'dense'' (123 '%' 100) :: 'Dense'
  -- \"USD\"@ as a decimal number with two decimal places, a scale of @1@
  -- (analogous to  @'UnitScale' \"USD\" \"dollar\"@) would render @1@ as the
  -- integer part and @23@ as the fractional part, whereas a scale of @100@
  -- (analogous @'UnitScale' \"USD\" \"cent\"@) would render @123@ as the integer
  -- part and @00@ as the fractional part.
  --
  -- You can easily obtain the scale for a particular currency and unit
  -- combination using the 'scale' function.
  --
  -- __Important:__ Generally, you will want this number to be @1@ or larger.
  -- This is because scales in the range @(0, 1)@ can be particularly lossy unless
  -- the number of decimal digits is sufficiently large.
  } deriving (DecimalConf -> DecimalConf -> Bool
(DecimalConf -> DecimalConf -> Bool)
-> (DecimalConf -> DecimalConf -> Bool) -> Eq DecimalConf
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DecimalConf -> DecimalConf -> Bool
$c/= :: DecimalConf -> DecimalConf -> Bool
== :: DecimalConf -> DecimalConf -> Bool
$c== :: DecimalConf -> DecimalConf -> Bool
Eq, Int -> DecimalConf -> ShowS
[DecimalConf] -> ShowS
DecimalConf -> String
(Int -> DecimalConf -> ShowS)
-> (DecimalConf -> String)
-> ([DecimalConf] -> ShowS)
-> Show DecimalConf
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DecimalConf] -> ShowS
$cshowList :: [DecimalConf] -> ShowS
show :: DecimalConf -> String
$cshow :: DecimalConf -> String
showsPrec :: Int -> DecimalConf -> ShowS
$cshowsPrec :: Int -> DecimalConf -> ShowS
Show)

-- | Default 'DecimalConf'.
--
-- * No leading @\'+\'@ sign
--
-- * No thousands separator
--
-- * Decimal separator is @\'.\'@
--
-- * @2@ decimal digits
--
-- * A scale of @1@
--
-- That is, something like @1.23@ or @-1234567.89@.
defaultDecimalConf :: DecimalConf
defaultDecimalConf :: DecimalConf
defaultDecimalConf = DecimalConf :: Separators -> Bool -> Word8 -> Scale -> DecimalConf
DecimalConf
  { decimalConf_separators :: Separators
decimalConf_separators = Separators
separatorsDot
  , decimalConf_leadingPlus :: Bool
decimalConf_leadingPlus = Bool
False
  , decimalConf_digits :: Word8
decimalConf_digits = Word8
2
  , decimalConf_scale :: Scale
decimalConf_scale = Rational -> Scale
Scale Rational
1
  }

--------------------------------------------------------------------------------

-- | Render a 'Rational' number as a decimal approximation.
rationalToDecimal
  :: DecimalConf
  -- ^ Config to use for rendering the decimal number.
  -> Approximation
  -- ^ Approximation to use if necessary in order to fit the 'Dense' amount in
  -- as many decimal numbers as requested.
  -> Rational
  -- ^ The dense monetary amount to render.
  -> T.Text
{-# INLINABLE rationalToDecimal #-}
rationalToDecimal :: DecimalConf -> Approximation -> Rational -> Text
rationalToDecimal (DecimalConf (Separators Char
ds Maybe Char
yts) Bool
plus Word8
fdigs Scale
sc) Approximation
a = \Rational
r0 -> do
  -- This string-fu is not particularly efficient. TODO: Make fast.
  let start :: Rational
start = Rational
r0 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Scale -> Rational
scaleToRational Scale
sc Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (Rational
10 Rational -> Word8 -> Rational
forall a b. (Num a, Integral b) => a -> b -> a
^ Word8
fdigs) :: Rational
      parts :: Integer
parts = Approximation -> Rational -> Integer
approximate Approximation
a Rational
start :: Integer
      ipart :: Natural
ipart = Integer -> Natural
forall a. Num a => Integer -> a
fromInteger (Integer -> Integer
forall a. Num a => a -> a
abs Integer
parts) Natural -> Natural -> Natural
forall a. Integral a => a -> a -> a
`div` (Natural
10 Natural -> Word8 -> Natural
forall a b. (Num a, Integral b) => a -> b -> a
^ Word8
fdigs) :: Natural
      ftext :: String
ftext | Natural
ipart Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
0 = String -> Integer -> String
forall r. PrintfType r => String -> r
printf (String
"%0." String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word8 -> String
forall a. Show a => a -> String
show Word8
fdigs String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"d") (Integer -> Integer
forall a. Num a => a -> a
abs Integer
parts)
            | Bool
otherwise = Int -> ShowS
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Natural -> String
forall a. Show a => a -> String
show Natural
ipart)) (Integer -> String
forall a. Show a => a -> String
show (Integer -> Integer
forall a. Num a => a -> a
abs Integer
parts)) :: String
      itext :: String
itext = String -> (Char -> String) -> Maybe Char -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Natural -> String
forall a. Show a => a -> String
show Natural
ipart) (Natural -> Char -> String
renderThousands Natural
ipart) Maybe Char
yts :: String
      fpadr :: String
fpadr = Int -> Char -> String
forall a. Int -> a -> [a]
List.replicate (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
fdigs Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
ftext) Char
'0' :: String
  String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat
    [ if | Integer
parts Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 -> String
"-"
         | Bool
plus Bool -> Bool -> Bool
&& Integer
parts Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 -> String
"+"
         | Bool
otherwise -> String
""
    , String
itext
    , if | Word8
fdigs Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
0 -> Char
ds Char -> ShowS
forall a. a -> [a] -> [a]
: String
ftext String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
fpadr
         | Bool
otherwise -> String
""
    ]


-- | Render a 'Natural' number with thousand markers.
--
-- @
-- > 'renderThousands' 12045 \',\'
-- \"12,045\"
-- @
renderThousands :: Natural -> Char -> String
{-# INLINABLE renderThousands #-}
renderThousands :: Natural -> Char -> String
renderThousands Natural
n0   -- TODO better use text
  | Natural
n0 Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Natural
1000 = \Char
_ -> Natural -> String
forall a. Show a => a -> String
show Natural
n0
  | Bool
otherwise = \Char
c -> (String -> ShowS) -> String -> [String] -> String
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' ((String -> ShowS) -> String -> ShowS
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> ShowS
forall a. Monoid a => a -> a -> a
mappend) String
forall a. Monoid a => a
mempty ((Natural -> Maybe (String, Natural)) -> Natural -> [String]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
List.unfoldr (Char -> Natural -> Maybe (String, Natural)
f Char
c) Natural
n0)
      where f :: Char -> Natural -> Maybe (String, Natural)
            f :: Char -> Natural -> Maybe (String, Natural)
f Char
c = \Natural
x -> case Natural -> Natural -> (Natural, Natural)
forall a. Integral a => a -> a -> (a, a)
divMod Natural
x Natural
1000 of
                           (Natural
0, Natural
0) -> Maybe (String, Natural)
forall a. Maybe a
Nothing
                           (Natural
0, Natural
z) -> (String, Natural) -> Maybe (String, Natural)
forall a. a -> Maybe a
Just (Natural -> String
forall a. Show a => a -> String
show Natural
z, Natural
0)
                           (Natural
y, Natural
z) | Natural
z Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<  Natural
10   -> (String, Natural) -> Maybe (String, Natural)
forall a. a -> Maybe a
Just (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:Char
'0'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'0'Char -> ShowS
forall a. a -> [a] -> [a]
:Natural -> String
forall a. Show a => a -> String
show Natural
z, Natural
y)
                                  | Natural
z Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Natural
100   -> (String, Natural) -> Maybe (String, Natural)
forall a. a -> Maybe a
Just (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:Char
'0'Char -> ShowS
forall a. a -> [a] -> [a]
:Natural -> String
forall a. Show a => a -> String
show Natural
z, Natural
y)
                                  | Bool
otherwise -> (String, Natural) -> Maybe (String, Natural)
forall a. a -> Maybe a
Just (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:Natural -> String
forall a. Show a => a -> String
show Natural
z, Natural
y)

--------------------------------------------------------------------------------
-- Decimal parsing

-- | Parses a decimal representation of a 'Dense'.
denseFromDecimal
  :: DecimalConf
  -- ^ Config to use for parsing the decimal number.
  --
  -- Notice that a leading @\'-\'@ or @\'+\'@ will always be correctly
  -- interpreted, notwithstanding what the “leading @\'+\'@” policy is on
  -- the given 'DecimalConf'.
  -> T.Text
  -- ^ The raw string containing the decimal representation (e.g.,
  -- @"-1,234.56789"@).
  -> Maybe (Dense currency)
denseFromDecimal :: DecimalConf -> Text -> Maybe (Dense currency)
denseFromDecimal DecimalConf
ds Text
t = do
  Rational
r <- DecimalConf -> Text -> Maybe Rational
rationalFromDecimal DecimalConf
ds Text
t
  Dense currency -> Maybe (Dense currency)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rational -> Dense currency
forall (currency :: Symbol). Rational -> Dense currency
Dense (Rational -> Dense currency) -> Rational -> Dense currency
forall a b. (a -> b) -> a -> b
$! Rational
r)

-- | Parses a decimal representation of a 'Discrete'.
--
-- Notice that parsing will fail unless the entire precision of the decimal
-- number can be represented in the desired @scale@.
discreteFromDecimal
  :: GoodScale scale
  => DecimalConf
  -- ^ Config to use for parsing the decimal number.
  --
  -- Notice that a leading @\'-\'@ or @\'+\'@ will always be correctly
  -- interpreted, notwithstanding what the “leading @\'+\'@” policy is on
  -- the given 'DecimalConf'.
  -> T.Text
  -- ^ The raw string containing the decimal representation (e.g.,
  -- @"-1,234.56789"@).
  -> Maybe (Discrete' currency scale)
discreteFromDecimal :: DecimalConf -> Text -> Maybe (Discrete' currency scale)
discreteFromDecimal DecimalConf
ds = \Text
t -> do
  Dense currency
dns <- DecimalConf -> Text -> Maybe (Dense currency)
forall (currency :: Symbol).
DecimalConf -> Text -> Maybe (Dense currency)
denseFromDecimal DecimalConf
ds Text
t
  case Approximation
-> Dense currency -> (Discrete' currency scale, Dense currency)
forall (currency :: Symbol) (scale :: (Nat, Nat)).
GoodScale scale =>
Approximation
-> Dense currency -> (Discrete' currency scale, Dense currency)
discreteFromDense Approximation
Truncate Dense currency
dns of
    (Discrete' currency scale
x, Dense currency
0) -> Discrete' currency scale -> Maybe (Discrete' currency scale)
forall a. a -> Maybe a
Just Discrete' currency scale
x
    (Discrete' currency scale, Dense currency)
_ -> Maybe (Discrete' currency scale)
forall a. Maybe a
Nothing -- We fail for decimals that don't fit exactly in our scale.

-- | Parses a decimal representation of an 'ExchangeRate'.
exchangeRateFromDecimal
  :: DecimalConf
  -- ^ Config to use for parsing the decimal number.
  --
  -- Notice that a leading @\'-\'@ or @\'+\'@ will always be correctly
  -- interpreted, notwithstanding what the “leading @\'+\'@” policy is on
  -- the given 'DecimalConf'.
  -> T.Text
  -- ^ The raw string containing the decimal representation (e.g.,
  -- @"1,234.56789"@).
  -> Maybe (ExchangeRate src dst)
exchangeRateFromDecimal :: DecimalConf -> Text -> Maybe (ExchangeRate src dst)
exchangeRateFromDecimal DecimalConf
ds Text
t
  | Text -> Text -> Bool
T.isPrefixOf Text
"-" Text
t = Maybe (ExchangeRate src dst)
forall a. Maybe a
Nothing
  | Bool
otherwise = Rational -> Maybe (ExchangeRate src dst)
forall (src :: Symbol) (dst :: Symbol).
Rational -> Maybe (ExchangeRate src dst)
exchangeRate (Rational -> Maybe (ExchangeRate src dst))
-> Maybe Rational -> Maybe (ExchangeRate src dst)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< DecimalConf -> Text -> Maybe Rational
rationalFromDecimal DecimalConf
ds Text
t

-- | Parses a decimal number representation as 'T.Text' into a 'Rational'.
rationalFromDecimal
  :: DecimalConf
  -- ^ Config to use for parsing the decimal number.
  --
  -- Notice that a leading @\'-\'@ or @\'+\'@ will always be correctly
  -- interpreted, notwithstanding what the “leading @\'+\'@” policy is on
  -- the given 'DecimalConf'.
  -> T.Text
  -- ^ The raw string containing the decimal representation (e.g.,
  -- @"-1,234.56789"@).
  -> Maybe Rational
rationalFromDecimal :: DecimalConf -> Text -> Maybe Rational
rationalFromDecimal DecimalConf
ds = \Text
t ->
  case ReadP Rational -> ReadS Rational
forall a. ReadP a -> ReadS a
ReadP.readP_to_S (DecimalConf -> ReadP Rational
rationalFromDecimalP DecimalConf
ds) (Text -> String
T.unpack Text
t) of
    [(Rational
x,String
"")] -> Rational -> Maybe Rational
forall a. a -> Maybe a
Just Rational
x
    [(Rational, String)]
_ -> Maybe Rational
forall a. Maybe a
Nothing

-- TODO limit number of digits parsed to prevent DoS
rationalFromDecimalP
  :: DecimalConf
  -- ^ Config to use for parsing the decimal number.
  --
  -- Notice that a leading @\'-\'@ or @\'+\'@ will always be correctly
  -- interpreted, notwithstanding what the “leading @\'+\'@” policy is on
  -- the given 'DecimalConf'.
  -> ReadP.ReadP Rational
rationalFromDecimalP :: DecimalConf -> ReadP Rational
rationalFromDecimalP DecimalConf
ds = do
   let Separators Char
dsep Maybe Char
ytsep = DecimalConf -> Separators
decimalConf_separators DecimalConf
ds
   Rational -> Rational
sig :: Rational -> Rational <-
     (Char -> ReadP Char
ReadP.char Char
'-' ReadP Char
-> (Rational -> Rational) -> ReadP (Rational -> Rational)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Rational -> Rational
forall a. Num a => a -> a
negate) ReadP (Rational -> Rational)
-> ReadP (Rational -> Rational) -> ReadP (Rational -> Rational)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     (Char -> ReadP Char
ReadP.char Char
'+' ReadP Char
-> (Rational -> Rational) -> ReadP (Rational -> Rational)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Rational -> Rational
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id) ReadP (Rational -> Rational)
-> ReadP (Rational -> Rational) -> ReadP (Rational -> Rational)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     ((Rational -> Rational) -> ReadP (Rational -> Rational)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rational -> Rational
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id)
   String
ipart :: String <- case Maybe Char
ytsep of
     Maybe Char
Nothing -> (Char -> Bool) -> ReadP String
ReadP.munch1 Char -> Bool
Char.isDigit
     Just Char
tsep -> String -> ShowS
forall a. Monoid a => a -> a -> a
mappend
       (String -> ShowS) -> ReadP String -> ReadP ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> ReadP Char -> ReadP String
forall a. Int -> ReadP a -> ReadP [a]
ReadP.count Int
3 ((Char -> Bool) -> ReadP Char
ReadP.satisfy Char -> Bool
Char.isDigit) ReadP String -> ReadP String -> ReadP String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
            Int -> ReadP Char -> ReadP String
forall a. Int -> ReadP a -> ReadP [a]
ReadP.count Int
2 ((Char -> Bool) -> ReadP Char
ReadP.satisfy Char -> Bool
Char.isDigit) ReadP String -> ReadP String -> ReadP String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
            Int -> ReadP Char -> ReadP String
forall a. Int -> ReadP a -> ReadP [a]
ReadP.count Int
1 ((Char -> Bool) -> ReadP Char
ReadP.satisfy Char -> Bool
Char.isDigit))
       ReadP ShowS -> ReadP String -> ReadP String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (([String] -> String) -> ReadP [String] -> ReadP String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (ReadP [String] -> ReadP String) -> ReadP [String] -> ReadP String
forall a b. (a -> b) -> a -> b
$ ReadP String -> ReadP [String]
forall a. ReadP a -> ReadP [a]
ReadP.many
              (Char -> ReadP Char
ReadP.char Char
tsep ReadP Char -> ReadP String -> ReadP String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> ReadP Char -> ReadP String
forall a. Int -> ReadP a -> ReadP [a]
ReadP.count Int
3 ((Char -> Bool) -> ReadP Char
ReadP.satisfy Char -> Bool
Char.isDigit)))
   Maybe String
yfpart :: Maybe String <-
     (Char -> ReadP Char
ReadP.char Char
dsep ReadP Char -> ReadP (Maybe String) -> ReadP (Maybe String)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (String -> Maybe String) -> ReadP String -> ReadP (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Maybe String
forall a. a -> Maybe a
Just ((Char -> Bool) -> ReadP String
ReadP.munch1 Char -> Bool
Char.isDigit) ReadP (Maybe String) -> ReadP () -> ReadP (Maybe String)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadP ()
ReadP.eof) ReadP (Maybe String)
-> ReadP (Maybe String) -> ReadP (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     (ReadP ()
ReadP.eof ReadP () -> Maybe String -> ReadP (Maybe String)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe String
forall a. Maybe a
Nothing)
   let r :: Rational
r = Rational -> Rational
sig (Rational -> Rational) -> Rational -> Rational
forall a b. (a -> b) -> a -> b
$ case Maybe String
yfpart of
         Maybe String
Nothing -> Integer -> Rational
forall a. Num a => Integer -> a
fromInteger (String -> Integer
forall a. Read a => String -> a
read String
ipart)
         Just String
fpart -> String -> Integer
forall a. Read a => String -> a
read (String
ipart String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
fpart) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% (Integer
10 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
fpart)
   Rational -> ReadP Rational
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rational -> ReadP Rational) -> Rational -> ReadP Rational
forall a b. (a -> b) -> a -> b
$! Rational
r Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Scale -> Rational
scaleToRational (DecimalConf -> Scale
decimalConf_scale DecimalConf
ds)

--------------------------------------------------------------------------------
-- QuickCheck Arbitrary instances

instance
  ( GoodScale scale
  ) => QC.Arbitrary (Discrete' currency scale) where
  arbitrary :: Gen (Discrete' currency scale)
arbitrary = (Integer -> Discrete' currency scale)
-> Gen Integer -> Gen (Discrete' currency scale)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Discrete' currency scale
forall a. Num a => Integer -> a
fromInteger Gen Integer
forall a. Arbitrary a => Gen a
QC.arbitrary
  shrink :: Discrete' currency scale -> [Discrete' currency scale]
shrink = (Integer -> Discrete' currency scale)
-> [Integer] -> [Discrete' currency scale]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Discrete' currency scale
forall a. Num a => Integer -> a
fromInteger ([Integer] -> [Discrete' currency scale])
-> (Discrete' currency scale -> [Integer])
-> Discrete' currency scale
-> [Discrete' currency scale]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Integer -> [Integer]
forall a. Arbitrary a => a -> [a]
QC.shrink (Integer -> [Integer])
-> (Discrete' currency scale -> Integer)
-> Discrete' currency scale
-> [Integer]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Discrete' currency scale -> Integer
forall a. Integral a => a -> Integer
toInteger

instance QC.Arbitrary SomeDiscrete where
  arbitrary :: Gen SomeDiscrete
arbitrary = Text -> Scale -> Integer -> SomeDiscrete
mkSomeDiscrete (Text -> Scale -> Integer -> SomeDiscrete)
-> Gen Text -> Gen (Scale -> Integer -> SomeDiscrete)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Text) -> Gen String -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack Gen String
forall a. Arbitrary a => Gen a
QC.arbitrary
                             Gen (Scale -> Integer -> SomeDiscrete)
-> Gen Scale -> Gen (Integer -> SomeDiscrete)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Scale
forall a. Arbitrary a => Gen a
QC.arbitrary
                             Gen (Integer -> SomeDiscrete) -> Gen Integer -> Gen SomeDiscrete
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Integer
forall a. Arbitrary a => Gen a
QC.arbitrary
  shrink :: SomeDiscrete -> [SomeDiscrete]
shrink = \SomeDiscrete
x -> SomeDiscrete
-> (forall (currency :: Symbol) (scale :: (Nat, Nat)).
    (KnownSymbol currency, GoodScale scale) =>
    Discrete' currency scale -> [SomeDiscrete])
-> [SomeDiscrete]
forall r.
SomeDiscrete
-> (forall (currency :: Symbol) (scale :: (Nat, Nat)).
    (KnownSymbol currency, GoodScale scale) =>
    Discrete' currency scale -> r)
-> r
withSomeDiscrete SomeDiscrete
x ((Discrete' currency scale -> SomeDiscrete)
-> [Discrete' currency scale] -> [SomeDiscrete]
forall a b. (a -> b) -> [a] -> [b]
map Discrete' currency scale -> SomeDiscrete
forall (currency :: Symbol) (scale :: (Nat, Nat)).
(KnownSymbol currency, GoodScale scale) =>
Discrete' currency scale -> SomeDiscrete
toSomeDiscrete ([Discrete' currency scale] -> [SomeDiscrete])
-> (Discrete' currency scale -> [Discrete' currency scale])
-> Discrete' currency scale
-> [SomeDiscrete]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Discrete' currency scale -> [Discrete' currency scale]
forall a. Arbitrary a => a -> [a]
QC.shrink)

instance QC.Arbitrary (Dense currency) where
  arbitrary :: Gen (Dense currency)
arbitrary = do
     let myd :: Gen (Maybe (Dense currency))
myd = (Rational -> Maybe (Dense currency))
-> Gen Rational -> Gen (Maybe (Dense currency))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rational -> Maybe (Dense currency)
forall (currency :: Symbol). Rational -> Maybe (Dense currency)
dense Gen Rational
forall a. Arbitrary a => Gen a
QC.arbitrary
     Maybe (Dense currency) -> Dense currency
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Dense currency) -> Dense currency)
-> Gen (Maybe (Dense currency)) -> Gen (Dense currency)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Maybe (Dense currency))
-> (Maybe (Dense currency) -> Bool) -> Gen (Maybe (Dense currency))
forall a. Gen a -> (a -> Bool) -> Gen a
QC.suchThat Gen (Maybe (Dense currency))
forall (currency :: Symbol). Gen (Maybe (Dense currency))
myd Maybe (Dense currency) -> Bool
forall a. Maybe a -> Bool
isJust
  shrink :: Dense currency -> [Dense currency]
shrink = [Maybe (Dense currency)] -> [Dense currency]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Dense currency)] -> [Dense currency])
-> (Dense currency -> [Maybe (Dense currency)])
-> Dense currency
-> [Dense currency]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Rational -> Maybe (Dense currency))
-> [Rational] -> [Maybe (Dense currency)]
forall a b. (a -> b) -> [a] -> [b]
map Rational -> Maybe (Dense currency)
forall (currency :: Symbol). Rational -> Maybe (Dense currency)
dense ([Rational] -> [Maybe (Dense currency)])
-> (Dense currency -> [Rational])
-> Dense currency
-> [Maybe (Dense currency)]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rational -> [Rational]
forall a. Arbitrary a => a -> [a]
QC.shrink (Rational -> [Rational])
-> (Dense currency -> Rational) -> Dense currency -> [Rational]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Dense currency -> Rational
forall a. Real a => a -> Rational
toRational

instance QC.Arbitrary SomeDense where
  arbitrary :: Gen SomeDense
arbitrary = do
    let md :: Gen (Maybe SomeDense)
md = Text -> Rational -> Maybe SomeDense
mkSomeDense (Text -> Rational -> Maybe SomeDense)
-> Gen Text -> Gen (Rational -> Maybe SomeDense)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Text) -> Gen String -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack Gen String
forall a. Arbitrary a => Gen a
QC.arbitrary Gen (Rational -> Maybe SomeDense)
-> Gen Rational -> Gen (Maybe SomeDense)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Rational
forall a. Arbitrary a => Gen a
QC.arbitrary
    Maybe SomeDense -> SomeDense
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe SomeDense -> SomeDense)
-> Gen (Maybe SomeDense) -> Gen SomeDense
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Maybe SomeDense)
-> (Maybe SomeDense -> Bool) -> Gen (Maybe SomeDense)
forall a. Gen a -> (a -> Bool) -> Gen a
QC.suchThat Gen (Maybe SomeDense)
md Maybe SomeDense -> Bool
forall a. Maybe a -> Bool
isJust
  shrink :: SomeDense -> [SomeDense]
shrink = \SomeDense
x -> SomeDense
-> (forall (currency :: Symbol).
    KnownSymbol currency =>
    Dense currency -> [SomeDense])
-> [SomeDense]
forall r.
SomeDense
-> (forall (currency :: Symbol).
    KnownSymbol currency =>
    Dense currency -> r)
-> r
withSomeDense SomeDense
x ((Dense currency -> SomeDense) -> [Dense currency] -> [SomeDense]
forall a b. (a -> b) -> [a] -> [b]
map Dense currency -> SomeDense
forall (currency :: Symbol).
KnownSymbol currency =>
Dense currency -> SomeDense
toSomeDense ([Dense currency] -> [SomeDense])
-> (Dense currency -> [Dense currency])
-> Dense currency
-> [SomeDense]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Dense currency -> [Dense currency]
forall a. Arbitrary a => a -> [a]
QC.shrink)

instance QC.Arbitrary (ExchangeRate src dst) where
  arbitrary :: Gen (ExchangeRate src dst)
arbitrary = do
    let myxr :: Gen (Maybe (ExchangeRate src dst))
myxr = (Rational -> Maybe (ExchangeRate src dst))
-> Gen Rational -> Gen (Maybe (ExchangeRate src dst))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rational -> Maybe (ExchangeRate src dst)
forall (src :: Symbol) (dst :: Symbol).
Rational -> Maybe (ExchangeRate src dst)
exchangeRate Gen Rational
forall a. Arbitrary a => Gen a
QC.arbitrary
    Maybe (ExchangeRate src dst) -> ExchangeRate src dst
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (ExchangeRate src dst) -> ExchangeRate src dst)
-> Gen (Maybe (ExchangeRate src dst)) -> Gen (ExchangeRate src dst)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Maybe (ExchangeRate src dst))
-> (Maybe (ExchangeRate src dst) -> Bool)
-> Gen (Maybe (ExchangeRate src dst))
forall a. Gen a -> (a -> Bool) -> Gen a
QC.suchThat Gen (Maybe (ExchangeRate src dst))
forall (src :: Symbol) (dst :: Symbol).
Gen (Maybe (ExchangeRate src dst))
myxr Maybe (ExchangeRate src dst) -> Bool
forall a. Maybe a -> Bool
isJust
  shrink :: ExchangeRate src dst -> [ExchangeRate src dst]
shrink = [Maybe (ExchangeRate src dst)] -> [ExchangeRate src dst]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (ExchangeRate src dst)] -> [ExchangeRate src dst])
-> (ExchangeRate src dst -> [Maybe (ExchangeRate src dst)])
-> ExchangeRate src dst
-> [ExchangeRate src dst]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Rational -> Maybe (ExchangeRate src dst))
-> [Rational] -> [Maybe (ExchangeRate src dst)]
forall a b. (a -> b) -> [a] -> [b]
map Rational -> Maybe (ExchangeRate src dst)
forall (src :: Symbol) (dst :: Symbol).
Rational -> Maybe (ExchangeRate src dst)
exchangeRate
         ([Rational] -> [Maybe (ExchangeRate src dst)])
-> (ExchangeRate src dst -> [Rational])
-> ExchangeRate src dst
-> [Maybe (ExchangeRate src dst)]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rational -> [Rational]
forall a. Arbitrary a => a -> [a]
QC.shrink (Rational -> [Rational])
-> (ExchangeRate src dst -> Rational)
-> ExchangeRate src dst
-> [Rational]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ExchangeRate src dst -> Rational
forall (src :: Symbol) (dst :: Symbol).
ExchangeRate src dst -> Rational
exchangeRateToRational

instance QC.Arbitrary SomeExchangeRate where
  arbitrary :: Gen SomeExchangeRate
arbitrary = do
    let md :: Gen (Maybe SomeExchangeRate)
md = Text -> Text -> Rational -> Maybe SomeExchangeRate
mkSomeExchangeRate
               (Text -> Text -> Rational -> Maybe SomeExchangeRate)
-> Gen Text -> Gen (Text -> Rational -> Maybe SomeExchangeRate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Text) -> Gen String -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack Gen String
forall a. Arbitrary a => Gen a
QC.arbitrary
               Gen (Text -> Rational -> Maybe SomeExchangeRate)
-> Gen Text -> Gen (Rational -> Maybe SomeExchangeRate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Text) -> Gen String -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack Gen String
forall a. Arbitrary a => Gen a
QC.arbitrary
               Gen (Rational -> Maybe SomeExchangeRate)
-> Gen Rational -> Gen (Maybe SomeExchangeRate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Rational
forall a. Arbitrary a => Gen a
QC.arbitrary
    Maybe SomeExchangeRate -> SomeExchangeRate
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe SomeExchangeRate -> SomeExchangeRate)
-> Gen (Maybe SomeExchangeRate) -> Gen SomeExchangeRate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Maybe SomeExchangeRate)
-> (Maybe SomeExchangeRate -> Bool) -> Gen (Maybe SomeExchangeRate)
forall a. Gen a -> (a -> Bool) -> Gen a
QC.suchThat Gen (Maybe SomeExchangeRate)
md Maybe SomeExchangeRate -> Bool
forall a. Maybe a -> Bool
isJust
  shrink :: SomeExchangeRate -> [SomeExchangeRate]
shrink = \SomeExchangeRate
x -> SomeExchangeRate
-> (forall (src :: Symbol) (dst :: Symbol).
    (KnownSymbol src, KnownSymbol dst) =>
    ExchangeRate src dst -> [SomeExchangeRate])
-> [SomeExchangeRate]
forall r.
SomeExchangeRate
-> (forall (src :: Symbol) (dst :: Symbol).
    (KnownSymbol src, KnownSymbol dst) =>
    ExchangeRate src dst -> r)
-> r
withSomeExchangeRate SomeExchangeRate
x ((ExchangeRate src dst -> SomeExchangeRate)
-> [ExchangeRate src dst] -> [SomeExchangeRate]
forall a b. (a -> b) -> [a] -> [b]
map ExchangeRate src dst -> SomeExchangeRate
forall (src :: Symbol) (dst :: Symbol).
(KnownSymbol src, KnownSymbol dst) =>
ExchangeRate src dst -> SomeExchangeRate
toSomeExchangeRate ([ExchangeRate src dst] -> [SomeExchangeRate])
-> (ExchangeRate src dst -> [ExchangeRate src dst])
-> ExchangeRate src dst
-> [SomeExchangeRate]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ExchangeRate src dst -> [ExchangeRate src dst]
forall a. Arbitrary a => a -> [a]
QC.shrink)

instance QC.Arbitrary Approximation where
  arbitrary :: Gen Approximation
arbitrary = [Gen Approximation] -> Gen Approximation
forall a. [Gen a] -> Gen a
QC.oneof [ Approximation -> Gen Approximation
forall (f :: * -> *) a. Applicative f => a -> f a
pure Approximation
Round, Approximation -> Gen Approximation
forall (f :: * -> *) a. Applicative f => a -> f a
pure Approximation
Floor, Approximation -> Gen Approximation
forall (f :: * -> *) a. Applicative f => a -> f a
pure Approximation
Ceiling, Approximation -> Gen Approximation
forall (f :: * -> *) a. Applicative f => a -> f a
pure Approximation
Truncate ]

instance QC.Arbitrary Scale where
  arbitrary :: Gen Scale
arbitrary = do
    Integer
n <- Gen Integer
forall a. Arbitrary a => Gen a
QC.arbitrary
    Integer
d <- Gen Integer
forall a. Arbitrary a => Gen a
QC.arbitrary
    let r :: Rational
r = (Integer -> Integer
forall a. Num a => a -> a
abs Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% (Integer -> Integer
forall a. Num a => a -> a
abs Integer
d Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)
    Scale -> Gen Scale
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rational -> Scale
Scale Rational
r)

instance QC.Arbitrary Separators where
  arbitrary :: Gen Separators
arbitrary = do
    let msep :: Gen Char
msep = Gen Char -> (Char -> Bool) -> Gen Char
forall a. Gen a -> (a -> Bool) -> Gen a
QC.suchThat Gen Char
forall a. Arbitrary a => Gen a
QC.arbitrary ((Char -> Bool) -> Gen Char) -> (Char -> Bool) -> Gen Char
forall a b. (a -> b) -> a -> b
$ \Char
c ->
          Bool -> Bool
not (Char -> Bool
Char.isDigit Char
c) Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
Char.isControl Char
c)
    Char
ds :: Char <- Gen Char
msep
    Maybe Char
yts :: Maybe Char <- [Gen (Maybe Char)] -> Gen (Maybe Char)
forall a. [Gen a] -> Gen a
QC.oneof
      [ Maybe Char -> Gen (Maybe Char)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Char
forall a. Maybe a
Nothing, (Char -> Maybe Char) -> Gen Char -> Gen (Maybe Char)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Maybe Char
forall a. a -> Maybe a
Just (Gen Char -> (Char -> Bool) -> Gen Char
forall a. Gen a -> (a -> Bool) -> Gen a
QC.suchThat Gen Char
msep (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
ds)) ]
    let Just Separators
out = Char -> Maybe Char -> Maybe Separators
mkSeparators Char
ds Maybe Char
yts
    Separators -> Gen Separators
forall (f :: * -> *) a. Applicative f => a -> f a
pure Separators
out

instance QC.Arbitrary DecimalConf where
  arbitrary :: Gen DecimalConf
arbitrary = Separators -> Bool -> Word8 -> Scale -> DecimalConf
DecimalConf (Separators -> Bool -> Word8 -> Scale -> DecimalConf)
-> Gen Separators -> Gen (Bool -> Word8 -> Scale -> DecimalConf)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Separators
forall a. Arbitrary a => Gen a
QC.arbitrary Gen (Bool -> Word8 -> Scale -> DecimalConf)
-> Gen Bool -> Gen (Word8 -> Scale -> DecimalConf)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Bool
forall a. Arbitrary a => Gen a
QC.arbitrary
                          Gen (Word8 -> Scale -> DecimalConf)
-> Gen Word8 -> Gen (Scale -> DecimalConf)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word8
forall a. Arbitrary a => Gen a
QC.arbitrary Gen (Scale -> DecimalConf) -> Gen Scale -> Gen DecimalConf
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Scale
forall a. Arbitrary a => Gen a
QC.arbitrary