safe-money 0.2 → 0.3
raw patch · 9 files changed
+2496/−2385 lines, 9 filesdep +safe-moneydep ~aesondep ~binarydep ~cerealsetup-changedPVP ok
version bump matches the API change (PVP)
Dependencies added: safe-money
Dependency ranges changed: aeson, binary, cereal, constraints, deepseq, hashable, store
API changes (from Hackage documentation)
- Data.Money: ceiling :: GoodScale scale => Dense currency -> (Discrete' currency scale, Maybe (Dense currency))
- Data.Money: data Dense (currency :: Symbol)
- Data.Money: data DenseRep
- Data.Money: data Discrete' (currency :: Symbol) (scale :: (Nat, Nat))
- Data.Money: data DiscreteRep
- Data.Money: data ExchangeRate (src :: Symbol) (dst :: Symbol)
- Data.Money: data ExchangeRateRep
- Data.Money: dense :: Rational -> Maybe (Dense currency)
- Data.Money: denseRep :: KnownSymbol currency => Dense currency -> DenseRep
- Data.Money: discreteRep :: (KnownSymbol currency, GoodScale scale) => Discrete' currency scale -> DiscreteRep
- Data.Money: exchange :: ExchangeRate src dst -> Dense src -> Dense dst
- Data.Money: exchangeRate :: Rational -> Maybe (ExchangeRate src dst)
- Data.Money: exchangeRateRep :: (KnownSymbol src, KnownSymbol dst) => ExchangeRate src dst -> ExchangeRateRep
- Data.Money: flipExchangeRate :: ExchangeRate a b -> ExchangeRate b a
- Data.Money: floor :: GoodScale scale => Dense currency -> (Discrete' currency scale, Maybe (Dense currency))
- Data.Money: fromDenseRep :: forall currency. KnownSymbol currency => DenseRep -> Maybe (Dense currency)
- Data.Money: fromDiscrete :: GoodScale scale => Discrete' currency scale -> Dense currency
- Data.Money: fromDiscreteRep :: forall currency scale. (KnownSymbol currency, GoodScale scale) => DiscreteRep -> Maybe (Discrete' currency scale)
- Data.Money: fromExchangeRate :: ExchangeRate src dst -> Rational
- Data.Money: fromExchangeRateRep :: forall src dst. (KnownSymbol src, KnownSymbol dst) => ExchangeRateRep -> Maybe (ExchangeRate src dst)
- Data.Money: round :: GoodScale scale => Dense currency -> (Discrete' currency scale, Maybe (Dense currency))
- Data.Money: scale :: forall proxy scale. GoodScale scale => proxy scale -> Rational
- Data.Money: truncate :: GoodScale scale => Dense currency -> (Discrete' currency scale, Maybe (Dense currency))
- Data.Money: type Discrete (currency :: Symbol) (unit :: Symbol) = Discrete' currency (Scale currency unit)
- Data.Money: type GoodScale (scale :: (Nat, Nat)) = (CmpNat 0 (Fst scale) ~ LT, CmpNat 0 (Snd scale) ~ LT, KnownNat (Fst scale), KnownNat (Snd scale))
- Data.Money: withDenseRep :: DenseRep -> (forall currency. KnownSymbol currency => Dense currency -> r) -> r
- Data.Money: withDiscreteRep :: forall r. DiscreteRep -> (forall currency scale. (KnownSymbol currency, GoodScale scale) => Discrete' currency scale -> r) -> r
- Data.Money: withExchangeRateRep :: ExchangeRateRep -> (forall src dst. (KnownSymbol src, KnownSymbol dst) => ExchangeRate src dst -> r) -> r
- Data.Money.Internal: ceiling :: GoodScale scale => Dense currency -> (Discrete' currency scale, Maybe (Dense currency))
- Data.Money.Internal: data Dense (currency :: Symbol)
- Data.Money.Internal: data DenseRep
- Data.Money.Internal: data Discrete' (currency :: Symbol) (scale :: (Nat, Nat))
- Data.Money.Internal: data DiscreteRep
- Data.Money.Internal: data ExchangeRate (src :: Symbol) (dst :: Symbol)
- Data.Money.Internal: data ExchangeRateRep
- Data.Money.Internal: dense :: Rational -> Maybe (Dense currency)
- Data.Money.Internal: denseRep :: KnownSymbol currency => Dense currency -> DenseRep
- Data.Money.Internal: denseRepAmount :: DenseRep -> Rational
- Data.Money.Internal: denseRepAmountDenominator :: DenseRep -> Integer
- Data.Money.Internal: denseRepAmountNumerator :: DenseRep -> Integer
- Data.Money.Internal: denseRepCurrency :: DenseRep -> String
- Data.Money.Internal: discreteRep :: (KnownSymbol currency, GoodScale scale) => Discrete' currency scale -> DiscreteRep
- Data.Money.Internal: discreteRepAmount :: DiscreteRep -> Integer
- Data.Money.Internal: discreteRepCurrency :: DiscreteRep -> String
- Data.Money.Internal: discreteRepScale :: DiscreteRep -> Rational
- Data.Money.Internal: discreteRepScaleDenominator :: DiscreteRep -> Integer
- Data.Money.Internal: discreteRepScaleNumerator :: DiscreteRep -> Integer
- Data.Money.Internal: exchange :: ExchangeRate src dst -> Dense src -> Dense dst
- Data.Money.Internal: exchangeRate :: Rational -> Maybe (ExchangeRate src dst)
- Data.Money.Internal: exchangeRateRep :: (KnownSymbol src, KnownSymbol dst) => ExchangeRate src dst -> ExchangeRateRep
- Data.Money.Internal: exchangeRateRepDstCurrency :: ExchangeRateRep -> String
- Data.Money.Internal: exchangeRateRepRate :: ExchangeRateRep -> Rational
- Data.Money.Internal: exchangeRateRepRateDenominator :: ExchangeRateRep -> Integer
- Data.Money.Internal: exchangeRateRepRateNumerator :: ExchangeRateRep -> Integer
- Data.Money.Internal: exchangeRateRepSrcCurrency :: ExchangeRateRep -> String
- Data.Money.Internal: flipExchangeRate :: ExchangeRate a b -> ExchangeRate b a
- Data.Money.Internal: floor :: GoodScale scale => Dense currency -> (Discrete' currency scale, Maybe (Dense currency))
- Data.Money.Internal: fromDenseRep :: forall currency. KnownSymbol currency => DenseRep -> Maybe (Dense currency)
- Data.Money.Internal: fromDiscrete :: GoodScale scale => Discrete' currency scale -> Dense currency
- Data.Money.Internal: fromDiscreteRep :: forall currency scale. (KnownSymbol currency, GoodScale scale) => DiscreteRep -> Maybe (Discrete' currency scale)
- Data.Money.Internal: fromExchangeRate :: ExchangeRate src dst -> Rational
- Data.Money.Internal: fromExchangeRateRep :: forall src dst. (KnownSymbol src, KnownSymbol dst) => ExchangeRateRep -> Maybe (ExchangeRate src dst)
- Data.Money.Internal: instance ((TypeError ...), Data.Money.Internal.GoodScale scale) => GHC.Real.Fractional (Data.Money.Internal.Discrete' currency scale)
- Data.Money.Internal: instance (GHC.TypeLits.KnownSymbol currency, Data.Money.Internal.GoodScale scale) => Data.Aeson.Types.FromJSON.FromJSON (Data.Money.Internal.Discrete' currency scale)
- Data.Money.Internal: instance (GHC.TypeLits.KnownSymbol currency, Data.Money.Internal.GoodScale scale) => Data.Aeson.Types.ToJSON.ToJSON (Data.Money.Internal.Discrete' currency scale)
- Data.Money.Internal: instance (GHC.TypeLits.KnownSymbol currency, Data.Money.Internal.GoodScale scale) => Data.Binary.Class.Binary (Data.Money.Internal.Discrete' currency scale)
- Data.Money.Internal: instance (GHC.TypeLits.KnownSymbol currency, Data.Money.Internal.GoodScale scale) => Data.Serialize.Serialize (Data.Money.Internal.Discrete' currency scale)
- Data.Money.Internal: instance (GHC.TypeLits.KnownSymbol currency, Data.Money.Internal.GoodScale scale) => Data.Store.Impl.Store (Data.Money.Internal.Discrete' currency scale)
- Data.Money.Internal: instance (GHC.TypeLits.KnownSymbol currency, Data.Money.Internal.GoodScale scale) => GHC.Read.Read (Data.Money.Internal.Discrete' currency scale)
- Data.Money.Internal: instance (GHC.TypeLits.KnownSymbol currency, Data.Money.Internal.GoodScale scale) => GHC.Show.Show (Data.Money.Internal.Discrete' currency scale)
- Data.Money.Internal: instance (GHC.TypeLits.KnownSymbol src, GHC.TypeLits.KnownSymbol dst) => Data.Aeson.Types.FromJSON.FromJSON (Data.Money.Internal.ExchangeRate src dst)
- Data.Money.Internal: instance (GHC.TypeLits.KnownSymbol src, GHC.TypeLits.KnownSymbol dst) => Data.Aeson.Types.ToJSON.ToJSON (Data.Money.Internal.ExchangeRate src dst)
- Data.Money.Internal: instance (GHC.TypeLits.KnownSymbol src, GHC.TypeLits.KnownSymbol dst) => Data.Binary.Class.Binary (Data.Money.Internal.ExchangeRate src dst)
- Data.Money.Internal: instance (GHC.TypeLits.KnownSymbol src, GHC.TypeLits.KnownSymbol dst) => Data.Serialize.Serialize (Data.Money.Internal.ExchangeRate src dst)
- Data.Money.Internal: instance (GHC.TypeLits.KnownSymbol src, GHC.TypeLits.KnownSymbol dst) => Data.Store.Impl.Store (Data.Money.Internal.ExchangeRate src dst)
- Data.Money.Internal: instance (GHC.TypeLits.KnownSymbol src, GHC.TypeLits.KnownSymbol dst) => GHC.Read.Read (Data.Money.Internal.ExchangeRate src dst)
- Data.Money.Internal: instance (GHC.TypeLits.KnownSymbol src, GHC.TypeLits.KnownSymbol dst) => GHC.Show.Show (Data.Money.Internal.ExchangeRate src dst)
- Data.Money.Internal: instance Control.DeepSeq.NFData (Data.Money.Internal.Dense currency)
- Data.Money.Internal: instance Control.DeepSeq.NFData (Data.Money.Internal.ExchangeRate src dst)
- Data.Money.Internal: instance Control.DeepSeq.NFData Data.Money.Internal.DenseRep
- Data.Money.Internal: instance Control.DeepSeq.NFData Data.Money.Internal.DiscreteRep
- Data.Money.Internal: instance Control.DeepSeq.NFData Data.Money.Internal.ExchangeRateRep
- Data.Money.Internal: instance Data.Aeson.Types.FromJSON.FromJSON Data.Money.Internal.DenseRep
- Data.Money.Internal: instance Data.Aeson.Types.FromJSON.FromJSON Data.Money.Internal.DiscreteRep
- Data.Money.Internal: instance Data.Aeson.Types.FromJSON.FromJSON Data.Money.Internal.ExchangeRateRep
- Data.Money.Internal: instance Data.Aeson.Types.ToJSON.ToJSON Data.Money.Internal.DenseRep
- Data.Money.Internal: instance Data.Aeson.Types.ToJSON.ToJSON Data.Money.Internal.DiscreteRep
- Data.Money.Internal: instance Data.Aeson.Types.ToJSON.ToJSON Data.Money.Internal.ExchangeRateRep
- Data.Money.Internal: instance Data.Binary.Class.Binary Data.Money.Internal.DenseRep
- Data.Money.Internal: instance Data.Binary.Class.Binary Data.Money.Internal.DiscreteRep
- Data.Money.Internal: instance Data.Binary.Class.Binary Data.Money.Internal.ExchangeRateRep
- Data.Money.Internal: instance Data.Hashable.Class.Hashable (Data.Money.Internal.Dense currency)
- Data.Money.Internal: instance Data.Hashable.Class.Hashable (Data.Money.Internal.ExchangeRate src dst)
- Data.Money.Internal: instance Data.Hashable.Class.Hashable Data.Money.Internal.DenseRep
- Data.Money.Internal: instance Data.Hashable.Class.Hashable Data.Money.Internal.DiscreteRep
- Data.Money.Internal: instance Data.Hashable.Class.Hashable Data.Money.Internal.ExchangeRateRep
- Data.Money.Internal: instance Data.Money.Internal.GoodScale scale => Control.DeepSeq.NFData (Data.Money.Internal.Discrete' currency scale)
- Data.Money.Internal: instance Data.Money.Internal.GoodScale scale => Data.Hashable.Class.Hashable (Data.Money.Internal.Discrete' currency scale)
- Data.Money.Internal: instance Data.Money.Internal.GoodScale scale => GHC.Classes.Eq (Data.Money.Internal.Discrete' currency scale)
- Data.Money.Internal: instance Data.Money.Internal.GoodScale scale => GHC.Classes.Ord (Data.Money.Internal.Discrete' currency scale)
- Data.Money.Internal: instance Data.Money.Internal.GoodScale scale => GHC.Enum.Enum (Data.Money.Internal.Discrete' currency scale)
- Data.Money.Internal: instance Data.Money.Internal.GoodScale scale => GHC.Generics.Generic (Data.Money.Internal.Discrete' currency scale)
- Data.Money.Internal: instance Data.Money.Internal.GoodScale scale => GHC.Num.Num (Data.Money.Internal.Discrete' currency scale)
- Data.Money.Internal: instance Data.Money.Internal.GoodScale scale => GHC.Real.Integral (Data.Money.Internal.Discrete' currency scale)
- Data.Money.Internal: instance Data.Money.Internal.GoodScale scale => GHC.Real.Real (Data.Money.Internal.Discrete' currency scale)
- Data.Money.Internal: instance Data.Serialize.Serialize Data.Money.Internal.DenseRep
- Data.Money.Internal: instance Data.Serialize.Serialize Data.Money.Internal.DiscreteRep
- Data.Money.Internal: instance Data.Serialize.Serialize Data.Money.Internal.ExchangeRateRep
- Data.Money.Internal: instance Data.Store.Impl.Store Data.Money.Internal.DenseRep
- Data.Money.Internal: instance Data.Store.Impl.Store Data.Money.Internal.DiscreteRep
- Data.Money.Internal: instance Data.Store.Impl.Store Data.Money.Internal.ExchangeRateRep
- Data.Money.Internal: instance GHC.Classes.Eq (Data.Money.Internal.Dense currency)
- Data.Money.Internal: instance GHC.Classes.Eq (Data.Money.Internal.ExchangeRate src dst)
- Data.Money.Internal: instance GHC.Classes.Eq Data.Money.Internal.DenseRep
- Data.Money.Internal: instance GHC.Classes.Eq Data.Money.Internal.DiscreteRep
- Data.Money.Internal: instance GHC.Classes.Eq Data.Money.Internal.ExchangeRateRep
- Data.Money.Internal: instance GHC.Classes.Ord (Data.Money.Internal.Dense currency)
- Data.Money.Internal: instance GHC.Classes.Ord (Data.Money.Internal.ExchangeRate src dst)
- Data.Money.Internal: instance GHC.Classes.Ord Data.Money.Internal.DenseRep
- Data.Money.Internal: instance GHC.Classes.Ord Data.Money.Internal.DiscreteRep
- Data.Money.Internal: instance GHC.Classes.Ord Data.Money.Internal.ExchangeRateRep
- Data.Money.Internal: instance GHC.Generics.Generic (Data.Money.Internal.Dense currency)
- Data.Money.Internal: instance GHC.Generics.Generic (Data.Money.Internal.ExchangeRate src dst)
- Data.Money.Internal: instance GHC.Generics.Generic Data.Money.Internal.DenseRep
- Data.Money.Internal: instance GHC.Generics.Generic Data.Money.Internal.DiscreteRep
- Data.Money.Internal: instance GHC.Generics.Generic Data.Money.Internal.ExchangeRateRep
- Data.Money.Internal: instance GHC.Num.Num (Data.Money.Internal.Dense currency)
- Data.Money.Internal: instance GHC.Real.Fractional (Data.Money.Internal.Dense currency)
- Data.Money.Internal: instance GHC.Real.Real (Data.Money.Internal.Dense currency)
- Data.Money.Internal: instance GHC.Show.Show Data.Money.Internal.DenseRep
- Data.Money.Internal: instance GHC.Show.Show Data.Money.Internal.DiscreteRep
- Data.Money.Internal: instance GHC.Show.Show Data.Money.Internal.ExchangeRateRep
- Data.Money.Internal: instance GHC.TypeLits.KnownSymbol currency => Data.Aeson.Types.FromJSON.FromJSON (Data.Money.Internal.Dense currency)
- Data.Money.Internal: instance GHC.TypeLits.KnownSymbol currency => Data.Aeson.Types.ToJSON.ToJSON (Data.Money.Internal.Dense currency)
- Data.Money.Internal: instance GHC.TypeLits.KnownSymbol currency => Data.Binary.Class.Binary (Data.Money.Internal.Dense currency)
- Data.Money.Internal: instance GHC.TypeLits.KnownSymbol currency => Data.Serialize.Serialize (Data.Money.Internal.Dense currency)
- Data.Money.Internal: instance GHC.TypeLits.KnownSymbol currency => Data.Store.Impl.Store (Data.Money.Internal.Dense currency)
- Data.Money.Internal: instance GHC.TypeLits.KnownSymbol currency => GHC.Read.Read (Data.Money.Internal.Dense currency)
- Data.Money.Internal: instance GHC.TypeLits.KnownSymbol currency => GHC.Show.Show (Data.Money.Internal.Dense currency)
- Data.Money.Internal: mkDenseRep :: String -> Integer -> Integer -> Maybe DenseRep
- Data.Money.Internal: mkDiscreteRep :: String -> Integer -> Integer -> Integer -> Maybe DiscreteRep
- Data.Money.Internal: mkExchangeRateRep :: String -> String -> Integer -> Integer -> Maybe ExchangeRateRep
- Data.Money.Internal: round :: GoodScale scale => Dense currency -> (Discrete' currency scale, Maybe (Dense currency))
- Data.Money.Internal: scale :: forall proxy scale. GoodScale scale => proxy scale -> Rational
- Data.Money.Internal: truncate :: GoodScale scale => Dense currency -> (Discrete' currency scale, Maybe (Dense currency))
- Data.Money.Internal: type Discrete (currency :: Symbol) (unit :: Symbol) = Discrete' currency (Scale currency unit)
- Data.Money.Internal: type GoodScale (scale :: (Nat, Nat)) = (CmpNat 0 (Fst scale) ~ LT, CmpNat 0 (Snd scale) ~ LT, KnownNat (Fst scale), KnownNat (Snd scale))
- Data.Money.Internal: withDenseRep :: DenseRep -> (forall currency. KnownSymbol currency => Dense currency -> r) -> r
- Data.Money.Internal: withDiscreteRep :: forall r. DiscreteRep -> (forall currency scale. (KnownSymbol currency, GoodScale scale) => Discrete' currency scale -> r) -> r
- Data.Money.Internal: withExchangeRateRep :: ExchangeRateRep -> (forall src dst. (KnownSymbol src, KnownSymbol dst) => ExchangeRate src dst -> r) -> r
+ Money: ceiling :: GoodScale scale => Dense currency -> (Discrete' currency scale, Maybe (Dense currency))
+ Money: data Dense (currency :: Symbol)
+ Money: data DenseRep
+ Money: data Discrete' (currency :: Symbol) (scale :: (Nat, Nat))
+ Money: data DiscreteRep
+ Money: data ExchangeRate (src :: Symbol) (dst :: Symbol)
+ Money: data ExchangeRateRep
+ Money: dense :: Rational -> Maybe (Dense currency)
+ Money: denseRepAmount :: DenseRep -> Rational
+ Money: denseRepAmountDenominator :: DenseRep -> Integer
+ Money: denseRepAmountNumerator :: DenseRep -> Integer
+ Money: denseRepCurrency :: DenseRep -> String
+ Money: discreteRepAmount :: DiscreteRep -> Integer
+ Money: discreteRepCurrency :: DiscreteRep -> String
+ Money: discreteRepScale :: DiscreteRep -> Rational
+ Money: discreteRepScaleDenominator :: DiscreteRep -> Integer
+ Money: discreteRepScaleNumerator :: DiscreteRep -> Integer
+ Money: exchange :: ExchangeRate src dst -> Dense src -> Dense dst
+ Money: exchangeRate :: Rational -> Maybe (ExchangeRate src dst)
+ Money: exchangeRateRepDstCurrency :: ExchangeRateRep -> String
+ Money: exchangeRateRepRate :: ExchangeRateRep -> Rational
+ Money: exchangeRateRepRateDenominator :: ExchangeRateRep -> Integer
+ Money: exchangeRateRepRateNumerator :: ExchangeRateRep -> Integer
+ Money: exchangeRateRepSrcCurrency :: ExchangeRateRep -> String
+ Money: flipExchangeRate :: ExchangeRate a b -> ExchangeRate b a
+ Money: floor :: GoodScale scale => Dense currency -> (Discrete' currency scale, Maybe (Dense currency))
+ Money: fromDenseRep :: forall currency. KnownSymbol currency => DenseRep -> Maybe (Dense currency)
+ Money: fromDiscrete :: GoodScale scale => Discrete' currency scale -> Dense currency
+ Money: fromDiscreteRep :: forall currency scale. (KnownSymbol currency, GoodScale scale) => DiscreteRep -> Maybe (Discrete' currency scale)
+ Money: fromExchangeRate :: ExchangeRate src dst -> Rational
+ Money: fromExchangeRateRep :: forall src dst. (KnownSymbol src, KnownSymbol dst) => ExchangeRateRep -> Maybe (ExchangeRate src dst)
+ Money: mkDenseRep :: String -> Integer -> Integer -> Maybe DenseRep
+ Money: mkDiscreteRep :: String -> Integer -> Integer -> Integer -> Maybe DiscreteRep
+ Money: mkExchangeRateRep :: String -> String -> Integer -> Integer -> Maybe ExchangeRateRep
+ Money: round :: GoodScale scale => Dense currency -> (Discrete' currency scale, Maybe (Dense currency))
+ Money: scale :: forall proxy scale. GoodScale scale => proxy scale -> Rational
+ Money: toDenseRep :: KnownSymbol currency => Dense currency -> DenseRep
+ Money: toDiscreteRep :: (KnownSymbol currency, GoodScale scale) => Discrete' currency scale -> DiscreteRep
+ Money: toExchangeRateRep :: (KnownSymbol src, KnownSymbol dst) => ExchangeRate src dst -> ExchangeRateRep
+ Money: truncate :: GoodScale scale => Dense currency -> (Discrete' currency scale, Maybe (Dense currency))
+ Money: type Discrete (currency :: Symbol) (unit :: Symbol) = Discrete' currency (Scale currency unit)
+ Money: type GoodScale (scale :: (Nat, Nat)) = (CmpNat 0 (Fst scale) ~ LT, CmpNat 0 (Snd scale) ~ LT, KnownNat (Fst scale), KnownNat (Snd scale))
+ Money: withDenseRep :: DenseRep -> (forall currency. KnownSymbol currency => Dense currency -> r) -> r
+ Money: withDiscreteRep :: forall r. DiscreteRep -> (forall currency scale. (KnownSymbol currency, GoodScale scale) => Discrete' currency scale -> r) -> r
+ Money: withExchangeRateRep :: ExchangeRateRep -> (forall src dst. (KnownSymbol src, KnownSymbol dst) => ExchangeRate src dst -> r) -> r
Files
- Setup.hs +2/−0
- changelog.md +21/−0
- safe-money.cabal +39/−31
- src/Data/Money.hs +0/−770
- src/Data/Money/Internal.hs +0/−1140
- src/Money.hs +793/−0
- src/Money/Internal.hs +1188/−0
- test/Main.hs +453/−0
- tests/Main.hs +0/−444
Setup.hs view
@@ -1,2 +1,4 @@+#! /usr/bin/env nix-shell+#! nix-shell ./shell.nix -i runghc import Distribution.Simple main = defaultMain
changelog.md view
@@ -1,3 +1,24 @@+# Version 0.3++* BREAKING CHANGE: The `Data.Money` module was renamed to `Money`.++* BREAKING CHANGE: The `Data.Money.Internal` module is not exposed anymore. All+ of its contents are now exported from the `Money` module.++* BREAKING CHANGE: Renamed `discreteRep` to `toDiscreteRep`.++* BREAKING CHANGE: Renamed `denseRep` to `toDenseRep`.++* BREAKING CHANGE: Renamed `exchangeRateRep` to `toExchangeRateRep`.++* BREAKING CHANGE: Renamed Iceleandic currency `"eyir"` to `"eyrir"`++* Remove upper bound constraints from all dependencies except `base`.++* Made dependency on `store` optional for the test suite, so that it can run on+ GHCJS.++ # Version 0.2 * Cabal flags are now manual (`aeson`, `binary`, `bytes`, `cereal`, `deepseq`,
safe-money.cabal view
@@ -1,8 +1,8 @@ name: safe-money-version: 0.2+version: 0.3 license: BSD3 license-file: LICENSE-copyright: Copyright (c) Renzo Carbonara 2016+copyright: Copyright (c) Renzo Carbonara 2016-2017 author: Renzo Carbonara maintainer: renλren!zone stability: Experimental@@ -13,8 +13,17 @@ build-type: Simple cabal-version: >=1.10 extra-source-files: README.md changelog.md-synopsis: Type-safe and lossless encoding and manipulation of money, world currencies and precious metals.-description: Type-safe and lossless encoding and manipulation of money, world currencies and precious metals.+synopsis:+ Type-safe and lossless encoding and manipulation of money, fiat currencies,+ crypto currencies and precious metals.+description:+ Type-safe and lossless encoding and manipulation of money, fiat currencies,+ crypto currencies and precious metals.+ .+ Notice that the only mandatory dependencies of this package are @base@ and+ @constraints@. The rest of the dependencies are optional but enabled by+ default (except @store@ which is also disabled when building with GHCJS), they+ can be disabled with Cabal flags. source-repository head type: git@@ -24,44 +33,43 @@ default-language: Haskell2010 hs-source-dirs: src ghc-options: -Wall -O2- exposed-modules:- Data.Money- Data.Money.Internal- build-depends:- base (>=4.8 && <5.0)- , constraints (>=0.6 && <0.9)+ exposed-modules: Money+ other-modules: Money.Internal+ build-depends: base (>=4.8 && <5.0), constraints if flag(aeson)- build-depends: aeson (>=0.9 && <1.1)+ build-depends: aeson (>=0.9) if flag(binary)- build-depends: binary (>=0.7 && <0.9)+ build-depends: binary (>=0.7) if flag(cereal)- build-depends: cereal (>=0.5 && <0.6)+ build-depends: cereal (>=0.5) if flag(deepseq)- build-depends: deepseq (>=1.4 && <1.5)+ build-depends: deepseq (>=1.4) if flag(hashable)- build-depends: hashable (>=1.2 && <1.3)- if flag(store)- build-depends: store (>=0.2 && <0.4)+ build-depends: hashable (>=1.2)+ if (flag(store) && !impl(ghcjs))+ build-depends: store (>=0.2) -test-suite tests+test-suite test default-language: Haskell2010 type: exitcode-stdio-1.0- hs-source-dirs: tests src+ hs-source-dirs: test main-is: Main.hs build-depends:- aeson- , base- , binary- , bytestring- , cereal- , constraints- , deepseq- , hashable- , store- , tasty- , tasty-hunit- , tasty-quickcheck+ aeson,+ base,+ binary,+ bytestring,+ cereal,+ constraints,+ deepseq,+ hashable,+ safe-money,+ tasty,+ tasty-hunit,+ tasty-quickcheck+ if (flag(store) || !impl(ghcjs))+ build-depends: store flag aeson description: Provide instances for @aeson@
− src/Data/Money.hs
@@ -1,770 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UndecidableInstances #-}---- | Import this module qualified:------ @--- import qualified Data.Money as Money--- @-module Data.Money- ( -- * Dense monetary values- I.Dense- , I.dense- -- * Discrete monetary values- , I.Discrete- , I.Discrete'- , I.fromDiscrete- , I.round- , I.ceiling- , I.floor- , I.truncate- -- * Currency scales- , I.Scale- , I.GoodScale- , I.scale- -- * Currency exchange- , I.ExchangeRate- , I.exchangeRate- , I.fromExchangeRate- , I.flipExchangeRate- , I.exchange- -- * Serializable representations- , I.DenseRep- , I.denseRep- , I.fromDenseRep- , I.withDenseRep- , I.DiscreteRep- , I.discreteRep- , I.fromDiscreteRep- , I.withDiscreteRep- , I.ExchangeRateRep- , I.exchangeRateRep- , I.fromExchangeRateRep- , I.withExchangeRateRep- ) where--import qualified Data.Money.Internal as I------------------------------------------------------------------------------------- Currency scales---- | United Arab Emirates dirham-type instance I.Scale "AED" "AED" = '(100, 1)-type instance I.Scale "AED" "dirham" = '(1, 1)-type instance I.Scale "AED" "fils" = '(100, 1)--- | Afghan afghani-type instance I.Scale "AFN" "AFN" = '(100, 1)-type instance I.Scale "AFN" "afghani" = '(1, 1)-type instance I.Scale "AFN" "pul" = '(100, 1)--- | Albanian lek-type instance I.Scale "ALL" "ALL" = '(100, 1)-type instance I.Scale "ALL" "lek" = '(1, 1)-type instance I.Scale "ALL" "qindarke" = '(100, 1)--- | Armenian dram-type instance I.Scale "AMD" "AMD" = '(100, 1)-type instance I.Scale "AMD" "dram" = '(1, 1)-type instance I.Scale "AMD" "luma" = '(100, 1)--- | Netherlands Antillean guilder-type instance I.Scale "ANG" "ANG" = '(100, 1)-type instance I.Scale "ANG" "guilder" = '(1, 1)-type instance I.Scale "ANG" "cent" = '(100, 1)--- | Angolan kwanza-type instance I.Scale "AOA" "AOA" = '(100, 1)-type instance I.Scale "AOA" "kwanza" = '(1, 1)-type instance I.Scale "AOA" "centimo" = '(100, 1)--- | Argentine peso-type instance I.Scale "ARS" "ARS" = '(100, 1)-type instance I.Scale "ARS" "peso" = '(1, 1)-type instance I.Scale "ARS" "centavo" = '(100, 1)--- | Australian dollar-type instance I.Scale "AUD" "AUD" = '(100, 1)-type instance I.Scale "AUD" "dollar" = '(1, 1)-type instance I.Scale "AUD" "cent" = '(100, 1)--- | Aruban florin-type instance I.Scale "AWG" "AWG" = '(100, 1)-type instance I.Scale "AWG" "florin" = '(1, 1)-type instance I.Scale "AWG" "cent" = '(100, 1)--- | Azerbaijani manat-type instance I.Scale "AZN" "AZN" = '(100, 1)-type instance I.Scale "AZN" "manat" = '(1, 1)-type instance I.Scale "AZN" "qapik" = '(100, 1)--- | Bosnia and Herzegovina convertible mark-type instance I.Scale "BAM" "BAM" = '(100, 1)-type instance I.Scale "BAM" "mark" = '(1, 1)-type instance I.Scale "BAM" "fening" = '(100, 1)--- | Barbadian dollar-type instance I.Scale "BBD" "BBD" = '(100, 1)-type instance I.Scale "BBD" "dollar" = '(1, 1)-type instance I.Scale "BBD" "cent" = '(100, 1)--- | Bangladeshi taka-type instance I.Scale "BDT" "BDT" = '(100, 1)-type instance I.Scale "BDT" "taka" = '(1, 1)-type instance I.Scale "BDT" "paisa" = '(100, 1)--- | Bulgarian lev-type instance I.Scale "BGN" "BGN" = '(100, 1)-type instance I.Scale "BGN" "lev" = '(1, 1)-type instance I.Scale "BGN" "stotinka" = '(100, 1)--- | Bahraini dinar-type instance I.Scale "BHD" "BHD" = '(1000, 1)-type instance I.Scale "BHD" "dinar" = '(1, 1)-type instance I.Scale "BHD" "fils" = '(1000, 1)--- | Burundi franc-type instance I.Scale "BIF" "BIF" = '(100, 1)-type instance I.Scale "BIF" "franc" = '(1, 1)-type instance I.Scale "BIF" "centime" = '(100, 1)--- | Bermudian dollar-type instance I.Scale "BMD" "BMD" = '(100, 1)-type instance I.Scale "BMD" "dollar" = '(1, 1)-type instance I.Scale "BMD" "cent" = '(100, 1)--- | Brunei dollar-type instance I.Scale "BND" "BND" = '(100, 1)-type instance I.Scale "BND" "dollar" = '(1, 1)-type instance I.Scale "BND" "sen" = '(100, 1)--- | Bolivian boliviano-type instance I.Scale "BOB" "BOB" = '(100, 1)-type instance I.Scale "BOB" "boliviano" = '(1, 1)-type instance I.Scale "BOB" "centavo" = '(100, 1)--- | Bolivian Mvdol-type instance I.Scale "BOV" "BOV" = '(100, 1)--- | Brazilian real-type instance I.Scale "BRL" "BRL" = '(100, 1)-type instance I.Scale "BRL" "real" = '(1, 1)-type instance I.Scale "BRL" "centavo" = '(100, 1)--- | Bahamian dollar-type instance I.Scale "BSD" "BSD" = '(100, 1)-type instance I.Scale "BSD" "dollar" = '(1, 1)-type instance I.Scale "BSD" "cent" = '(1, 1)--- | Bhutanese ngultrum-type instance I.Scale "BTN" "BTN" = '(100, 1)-type instance I.Scale "BTN" "ngultrum" = '(1, 1)-type instance I.Scale "BTN" "chetrum" = '(100, 1)--- | Botswana pula-type instance I.Scale "BWP" "BWP" = '(100, 1)-type instance I.Scale "BWP" "pula" = '(1, 1)-type instance I.Scale "BWP" "thebe" = '(100, 1)--- | Belarusian ruble-type instance I.Scale "BYN" "BYN" = '(100, 1)--- | Belarusian ruble-type instance I.Scale "BYR" "BYR" = '(100, 1)-type instance I.Scale "BYR" "ruble" = '(1, 1)-type instance I.Scale "BYR" "kapyeyka" = '(100, 1)--- | Belize dollar-type instance I.Scale "BZD" "BZD" = '(100, 1)-type instance I.Scale "BZD" "dollar" = '(1, 1)-type instance I.Scale "BZD" "cent" = '(100, 1)--- | Canadian dollar-type instance I.Scale "CAD" "CAD" = '(100, 1)-type instance I.Scale "CAD" "dollar" = '(1, 1)-type instance I.Scale "CAD" "cent" = '(100, 1)--- | Congolese franc-type instance I.Scale "CDF" "CDF" = '(100, 1)-type instance I.Scale "CDF" "franc" = '(1, 1)-type instance I.Scale "CDF" "centime" = '(100, 1)--- | WIR euro-type instance I.Scale "CHE" "CHE" = '(100, 1)--- | Swiss franc-type instance I.Scale "CHF" "CHF" = '(100, 1)-type instance I.Scale "CHF" "franc" = '(1, 1)-type instance I.Scale "CHF" "rappen" = '(100, 1)--- | WIR franc-type instance I.Scale "CHW" "CHW" = '(100, 1)--- | Chilean unidad de fomento-type instance I.Scale "CLF" "CLF" = '(100, 1)--- | Chilean peso-type instance I.Scale "CLP" "CLP" = '(100, 1)-type instance I.Scale "CLP" "peso" = '(1, 1)-type instance I.Scale "CLP" "centavo" = '(100, 1)--- | Chinese Renminbi-type instance I.Scale "CNY" "CNY" = '(100, 1)-type instance I.Scale "CNY" "yuan" = '(1, 1)-type instance I.Scale "CNY" "fen" = '(100, 1)--- | Colombian peso-type instance I.Scale "COP" "COP" = '(100, 1)-type instance I.Scale "COP" "peso" = '(1, 1)-type instance I.Scale "COP" "centavo" = '(100, 1)--- | Colombian unidad de valor real-type instance I.Scale "COU" "COU" = '(100, 1)--- | Costa Rican colon-type instance I.Scale "CRC" "CRC" = '(100, 1)-type instance I.Scale "CRC" "colon" = '(1, 1)-type instance I.Scale "CRC" "centimo" = '(100, 1)--- | Cuban peso convertible-type instance I.Scale "CUC" "CUC" = '(100, 1)-type instance I.Scale "CUC" "peso" = '(1, 1)-type instance I.Scale "CUC" "centavo" = '(100, 1)--- | Cuban peso-type instance I.Scale "CUP" "CUP" = '(100, 1)-type instance I.Scale "CUP" "peso" = '(1, 1)-type instance I.Scale "CUP" "centavo" = '(100, 1)--- | Cape Verdean escudo-type instance I.Scale "CVE" "CVE" = '(100, 1)-type instance I.Scale "CVE" "escudo" = '(1, 1)-type instance I.Scale "CVE" "centavo" = '(100, 1)--- | Czech koruna-type instance I.Scale "CZK" "CZK" = '(100, 1)-type instance I.Scale "CZK" "koruna" = '(1, 1)-type instance I.Scale "CZK" "haler" = '(100, 1)--- | Djiboutian franc-type instance I.Scale "DJF" "DJF" = '(100, 1)-type instance I.Scale "DJF" "franc" = '(1, 1)-type instance I.Scale "DJF" "centime" = '(100, 1)--- | Danish krone-type instance I.Scale "DKK" "DKK" = '(100, 1)-type instance I.Scale "DKK" "krone" = '(1, 1)-type instance I.Scale "DKK" "ore" = '(100, 1)--- | Dominican peso-type instance I.Scale "DOP" "DOP" = '(100, 1)-type instance I.Scale "DOP" "peso" = '(1, 1)-type instance I.Scale "DOP" "centavo" = '(100, 1)--- | Algerian dinar-type instance I.Scale "DZD" "DZD" = '(100, 1)-type instance I.Scale "DZD" "dinar" = '(1, 1)-type instance I.Scale "DZD" "santeem" = '(100, 1)--- | Egyptian pound-type instance I.Scale "EGP" "EGP" = '(100, 1)-type instance I.Scale "EGP" "pound" = '(1, 1)-type instance I.Scale "EGP" "piastre" = '(100, 1)--- | Eritrean nakfa-type instance I.Scale "ERN" "ERN" = '(100, 1)-type instance I.Scale "ERN" "nafka" = '(1, 1)-type instance I.Scale "ERN" "cent" = '(100, 1)--- | Ethiopian birr-type instance I.Scale "ETB" "ETB" = '(100, 1)-type instance I.Scale "ETB" "birr" = '(1, 1)-type instance I.Scale "ETB" "santim" = '(100, 1)--- | European euro-type instance I.Scale "EUR" "EUR" = '(100, 1)-type instance I.Scale "EUR" "euro" = '(1, 1)-type instance I.Scale "EUR" "cent" = '(100, 1)--- | Fijian dollar-type instance I.Scale "FJD" "FJD" = '(100, 1)--- | Falkland Islands pound-type instance I.Scale "FKP" "FKP" = '(100, 1)-type instance I.Scale "FKP" "pound" = '(1, 1)-type instance I.Scale "FKP" "penny" = '(100, 1)--- | Pound sterling-type instance I.Scale "GBP" "GBP" = '(100, 1)-type instance I.Scale "GBP" "pound" = '(1, 1)-type instance I.Scale "GBP" "penny" = '(100, 1)--- | Georgian lari-type instance I.Scale "GEL" "GEL" = '(100, 1)-type instance I.Scale "GEL" "lari" = '(1, 1)-type instance I.Scale "GEL" "tetri" = '(100, 1)--- | Ghanaian cedi-type instance I.Scale "GHS" "GHS" = '(100, 1)-type instance I.Scale "GHS" "cedi" = '(1, 1)-type instance I.Scale "GHS" "pesewa" = '(100, 1)--- | Gibraltar pound-type instance I.Scale "GIP" "GIP" = '(100, 1)-type instance I.Scale "GIP" "pound" = '(1, 1)-type instance I.Scale "GIP" "penny" = '(100, 1)--- | Gambian dalasi-type instance I.Scale "GMD" "GMD" = '(100, 1)-type instance I.Scale "GMD" "dalasi" = '(1, 1)-type instance I.Scale "GMD" "butut" = '(100, 1)--- | Guinean franc-type instance I.Scale "GNF" "GNF" = '(100, 1)-type instance I.Scale "GNF" "franc" = '(1, 1)-type instance I.Scale "GNF" "centime" = '(100, 1)--- | Guatemalan quetzal-type instance I.Scale "GTQ" "GTQ" = '(100, 1)-type instance I.Scale "GTQ" "quetzal" = '(1, 1)-type instance I.Scale "GTQ" "centavo" = '(100, 1)--- | Guyanese dollar-type instance I.Scale "GYD" "GYD" = '(100, 1)-type instance I.Scale "GYD" "dollar" = '(1, 1)-type instance I.Scale "GYD" "cent" = '(100, 1)--- | Hong Kong dollar-type instance I.Scale "HKD" "HKD" = '(100, 1)-type instance I.Scale "HKD" "dollar" = '(1, 1)-type instance I.Scale "HKD" "cent" = '(100, 1)--- | Honduran lempira-type instance I.Scale "HNL" "HNL" = '(100, 1)-type instance I.Scale "HNL" "lempira" = '(1, 1)-type instance I.Scale "HNL" "centavo" = '(100, 1)--- | Croatian kuna-type instance I.Scale "HRK" "HRK" = '(100, 1)-type instance I.Scale "HRK" "kuna" = '(1, 1)-type instance I.Scale "HRK" "lipa" = '(100, 1)--- | Haitian gourde-type instance I.Scale "HTG" "HTG" = '(100, 1)-type instance I.Scale "HTG" "gourde" = '(1, 1)-type instance I.Scale "HTG" "centime" = '(1, 1)--- | Hungarian forint-type instance I.Scale "HUF" "HUF" = '(100, 1)-type instance I.Scale "HUF" "forint" = '(1, 1)-type instance I.Scale "HUF" "filler" = '(100, 1)--- | Indonesian rupiah-type instance I.Scale "IDR" "IDR" = '(100, 1)-type instance I.Scale "IDR" "rupiah" = '(1, 1)-type instance I.Scale "IDR" "sen" = '(100, 1)--- | Israeli new shekel-type instance I.Scale "ILS" "ILS" = '(100, 1)-type instance I.Scale "ILS" "shekel" = '(1, 1)-type instance I.Scale "ILS" "agora" = '(100, 1)--- | Indian rupee-type instance I.Scale "INR" "INR" = '(100, 1)-type instance I.Scale "INR" "rupee" = '(1, 1)-type instance I.Scale "INR" "paisa" = '(100, 1)--- | Iraqi dinar-type instance I.Scale "IQD" "IQD" = '(1000, 1)-type instance I.Scale "IQD" "dinar" = '(1, 1)-type instance I.Scale "IQD" "fils" = '(1000, 1)--- | Iranian rial-type instance I.Scale "IRR" "IRR" = '(100, 1)-type instance I.Scale "IRR" "rial" = '(1, 1)-type instance I.Scale "IRR" "dinar" = '(100, 1)--- | Icelandic króna-type instance I.Scale "ISK" "ISK" = '(100, 1)-type instance I.Scale "ISK" "krona" = '(1, 1)-type instance I.Scale "ISK" "eyir" = '(100, 1)--- | Jamaican dollar-type instance I.Scale "JMD" "JMD" = '(100, 1)-type instance I.Scale "JMD" "dollar" = '(1, 1)-type instance I.Scale "JMD" "cent" = '(100, 1)--- | Jordanian dinar-type instance I.Scale "JOD" "JOD" = '(100, 1)-type instance I.Scale "JOD" "dinar" = '(1, 1)-type instance I.Scale "JOD" "piastre" = '(100, 1)--- | Japanese yen-type instance I.Scale "JPY" "JPY" = '(100, 1)-type instance I.Scale "JPY" "yen" = '(1, 1)-type instance I.Scale "JPY" "sen" = '(100, 1)--- | Kenyan shilling-type instance I.Scale "KES" "KES" = '(100, 1)-type instance I.Scale "KES" "shilling" = '(1, 1)-type instance I.Scale "KES" "cent" = '(100, 1)--- | Kyrgyzstani som-type instance I.Scale "KGS" "KGS" = '(100, 1)-type instance I.Scale "KGS" "som" = '(1, 1)-type instance I.Scale "KGS" "tyiyn" = '(100, 1)--- | Cambodian riel-type instance I.Scale "KHR" "KHR" = '(100, 1)-type instance I.Scale "KHR" "riel" = '(1, 1)-type instance I.Scale "KHR" "sen" = '(100, 1)--- | Comorian franc-type instance I.Scale "KMF" "KMF" = '(100, 1)-type instance I.Scale "KMF" "franc" = '(1, 1)-type instance I.Scale "KMF" "centime" = '(100, 1)--- | North Korean won-type instance I.Scale "KPW" "KPW" = '(100, 1)-type instance I.Scale "KPW" "won" = '(1, 1)-type instance I.Scale "KPW" "chon" = '(100, 1)--- | South Korean won-type instance I.Scale "KRW" "KRW" = '(100, 1)-type instance I.Scale "KRW" "won" = '(1, 1)-type instance I.Scale "KRW" "jeon" = '(100, 1)--- | Kuwaiti dinar-type instance I.Scale "KWD" "KWD" = '(1000, 1)-type instance I.Scale "KWD" "dinar" = '(1, 1)-type instance I.Scale "KWD" "fils" = '(1000, 1)--- | Cayman Islands dollar-type instance I.Scale "KYD" "KYD" = '(100, 1)-type instance I.Scale "KYD" "dollar" = '(1, 1)-type instance I.Scale "KYD" "cent" = '(100, 1)--- | Kazakhstani tenge-type instance I.Scale "KZT" "KZT" = '(100, 1)-type instance I.Scale "KZT" "tenge" = '(1, 1)-type instance I.Scale "KZT" "tiyin" = '(100, 1)--- | Lao kip-type instance I.Scale "LAK" "LAK" = '(100, 1)-type instance I.Scale "LAK" "kip" = '(1, 1)-type instance I.Scale "LAK" "att" = '(100, 1)--- | Lebanese pound-type instance I.Scale "LBP" "LBP" = '(100, 1)-type instance I.Scale "LBP" "pound" = '(1, 1)-type instance I.Scale "LBP" "piastre" = '(100, 1)--- | Sri Lankan rupee-type instance I.Scale "LKR" "LKR" = '(100, 1)-type instance I.Scale "LKR" "rupee" = '(1, 1)-type instance I.Scale "LKR" "cent" = '(100, 1)--- | Liberian dollar-type instance I.Scale "LRD" "LRD" = '(100, 1)-type instance I.Scale "LRD" "dollar" = '(1, 1)-type instance I.Scale "LRD" "cent" = '(100, 1)--- | Lesotho loti-type instance I.Scale "LSL" "LSL" = '(100, 1)-type instance I.Scale "LSL" "loti" = '(1, 1)-type instance I.Scale "LSL" "sente" = '(100, 1)--- | Libyan dinar-type instance I.Scale "LYD" "LYD" = '(100, 1)-type instance I.Scale "LYD" "dinar" = '(1, 1)-type instance I.Scale "LYD" "dirham" = '(1000, 1)--- | Moroccan dirham-type instance I.Scale "MAD" "MAD" = '(100, 1)-type instance I.Scale "MAD" "dirham" = '(1, 1)-type instance I.Scale "MAD" "centime" = '(100, 1)--- | Moldovan leu-type instance I.Scale "MDL" "MDL" = '(100, 1)-type instance I.Scale "MDL" "leu" = '(100, 1)-type instance I.Scale "MDL" "ban" = '(100, 1)--- | Malagasy ariary-type instance I.Scale "MGA" "MGA" = '(5, 1)-type instance I.Scale "MGA" "ariary" = '(1, 1)-type instance I.Scale "MGA" "iraimbilanja" = '(5, 1)--- | Macedonian denar-type instance I.Scale "MKD" "MKD" = '(100, 1)-type instance I.Scale "MKD" "denar" = '(1, 1)-type instance I.Scale "MKD" "deni" = '(100, 1)--- | Myanmar kyat-type instance I.Scale "MMK" "MMK" = '(100, 1)-type instance I.Scale "MMK" "kyat" = '(1, 1)-type instance I.Scale "MMK" "pya" = '(100, 1)--- | Mongolian tugrik-type instance I.Scale "MNT" "MNT" = '(100, 1)-type instance I.Scale "MNT" "tugrik" = '(1, 1)-type instance I.Scale "MNT" "mongo" = '(100, 1)--- | Macanese pataca-type instance I.Scale "MOP" "MOP" = '(100, 1)-type instance I.Scale "MOP" "pataca" = '(1, 1)-type instance I.Scale "MOP" "avo" = '(100, 1)--- | Mauritanian ouguiya-type instance I.Scale "MRO" "MRO" = '(5, 1)-type instance I.Scale "MRO" "ouguiya" = '(1, 1)-type instance I.Scale "MRO" "khoums" = '(5, 1)--- | Mauritian rupee-type instance I.Scale "MUR" "MUR" = '(100, 1)-type instance I.Scale "MUR" "rupee" = '(1, 1)-type instance I.Scale "MUR" "cent" = '(100, 1)--- | Maldivian rufiyaa-type instance I.Scale "MVR" "MVR" = '(100, 1)-type instance I.Scale "MVR" "rufiyaa" = '(1, 1)-type instance I.Scale "MVR" "laari" = '(100, 1)--- | Malawian kwacha-type instance I.Scale "MWK" "MWK" = '(100, 1)-type instance I.Scale "MWK" "kwacha" = '(1, 1)-type instance I.Scale "MWK" "tambala" = '(100, 1)--- | Mexican peso-type instance I.Scale "MXN" "MXN" = '(100, 1)-type instance I.Scale "MXN" "peso" = '(1, 1)-type instance I.Scale "MXN" "centavo" = '(100, 1)--- | Mexican unidad de inversion-type instance I.Scale "MXV" "MXV" = '(100, 1)--- | Malaysian ringgit-type instance I.Scale "MYR" "MYR" = '(100, 1)-type instance I.Scale "MYR" "ringgit" = '(1, 1)-type instance I.Scale "MYR" "sen" = '(100, 1)--- | Mozambican metical-type instance I.Scale "MZN" "MZN" = '(100, 1)-type instance I.Scale "MZN" "metical" = '(1, 1)-type instance I.Scale "MZN" "centavo" = '(100, 1)--- | Namibian dollar-type instance I.Scale "NAD" "NAD" = '(100, 1)-type instance I.Scale "NAD" "dollar" = '(1, 1)-type instance I.Scale "NAD" "cent" = '(100, 1)--- | Nigerian naira-type instance I.Scale "NGN" "NGN" = '(100, 1)-type instance I.Scale "NGN" "naira" = '(1, 1)-type instance I.Scale "NGN" "kobo" = '(100, 1)--- | Nicaraguan cordoba-type instance I.Scale "NIO" "NIO" = '(100, 1)-type instance I.Scale "NIO" "cordoba" = '(1, 1)-type instance I.Scale "NIO" "centavo" = '(100, 1)--- | Norwegian krone-type instance I.Scale "NOK" "NOK" = '(100, 1)-type instance I.Scale "NOK" "krone" = '(1, 1)-type instance I.Scale "NOK" "ore" = '(100, 1)--- | Nepalese rupee-type instance I.Scale "NPR" "NPR" = '(100, 1)-type instance I.Scale "NPR" "rupee" = '(1, 1)-type instance I.Scale "NPR" "paisa" = '(100, 1)--- | New Zealand dollar-type instance I.Scale "NZD" "NZD" = '(100, 1)-type instance I.Scale "NZD" "dollar" = '(1, 1)-type instance I.Scale "NZD" "cent" = '(100, 1)--- | Omani rial-type instance I.Scale "OMR" "OMR" = '(1000, 1)-type instance I.Scale "OMR" "rial" = '(1, 1)-type instance I.Scale "OMR" "baisa" = '(1000, 1)--- | Panamenian balboa-type instance I.Scale "PAB" "PAB" = '(100, 1)-type instance I.Scale "PAB" "balboa" = '(1, 1)-type instance I.Scale "PAB" "centesimo" = '(100, 1)--- | Peruvian sol-type instance I.Scale "PEN" "PEN" = '(100, 1)-type instance I.Scale "PEN" "sol" = '(1, 1)-type instance I.Scale "PEN" "centimo" = '(100, 1)--- | Papua New Guinean kina-type instance I.Scale "PGK" "PGK" = '(100, 1)-type instance I.Scale "PGK" "kina" = '(1, 1)-type instance I.Scale "PGK" "toea" = '(100, 1)--- | Philippine peso-type instance I.Scale "PHP" "PHP" = '(100, 1)-type instance I.Scale "PHP" "peso" = '(1, 1)-type instance I.Scale "PHP" "centavo" = '(100, 1)--- | Pakistani rupee-type instance I.Scale "PKR" "PKR" = '(100, 1)-type instance I.Scale "PKR" "rupee" = '(1, 1)-type instance I.Scale "PKR" "paisa" = '(100, 1)--- | Polish zloty-type instance I.Scale "PLN" "PLN" = '(100, 1)-type instance I.Scale "PLN" "zloty" = '(1, 1)-type instance I.Scale "PLN" "grosz" = '(100, 1)--- | Paraguayan guarani-type instance I.Scale "PYG" "PYG" = '(100, 1)-type instance I.Scale "PYG" "guarani" = '(1, 1)-type instance I.Scale "PYG" "centimo" = '(100, 1)--- | Qatari riyal-type instance I.Scale "QAR" "QAR" = '(100, 1)-type instance I.Scale "QAR" "riyal" = '(1, 1)-type instance I.Scale "QAR" "dirham" = '(100, 1)--- | Romanian leu-type instance I.Scale "RON" "RON" = '(100, 1)-type instance I.Scale "RON" "leu" = '(1, 1)-type instance I.Scale "RON" "ban" = '(100, 1)--- | Serbian dinar-type instance I.Scale "RSD" "RSD" = '(100, 1)-type instance I.Scale "RSD" "dinar" = '(1, 1)-type instance I.Scale "RSD" "para" = '(100, 1)--- | Russian ruble-type instance I.Scale "RUB" "RUB" = '(100, 1)-type instance I.Scale "RUB" "ruble" = '(1, 1)-type instance I.Scale "RUB" "kopek" = '(100, 1)--- | Rwandan franc-type instance I.Scale "RWF" "RWF" = '(100, 1)-type instance I.Scale "RWF" "franc" = '(1, 1)-type instance I.Scale "RWF" "centime" = '(100, 1)--- | Saudi Arabian riyal-type instance I.Scale "SAR" "SAR" = '(100, 1)-type instance I.Scale "SAR" "riyal" = '(1, 1)-type instance I.Scale "SAR" "halala" = '(100, 1)--- | Solomon Islands dollar-type instance I.Scale "SBD" "SBD" = '(100, 1)-type instance I.Scale "SBD" "dollar" = '(100, 1)-type instance I.Scale "SBD" "cent" = '(100, 1)--- | Seychellois rupee-type instance I.Scale "SCR" "SCR" = '(100, 1)-type instance I.Scale "SCR" "rupee" = '(1, 1)-type instance I.Scale "SCR" "cent" = '(100, 1)--- | Sudanese pound-type instance I.Scale "SDG" "SDG" = '(100, 1)-type instance I.Scale "SDG" "pound" = '(1, 1)-type instance I.Scale "SDG" "piastre" = '(100, 1)--- | Swedish krona-type instance I.Scale "SEK" "SEK" = '(100, 1)-type instance I.Scale "SEK" "krona" = '(1, 1)-type instance I.Scale "SEK" "ore" = '(100, 1)--- | Singapore dollar-type instance I.Scale "SGD" "SGD" = '(100, 1)-type instance I.Scale "SGD" "dollar" = '(1, 1)-type instance I.Scale "SGD" "cent" = '(100, 1)--- | Saint Helena pound-type instance I.Scale "SHP" "SHP" = '(100, 1)-type instance I.Scale "SHP" "pound" = '(1, 1)-type instance I.Scale "SHP" "penny" = '(100, 1)--- | Sierra Leonean leone-type instance I.Scale "SLL" "SLL" = '(100, 1)-type instance I.Scale "SLL" "leone" = '(1, 1)-type instance I.Scale "SLL" "cent" = '(100, 1)--- | Somali shilling-type instance I.Scale "SOS" "SOS" = '(100, 1)-type instance I.Scale "SOS" "shilling" = '(1, 1)-type instance I.Scale "SOS" "cent" = '(100, 1)--- | Surinamese dollar-type instance I.Scale "SRD" "SRD" = '(100, 1)-type instance I.Scale "SRD" "dollar" = '(1, 1)-type instance I.Scale "SRD" "cent" = '(100, 1)--- | South Sudanese pound-type instance I.Scale "SSP" "SSP" = '(100, 1)-type instance I.Scale "SSP" "pound" = '(1, 1)-type instance I.Scale "SSP" "piastre" = '(100, 1)--- | Sao Tome and Principe dobra-type instance I.Scale "STD" "STD" = '(100, 1)-type instance I.Scale "STD" "dobra" = '(1, 1)-type instance I.Scale "STD" "centimo" = '(100, 1)--- | Salvadoran colon-type instance I.Scale "SVC" "SVC" = '(100, 1)-type instance I.Scale "SVC" "colon" = '(1, 1)-type instance I.Scale "SVC" "centavo" = '(100, 1)--- | Syrian pound-type instance I.Scale "SYP" "SYP" = '(100, 1)-type instance I.Scale "SYP" "pound" = '(1, 1)-type instance I.Scale "SYP" "piastre" = '(100, 1)--- | Swazi lilangeni-type instance I.Scale "SZL" "SZL" = '(100, 1)-type instance I.Scale "SZL" "lilangeni" = '(1, 1)-type instance I.Scale "SZL" "cent" = '(100, 1)--- | Thai baht-type instance I.Scale "THB" "THB" = '(100, 1)-type instance I.Scale "THB" "baht" = '(1, 1)-type instance I.Scale "THB" "satang" = '(100, 1)--- | Tajikistani somoni-type instance I.Scale "TJS" "TJS" = '(100, 1)-type instance I.Scale "TJS" "somoni" = '(1, 1)-type instance I.Scale "TJS" "diram" = '(100, 1)--- | Turkmen manat-type instance I.Scale "TMT" "TMT" = '(100, 1)-type instance I.Scale "TMT" "manat" = '(1, 1)-type instance I.Scale "TMT" "tennesi" = '(100, 1)--- | Tunisian dinar-type instance I.Scale "TND" "TND" = '(1000, 1)-type instance I.Scale "TND" "dinar" = '(1, 1)-type instance I.Scale "TND" "millime" = '(1000, 1)--- | Tongan pa’anga-type instance I.Scale "TOP" "TOP" = '(100, 1)-type instance I.Scale "TOP" "pa'anga" = '(1, 1)-type instance I.Scale "TOP" "seniti" = '(100, 1)--- | Turkish lira-type instance I.Scale "TRY" "TRY" = '(100, 1)-type instance I.Scale "TRY" "lira" = '(1, 1)-type instance I.Scale "TRY" "kurus" = '(100, 1)--- | Tobago Trinidad and Tobago dollar-type instance I.Scale "TTD" "TTD" = '(100, 1)-type instance I.Scale "TTD" "dollar" = '(1, 1)-type instance I.Scale "TTD" "cent" = '(100, 1)--- | New Taiwan dollar-type instance I.Scale "TWD" "TWD" = '(100, 1)-type instance I.Scale "TWD" "dollar" = '(1, 1)-type instance I.Scale "TWD" "cent" = '(100, 1)--- | Tanzanian shilling-type instance I.Scale "TZS" "TZS" = '(100, 1)-type instance I.Scale "TZS" "shilling" = '(1, 1)-type instance I.Scale "TZS" "cent" = '(100, 1)--- | Ukrainian hryvnia-type instance I.Scale "UAH" "UAH" = '(100, 1)-type instance I.Scale "UAH" "hryvnia" = '(1, 1)-type instance I.Scale "UAH" "kopiyka" = '(100, 1)--- | Ugandan shilling-type instance I.Scale "UGX" "UGX" = '(100, 1)-type instance I.Scale "UGX" "shilling" = '(1, 1)-type instance I.Scale "UGX" "cent" = '(100, 1)--- | United States dollar-type instance I.Scale "USD" "USD" = '(100, 1)-type instance I.Scale "USD" "dollar" = '(1, 1)-type instance I.Scale "USD" "cent" = '(100, 1)--- | United States dollar (next day)-type instance I.Scale "USN" "USN" = '(100, 1)--- | Uruguayan peso en unidades-type instance I.Scale "UYI" "UYI" = '(100, 1)--- | Uruguayan peso-type instance I.Scale "UYU" "UYU" = '(100, 1)-type instance I.Scale "UYU" "peso" = '(1, 1)-type instance I.Scale "UYU" "centesimo" = '(100, 1)--- | Uzbekistani som-type instance I.Scale "UZS" "UZS" = '(100, 1)-type instance I.Scale "UZS" "som" = '(1, 1)-type instance I.Scale "UZS" "tiyin" = '(100, 1)--- | Venezuelan bolivar-type instance I.Scale "VEF" "VEF" = '(100, 1)-type instance I.Scale "VEF" "bolivar" = '(1, 1)-type instance I.Scale "VEF" "centimo" = '(100, 1)--- | Vietnamese dong-type instance I.Scale "VND" "VND" = '(10, 1)-type instance I.Scale "VND" "dong" = '(1, 1)-type instance I.Scale "VND" "hao" = '(10, 1)--- | Vanuatu vatu-type instance I.Scale "VUV" "VUV" = '(1, 1)-type instance I.Scale "VUV" "vatu" = '(1, 1)--- | Samoan tālā-type instance I.Scale "WST" "WST" = '(100, 1)-type instance I.Scale "WST" "tala" = '(1, 1)-type instance I.Scale "WST" "sene" = '(100, 1)--- | Central African CFA franc-type instance I.Scale "XAF" "XAF" = '(100, 1)-type instance I.Scale "XAF" "franc" = '(1, 1)-type instance I.Scale "XAF" "centime" = '(100, 1)--- | East Caribbean dollar-type instance I.Scale "XCD" "XCD" = '(100, 1)-type instance I.Scale "XCD" "dollar" = '(1, 1)-type instance I.Scale "XCD" "cent" = '(100, 1)--- | International Monetary Fund Special Drawing Right-type instance I.Scale "XDR" "XDR" = '(100, 1)--- | West African CFA franc-type instance I.Scale "XOF" "XOF" = '(100, 1)-type instance I.Scale "XOF" "franc" = '(1, 1)-type instance I.Scale "XOF" "centime" = '(100, 1)--- | CFP franc-type instance I.Scale "XPF" "XPF" = '(100, 1)-type instance I.Scale "XPF" "franc" = '(1, 1)-type instance I.Scale "XPF" "centime" = '(100, 1)--- | Sucre-type instance I.Scale "XSU" "XSU" = '(100, 1)--- | African Development Bank unit of account-type instance I.Scale "XUA" "XUA" = '(100, 1)--- | Yemeni rial-type instance I.Scale "YER" "YER" = '(100, 1)-type instance I.Scale "YER" "rial" = '(1, 1)-type instance I.Scale "YER" "fils" = '(100, 1)--- | South African rand-type instance I.Scale "ZAR" "ZAR" = '(100, 1)-type instance I.Scale "ZAR" "rand" = '(1, 1)-type instance I.Scale "ZAR" "cent" = '(100, 1)--- | Zambian kwacha-type instance I.Scale "ZMW" "ZMW" = '(100, 1)-type instance I.Scale "ZMW" "kwacha" = '(1, 1)-type instance I.Scale "ZMW" "ngwee" = '(100, 1)--- | Zimbawe dollar-type instance I.Scale "ZWL" "ZWL" = '(100, 1)-type instance I.Scale "ZWL" "dollar" = '(1, 1)-type instance I.Scale "ZWL" "cent" = '(100, 1)---- | Gold. No canonical smallest unit. Unusable instance.-type instance I.Scale "XAU" "XAU" = I.ErrScaleNonCanonical "XAU"-type instance I.Scale "XAU" "troy-ounce" = '(1, 1)-type instance I.Scale "XAU" "grain" = '(480, 1)-type instance I.Scale "XAU" "milligrain" = '(480000, 1)-type instance I.Scale "XAU" "micrograin" = '(480000000, 1)-type instance I.Scale "XAU" "kilogram" = '(31103477, 1000000000)-type instance I.Scale "XAU" "gram" = '(31103477, 1000000)-type instance I.Scale "XAU" "milligram" = '(31103477, 1000)-type instance I.Scale "XAU" "microgram" = '(31103477, 1)---- | Silver. No canonical smallest unit. Unusable instance.-type instance I.Scale "XAG" "XAG" = I.ErrScaleNonCanonical "XAG"-type instance I.Scale "XAG" "troy-ounce" = '(1, 1)-type instance I.Scale "XAG" "grain" = '(480, 1)-type instance I.Scale "XAG" "milligrain" = '(480000, 1)-type instance I.Scale "XAG" "micrograin" = '(480000000, 1)-type instance I.Scale "XAG" "kilogram" = '(31103477, 1000000000)-type instance I.Scale "XAG" "gram" = '(31103477, 1000000)-type instance I.Scale "XAG" "milligram" = '(31103477, 1000)-type instance I.Scale "XAG" "microgram" = '(31103477, 1)---- | Palladium. No canonical smallest unit. Unusable instance.-type instance I.Scale "XPD" "XPD" = I.ErrScaleNonCanonical "XPD"-type instance I.Scale "XPD" "troy-ounce" = '(1, 1)-type instance I.Scale "XPD" "grain" = '(480, 1)-type instance I.Scale "XPD" "milligrain" = '(480000, 1)-type instance I.Scale "XPD" "micrograin" = '(480000000, 1)-type instance I.Scale "XPD" "kilogram" = '(31103477, 1000000000)-type instance I.Scale "XPD" "gram" = '(31103477, 1000000)-type instance I.Scale "XPD" "milligram" = '(31103477, 1000)-type instance I.Scale "XPD" "microgram" = '(31103477, 1)---- | Platinum. No canonical smallest unit. Unusable instance.-type instance I.Scale "XPT" "XPT" = I.ErrScaleNonCanonical "XPT"-type instance I.Scale "XPT" "troy-ounce" = '(1, 1)-type instance I.Scale "XPT" "grain" = '(480, 1)-type instance I.Scale "XPT" "milligrain" = '(480000, 1)-type instance I.Scale "XPT" "micrograin" = '(480000000, 1)-type instance I.Scale "XPT" "kilogram" = '(31103477, 1000000000)-type instance I.Scale "XPT" "gram" = '(31103477, 1000000)-type instance I.Scale "XPT" "milligram" = '(31103477, 1000)-type instance I.Scale "XPT" "microgram" = '(31103477, 1)---- | Bitcoin-type instance I.Scale "BTC" "BTC" = '(100000000, 1)-type instance I.Scale "BTC" "bitcoin" = '(1, 1)-type instance I.Scale "BTC" "satoshi" = '(100000000, 1)---- | Bitcoin-type instance I.Scale "XBT" "XBT" = '(100000000, 1)-type instance I.Scale "XBT" "bitcoin" = '(1, 1)-type instance I.Scale "XBT" "satoshi" = '(100000000, 1)---- | Ether-type instance I.Scale "ETH" "ETH" = '(1000000000000000000, 1)-type instance I.Scale "ETH" "ether" = '(1, 1)-type instance I.Scale "ETH" "kwei" = '(1000, 1)-type instance I.Scale "ETH" "babbage" = '(1000, 1)-type instance I.Scale "ETH" "mwei" = '(1000000, 1)-type instance I.Scale "ETH" "lovelace" = '(1000000, 1)-type instance I.Scale "ETH" "gwei" = '(1000000000, 1)-type instance I.Scale "ETH" "shannon" = '(1000000000, 1)-type instance I.Scale "ETH" "microether" = '(1000000000000, 1)-type instance I.Scale "ETH" "szabo" = '(1000000000000, 1)-type instance I.Scale "ETH" "finney" = '(1000000000000000, 1)-type instance I.Scale "ETH" "milliether" = '(1000000000000000, 1)-type instance I.Scale "ETH" "wei" = '(1000000000000000000, 1)
− src/Data/Money/Internal.hs
@@ -1,1140 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}--#if MIN_VERSION_base(4,9,0)-{-# OPTIONS_GHC -Wno-redundant-constraints #-}-#endif---- | This is an internal module. Import "Data.Money" instead.-module Data.Money.Internal- ( -- * Dense monetary values- Dense- , dense- -- * Discrete monetary values- , Discrete- , Discrete'- , fromDiscrete- , round- , ceiling- , floor- , truncate- -- * Currency scales- , Scale- , GoodScale- , ErrScaleNonCanonical- , scale- -- * Currency exchange- , ExchangeRate- , exchangeRate- , fromExchangeRate- , flipExchangeRate- , exchange- -- * Serializable representations- , DenseRep- , denseRep- , denseRepCurrency- , denseRepAmount- , denseRepAmountNumerator- , denseRepAmountDenominator- , mkDenseRep- , fromDenseRep- , withDenseRep- , DiscreteRep- , discreteRep- , discreteRepCurrency- , discreteRepScale- , discreteRepScaleNumerator- , discreteRepScaleDenominator- , discreteRepAmount- , mkDiscreteRep- , fromDiscreteRep- , withDiscreteRep- , ExchangeRateRep- , exchangeRateRep- , exchangeRateRepSrcCurrency- , exchangeRateRepDstCurrency- , exchangeRateRepRate- , exchangeRateRepRateNumerator- , exchangeRateRepRateDenominator- , mkExchangeRateRep- , fromExchangeRateRep- , withExchangeRateRep- ) where--import Control.Applicative (empty)-import Control.Monad ((<=<))-import Data.Constraint (Dict(Dict))-import Data.Proxy (Proxy(..))-import Data.Ratio ((%), numerator, denominator)-import qualified GHC.Generics as GHC-import GHC.Real (infinity, notANumber)-import GHC.TypeLits- (Symbol, SomeSymbol(..), Nat, SomeNat(..), CmpNat, KnownSymbol, KnownNat,- natVal, someNatVal, symbolVal, someSymbolVal)-import Prelude hiding (round, ceiling, floor, truncate)-import qualified Prelude-import qualified Text.ParserCombinators.ReadPrec as ReadPrec-import qualified Text.ParserCombinators.ReadP as ReadP-import Text.Read (readPrec)-import Unsafe.Coerce (unsafeCoerce)--#ifdef VERSION_aeson-import qualified Data.Aeson as Ae-#endif--#ifdef VERSION_binary-import qualified Data.Binary as Binary-#endif--#ifdef VERSION_cereal-import qualified Data.Serialize as Cereal-#endif--#ifdef VERSION_deepseq-import Control.DeepSeq (NFData)-#endif--#ifdef VERSION_hashable-import Data.Hashable (Hashable)-#endif--#ifdef VERSION_store-import qualified Data.Store as Store-#endif--#if MIN_VERSION_base(4,9,0)-import qualified GHC.TypeLits as GHC-#endif------------------------------------------------------------------------------------- | '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, 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 eventually multiply @USD 1.705@--- by @4@, for example, 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--- aproximate a 'Dense' value to a 'Discrete' value you can use one of--- 'round', 'floor', 'ceiling' or 'truncate'. Otherwise, using 'toRational' you--- can obtain a precise 'Rational' representation.------ Construct 'Dense' monetary values using 'dense', or--- 'fromInteger' / 'fromIntegral' if that suffices.------ /WARNING/ if you want to treat a dense monetary value as a /Real/ number (for--- example, to take the square root of that monetary value), 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 (Eq, Ord, Num, Real, Fractional, GHC.Generic)--instance forall currency. KnownSymbol currency => Show (Dense currency) where- show = \(Dense r0) ->- let c = symbolVal (Proxy :: Proxy currency)- in concat [ "Dense ", show c, " (", show r0, ")" ]--instance forall currency. KnownSymbol currency => Read (Dense currency) where- readPrec = do- let c = symbolVal (Proxy :: Proxy currency)- _ <- ReadPrec.lift (ReadP.string ("Dense " ++ show c ++ " "))- maybe empty pure =<< fmap dense 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)--- @------ This function returns 'Nothing' in case the given 'Rational' is 'infinity' or--- 'notANumber'.-dense :: Rational -> Maybe (Dense currency)-dense = \r0 ->- if (infinity == r0 || notANumber == r0)- then Nothing else Just (Dense r0)-{-# INLINE dense #-}---- | '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 'fromInteger'.------ 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., @'Scale' \"GBP\" ~ '(100, 1)@), then you can--- use:------ @--- 'fromInteger' 2105 :: Discrete \"GBP\" \"penny\"--- @------ Because @2015 / 100 == 20.15@.-type Discrete (currency :: Symbol) (unit :: Symbol)- = Discrete' currency (Scale currency unit)---- | 'Discrete'' represents a discrete monetary value for a @currency@ expresed--- as an 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 => Num (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)--instance forall currency scale.- ( KnownSymbol currency, GoodScale scale- ) => Show (Discrete' currency scale) where- show = \d0@(Discrete i0) ->- let c = symbolVal (Proxy :: Proxy currency)- in concat [ "Discrete ", show c, " (", show (scale d0), ") ", show i0 ]--instance forall currency scale.- ( KnownSymbol currency, GoodScale scale- ) => Read (Discrete' currency scale) where- readPrec = do- let c = symbolVal (Proxy :: Proxy currency)- s = scale (Proxy :: Proxy scale)- _ <- ReadPrec.lift (ReadP.string- ("Discrete " ++ show c ++ " (" ++ show s ++ ") ") )- Discrete <$> readPrec--#if MIN_VERSION_base(4,9,0)-instance- ( 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."))- , GoodScale scale- ) => Fractional (Discrete' currency scale) where- fromRational = undefined- recip = undefined-#endif---- | Convert currency 'Discrete' monetary value into a 'Dense' monetary--- value.-fromDiscrete- :: GoodScale scale- => Discrete' currency scale- -> Dense currency -- ^-fromDiscrete = \c@(Discrete i) -> Dense (fromInteger i / scale c)-{-# INLINE fromDiscrete #-}---- | Internal. Used to implement 'round', 'ceiling', 'floor' and 'truncate'.-roundf- :: forall currency scale- . GoodScale scale- => (Rational -> Integer) -- ^ 'Prelude.round', 'Prelude.ceiling' or similar.- -> Dense currency- -> (Discrete' currency scale, Maybe (Dense currency))-roundf f = \c0 ->- let !r0 = toRational c0 :: Rational- !r1 = scale (Proxy :: Proxy scale)- !i2 = f (r0 * r1) :: Integer- !r2 = fromInteger i2 / r1 :: Rational- !ycrest | r0 == r2 = Nothing- | otherwise = Just (Dense (r0 - r2))- !d2 = Discrete i2- in (d2, ycrest)-{-# INLINE roundf #-}---- | Round a 'Dense' value @x@ to the nearest value fully representable in--- its @currency@'s @unit@ 'Scale', which might be @x@ itself.------ If @x@ is already fully representable in its @currency@'s @unit@ 'Scale',--- then the following holds:------ @--- 'round' x == (x, 'Nothing')--- @------ Otherwise, if the nearest value to @x@ that is fully representable in its--- @currency@'s @unit@ 'Scale' is greater than @x@, then the following holds:------ @--- 'round' == 'ceiling'--- @------ Otherwise, the nearest value to @x@ that is fully representable in its--- @currency@'s @unit@ 'Scale' is smaller than @x@, and the following holds:------ @--- 'round' == 'floor'--- @------ Proof that 'round' doesn't lose money:------ @--- x == case 'round' x of--- (y, 'Nothing') -> y--- (y, 'Just' z) -> y + z--- @-round- :: GoodScale scale- => Dense currency- -> (Discrete' currency scale, Maybe (Dense currency)) -- ^-round = roundf Prelude.round-{-# INLINE round #-}---- | Round a 'Dense' value @x@ to the nearest value fully representable in--- its @currency@'s @unit@ 'Scale' which is greater than @x@ or equal to @x@.--------- If @x@ is already fully representable in its @currency@'s @unit@ 'Scale',--- then the following holds:------ @--- 'ceiling' x == (x, 'Nothing')--- @------ Otherwise, if @x@ is not representable in its @currency@'s @unit@ 'Scale',--- then the following holds:------ @--- 'ceiling' x == (y, 'Just' z)--- @------ @--- x /= y--- @------ @--- z < 'zero'--- @------ Proof that 'ceiling' doesn't lose money:------ @--- x == case 'ceiling' x of--- (y, 'Nothing') -> y--- (y, 'Just' z) -> y + z--- @-ceiling- :: GoodScale scale- => Dense currency- -> (Discrete' currency scale, Maybe (Dense currency)) -- ^-ceiling = roundf Prelude.ceiling-{-# INLINE ceiling #-}---- | Round a 'Dense' value @x@ to the nearest value fully representable in--- its @currency@'s @unit@ 'Scale' which is smaller than @x@ or equal to @x@.--------- If @x@ is already fully representable in its @currency@'s @unit@ 'Scale',--- then the following holds:------ @--- 'floor' x == (x, 'Nothing')--- @------ Otherwise, if @x@ is not representable in its @currency@'s @unit@ 'Scale',--- then the following holds:------ @--- 'floor' x == (y, 'Just' z)--- @------ @--- x /= y--- @------ @--- z > 'zero'--- @------ Proof that 'floor' doesn't lose money:------ @--- x == case 'floor' x of--- (y, 'Nothing') -> y--- (y, 'Just' z) -> y + z--- @-floor- :: GoodScale scale- => Dense currency- -> (Discrete' currency scale, Maybe (Dense currency)) -- ^-floor = roundf Prelude.floor-{-# INLINE floor #-}---- | Round a 'Dense' value @x@ to the nearest value between zero and--- @x@ (inclusive) which is fully representable in its @currency@'s @unit@--- 'Scale'.------ If @x@ is already fully representable in its @currency@'s @unit@ 'Scale',--- then the following holds:------ @--- 'truncate' x == (x, 'Nothing')--- @------ Otherwise, if @x@ is positive, then the following holds:------ @--- 'truncate' == 'floor'--- @------ Otherwise, if @x@ is negative, the following holds:------ @--- 'truncate' == 'ceiling'--- @------ Proof that 'truncate' doesn't lose money:------ @--- x == case 'truncate' x of--- (y, 'Nothing') -> y--- (y, 'Just' z) -> y + z--- @-truncate- :: GoodScale scale- => Dense currency- -> (Discrete' currency scale, Maybe (Dense currency)) -- ^-truncate = roundf Prelude.truncate-{-# INLINE truncate #-}-------------------------------------------------------------------------------------- | @'Scale' currency unit@ is a 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 '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 'Scale' \"USD\" \"cent\" = '(100, 1)--- @------ As another example, there is 1 dollar in USD, so the scale for this--- relationship is:------ @--- type instance 'Scale' \"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 @Scale \"USD\" \"dollar\"@ as your scale, you will not be able to--- represent values such as USD 3.50 or USD 21.87, since they are not exact--- multiples of a dollar.------ If there exists a canonical smallest @unit@ that can fully represent the--- currency, then an instance @'Scale' currency currency@ exists.------ @--- type instance 'Scale' \"USD\" \"USD\" = Scale \"USD\" \"cent\"--- @------ For some monetary values, such as precious metals, the smallest representable--- unit is not obvious, since you can continue to split the precious metal many--- times before it stops being a precious metal. Still, 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 'Scale' \"XAG\" \"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 number to express it.------ @--- type instance 'Scale' \"XAU\" \"milligram\" = '(31103477, 1000)--- @------ If you try to obtain the 'Scale of a @currency@ without an obvious smallest--- representable @unit@, like XAU, you will get a compile error.-type family Scale (currency :: Symbol) (unit :: Symbol) :: (Nat, Nat)--#if MIN_VERSION_base(4,9,0)--- | 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." )-#else--- | Forbid a @currency@ that doesn't have a canonical small unit.------ In GHC versions before 8.0 we can't provide a nice error message here, so we--- simply set this to a value that will fail to satisfy 'GoodScale'. As a--- consequence, trying to use this 'Scale' will result in a cryptic error saying--- /«@Couldn't match type ‘'EQ’ with ‘'LT’@»/.-type ErrScaleNonCanonical (currency :: Symbol) = '(0, 0)-#endif---- | Constraints to a scale (like the one returned by @'Scale' currency unit@)--- expected to always be satisfied. In particular, the scale is always--- guaranteed to be a positive rational number ('infinity' and '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 =- let n = natVal (Proxy :: Proxy num)- d = natVal (Proxy :: Proxy den)- in if (n > 0) && (d > 0)- then Just (unsafeCoerce (Dict :: Dict ('LT ~ 'LT, 'LT ~ 'LT,- KnownNat num, KnownNat den)))- else Nothing-{-# INLINE mkGoodScale #-}---- | Term-level representation for the @currency@'s @unit@ 'Scale'.------ For example, the 'Scale' for @\"USD\"@ in @\"cent\"@s is @100/1@.------ The returned 'Rational' is statically guaranteed to be a positive number, and--- to be different from both 'notANumber' and 'infinity'.-scale :: forall proxy scale. GoodScale scale => proxy scale -> Rational -- ^-scale = \_ ->- natVal (Proxy :: Proxy (Fst scale)) %- natVal (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 (Eq, Ord, GHC.Generic)--instance forall src dst.- ( KnownSymbol src, KnownSymbol dst- ) => Show (ExchangeRate src dst) where- show = \(ExchangeRate r0) ->- let s = symbolVal (Proxy :: Proxy src)- d = symbolVal (Proxy :: Proxy dst)- in concat [ "ExchangeRate ", show s, " ", show d, " (", show r0, ")" ]--instance forall src dst.- ( KnownSymbol src, KnownSymbol dst- ) => Read (ExchangeRate (src :: Symbol) (dst :: Symbol)) where- readPrec = do- let s = symbolVal (Proxy :: Proxy src)- d = symbolVal (Proxy :: Proxy dst)- _ <- ReadPrec.lift (ReadP.string- ("ExchangeRate " ++ show s ++ " " ++ show d ++ " "))- maybe empty pure =<< fmap exchangeRate readPrec---- | Obtain a 'Rational' representation of the 'ExchangeRate'.------ This 'Rational' is statically guaranteed to be greater than 0, different--- from 'infinity' and different from 'notANumber'.-fromExchangeRate :: ExchangeRate src dst -> Rational-fromExchangeRate = \(ExchangeRate r0) -> r0-{-# INLINE fromExchangeRate #-}---- | Safely construct an 'ExchangeRate' from a 'Rational' number.------ For construction to succeed, this 'Rational' must be greater than 0,--- different from 'infinity' and different from 'notANumber'.-exchangeRate :: Rational -> Maybe (ExchangeRate src dst)-exchangeRate = \r0 ->- if (r0 <= 0 || infinity == r0 || notANumber == r0)- then Nothing else Just (ExchangeRate r0)-{-# INLINE exchangeRate #-}---- | Flip the direction of an 'ExchangeRate'.------ Identity law:------ @--- 'flipExchangeRate' . 'flipExchangeRate' == 'id'--- @-flipExchangeRate :: ExchangeRate a b -> ExchangeRate b a-flipExchangeRate = \(ExchangeRate x) -> ExchangeRate (1 / x)-{-# INLINE flipExchangeRate #-}---- | Apply the 'ExchangeRate' to the given @'Dense' src@ monetary value.------ Identity law:------ @--- 'exchange' ('flipExchangeRate' 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 r) -> \(Dense s) -> Dense (r * s)-{-# INLINE exchange #-}------------------------------------------------------------------------------------- DenseRep---- | A monomorphic representation of 'Dense' that is easier to serialize and--- deserialize than 'Dense' in case you don't know the type indexes involved.-data DenseRep = DenseRep- { _denseRepCurrency :: !String- , _denseRepAmountNumerator :: !Integer- , _denseRepAmountDenominator :: !Integer -- ^ Positive, non-zero.- } deriving (Eq, Show, GHC.Generic)---- | WARNING: This instance does not compare monetary amounts, it just helps you--- sort 'DenseRep' values in case you need to put them in a 'Data.Set.Set' or--- similar.-deriving instance Ord DenseRep---- | Currency name.-denseRepCurrency :: DenseRep -> String-denseRepCurrency = _denseRepCurrency-{-# INLINE denseRepCurrency #-}---- | Currency unit amount.-denseRepAmount :: DenseRep -> Rational-denseRepAmount = \dr ->- denseRepAmountNumerator dr % denseRepAmountDenominator dr-{-# INLINE denseRepAmount #-}---- | Currency unit amount numerator.-denseRepAmountNumerator :: DenseRep -> Integer-denseRepAmountNumerator = _denseRepAmountNumerator-{-# INLINE denseRepAmountNumerator #-}---- | Currency unit amount denominator. Positive, non-zero.-denseRepAmountDenominator :: DenseRep -> Integer-denseRepAmountDenominator = _denseRepAmountDenominator-{-# INLINE denseRepAmountDenominator #-}---- | Internal. Build a 'DenseRep' from raw values.-mkDenseRep- :: String -- ^ Currency.- -> Integer -- ^ Scale nominator.- -> Integer -- ^ Scale denominator (positive, non zero)- -> Maybe DenseRep-mkDenseRep = \c n d -> case d > 0 of- False -> Nothing- True -> Just (DenseRep c n d)-{-# INLINE mkDenseRep #-}---- | Convert a 'Dense' to a 'DenseRep' for ease of serialization.-denseRep :: KnownSymbol currency => Dense currency -> DenseRep-denseRep = \(Dense r0 :: Dense currency) ->- let c = symbolVal (Proxy :: Proxy currency)- in DenseRep c (numerator r0) (denominator r0)-{-# INLINE denseRep #-}---- | Attempt to convert a 'DenseRep' to a 'Dense', provided you know the target--- @currency@.-fromDenseRep- :: forall currency- . KnownSymbol currency- => DenseRep- -> Maybe (Dense currency) -- ^-fromDenseRep = \dr ->- case denseRepCurrency dr == symbolVal (Proxy :: Proxy currency) of- False -> Nothing- True -> Just (Dense (denseRepAmount dr))-{-# INLINE fromDenseRep #-}---- | Convert a 'DenseRep' 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 'fromDenseRep' directly.-withDenseRep- :: DenseRep- -> (forall currency. KnownSymbol currency => Dense currency -> r)- -> r -- ^-withDenseRep dr = \f ->- case someSymbolVal (denseRepCurrency dr) of- SomeSymbol (Proxy :: Proxy currency) ->- f (Dense (denseRepAmount dr) :: Dense currency)-{-# INLINE withDenseRep #-}------------------------------------------------------------------------------------- DiscreteRep---- | A monomorphic representation of 'Discrete' that is easier to serialize and--- deserialize than 'Discrete' in case you don't know the type indexes involved.-data DiscreteRep = DiscreteRep- { _discreteRepCurrency :: !String -- ^ Currency name.- , _discreteRepScaleNumerator :: !Integer -- ^ Positive, non-zero.- , _discreteRepScaleDenominator :: !Integer -- ^ Positive, non-zero.- , _discreteRepAmount :: !Integer -- ^ Amount of unit.- } deriving (Eq, Show, GHC.Generic)---- | WARNING: This instance does not compare monetary amounts, it just helps you--- sort 'DiscreteRep' values in case you need to put them in a 'Data.Set.Set' or--- similar.-deriving instance Ord DiscreteRep---- | Currency name.-discreteRepCurrency :: DiscreteRep -> String-discreteRepCurrency = _discreteRepCurrency-{-# INLINE discreteRepCurrency #-}---- | Positive, non-zero.-discreteRepScale :: DiscreteRep -> Rational-discreteRepScale = \dr ->- discreteRepScaleNumerator dr % discreteRepScaleDenominator dr-{-# INLINE discreteRepScale #-}---- | Positive, non-zero.-discreteRepScaleNumerator :: DiscreteRep -> Integer-discreteRepScaleNumerator = _discreteRepScaleNumerator-{-# INLINE discreteRepScaleNumerator #-}---- | Positive, non-zero.-discreteRepScaleDenominator :: DiscreteRep -> Integer-discreteRepScaleDenominator = _discreteRepScaleDenominator-{-# INLINE discreteRepScaleDenominator #-}---- | Amount of currency unit.-discreteRepAmount :: DiscreteRep -> Integer-discreteRepAmount = _discreteRepAmount-{-# INLINE discreteRepAmount #-}---- | Internal. Build a 'DiscreteRep' from raw values.-mkDiscreteRep- :: String -- ^ Currency name.- -> Integer -- ^ Scale numerator. Positive, non-zero.- -> Integer -- ^ Scale denominator. Positive, non-zero.- -> Integer -- ^ Amount of unit.- -> Maybe DiscreteRep-mkDiscreteRep = \c n d a -> case (n > 0) && (d > 0) of- False -> Nothing- True -> Just (DiscreteRep c n d a)-{-# INLINE mkDiscreteRep #-}---- | Convert a 'Discrete' to a 'DiscreteRep' for ease of serialization.-discreteRep- :: (KnownSymbol currency, GoodScale scale)- => Discrete' currency scale- -> DiscreteRep -- ^-discreteRep = \(Discrete i0 :: Discrete' currency scale) ->- let c = symbolVal (Proxy :: Proxy currency)- n = natVal (Proxy :: Proxy (Fst scale))- d = natVal (Proxy :: Proxy (Snd scale))- in DiscreteRep c n d i0-{-# INLINE discreteRep #-}---- | Attempt to convert a 'DiscreteRep' to a 'Discrete', provided you know the--- target @currency@ and @unit@.-fromDiscreteRep- :: forall currency scale- . (KnownSymbol currency, GoodScale scale)- => DiscreteRep- -> Maybe (Discrete' currency scale) -- ^-fromDiscreteRep = \dr ->- if (discreteRepCurrency dr == symbolVal (Proxy :: Proxy currency)) &&- (discreteRepScaleNumerator dr == natVal (Proxy :: Proxy (Fst scale))) &&- (discreteRepScaleDenominator dr == natVal (Proxy :: Proxy (Snd scale)))- then Just (Discrete (discreteRepAmount dr))- else Nothing-{-# INLINE fromDiscreteRep #-}---- | Convert a 'DiscreteRep' 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 'fromDiscreteRep' directly.------ Notice that you may need to add an explicit type to the result of this--- function in order to keep the compiler happy.-withDiscreteRep- :: forall r- . DiscreteRep- -> ( forall currency scale.- ( KnownSymbol currency- , GoodScale scale- ) => Discrete' currency scale- -> r )- -> r -- ^-withDiscreteRep dr = \f ->- case someSymbolVal (discreteRepCurrency dr) of- SomeSymbol (Proxy :: Proxy currency) ->- case someNatVal (discreteRepScaleNumerator dr) of- Nothing -> error "withDiscreteRep: impossible: numerator < 0"- Just (SomeNat (Proxy :: Proxy num)) ->- case someNatVal (discreteRepScaleDenominator dr) of- Nothing -> error "withDiscreteRep: impossible: denominator < 0"- Just (SomeNat (Proxy :: Proxy den)) ->- case mkGoodScale of- Nothing -> error "withDiscreteRep: impossible: mkGoodScale"- Just (Dict :: Dict (GoodScale '(num, den))) ->- f (Discrete (discreteRepAmount dr)- :: Discrete' currency '(num, den))-{-# INLINABLE withDiscreteRep #-}------------------------------------------------------------------------------------- ExchangeRateRep---- | A monomorphic representation of 'ExchangeRate' that is easier to serialize--- and deserialize than 'ExchangeRate' in case you don't know the type indexes--- involved.-data ExchangeRateRep = ExchangeRateRep- { _exchangeRateRepSrcCurrency :: !String- , _exchangeRateRepDstCurrency :: !String- , _exchangeRateRepRateNumerator :: !Integer -- ^ Positive, non-zero.- , _exchangeRateRepRateDenominator :: !Integer -- ^ Positive, non-zero.- } deriving (Eq, Show, GHC.Generic)---- | WARNING: This instance does not compare monetary amounts, it just helps you--- sort 'ExchangeRateRep' values in case you need to put them in a--- 'Data.Set.Set' or similar.-deriving instance Ord ExchangeRateRep---- | Source currency name.-exchangeRateRepSrcCurrency :: ExchangeRateRep -> String-exchangeRateRepSrcCurrency = _exchangeRateRepSrcCurrency-{-# INLINE exchangeRateRepSrcCurrency #-}---- | Destination currency name.-exchangeRateRepDstCurrency :: ExchangeRateRep -> String-exchangeRateRepDstCurrency = _exchangeRateRepDstCurrency-{-# INLINE exchangeRateRepDstCurrency #-}---- | Exchange rate. Positive, non-zero.-exchangeRateRepRate :: ExchangeRateRep -> Rational-exchangeRateRepRate = \x ->- exchangeRateRepRateNumerator x % _exchangeRateRepRateDenominator x-{-# INLINE exchangeRateRepRate #-}---- | Exchange rate numerator. Positive, non-zero.-exchangeRateRepRateNumerator :: ExchangeRateRep -> Integer-exchangeRateRepRateNumerator = _exchangeRateRepRateNumerator-{-# INLINE exchangeRateRepRateNumerator #-}---- | Exchange rate denominator. Positive, non-zero.-exchangeRateRepRateDenominator :: ExchangeRateRep -> Integer-exchangeRateRepRateDenominator = _exchangeRateRepRateDenominator-{-# INLINE exchangeRateRepRateDenominator #-}---- | Internal. Build a 'ExchangeRateRep' from raw values.-mkExchangeRateRep- :: String -- ^ Source currency name.- -> String -- ^ Destination currency name.- -> Integer -- ^ Exchange rate numerator. Positive, non-zero.- -> Integer -- ^ Exchange rate denominator. Positive, non-zero.- -> Maybe ExchangeRateRep-mkExchangeRateRep = \src dst n d -> case (n > 0) && (d > 0) of- False -> Nothing- True -> Just (ExchangeRateRep src dst n d)-{-# INLINE mkExchangeRateRep #-}---- | Convert a 'ExchangeRate' to a 'DiscreteRep' for ease of serialization.-exchangeRateRep- :: (KnownSymbol src, KnownSymbol dst)- => ExchangeRate src dst- -> ExchangeRateRep -- ^-exchangeRateRep = \(ExchangeRate r0 :: ExchangeRate src dst) ->- let src = symbolVal (Proxy :: Proxy src)- dst = symbolVal (Proxy :: Proxy dst)- in ExchangeRateRep src dst (numerator r0) (denominator r0)-{-# INLINE exchangeRateRep #-}---- | Attempt to convert a 'ExchangeRateRep' to a 'ExchangeRate', provided you--- know the target @src@ and @dst@ types.-fromExchangeRateRep- :: forall src dst- . (KnownSymbol src, KnownSymbol dst)- => ExchangeRateRep- -> Maybe (ExchangeRate src dst) -- ^-fromExchangeRateRep = \x ->- if (exchangeRateRepSrcCurrency x == symbolVal (Proxy :: Proxy src)) &&- (exchangeRateRepDstCurrency x == symbolVal (Proxy :: Proxy dst))- then Just (ExchangeRate (exchangeRateRepRate x))- else Nothing-{-# INLINE fromExchangeRateRep #-}---- | Convert a 'ExchangeRateRep' 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 'fromExchangeRateRep' directly.-withExchangeRateRep- :: ExchangeRateRep- -> ( forall src dst.- ( KnownSymbol src- , KnownSymbol dst- ) => ExchangeRate src dst- -> r )- -> r -- ^-withExchangeRateRep x = \f ->- case someSymbolVal (exchangeRateRepSrcCurrency x) of- SomeSymbol (Proxy :: Proxy src) ->- case someSymbolVal (exchangeRateRepDstCurrency x) of- SomeSymbol (Proxy :: Proxy dst) ->- f (ExchangeRate (exchangeRateRepRate x) :: ExchangeRate src dst)-{-# INLINABLE withExchangeRateRep #-}------------------------------------------------------------------------------------- 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------------------------------------------------------------------------------------- Extra instances: hashable-#ifdef VERSION_hashable-instance Hashable (Dense currency)-instance Hashable DenseRep-instance GoodScale scale => Hashable (Discrete' currency scale)-instance Hashable DiscreteRep-instance Hashable (ExchangeRate src dst)-instance Hashable ExchangeRateRep-#endif------------------------------------------------------------------------------------- Extra instances: deepseq-#ifdef VERSION_deepseq-instance NFData (Dense currency)-instance NFData DenseRep-instance GoodScale scale => NFData (Discrete' currency scale)-instance NFData DiscreteRep-instance NFData (ExchangeRate src dst)-instance NFData ExchangeRateRep-#endif------------------------------------------------------------------------------------- Extra instances: cereal-#ifdef VERSION_cereal--- | Compatible with 'DenseRep'.-instance (KnownSymbol currency) => Cereal.Serialize (Dense currency) where- put = Cereal.put . denseRep- get = maybe empty pure =<< fmap fromDenseRep Cereal.get--- | Compatible with 'DiscreteRep'.-instance- ( KnownSymbol currency, GoodScale scale- ) => Cereal.Serialize (Discrete' currency scale) where- put = Cereal.put . discreteRep- get = maybe empty pure =<< fmap fromDiscreteRep Cereal.get--- | Compatible with 'ExchangeRateRep'.-instance- ( KnownSymbol src, KnownSymbol dst- ) => Cereal.Serialize (ExchangeRate src dst) where- put = Cereal.put . exchangeRateRep- get = maybe empty pure =<< fmap fromExchangeRateRep Cereal.get--- | Compatible with 'Dense'.-instance Cereal.Serialize DenseRep where- put = \(DenseRep c n d) -> Cereal.put c >> Cereal.put n >> Cereal.put d- get = maybe empty pure =<< mkDenseRep- <$> Cereal.get <*> Cereal.get <*> Cereal.get--- | Compatible with 'Discrete'.-instance Cereal.Serialize DiscreteRep where- put = \(DiscreteRep c n d a) ->- Cereal.put c >> Cereal.put n >> Cereal.put d >> Cereal.put a- get = maybe empty pure =<< mkDiscreteRep- <$> Cereal.get <*> Cereal.get <*> Cereal.get <*> Cereal.get--- | Compatible with 'ExchangeRate'.-instance Cereal.Serialize ExchangeRateRep where- put = \(ExchangeRateRep src dst n d) ->- Cereal.put src >> Cereal.put dst >> Cereal.put n >> Cereal.put d- get = maybe empty pure =<< mkExchangeRateRep- <$> Cereal.get <*> Cereal.get <*> Cereal.get <*> Cereal.get-#endif------------------------------------------------------------------------------------- Extra instances: binary-#ifdef VERSION_binary--- | Compatible with 'DenseRep'.-instance (KnownSymbol currency) => Binary.Binary (Dense currency) where- put = Binary.put . denseRep- get = maybe empty pure =<< fmap fromDenseRep Binary.get--- | Compatible with 'DiscreteRep'.-instance- ( KnownSymbol currency, GoodScale scale- ) => Binary.Binary (Discrete' currency scale) where- put = Binary.put . discreteRep- get = maybe empty pure =<< fmap fromDiscreteRep Binary.get--- | Compatible with 'ExchangeRateRep'.-instance- ( KnownSymbol src, KnownSymbol dst- ) => Binary.Binary (ExchangeRate src dst) where- put = Binary.put . exchangeRateRep- get = maybe empty pure =<< fmap fromExchangeRateRep Binary.get--- | Compatible with 'Dense'.-instance Binary.Binary DenseRep where- put = \(DenseRep c n d) -> Binary.put c >> Binary.put n >> Binary.put d- get = maybe empty pure =<< mkDenseRep- <$> Binary.get <*> Binary.get <*> Binary.get--- | Compatible with 'Discrete'.-instance Binary.Binary DiscreteRep where- put = \(DiscreteRep c n d a) ->- Binary.put c >> Binary.put n >> Binary.put d >> Binary.put a- get = maybe empty pure =<< mkDiscreteRep- <$> Binary.get <*> Binary.get <*> Binary.get <*> Binary.get--- | Compatible with 'ExchangeRate'.-instance Binary.Binary ExchangeRateRep where- put = \(ExchangeRateRep src dst n d) ->- Binary.put src >> Binary.put dst >> Binary.put n >> Binary.put d- get = maybe empty pure =<< mkExchangeRateRep- <$> Binary.get <*> Binary.get <*> Binary.get <*> Binary.get-#endif------------------------------------------------------------------------------------- Extra instances: aeson-#ifdef VERSION_aeson--- | Compatible with 'DenseRep'-instance KnownSymbol currency => Ae.ToJSON (Dense currency) where- toJSON = Ae.toJSON . denseRep--- | Compatible with 'DenseRep'-instance KnownSymbol currency => Ae.FromJSON (Dense currency) where- parseJSON = maybe empty pure <=< fmap fromDenseRep . Ae.parseJSON--- | Compatible with 'Dense'-instance Ae.ToJSON DenseRep where- toJSON = \(DenseRep c n d) -> Ae.toJSON ("Dense", c, n, d)--- | Compatible with 'Dense'-instance Ae.FromJSON DenseRep where- parseJSON = \v -> do- ("Dense", c, n, d) <- Ae.parseJSON v- maybe empty pure (mkDenseRep c n d)--- | Compatible with 'DiscreteRep'-instance- ( KnownSymbol currency, GoodScale scale- ) => Ae.ToJSON (Discrete' currency scale) where- toJSON = Ae.toJSON . discreteRep--- | Compatible with 'DiscreteRep'-instance- ( KnownSymbol currency, GoodScale scale- ) => Ae.FromJSON (Discrete' currency scale) where- parseJSON = maybe empty pure <=< fmap fromDiscreteRep . Ae.parseJSON--- | Compatible with 'Discrete''-instance Ae.ToJSON DiscreteRep where- toJSON = \(DiscreteRep c n d a) -> Ae.toJSON ("Discrete", c, n, d, a)--- | Compatible with 'Discrete''-instance Ae.FromJSON DiscreteRep where- parseJSON = \v -> do- ("Discrete", c, n, d, a) <- Ae.parseJSON v- maybe empty pure (mkDiscreteRep c n d a)--- | Compatible with 'ExchangeRateRep'-instance- ( KnownSymbol src, KnownSymbol dst- ) => Ae.ToJSON (ExchangeRate src dst) where- toJSON = Ae.toJSON . exchangeRateRep--- | Compatible with 'ExchangeRateRep'-instance- ( KnownSymbol src, KnownSymbol dst- ) => Ae.FromJSON (ExchangeRate src dst) where- parseJSON = maybe empty pure <=< fmap fromExchangeRateRep . Ae.parseJSON--- | Compatible with 'ExchangeRate'-instance Ae.ToJSON ExchangeRateRep where- toJSON = \(ExchangeRateRep src dst n d) ->- Ae.toJSON ("ExchangeRate", src, dst, n, d)--- | Compatible with 'ExchangeRate'-instance Ae.FromJSON ExchangeRateRep where- parseJSON = \v -> do- ("ExchangeRate", src, dst, n, d) <- Ae.parseJSON v- maybe empty pure (mkExchangeRateRep src dst n d)-#endif------------------------------------------------------------------------------------- Extra instances: store-#ifdef VERSION_store--- | Compatible with 'DenseRep'.-instance (KnownSymbol currency) => Store.Store (Dense currency) where- size = storeContramapSize denseRep Store.size- poke = Store.poke . denseRep- peek = maybe (fail "peek") pure =<< fmap fromDenseRep Store.peek--- | Compatible with 'Dense'.-instance Store.Store DenseRep where- poke = \(DenseRep c n d) -> Store.poke c >> Store.poke n >> Store.poke d- peek = maybe (fail "peek") pure =<< do- mkDenseRep <$> Store.peek <*> Store.peek <*> Store.peek---- | Compatible with 'DiscreteRep'.-instance- ( KnownSymbol currency, GoodScale scale- ) => Store.Store (Discrete' currency scale) where- size = storeContramapSize discreteRep Store.size- poke = Store.poke . discreteRep- peek = maybe (fail "peek") pure =<< fmap fromDiscreteRep Store.peek--- | Compatible with 'Discrete''.-instance Store.Store DiscreteRep where- poke = \(DiscreteRep c n d a) ->- Store.poke c >> Store.poke n >> Store.poke d >> Store.poke a- peek = maybe (fail "peek") pure =<< do- mkDiscreteRep <$> Store.peek <*> Store.peek <*> Store.peek <*> Store.peek--- | Compatible with 'ExchangeRateRep'.-instance- ( KnownSymbol src, KnownSymbol dst- ) => Store.Store (ExchangeRate src dst) where- size = storeContramapSize exchangeRateRep Store.size- poke = Store.poke . exchangeRateRep- peek = maybe (fail "peek") pure =<< fmap fromExchangeRateRep Store.peek--- | Compatible with 'ExchangeRate'.-instance Store.Store ExchangeRateRep where- poke = \(ExchangeRateRep src dst n d) ->- Store.poke src >> Store.poke dst >> Store.poke n >> Store.poke d- peek = maybe (fail "peek") pure =<< mkExchangeRateRep- <$> Store.peek <*> Store.peek <*> Store.peek <*> Store.peek--storeContramapSize :: (a -> b) -> Store.Size b -> Store.Size a-storeContramapSize f = \case- Store.VarSize g -> Store.VarSize (g . f)- Store.ConstSize x -> Store.ConstSize x-{-# INLINE storeContramapSize #-}-#endif
+ src/Money.hs view
@@ -0,0 +1,793 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-- | Import this module qualified as follows:+--+-- @+-- import qualified Money+-- @+--+-- Note: This module exports many well-known currencies out-of-the-box, but+-- you are not limited to the currencies mentioned here. You can simply create+-- a new 'I.Scale' instance, and /voilà/. If you want to add a new currency to the+-- out-of-the-box offer, please request so in+-- https://github.com/k0001/safe-money/issues and the authors will see to it.+module Money+ ( -- * Dense monetary values+ I.Dense+ , I.dense+ -- * Discrete monetary values+ , I.Discrete+ , I.Discrete'+ , I.fromDiscrete+ , I.round+ , I.ceiling+ , I.floor+ , I.truncate+ -- * Currency scales+ , I.Scale+ , I.GoodScale+ , I.scale+ -- * Currency exchange+ , I.ExchangeRate+ , I.exchangeRate+ , I.fromExchangeRate+ , I.flipExchangeRate+ , I.exchange+ -- * Serializable representations+ , I.DenseRep+ , I.toDenseRep+ , I.mkDenseRep+ , I.fromDenseRep+ , I.withDenseRep+ , I.denseRepCurrency+ , I.denseRepAmount+ , I.denseRepAmountNumerator+ , I.denseRepAmountDenominator+ , I.DiscreteRep+ , I.toDiscreteRep+ , I.mkDiscreteRep+ , I.fromDiscreteRep+ , I.withDiscreteRep+ , I.discreteRepCurrency+ , I.discreteRepScale+ , I.discreteRepScaleNumerator+ , I.discreteRepScaleDenominator+ , I.discreteRepAmount+ , I.ExchangeRateRep+ , I.toExchangeRateRep+ , I.mkExchangeRateRep+ , I.fromExchangeRateRep+ , I.withExchangeRateRep+ , I.exchangeRateRepSrcCurrency+ , I.exchangeRateRepDstCurrency+ , I.exchangeRateRepRate+ , I.exchangeRateRepRateNumerator+ , I.exchangeRateRepRateDenominator+ ) where++import qualified Money.Internal as I++--------------------------------------------------------------------------------+-- Currency scales++-- | United Arab Emirates dirham+type instance I.Scale "AED" "AED" = '(100, 1)+type instance I.Scale "AED" "dirham" = '(1, 1)+type instance I.Scale "AED" "fils" = '(100, 1)+-- | Afghan afghani+type instance I.Scale "AFN" "AFN" = '(100, 1)+type instance I.Scale "AFN" "afghani" = '(1, 1)+type instance I.Scale "AFN" "pul" = '(100, 1)+-- | Albanian lek+type instance I.Scale "ALL" "ALL" = '(100, 1)+type instance I.Scale "ALL" "lek" = '(1, 1)+type instance I.Scale "ALL" "qindarke" = '(100, 1)+-- | Armenian dram+type instance I.Scale "AMD" "AMD" = '(100, 1)+type instance I.Scale "AMD" "dram" = '(1, 1)+type instance I.Scale "AMD" "luma" = '(100, 1)+-- | Netherlands Antillean guilder+type instance I.Scale "ANG" "ANG" = '(100, 1)+type instance I.Scale "ANG" "guilder" = '(1, 1)+type instance I.Scale "ANG" "cent" = '(100, 1)+-- | Angolan kwanza+type instance I.Scale "AOA" "AOA" = '(100, 1)+type instance I.Scale "AOA" "kwanza" = '(1, 1)+type instance I.Scale "AOA" "centimo" = '(100, 1)+-- | Argentine peso+type instance I.Scale "ARS" "ARS" = '(100, 1)+type instance I.Scale "ARS" "peso" = '(1, 1)+type instance I.Scale "ARS" "centavo" = '(100, 1)+-- | Australian dollar+type instance I.Scale "AUD" "AUD" = '(100, 1)+type instance I.Scale "AUD" "dollar" = '(1, 1)+type instance I.Scale "AUD" "cent" = '(100, 1)+-- | Aruban florin+type instance I.Scale "AWG" "AWG" = '(100, 1)+type instance I.Scale "AWG" "florin" = '(1, 1)+type instance I.Scale "AWG" "cent" = '(100, 1)+-- | Azerbaijani manat+type instance I.Scale "AZN" "AZN" = '(100, 1)+type instance I.Scale "AZN" "manat" = '(1, 1)+type instance I.Scale "AZN" "qapik" = '(100, 1)+-- | Bosnia and Herzegovina convertible mark+type instance I.Scale "BAM" "BAM" = '(100, 1)+type instance I.Scale "BAM" "mark" = '(1, 1)+type instance I.Scale "BAM" "fening" = '(100, 1)+-- | Barbadian dollar+type instance I.Scale "BBD" "BBD" = '(100, 1)+type instance I.Scale "BBD" "dollar" = '(1, 1)+type instance I.Scale "BBD" "cent" = '(100, 1)+-- | Bangladeshi taka+type instance I.Scale "BDT" "BDT" = '(100, 1)+type instance I.Scale "BDT" "taka" = '(1, 1)+type instance I.Scale "BDT" "paisa" = '(100, 1)+-- | Bulgarian lev+type instance I.Scale "BGN" "BGN" = '(100, 1)+type instance I.Scale "BGN" "lev" = '(1, 1)+type instance I.Scale "BGN" "stotinka" = '(100, 1)+-- | Bahraini dinar+type instance I.Scale "BHD" "BHD" = '(1000, 1)+type instance I.Scale "BHD" "dinar" = '(1, 1)+type instance I.Scale "BHD" "fils" = '(1000, 1)+-- | Burundi franc+type instance I.Scale "BIF" "BIF" = '(100, 1)+type instance I.Scale "BIF" "franc" = '(1, 1)+type instance I.Scale "BIF" "centime" = '(100, 1)+-- | Bermudian dollar+type instance I.Scale "BMD" "BMD" = '(100, 1)+type instance I.Scale "BMD" "dollar" = '(1, 1)+type instance I.Scale "BMD" "cent" = '(100, 1)+-- | Brunei dollar+type instance I.Scale "BND" "BND" = '(100, 1)+type instance I.Scale "BND" "dollar" = '(1, 1)+type instance I.Scale "BND" "sen" = '(100, 1)+-- | Bolivian boliviano+type instance I.Scale "BOB" "BOB" = '(100, 1)+type instance I.Scale "BOB" "boliviano" = '(1, 1)+type instance I.Scale "BOB" "centavo" = '(100, 1)+-- | Bolivian Mvdol+type instance I.Scale "BOV" "BOV" = '(100, 1)+-- | Brazilian real+type instance I.Scale "BRL" "BRL" = '(100, 1)+type instance I.Scale "BRL" "real" = '(1, 1)+type instance I.Scale "BRL" "centavo" = '(100, 1)+-- | Bahamian dollar+type instance I.Scale "BSD" "BSD" = '(100, 1)+type instance I.Scale "BSD" "dollar" = '(1, 1)+type instance I.Scale "BSD" "cent" = '(1, 1)+-- | Bhutanese ngultrum+type instance I.Scale "BTN" "BTN" = '(100, 1)+type instance I.Scale "BTN" "ngultrum" = '(1, 1)+type instance I.Scale "BTN" "chetrum" = '(100, 1)+-- | Botswana pula+type instance I.Scale "BWP" "BWP" = '(100, 1)+type instance I.Scale "BWP" "pula" = '(1, 1)+type instance I.Scale "BWP" "thebe" = '(100, 1)+-- | Belarusian ruble+type instance I.Scale "BYN" "BYN" = '(100, 1)+-- | Belarusian ruble+type instance I.Scale "BYR" "BYR" = '(100, 1)+type instance I.Scale "BYR" "ruble" = '(1, 1)+type instance I.Scale "BYR" "kapyeyka" = '(100, 1)+-- | Belize dollar+type instance I.Scale "BZD" "BZD" = '(100, 1)+type instance I.Scale "BZD" "dollar" = '(1, 1)+type instance I.Scale "BZD" "cent" = '(100, 1)+-- | Canadian dollar+type instance I.Scale "CAD" "CAD" = '(100, 1)+type instance I.Scale "CAD" "dollar" = '(1, 1)+type instance I.Scale "CAD" "cent" = '(100, 1)+-- | Congolese franc+type instance I.Scale "CDF" "CDF" = '(100, 1)+type instance I.Scale "CDF" "franc" = '(1, 1)+type instance I.Scale "CDF" "centime" = '(100, 1)+-- | WIR euro+type instance I.Scale "CHE" "CHE" = '(100, 1)+-- | Swiss franc+type instance I.Scale "CHF" "CHF" = '(100, 1)+type instance I.Scale "CHF" "franc" = '(1, 1)+type instance I.Scale "CHF" "rappen" = '(100, 1)+-- | WIR franc+type instance I.Scale "CHW" "CHW" = '(100, 1)+-- | Chilean unidad de fomento+type instance I.Scale "CLF" "CLF" = '(100, 1)+-- | Chilean peso+type instance I.Scale "CLP" "CLP" = '(100, 1)+type instance I.Scale "CLP" "peso" = '(1, 1)+type instance I.Scale "CLP" "centavo" = '(100, 1)+-- | Chinese Renminbi+type instance I.Scale "CNY" "CNY" = '(100, 1)+type instance I.Scale "CNY" "yuan" = '(1, 1)+type instance I.Scale "CNY" "fen" = '(100, 1)+-- | Colombian peso+type instance I.Scale "COP" "COP" = '(100, 1)+type instance I.Scale "COP" "peso" = '(1, 1)+type instance I.Scale "COP" "centavo" = '(100, 1)+-- | Colombian unidad de valor real+type instance I.Scale "COU" "COU" = '(100, 1)+-- | Costa Rican colon+type instance I.Scale "CRC" "CRC" = '(100, 1)+type instance I.Scale "CRC" "colon" = '(1, 1)+type instance I.Scale "CRC" "centimo" = '(100, 1)+-- | Cuban peso convertible+type instance I.Scale "CUC" "CUC" = '(100, 1)+type instance I.Scale "CUC" "peso" = '(1, 1)+type instance I.Scale "CUC" "centavo" = '(100, 1)+-- | Cuban peso+type instance I.Scale "CUP" "CUP" = '(100, 1)+type instance I.Scale "CUP" "peso" = '(1, 1)+type instance I.Scale "CUP" "centavo" = '(100, 1)+-- | Cape Verdean escudo+type instance I.Scale "CVE" "CVE" = '(100, 1)+type instance I.Scale "CVE" "escudo" = '(1, 1)+type instance I.Scale "CVE" "centavo" = '(100, 1)+-- | Czech koruna+type instance I.Scale "CZK" "CZK" = '(100, 1)+type instance I.Scale "CZK" "koruna" = '(1, 1)+type instance I.Scale "CZK" "haler" = '(100, 1)+-- | Djiboutian franc+type instance I.Scale "DJF" "DJF" = '(100, 1)+type instance I.Scale "DJF" "franc" = '(1, 1)+type instance I.Scale "DJF" "centime" = '(100, 1)+-- | Danish krone+type instance I.Scale "DKK" "DKK" = '(100, 1)+type instance I.Scale "DKK" "krone" = '(1, 1)+type instance I.Scale "DKK" "ore" = '(100, 1)+-- | Dominican peso+type instance I.Scale "DOP" "DOP" = '(100, 1)+type instance I.Scale "DOP" "peso" = '(1, 1)+type instance I.Scale "DOP" "centavo" = '(100, 1)+-- | Algerian dinar+type instance I.Scale "DZD" "DZD" = '(100, 1)+type instance I.Scale "DZD" "dinar" = '(1, 1)+type instance I.Scale "DZD" "santeem" = '(100, 1)+-- | Egyptian pound+type instance I.Scale "EGP" "EGP" = '(100, 1)+type instance I.Scale "EGP" "pound" = '(1, 1)+type instance I.Scale "EGP" "piastre" = '(100, 1)+-- | Eritrean nakfa+type instance I.Scale "ERN" "ERN" = '(100, 1)+type instance I.Scale "ERN" "nafka" = '(1, 1)+type instance I.Scale "ERN" "cent" = '(100, 1)+-- | Ethiopian birr+type instance I.Scale "ETB" "ETB" = '(100, 1)+type instance I.Scale "ETB" "birr" = '(1, 1)+type instance I.Scale "ETB" "santim" = '(100, 1)+-- | European euro+type instance I.Scale "EUR" "EUR" = '(100, 1)+type instance I.Scale "EUR" "euro" = '(1, 1)+type instance I.Scale "EUR" "cent" = '(100, 1)+-- | Fijian dollar+type instance I.Scale "FJD" "FJD" = '(100, 1)+-- | Falkland Islands pound+type instance I.Scale "FKP" "FKP" = '(100, 1)+type instance I.Scale "FKP" "pound" = '(1, 1)+type instance I.Scale "FKP" "penny" = '(100, 1)+-- | Pound sterling+type instance I.Scale "GBP" "GBP" = '(100, 1)+type instance I.Scale "GBP" "pound" = '(1, 1)+type instance I.Scale "GBP" "penny" = '(100, 1)+-- | Georgian lari+type instance I.Scale "GEL" "GEL" = '(100, 1)+type instance I.Scale "GEL" "lari" = '(1, 1)+type instance I.Scale "GEL" "tetri" = '(100, 1)+-- | Ghanaian cedi+type instance I.Scale "GHS" "GHS" = '(100, 1)+type instance I.Scale "GHS" "cedi" = '(1, 1)+type instance I.Scale "GHS" "pesewa" = '(100, 1)+-- | Gibraltar pound+type instance I.Scale "GIP" "GIP" = '(100, 1)+type instance I.Scale "GIP" "pound" = '(1, 1)+type instance I.Scale "GIP" "penny" = '(100, 1)+-- | Gambian dalasi+type instance I.Scale "GMD" "GMD" = '(100, 1)+type instance I.Scale "GMD" "dalasi" = '(1, 1)+type instance I.Scale "GMD" "butut" = '(100, 1)+-- | Guinean franc+type instance I.Scale "GNF" "GNF" = '(100, 1)+type instance I.Scale "GNF" "franc" = '(1, 1)+type instance I.Scale "GNF" "centime" = '(100, 1)+-- | Guatemalan quetzal+type instance I.Scale "GTQ" "GTQ" = '(100, 1)+type instance I.Scale "GTQ" "quetzal" = '(1, 1)+type instance I.Scale "GTQ" "centavo" = '(100, 1)+-- | Guyanese dollar+type instance I.Scale "GYD" "GYD" = '(100, 1)+type instance I.Scale "GYD" "dollar" = '(1, 1)+type instance I.Scale "GYD" "cent" = '(100, 1)+-- | Hong Kong dollar+type instance I.Scale "HKD" "HKD" = '(100, 1)+type instance I.Scale "HKD" "dollar" = '(1, 1)+type instance I.Scale "HKD" "cent" = '(100, 1)+-- | Honduran lempira+type instance I.Scale "HNL" "HNL" = '(100, 1)+type instance I.Scale "HNL" "lempira" = '(1, 1)+type instance I.Scale "HNL" "centavo" = '(100, 1)+-- | Croatian kuna+type instance I.Scale "HRK" "HRK" = '(100, 1)+type instance I.Scale "HRK" "kuna" = '(1, 1)+type instance I.Scale "HRK" "lipa" = '(100, 1)+-- | Haitian gourde+type instance I.Scale "HTG" "HTG" = '(100, 1)+type instance I.Scale "HTG" "gourde" = '(1, 1)+type instance I.Scale "HTG" "centime" = '(1, 1)+-- | Hungarian forint+type instance I.Scale "HUF" "HUF" = '(100, 1)+type instance I.Scale "HUF" "forint" = '(1, 1)+type instance I.Scale "HUF" "filler" = '(100, 1)+-- | Indonesian rupiah+type instance I.Scale "IDR" "IDR" = '(100, 1)+type instance I.Scale "IDR" "rupiah" = '(1, 1)+type instance I.Scale "IDR" "sen" = '(100, 1)+-- | Israeli new shekel+type instance I.Scale "ILS" "ILS" = '(100, 1)+type instance I.Scale "ILS" "shekel" = '(1, 1)+type instance I.Scale "ILS" "agora" = '(100, 1)+-- | Indian rupee+type instance I.Scale "INR" "INR" = '(100, 1)+type instance I.Scale "INR" "rupee" = '(1, 1)+type instance I.Scale "INR" "paisa" = '(100, 1)+-- | Iraqi dinar+type instance I.Scale "IQD" "IQD" = '(1000, 1)+type instance I.Scale "IQD" "dinar" = '(1, 1)+type instance I.Scale "IQD" "fils" = '(1000, 1)+-- | Iranian rial+type instance I.Scale "IRR" "IRR" = '(100, 1)+type instance I.Scale "IRR" "rial" = '(1, 1)+type instance I.Scale "IRR" "dinar" = '(100, 1)+-- | Icelandic króna+type instance I.Scale "ISK" "ISK" = '(100, 1)+type instance I.Scale "ISK" "krona" = '(1, 1)+type instance I.Scale "ISK" "eyrir" = '(100, 1)+-- | Jamaican dollar+type instance I.Scale "JMD" "JMD" = '(100, 1)+type instance I.Scale "JMD" "dollar" = '(1, 1)+type instance I.Scale "JMD" "cent" = '(100, 1)+-- | Jordanian dinar+type instance I.Scale "JOD" "JOD" = '(100, 1)+type instance I.Scale "JOD" "dinar" = '(1, 1)+type instance I.Scale "JOD" "piastre" = '(100, 1)+-- | Japanese yen+type instance I.Scale "JPY" "JPY" = '(100, 1)+type instance I.Scale "JPY" "yen" = '(1, 1)+type instance I.Scale "JPY" "sen" = '(100, 1)+-- | Kenyan shilling+type instance I.Scale "KES" "KES" = '(100, 1)+type instance I.Scale "KES" "shilling" = '(1, 1)+type instance I.Scale "KES" "cent" = '(100, 1)+-- | Kyrgyzstani som+type instance I.Scale "KGS" "KGS" = '(100, 1)+type instance I.Scale "KGS" "som" = '(1, 1)+type instance I.Scale "KGS" "tyiyn" = '(100, 1)+-- | Cambodian riel+type instance I.Scale "KHR" "KHR" = '(100, 1)+type instance I.Scale "KHR" "riel" = '(1, 1)+type instance I.Scale "KHR" "sen" = '(100, 1)+-- | Comorian franc+type instance I.Scale "KMF" "KMF" = '(100, 1)+type instance I.Scale "KMF" "franc" = '(1, 1)+type instance I.Scale "KMF" "centime" = '(100, 1)+-- | North Korean won+type instance I.Scale "KPW" "KPW" = '(100, 1)+type instance I.Scale "KPW" "won" = '(1, 1)+type instance I.Scale "KPW" "chon" = '(100, 1)+-- | South Korean won+type instance I.Scale "KRW" "KRW" = '(100, 1)+type instance I.Scale "KRW" "won" = '(1, 1)+type instance I.Scale "KRW" "jeon" = '(100, 1)+-- | Kuwaiti dinar+type instance I.Scale "KWD" "KWD" = '(1000, 1)+type instance I.Scale "KWD" "dinar" = '(1, 1)+type instance I.Scale "KWD" "fils" = '(1000, 1)+-- | Cayman Islands dollar+type instance I.Scale "KYD" "KYD" = '(100, 1)+type instance I.Scale "KYD" "dollar" = '(1, 1)+type instance I.Scale "KYD" "cent" = '(100, 1)+-- | Kazakhstani tenge+type instance I.Scale "KZT" "KZT" = '(100, 1)+type instance I.Scale "KZT" "tenge" = '(1, 1)+type instance I.Scale "KZT" "tiyin" = '(100, 1)+-- | Lao kip+type instance I.Scale "LAK" "LAK" = '(100, 1)+type instance I.Scale "LAK" "kip" = '(1, 1)+type instance I.Scale "LAK" "att" = '(100, 1)+-- | Lebanese pound+type instance I.Scale "LBP" "LBP" = '(100, 1)+type instance I.Scale "LBP" "pound" = '(1, 1)+type instance I.Scale "LBP" "piastre" = '(100, 1)+-- | Sri Lankan rupee+type instance I.Scale "LKR" "LKR" = '(100, 1)+type instance I.Scale "LKR" "rupee" = '(1, 1)+type instance I.Scale "LKR" "cent" = '(100, 1)+-- | Liberian dollar+type instance I.Scale "LRD" "LRD" = '(100, 1)+type instance I.Scale "LRD" "dollar" = '(1, 1)+type instance I.Scale "LRD" "cent" = '(100, 1)+-- | Lesotho loti+type instance I.Scale "LSL" "LSL" = '(100, 1)+type instance I.Scale "LSL" "loti" = '(1, 1)+type instance I.Scale "LSL" "sente" = '(100, 1)+-- | Libyan dinar+type instance I.Scale "LYD" "LYD" = '(100, 1)+type instance I.Scale "LYD" "dinar" = '(1, 1)+type instance I.Scale "LYD" "dirham" = '(1000, 1)+-- | Moroccan dirham+type instance I.Scale "MAD" "MAD" = '(100, 1)+type instance I.Scale "MAD" "dirham" = '(1, 1)+type instance I.Scale "MAD" "centime" = '(100, 1)+-- | Moldovan leu+type instance I.Scale "MDL" "MDL" = '(100, 1)+type instance I.Scale "MDL" "leu" = '(100, 1)+type instance I.Scale "MDL" "ban" = '(100, 1)+-- | Malagasy ariary+type instance I.Scale "MGA" "MGA" = '(5, 1)+type instance I.Scale "MGA" "ariary" = '(1, 1)+type instance I.Scale "MGA" "iraimbilanja" = '(5, 1)+-- | Macedonian denar+type instance I.Scale "MKD" "MKD" = '(100, 1)+type instance I.Scale "MKD" "denar" = '(1, 1)+type instance I.Scale "MKD" "deni" = '(100, 1)+-- | Myanmar kyat+type instance I.Scale "MMK" "MMK" = '(100, 1)+type instance I.Scale "MMK" "kyat" = '(1, 1)+type instance I.Scale "MMK" "pya" = '(100, 1)+-- | Mongolian tugrik+type instance I.Scale "MNT" "MNT" = '(100, 1)+type instance I.Scale "MNT" "tugrik" = '(1, 1)+type instance I.Scale "MNT" "mongo" = '(100, 1)+-- | Macanese pataca+type instance I.Scale "MOP" "MOP" = '(100, 1)+type instance I.Scale "MOP" "pataca" = '(1, 1)+type instance I.Scale "MOP" "avo" = '(100, 1)+-- | Mauritanian ouguiya+type instance I.Scale "MRO" "MRO" = '(5, 1)+type instance I.Scale "MRO" "ouguiya" = '(1, 1)+type instance I.Scale "MRO" "khoums" = '(5, 1)+-- | Mauritian rupee+type instance I.Scale "MUR" "MUR" = '(100, 1)+type instance I.Scale "MUR" "rupee" = '(1, 1)+type instance I.Scale "MUR" "cent" = '(100, 1)+-- | Maldivian rufiyaa+type instance I.Scale "MVR" "MVR" = '(100, 1)+type instance I.Scale "MVR" "rufiyaa" = '(1, 1)+type instance I.Scale "MVR" "laari" = '(100, 1)+-- | Malawian kwacha+type instance I.Scale "MWK" "MWK" = '(100, 1)+type instance I.Scale "MWK" "kwacha" = '(1, 1)+type instance I.Scale "MWK" "tambala" = '(100, 1)+-- | Mexican peso+type instance I.Scale "MXN" "MXN" = '(100, 1)+type instance I.Scale "MXN" "peso" = '(1, 1)+type instance I.Scale "MXN" "centavo" = '(100, 1)+-- | Mexican unidad de inversion+type instance I.Scale "MXV" "MXV" = '(100, 1)+-- | Malaysian ringgit+type instance I.Scale "MYR" "MYR" = '(100, 1)+type instance I.Scale "MYR" "ringgit" = '(1, 1)+type instance I.Scale "MYR" "sen" = '(100, 1)+-- | Mozambican metical+type instance I.Scale "MZN" "MZN" = '(100, 1)+type instance I.Scale "MZN" "metical" = '(1, 1)+type instance I.Scale "MZN" "centavo" = '(100, 1)+-- | Namibian dollar+type instance I.Scale "NAD" "NAD" = '(100, 1)+type instance I.Scale "NAD" "dollar" = '(1, 1)+type instance I.Scale "NAD" "cent" = '(100, 1)+-- | Nigerian naira+type instance I.Scale "NGN" "NGN" = '(100, 1)+type instance I.Scale "NGN" "naira" = '(1, 1)+type instance I.Scale "NGN" "kobo" = '(100, 1)+-- | Nicaraguan cordoba+type instance I.Scale "NIO" "NIO" = '(100, 1)+type instance I.Scale "NIO" "cordoba" = '(1, 1)+type instance I.Scale "NIO" "centavo" = '(100, 1)+-- | Norwegian krone+type instance I.Scale "NOK" "NOK" = '(100, 1)+type instance I.Scale "NOK" "krone" = '(1, 1)+type instance I.Scale "NOK" "ore" = '(100, 1)+-- | Nepalese rupee+type instance I.Scale "NPR" "NPR" = '(100, 1)+type instance I.Scale "NPR" "rupee" = '(1, 1)+type instance I.Scale "NPR" "paisa" = '(100, 1)+-- | New Zealand dollar+type instance I.Scale "NZD" "NZD" = '(100, 1)+type instance I.Scale "NZD" "dollar" = '(1, 1)+type instance I.Scale "NZD" "cent" = '(100, 1)+-- | Omani rial+type instance I.Scale "OMR" "OMR" = '(1000, 1)+type instance I.Scale "OMR" "rial" = '(1, 1)+type instance I.Scale "OMR" "baisa" = '(1000, 1)+-- | Panamenian balboa+type instance I.Scale "PAB" "PAB" = '(100, 1)+type instance I.Scale "PAB" "balboa" = '(1, 1)+type instance I.Scale "PAB" "centesimo" = '(100, 1)+-- | Peruvian sol+type instance I.Scale "PEN" "PEN" = '(100, 1)+type instance I.Scale "PEN" "sol" = '(1, 1)+type instance I.Scale "PEN" "centimo" = '(100, 1)+-- | Papua New Guinean kina+type instance I.Scale "PGK" "PGK" = '(100, 1)+type instance I.Scale "PGK" "kina" = '(1, 1)+type instance I.Scale "PGK" "toea" = '(100, 1)+-- | Philippine peso+type instance I.Scale "PHP" "PHP" = '(100, 1)+type instance I.Scale "PHP" "peso" = '(1, 1)+type instance I.Scale "PHP" "centavo" = '(100, 1)+-- | Pakistani rupee+type instance I.Scale "PKR" "PKR" = '(100, 1)+type instance I.Scale "PKR" "rupee" = '(1, 1)+type instance I.Scale "PKR" "paisa" = '(100, 1)+-- | Polish zloty+type instance I.Scale "PLN" "PLN" = '(100, 1)+type instance I.Scale "PLN" "zloty" = '(1, 1)+type instance I.Scale "PLN" "grosz" = '(100, 1)+-- | Paraguayan guarani+type instance I.Scale "PYG" "PYG" = '(100, 1)+type instance I.Scale "PYG" "guarani" = '(1, 1)+type instance I.Scale "PYG" "centimo" = '(100, 1)+-- | Qatari riyal+type instance I.Scale "QAR" "QAR" = '(100, 1)+type instance I.Scale "QAR" "riyal" = '(1, 1)+type instance I.Scale "QAR" "dirham" = '(100, 1)+-- | Romanian leu+type instance I.Scale "RON" "RON" = '(100, 1)+type instance I.Scale "RON" "leu" = '(1, 1)+type instance I.Scale "RON" "ban" = '(100, 1)+-- | Serbian dinar+type instance I.Scale "RSD" "RSD" = '(100, 1)+type instance I.Scale "RSD" "dinar" = '(1, 1)+type instance I.Scale "RSD" "para" = '(100, 1)+-- | Russian ruble+type instance I.Scale "RUB" "RUB" = '(100, 1)+type instance I.Scale "RUB" "ruble" = '(1, 1)+type instance I.Scale "RUB" "kopek" = '(100, 1)+-- | Rwandan franc+type instance I.Scale "RWF" "RWF" = '(100, 1)+type instance I.Scale "RWF" "franc" = '(1, 1)+type instance I.Scale "RWF" "centime" = '(100, 1)+-- | Saudi Arabian riyal+type instance I.Scale "SAR" "SAR" = '(100, 1)+type instance I.Scale "SAR" "riyal" = '(1, 1)+type instance I.Scale "SAR" "halala" = '(100, 1)+-- | Solomon Islands dollar+type instance I.Scale "SBD" "SBD" = '(100, 1)+type instance I.Scale "SBD" "dollar" = '(100, 1)+type instance I.Scale "SBD" "cent" = '(100, 1)+-- | Seychellois rupee+type instance I.Scale "SCR" "SCR" = '(100, 1)+type instance I.Scale "SCR" "rupee" = '(1, 1)+type instance I.Scale "SCR" "cent" = '(100, 1)+-- | Sudanese pound+type instance I.Scale "SDG" "SDG" = '(100, 1)+type instance I.Scale "SDG" "pound" = '(1, 1)+type instance I.Scale "SDG" "piastre" = '(100, 1)+-- | Swedish krona+type instance I.Scale "SEK" "SEK" = '(100, 1)+type instance I.Scale "SEK" "krona" = '(1, 1)+type instance I.Scale "SEK" "ore" = '(100, 1)+-- | Singapore dollar+type instance I.Scale "SGD" "SGD" = '(100, 1)+type instance I.Scale "SGD" "dollar" = '(1, 1)+type instance I.Scale "SGD" "cent" = '(100, 1)+-- | Saint Helena pound+type instance I.Scale "SHP" "SHP" = '(100, 1)+type instance I.Scale "SHP" "pound" = '(1, 1)+type instance I.Scale "SHP" "penny" = '(100, 1)+-- | Sierra Leonean leone+type instance I.Scale "SLL" "SLL" = '(100, 1)+type instance I.Scale "SLL" "leone" = '(1, 1)+type instance I.Scale "SLL" "cent" = '(100, 1)+-- | Somali shilling+type instance I.Scale "SOS" "SOS" = '(100, 1)+type instance I.Scale "SOS" "shilling" = '(1, 1)+type instance I.Scale "SOS" "cent" = '(100, 1)+-- | Surinamese dollar+type instance I.Scale "SRD" "SRD" = '(100, 1)+type instance I.Scale "SRD" "dollar" = '(1, 1)+type instance I.Scale "SRD" "cent" = '(100, 1)+-- | South Sudanese pound+type instance I.Scale "SSP" "SSP" = '(100, 1)+type instance I.Scale "SSP" "pound" = '(1, 1)+type instance I.Scale "SSP" "piastre" = '(100, 1)+-- | Sao Tome and Principe dobra+type instance I.Scale "STD" "STD" = '(100, 1)+type instance I.Scale "STD" "dobra" = '(1, 1)+type instance I.Scale "STD" "centimo" = '(100, 1)+-- | Salvadoran colon+type instance I.Scale "SVC" "SVC" = '(100, 1)+type instance I.Scale "SVC" "colon" = '(1, 1)+type instance I.Scale "SVC" "centavo" = '(100, 1)+-- | Syrian pound+type instance I.Scale "SYP" "SYP" = '(100, 1)+type instance I.Scale "SYP" "pound" = '(1, 1)+type instance I.Scale "SYP" "piastre" = '(100, 1)+-- | Swazi lilangeni+type instance I.Scale "SZL" "SZL" = '(100, 1)+type instance I.Scale "SZL" "lilangeni" = '(1, 1)+type instance I.Scale "SZL" "cent" = '(100, 1)+-- | Thai baht+type instance I.Scale "THB" "THB" = '(100, 1)+type instance I.Scale "THB" "baht" = '(1, 1)+type instance I.Scale "THB" "satang" = '(100, 1)+-- | Tajikistani somoni+type instance I.Scale "TJS" "TJS" = '(100, 1)+type instance I.Scale "TJS" "somoni" = '(1, 1)+type instance I.Scale "TJS" "diram" = '(100, 1)+-- | Turkmen manat+type instance I.Scale "TMT" "TMT" = '(100, 1)+type instance I.Scale "TMT" "manat" = '(1, 1)+type instance I.Scale "TMT" "tennesi" = '(100, 1)+-- | Tunisian dinar+type instance I.Scale "TND" "TND" = '(1000, 1)+type instance I.Scale "TND" "dinar" = '(1, 1)+type instance I.Scale "TND" "millime" = '(1000, 1)+-- | Tongan pa’anga+type instance I.Scale "TOP" "TOP" = '(100, 1)+type instance I.Scale "TOP" "pa'anga" = '(1, 1)+type instance I.Scale "TOP" "seniti" = '(100, 1)+-- | Turkish lira+type instance I.Scale "TRY" "TRY" = '(100, 1)+type instance I.Scale "TRY" "lira" = '(1, 1)+type instance I.Scale "TRY" "kurus" = '(100, 1)+-- | Tobago Trinidad and Tobago dollar+type instance I.Scale "TTD" "TTD" = '(100, 1)+type instance I.Scale "TTD" "dollar" = '(1, 1)+type instance I.Scale "TTD" "cent" = '(100, 1)+-- | New Taiwan dollar+type instance I.Scale "TWD" "TWD" = '(100, 1)+type instance I.Scale "TWD" "dollar" = '(1, 1)+type instance I.Scale "TWD" "cent" = '(100, 1)+-- | Tanzanian shilling+type instance I.Scale "TZS" "TZS" = '(100, 1)+type instance I.Scale "TZS" "shilling" = '(1, 1)+type instance I.Scale "TZS" "cent" = '(100, 1)+-- | Ukrainian hryvnia+type instance I.Scale "UAH" "UAH" = '(100, 1)+type instance I.Scale "UAH" "hryvnia" = '(1, 1)+type instance I.Scale "UAH" "kopiyka" = '(100, 1)+-- | Ugandan shilling+type instance I.Scale "UGX" "UGX" = '(100, 1)+type instance I.Scale "UGX" "shilling" = '(1, 1)+type instance I.Scale "UGX" "cent" = '(100, 1)+-- | United States dollar+type instance I.Scale "USD" "USD" = '(100, 1)+type instance I.Scale "USD" "dollar" = '(1, 1)+type instance I.Scale "USD" "cent" = '(100, 1)+-- | United States dollar (next day)+type instance I.Scale "USN" "USN" = '(100, 1)+-- | Uruguayan peso en unidades+type instance I.Scale "UYI" "UYI" = '(100, 1)+-- | Uruguayan peso+type instance I.Scale "UYU" "UYU" = '(100, 1)+type instance I.Scale "UYU" "peso" = '(1, 1)+type instance I.Scale "UYU" "centesimo" = '(100, 1)+-- | Uzbekistani som+type instance I.Scale "UZS" "UZS" = '(100, 1)+type instance I.Scale "UZS" "som" = '(1, 1)+type instance I.Scale "UZS" "tiyin" = '(100, 1)+-- | Venezuelan bolivar+type instance I.Scale "VEF" "VEF" = '(100, 1)+type instance I.Scale "VEF" "bolivar" = '(1, 1)+type instance I.Scale "VEF" "centimo" = '(100, 1)+-- | Vietnamese dong+type instance I.Scale "VND" "VND" = '(10, 1)+type instance I.Scale "VND" "dong" = '(1, 1)+type instance I.Scale "VND" "hao" = '(10, 1)+-- | Vanuatu vatu+type instance I.Scale "VUV" "VUV" = '(1, 1)+type instance I.Scale "VUV" "vatu" = '(1, 1)+-- | Samoan tālā+type instance I.Scale "WST" "WST" = '(100, 1)+type instance I.Scale "WST" "tala" = '(1, 1)+type instance I.Scale "WST" "sene" = '(100, 1)+-- | Central African CFA franc+type instance I.Scale "XAF" "XAF" = '(100, 1)+type instance I.Scale "XAF" "franc" = '(1, 1)+type instance I.Scale "XAF" "centime" = '(100, 1)+-- | East Caribbean dollar+type instance I.Scale "XCD" "XCD" = '(100, 1)+type instance I.Scale "XCD" "dollar" = '(1, 1)+type instance I.Scale "XCD" "cent" = '(100, 1)+-- | International Monetary Fund Special Drawing Right+type instance I.Scale "XDR" "XDR" = '(100, 1)+-- | West African CFA franc+type instance I.Scale "XOF" "XOF" = '(100, 1)+type instance I.Scale "XOF" "franc" = '(1, 1)+type instance I.Scale "XOF" "centime" = '(100, 1)+-- | CFP franc+type instance I.Scale "XPF" "XPF" = '(100, 1)+type instance I.Scale "XPF" "franc" = '(1, 1)+type instance I.Scale "XPF" "centime" = '(100, 1)+-- | Sucre+type instance I.Scale "XSU" "XSU" = '(100, 1)+-- | African Development Bank unit of account+type instance I.Scale "XUA" "XUA" = '(100, 1)+-- | Yemeni rial+type instance I.Scale "YER" "YER" = '(100, 1)+type instance I.Scale "YER" "rial" = '(1, 1)+type instance I.Scale "YER" "fils" = '(100, 1)+-- | South African rand+type instance I.Scale "ZAR" "ZAR" = '(100, 1)+type instance I.Scale "ZAR" "rand" = '(1, 1)+type instance I.Scale "ZAR" "cent" = '(100, 1)+-- | Zambian kwacha+type instance I.Scale "ZMW" "ZMW" = '(100, 1)+type instance I.Scale "ZMW" "kwacha" = '(1, 1)+type instance I.Scale "ZMW" "ngwee" = '(100, 1)+-- | Zimbawe dollar+type instance I.Scale "ZWL" "ZWL" = '(100, 1)+type instance I.Scale "ZWL" "dollar" = '(1, 1)+type instance I.Scale "ZWL" "cent" = '(100, 1)++-- | Gold. No canonical smallest unit. Unusable instance.+type instance I.Scale "XAU" "XAU" = I.ErrScaleNonCanonical "XAU"+type instance I.Scale "XAU" "troy-ounce" = '(1, 1)+type instance I.Scale "XAU" "grain" = '(480, 1)+type instance I.Scale "XAU" "milligrain" = '(480000, 1)+type instance I.Scale "XAU" "micrograin" = '(480000000, 1)+type instance I.Scale "XAU" "kilogram" = '(31103477, 1000000000)+type instance I.Scale "XAU" "gram" = '(31103477, 1000000)+type instance I.Scale "XAU" "milligram" = '(31103477, 1000)+type instance I.Scale "XAU" "microgram" = '(31103477, 1)++-- | Silver. No canonical smallest unit. Unusable instance.+type instance I.Scale "XAG" "XAG" = I.ErrScaleNonCanonical "XAG"+type instance I.Scale "XAG" "troy-ounce" = '(1, 1)+type instance I.Scale "XAG" "grain" = '(480, 1)+type instance I.Scale "XAG" "milligrain" = '(480000, 1)+type instance I.Scale "XAG" "micrograin" = '(480000000, 1)+type instance I.Scale "XAG" "kilogram" = '(31103477, 1000000000)+type instance I.Scale "XAG" "gram" = '(31103477, 1000000)+type instance I.Scale "XAG" "milligram" = '(31103477, 1000)+type instance I.Scale "XAG" "microgram" = '(31103477, 1)++-- | Palladium. No canonical smallest unit. Unusable instance.+type instance I.Scale "XPD" "XPD" = I.ErrScaleNonCanonical "XPD"+type instance I.Scale "XPD" "troy-ounce" = '(1, 1)+type instance I.Scale "XPD" "grain" = '(480, 1)+type instance I.Scale "XPD" "milligrain" = '(480000, 1)+type instance I.Scale "XPD" "micrograin" = '(480000000, 1)+type instance I.Scale "XPD" "kilogram" = '(31103477, 1000000000)+type instance I.Scale "XPD" "gram" = '(31103477, 1000000)+type instance I.Scale "XPD" "milligram" = '(31103477, 1000)+type instance I.Scale "XPD" "microgram" = '(31103477, 1)++-- | Platinum. No canonical smallest unit. Unusable instance.+type instance I.Scale "XPT" "XPT" = I.ErrScaleNonCanonical "XPT"+type instance I.Scale "XPT" "troy-ounce" = '(1, 1)+type instance I.Scale "XPT" "grain" = '(480, 1)+type instance I.Scale "XPT" "milligrain" = '(480000, 1)+type instance I.Scale "XPT" "micrograin" = '(480000000, 1)+type instance I.Scale "XPT" "kilogram" = '(31103477, 1000000000)+type instance I.Scale "XPT" "gram" = '(31103477, 1000000)+type instance I.Scale "XPT" "milligram" = '(31103477, 1000)+type instance I.Scale "XPT" "microgram" = '(31103477, 1)++-- | Bitcoin+type instance I.Scale "BTC" "BTC" = '(100000000, 1)+type instance I.Scale "BTC" "bitcoin" = '(1, 1)+type instance I.Scale "BTC" "satoshi" = '(100000000, 1)++-- | Bitcoin+type instance I.Scale "XBT" "XBT" = '(100000000, 1)+type instance I.Scale "XBT" "bitcoin" = '(1, 1)+type instance I.Scale "XBT" "satoshi" = '(100000000, 1)++-- | Ether+type instance I.Scale "ETH" "ETH" = '(1000000000000000000, 1)+type instance I.Scale "ETH" "ether" = '(1, 1)+type instance I.Scale "ETH" "kwei" = '(1000, 1)+type instance I.Scale "ETH" "babbage" = '(1000, 1)+type instance I.Scale "ETH" "mwei" = '(1000000, 1)+type instance I.Scale "ETH" "lovelace" = '(1000000, 1)+type instance I.Scale "ETH" "gwei" = '(1000000000, 1)+type instance I.Scale "ETH" "shannon" = '(1000000000, 1)+type instance I.Scale "ETH" "microether" = '(1000000000000, 1)+type instance I.Scale "ETH" "szabo" = '(1000000000000, 1)+type instance I.Scale "ETH" "finney" = '(1000000000000000, 1)+type instance I.Scale "ETH" "milliether" = '(1000000000000000, 1)+type instance I.Scale "ETH" "wei" = '(1000000000000000000, 1)
+ src/Money/Internal.hs view
@@ -0,0 +1,1188 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++#if MIN_VERSION_base(4,9,0)+{-# OPTIONS_GHC -Wno-redundant-constraints #-}+#endif++-- | This is an internal module. Import "Money" instead.+module Money.Internal+ ( -- * Dense monetary values+ Dense+ , dense+ -- * Discrete monetary values+ , Discrete+ , Discrete'+ , fromDiscrete+ , round+ , ceiling+ , floor+ , truncate+ -- * Currency scales+ , Scale+ , GoodScale+ , ErrScaleNonCanonical+ , scale+ -- * Currency exchange+ , ExchangeRate+ , exchangeRate+ , fromExchangeRate+ , flipExchangeRate+ , exchange+ -- * Serializable representations+ , DenseRep+ , toDenseRep+ , mkDenseRep+ , fromDenseRep+ , withDenseRep+ , denseRepCurrency+ , denseRepAmount+ , denseRepAmountNumerator+ , denseRepAmountDenominator+ , DiscreteRep+ , toDiscreteRep+ , mkDiscreteRep+ , fromDiscreteRep+ , withDiscreteRep+ , discreteRepCurrency+ , discreteRepScale+ , discreteRepScaleNumerator+ , discreteRepScaleDenominator+ , discreteRepAmount+ , ExchangeRateRep+ , toExchangeRateRep+ , mkExchangeRateRep+ , fromExchangeRateRep+ , withExchangeRateRep+ , exchangeRateRepSrcCurrency+ , exchangeRateRepDstCurrency+ , exchangeRateRepRate+ , exchangeRateRepRateNumerator+ , exchangeRateRepRateDenominator+ ) where++import Control.Applicative (empty)+import Control.Monad ((<=<))+import Data.Constraint (Dict(Dict))+import Data.Proxy (Proxy(..))+import Data.Ratio ((%), numerator, denominator)+import qualified GHC.Generics as GHC+import GHC.Real (infinity, notANumber)+import GHC.TypeLits+ (Symbol, SomeSymbol(..), Nat, SomeNat(..), CmpNat, KnownSymbol, KnownNat,+ natVal, someNatVal, symbolVal, someSymbolVal)+import Prelude hiding (round, ceiling, floor, truncate)+import qualified Prelude+import qualified Text.ParserCombinators.ReadPrec as ReadPrec+import qualified Text.ParserCombinators.ReadP as ReadP+import Text.Read (readPrec)+import Unsafe.Coerce (unsafeCoerce)++#ifdef VERSION_aeson+import qualified Data.Aeson as Ae+#endif++#ifdef VERSION_binary+import qualified Data.Binary as Binary+#endif++#ifdef VERSION_cereal+import qualified Data.Serialize as Cereal+#endif++#ifdef VERSION_deepseq+import Control.DeepSeq (NFData)+#endif++#ifdef VERSION_hashable+import Data.Hashable (Hashable)+#endif++#ifdef VERSION_store+import qualified Data.Store as Store+#endif++#if MIN_VERSION_base(4,9,0)+import qualified GHC.TypeLits as GHC+#endif++--------------------------------------------------------------------------------+-- | '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, 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 eventually multiply @USD 1.705@+-- by @4@, for example, 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+-- aproximate a 'Dense' value to a 'Discrete' value you can use one of+-- 'round', 'floor', 'ceiling' or 'truncate'. Otherwise, using 'toRational' you+-- can obtain a precise 'Rational' representation.+--+-- Construct 'Dense' monetary values using 'dense', or+-- 'fromInteger' / 'fromIntegral' if that suffices.+--+-- /WARNING/ if you want to treat a dense monetary value as a /Real/ number (for+-- example, to take the square root of that monetary value), 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 (Eq, Ord, Num, Real, Fractional, GHC.Generic)++instance forall currency. KnownSymbol currency => Show (Dense currency) where+ show = \(Dense r0) ->+ let c = symbolVal (Proxy :: Proxy currency)+ in concat [ "Dense ", show c, " (", show r0, ")" ]++instance forall currency. KnownSymbol currency => Read (Dense currency) where+ readPrec = do+ let c = symbolVal (Proxy :: Proxy currency)+ _ <- ReadPrec.lift (ReadP.string ("Dense " ++ show c ++ " "))+ maybe empty pure =<< fmap dense 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)+-- @+--+-- This function returns 'Nothing' in case the given 'Rational' is 'infinity' or+-- 'notANumber'.+dense :: Rational -> Maybe (Dense currency)+dense = \r0 ->+ if (infinity == r0 || notANumber == r0)+ then Nothing else Just (Dense r0)+{-# INLINABLE dense #-}++-- | '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 'fromInteger'.+--+-- 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., @'Scale' \"GBP\" ~ '(100, 1)@), then you can+-- use:+--+-- @+-- 'fromInteger' 2105 :: Discrete \"GBP\" \"penny\"+-- @+--+-- Because @2015 / 100 == 20.15@.+type Discrete (currency :: Symbol) (unit :: Symbol)+ = Discrete' currency (Scale currency unit)++-- | 'Discrete'' represents a discrete monetary value for a @currency@ expresed+-- as an 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 => Num (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)++instance forall currency scale.+ ( KnownSymbol currency, GoodScale scale+ ) => Show (Discrete' currency scale) where+ show = \d0@(Discrete i0) ->+ let c = symbolVal (Proxy :: Proxy currency)+ in concat [ "Discrete ", show c, " (", show (scale d0), ") ", show i0 ]++instance forall currency scale.+ ( KnownSymbol currency, GoodScale scale+ ) => Read (Discrete' currency scale) where+ readPrec = do+ let c = symbolVal (Proxy :: Proxy currency)+ s = scale (Proxy :: Proxy scale)+ _ <- ReadPrec.lift (ReadP.string+ ("Discrete " ++ show c ++ " (" ++ show s ++ ") ") )+ Discrete <$> readPrec++#if MIN_VERSION_base(4,9,0)+instance+ ( 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."))+ , GoodScale scale+ ) => Fractional (Discrete' currency scale) where+ fromRational = undefined+ recip = undefined+#endif++-- | Convert currency 'Discrete' monetary value into a 'Dense' monetary+-- value.+fromDiscrete+ :: GoodScale scale+ => Discrete' currency scale+ -> Dense currency -- ^+fromDiscrete = \c@(Discrete i) -> Dense (fromInteger i / scale c)+{-# INLINABLE fromDiscrete #-}++-- | Internal. Used to implement 'round', 'ceiling', 'floor' and 'truncate'.+roundf+ :: forall currency scale+ . GoodScale scale+ => (Rational -> Integer) -- ^ 'Prelude.round', 'Prelude.ceiling' or similar.+ -> Dense currency+ -> (Discrete' currency scale, Maybe (Dense currency))+roundf f = \c0 ->+ let !r0 = toRational c0 :: Rational+ !r1 = scale (Proxy :: Proxy scale)+ !i2 = f (r0 * r1) :: Integer+ !r2 = fromInteger i2 / r1 :: Rational+ !ycrest | r0 == r2 = Nothing+ | otherwise = Just (Dense (r0 - r2))+ !d2 = Discrete i2+ in (d2, ycrest)+{-# INLINABLE roundf #-}++-- | Round a 'Dense' value @x@ to the nearest value fully representable in+-- its @currency@'s @unit@ 'Scale', which might be @x@ itself.+--+-- If @x@ is already fully representable in its @currency@'s @unit@ 'Scale',+-- then the following holds:+--+-- @+-- 'round' x == (x, 'Nothing')+-- @+--+-- Otherwise, if the nearest value to @x@ that is fully representable in its+-- @currency@'s @unit@ 'Scale' is greater than @x@, then the following holds:+--+-- @+-- 'round' == 'ceiling'+-- @+--+-- Otherwise, the nearest value to @x@ that is fully representable in its+-- @currency@'s @unit@ 'Scale' is smaller than @x@, and the following holds:+--+-- @+-- 'round' == 'floor'+-- @+--+-- Proof that 'round' doesn't lose money:+--+-- @+-- x == case 'round' x of+-- (y, 'Nothing') -> y+-- (y, 'Just' z) -> y + z+-- @+round+ :: GoodScale scale+ => Dense currency+ -> (Discrete' currency scale, Maybe (Dense currency)) -- ^+round = roundf Prelude.round+{-# INLINABLE round #-}++-- | Round a 'Dense' value @x@ to the nearest value fully representable in+-- its @currency@'s @unit@ 'Scale' which is greater than @x@ or equal to @x@.+--+--+-- If @x@ is already fully representable in its @currency@'s @unit@ 'Scale',+-- then the following holds:+--+-- @+-- 'ceiling' x == (x, 'Nothing')+-- @+--+-- Otherwise, if @x@ is not representable in its @currency@'s @unit@ 'Scale',+-- then the following holds:+--+-- @+-- 'ceiling' x == (y, 'Just' z)+-- @+--+-- @+-- x /= y+-- @+--+-- @+-- z < 'zero'+-- @+--+-- Proof that 'ceiling' doesn't lose money:+--+-- @+-- x == case 'ceiling' x of+-- (y, 'Nothing') -> y+-- (y, 'Just' z) -> y + z+-- @+ceiling+ :: GoodScale scale+ => Dense currency+ -> (Discrete' currency scale, Maybe (Dense currency)) -- ^+ceiling = roundf Prelude.ceiling+{-# INLINABLE ceiling #-}++-- | Round a 'Dense' value @x@ to the nearest value fully representable in+-- its @currency@'s @unit@ 'Scale' which is smaller than @x@ or equal to @x@.+--+--+-- If @x@ is already fully representable in its @currency@'s @unit@ 'Scale',+-- then the following holds:+--+-- @+-- 'floor' x == (x, 'Nothing')+-- @+--+-- Otherwise, if @x@ is not representable in its @currency@'s @unit@ 'Scale',+-- then the following holds:+--+-- @+-- 'floor' x == (y, 'Just' z)+-- @+--+-- @+-- x /= y+-- @+--+-- @+-- z > 'zero'+-- @+--+-- Proof that 'floor' doesn't lose money:+--+-- @+-- x == case 'floor' x of+-- (y, 'Nothing') -> y+-- (y, 'Just' z) -> y + z+-- @+floor+ :: GoodScale scale+ => Dense currency+ -> (Discrete' currency scale, Maybe (Dense currency)) -- ^+floor = roundf Prelude.floor+{-# INLINABLE floor #-}++-- | Round a 'Dense' value @x@ to the nearest value between zero and+-- @x@ (inclusive) which is fully representable in its @currency@'s @unit@+-- 'Scale'.+--+-- If @x@ is already fully representable in its @currency@'s @unit@ 'Scale',+-- then the following holds:+--+-- @+-- 'truncate' x == (x, 'Nothing')+-- @+--+-- Otherwise, if @x@ is positive, then the following holds:+--+-- @+-- 'truncate' == 'floor'+-- @+--+-- Otherwise, if @x@ is negative, the following holds:+--+-- @+-- 'truncate' == 'ceiling'+-- @+--+-- Proof that 'truncate' doesn't lose money:+--+-- @+-- x == case 'truncate' x of+-- (y, 'Nothing') -> y+-- (y, 'Just' z) -> y + z+-- @+truncate+ :: GoodScale scale+ => Dense currency+ -> (Discrete' currency scale, Maybe (Dense currency)) -- ^+truncate = roundf Prelude.truncate+{-# INLINABLE truncate #-}++--------------------------------------------------------------------------------++-- | @'Scale' currency unit@ is a 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 '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 'Scale' \"USD\" \"cent\" = '(100, 1)+-- @+--+-- As another example, there is 1 dollar in USD, so the scale for this+-- relationship is:+--+-- @+-- type instance 'Scale' \"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 @Scale \"USD\" \"dollar\"@ as your scale, you will not be able to+-- represent values such as USD 3.50 or USD 21.87, since they are not exact+-- multiples of a dollar.+--+-- If there exists a canonical smallest @unit@ that can fully represent the+-- currency, then an instance @'Scale' currency currency@ exists.+--+-- @+-- type instance 'Scale' \"USD\" \"USD\" = Scale \"USD\" \"cent\"+-- @+--+-- For some monetary values, such as precious metals, the smallest representable+-- unit is not obvious, since you can continue to split the precious metal many+-- times before it stops being a precious metal. Still, 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 'Scale' \"XAG\" \"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 number to express it.+--+-- @+-- type instance 'Scale' \"XAU\" \"milligram\" = '(31103477, 1000)+-- @+--+-- If you try to obtain the 'Scale of a @currency@ without an obvious smallest+-- representable @unit@, like XAU, you will get a compile error.+type family Scale (currency :: Symbol) (unit :: Symbol) :: (Nat, Nat)++#if MIN_VERSION_base(4,9,0)+-- | 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." )+#else+-- | Forbid a @currency@ that doesn't have a canonical small unit.+--+-- In GHC versions before 8.0 we can't provide a nice error message here, so we+-- simply set this to a value that will fail to satisfy 'GoodScale'. As a+-- consequence, trying to use this 'Scale' will result in a cryptic error saying+-- /«@Couldn't match type ‘'EQ’ with ‘'LT’@»/.+type ErrScaleNonCanonical (currency :: Symbol) = '(0, 0)+#endif++-- | Constraints to a scale (like the one returned by @'Scale' currency unit@)+-- expected to always be satisfied. In particular, the scale is always+-- guaranteed to be a positive rational number ('infinity' and '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 =+ let n = natVal (Proxy :: Proxy num)+ d = natVal (Proxy :: Proxy den)+ in if (n > 0) && (d > 0)+ then Just (unsafeCoerce (Dict :: Dict ('LT ~ 'LT, 'LT ~ 'LT,+ KnownNat num, KnownNat den)))+ else Nothing+{-# INLINABLE mkGoodScale #-}++-- | Term-level representation for the @currency@'s @unit@ 'Scale'.+--+-- For example, the 'Scale' for @\"USD\"@ in @\"cent\"@s is @100/1@.+--+-- The returned 'Rational' is statically guaranteed to be a positive number, and+-- to be different from both 'notANumber' and 'infinity'.+scale :: forall proxy scale. GoodScale scale => proxy scale -> Rational -- ^+scale = \_ ->+ natVal (Proxy :: Proxy (Fst scale)) %+ natVal (Proxy :: Proxy (Snd scale))+{-# INLINABLE 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 (Eq, Ord, GHC.Generic)++instance forall src dst.+ ( KnownSymbol src, KnownSymbol dst+ ) => Show (ExchangeRate src dst) where+ show = \(ExchangeRate r0) ->+ let s = symbolVal (Proxy :: Proxy src)+ d = symbolVal (Proxy :: Proxy dst)+ in concat [ "ExchangeRate ", show s, " ", show d, " (", show r0, ")" ]++instance forall src dst.+ ( KnownSymbol src, KnownSymbol dst+ ) => Read (ExchangeRate (src :: Symbol) (dst :: Symbol)) where+ readPrec = do+ let s = symbolVal (Proxy :: Proxy src)+ d = symbolVal (Proxy :: Proxy dst)+ _ <- ReadPrec.lift (ReadP.string+ ("ExchangeRate " ++ show s ++ " " ++ show d ++ " "))+ maybe empty pure =<< fmap exchangeRate readPrec++-- | Obtain a 'Rational' representation of the 'ExchangeRate'.+--+-- This 'Rational' is statically guaranteed to be greater than 0, different+-- from 'infinity' and different from 'notANumber'.+fromExchangeRate :: ExchangeRate src dst -> Rational+fromExchangeRate = \(ExchangeRate r0) -> r0+{-# INLINABLE fromExchangeRate #-}++-- | Safely construct an 'ExchangeRate' from a 'Rational' number.+--+-- For construction to succeed, this 'Rational' must be greater than 0,+-- different from 'infinity' and different from 'notANumber'.+exchangeRate :: Rational -> Maybe (ExchangeRate src dst)+exchangeRate = \r0 ->+ if (r0 <= 0 || infinity == r0 || notANumber == r0)+ then Nothing else Just (ExchangeRate r0)+{-# INLINABLE exchangeRate #-}++-- | Flip the direction of an 'ExchangeRate'.+--+-- Identity law:+--+-- @+-- 'flipExchangeRate' . 'flipExchangeRate' == 'id'+-- @+flipExchangeRate :: ExchangeRate a b -> ExchangeRate b a+flipExchangeRate = \(ExchangeRate x) -> ExchangeRate (1 / x)+{-# INLINABLE flipExchangeRate #-}++-- | Apply the 'ExchangeRate' to the given @'Dense' src@ monetary value.+--+-- Identity law:+--+-- @+-- 'exchange' ('flipExchangeRate' 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 r) -> \(Dense s) -> Dense (r * s)+{-# INLINABLE exchange #-}++--------------------------------------------------------------------------------+-- DenseRep++-- | 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 'mkDenseRep' function.+--+-- In order to be able to effectively serialize a 'DenseRep' value, you+-- need to serialize the following three values (which are the eventual+-- arguments to 'mkDenseRep'):+--+-- * 'denseRepCurrency'+-- * 'denseRepAmountNumerator'+-- * 'denseRepAmountDenominator'+data DenseRep = DenseRep+ { _denseRepCurrency :: !String+ , _denseRepAmountNumerator :: !Integer+ , _denseRepAmountDenominator :: !Integer -- ^ Positive, non-zero.+ } deriving (Eq, Show, GHC.Generic)++-- | WARNING: This instance does not compare monetary amounts, it just helps you+-- sort 'DenseRep' values in case you need to put them in a 'Data.Set.Set' or+-- similar.+deriving instance Ord DenseRep++-- | Currency name.+denseRepCurrency :: DenseRep -> String+denseRepCurrency = _denseRepCurrency+{-# INLINABLE denseRepCurrency #-}++-- | Currency unit amount.+denseRepAmount :: DenseRep -> Rational+denseRepAmount = \dr ->+ denseRepAmountNumerator dr % denseRepAmountDenominator dr+{-# INLINABLE denseRepAmount #-}++-- | Currency unit amount numerator.+denseRepAmountNumerator :: DenseRep -> Integer+denseRepAmountNumerator = _denseRepAmountNumerator+{-# INLINABLE denseRepAmountNumerator #-}++-- | Currency unit amount denominator. Positive, non-zero.+denseRepAmountDenominator :: DenseRep -> Integer+denseRepAmountDenominator = _denseRepAmountDenominator+{-# INLINABLE denseRepAmountDenominator #-}++-- | Build a 'DenseRep' from raw values.+--+-- This function is intended for deserialization purposes. You need to convert+-- this 'DenseRep' value to a 'Dense' value in order to do any arithmetic+-- operation on the monetary value.+mkDenseRep+ :: String -- ^ Currency. ('denseRepCurrency')+ -> Integer -- ^ Scale numerator. ('denseRepAmountNumerator')+ -> Integer -- ^ Scale denominator (positive, non zero). ('denseRepAmountDenominator')+ -> Maybe DenseRep+mkDenseRep = \c n d -> case d > 0 of+ False -> Nothing+ True -> Just (DenseRep c n d)+{-# INLINABLE mkDenseRep #-}++-- | Convert a 'Dense' to a 'DenseRep' for ease of serialization.+toDenseRep :: KnownSymbol currency => Dense currency -> DenseRep+toDenseRep = \(Dense r0 :: Dense currency) ->+ let c = symbolVal (Proxy :: Proxy currency)+ in DenseRep c (numerator r0) (denominator r0)+{-# INLINABLE toDenseRep #-}++-- | Attempt to convert a 'DenseRep' to a 'Dense', provided you know the target+-- @currency@.+fromDenseRep+ :: forall currency+ . KnownSymbol currency+ => DenseRep+ -> Maybe (Dense currency) -- ^+fromDenseRep = \dr ->+ case denseRepCurrency dr == symbolVal (Proxy :: Proxy currency) of+ False -> Nothing+ True -> Just (Dense (denseRepAmount dr))+{-# INLINABLE fromDenseRep #-}++-- | Convert a 'DenseRep' 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 'fromDenseRep' directly.+withDenseRep+ :: DenseRep+ -> (forall currency. KnownSymbol currency => Dense currency -> r)+ -> r -- ^+withDenseRep dr = \f ->+ case someSymbolVal (denseRepCurrency dr) of+ SomeSymbol (Proxy :: Proxy currency) ->+ f (Dense (denseRepAmount dr) :: Dense currency)+{-# INLINABLE withDenseRep #-}++--------------------------------------------------------------------------------+-- DiscreteRep++-- | 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 'mkDiscreteRep' function.+--+-- In order to be able to effectively serialize a 'DiscreteRep' value, you need+-- to serialize the following four values (which are the eventual arguments to+-- 'mkDiscreteRep'):+--+-- * 'discreteRepCurrency'+-- * 'discreteRepScaleNumerator'+-- * 'discreteRepScaleDenominator'+-- * 'discreteRepAmount'+data DiscreteRep = DiscreteRep+ { _discreteRepCurrency :: !String -- ^ Currency name.+ , _discreteRepScaleNumerator :: !Integer -- ^ Positive, non-zero.+ , _discreteRepScaleDenominator :: !Integer -- ^ Positive, non-zero.+ , _discreteRepAmount :: !Integer -- ^ Amount of unit.+ } deriving (Eq, Show, GHC.Generic)++-- | WARNING: This instance does not compare monetary amounts, it just helps you+-- sort 'DiscreteRep' values in case you need to put them in a 'Data.Set.Set' or+-- similar.+deriving instance Ord DiscreteRep++-- | Currency name.+discreteRepCurrency :: DiscreteRep -> String+discreteRepCurrency = _discreteRepCurrency+{-# INLINABLE discreteRepCurrency #-}++-- | Positive, non-zero.+discreteRepScaleNumerator :: DiscreteRep -> Integer+discreteRepScaleNumerator = _discreteRepScaleNumerator+{-# INLINABLE discreteRepScaleNumerator #-}++-- | Positive, non-zero.+discreteRepScaleDenominator :: DiscreteRep -> Integer+discreteRepScaleDenominator = _discreteRepScaleDenominator+{-# INLINABLE discreteRepScaleDenominator #-}++-- | Amount of currency unit.+discreteRepAmount :: DiscreteRep -> Integer+discreteRepAmount = _discreteRepAmount+{-# INLINABLE discreteRepAmount #-}++-- | Positive, non-zero.+discreteRepScale :: DiscreteRep -> Rational+discreteRepScale = \dr ->+ discreteRepScaleNumerator dr % discreteRepScaleDenominator dr+{-# INLINABLE discreteRepScale #-}+++-- | Internal. Build a 'DiscreteRep' from raw values.+--+-- This function is intended for deserialization purposes. You need to convert+-- this 'DiscreteRep' value to a 'Discrete' vallue in order to do any arithmetic+-- operation on the monetary value.+mkDiscreteRep+ :: String -- ^ Currency name. ('discreteRepCurrency')+ -> Integer -- ^ Scale numerator. Positive, non-zero. ('discreteRepScaleNumerator')+ -> Integer -- ^ Scale denominator. Positive, non-zero. ('discreteRepScaleDenominator')+ -> Integer -- ^ Amount of unit. ('discreteRepAmount')+ -> Maybe DiscreteRep+mkDiscreteRep = \c n d a -> case (n > 0) && (d > 0) of+ False -> Nothing+ True -> Just (DiscreteRep c n d a)+{-# INLINABLE mkDiscreteRep #-}++-- | Convert a 'Discrete' to a 'DiscreteRep' for ease of serialization.+toDiscreteRep+ :: (KnownSymbol currency, GoodScale scale)+ => Discrete' currency scale+ -> DiscreteRep -- ^+toDiscreteRep = \(Discrete i0 :: Discrete' currency scale) ->+ let c = symbolVal (Proxy :: Proxy currency)+ n = natVal (Proxy :: Proxy (Fst scale))+ d = natVal (Proxy :: Proxy (Snd scale))+ in DiscreteRep c n d i0+{-# INLINABLE toDiscreteRep #-}++-- | Attempt to convert a 'DiscreteRep' to a 'Discrete', provided you know the+-- target @currency@ and @unit@.+fromDiscreteRep+ :: forall currency scale+ . (KnownSymbol currency, GoodScale scale)+ => DiscreteRep+ -> Maybe (Discrete' currency scale) -- ^+fromDiscreteRep = \dr ->+ if (discreteRepCurrency dr == symbolVal (Proxy :: Proxy currency)) &&+ (discreteRepScaleNumerator dr == natVal (Proxy :: Proxy (Fst scale))) &&+ (discreteRepScaleDenominator dr == natVal (Proxy :: Proxy (Snd scale)))+ then Just (Discrete (discreteRepAmount dr))+ else Nothing+{-# INLINABLE fromDiscreteRep #-}++-- | Convert a 'DiscreteRep' 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 'fromDiscreteRep' directly.+--+-- Notice that you may need to add an explicit type to the result of this+-- function in order to keep the compiler happy.+withDiscreteRep+ :: forall r+ . DiscreteRep+ -> ( forall currency scale.+ ( KnownSymbol currency+ , GoodScale scale+ ) => Discrete' currency scale+ -> r )+ -> r -- ^+withDiscreteRep dr = \f ->+ case someSymbolVal (discreteRepCurrency dr) of+ SomeSymbol (Proxy :: Proxy currency) ->+ case someNatVal (discreteRepScaleNumerator dr) of+ Nothing -> error "withDiscreteRep: impossible: numerator < 0"+ Just (SomeNat (Proxy :: Proxy num)) ->+ case someNatVal (discreteRepScaleDenominator dr) of+ Nothing -> error "withDiscreteRep: impossible: denominator < 0"+ Just (SomeNat (Proxy :: Proxy den)) ->+ case mkGoodScale of+ Nothing -> error "withDiscreteRep: impossible: mkGoodScale"+ Just (Dict :: Dict (GoodScale '(num, den))) ->+ f (Discrete (discreteRepAmount dr)+ :: Discrete' currency '(num, den))+{-# INLINABLE withDiscreteRep #-}++--------------------------------------------------------------------------------+-- ExchangeRateRep++-- | 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 'mkExchangeRateRep' function.+--+-- In order to be able to effectively serialize an 'ExchangeRateRep' value, you+-- need to serialize the following four values (which are the eventual arguments+-- to 'mkExchangeRateRep'):+--+-- * 'exchangeRateRepSrcCurrency'+-- * 'exchangeRateRepDstCurrency'+-- * 'exchangeRateRepRateNumerator'+-- * 'exchangeRateRepRateDenominator'+data ExchangeRateRep = ExchangeRateRep+ { _exchangeRateRepSrcCurrency :: !String+ , _exchangeRateRepDstCurrency :: !String+ , _exchangeRateRepRateNumerator :: !Integer -- ^ Positive, non-zero.+ , _exchangeRateRepRateDenominator :: !Integer -- ^ Positive, non-zero.+ } deriving (Eq, Show, GHC.Generic)++-- | WARNING: This instance does not compare monetary amounts, it just helps you+-- sort 'ExchangeRateRep' values in case you need to put them in a+-- 'Data.Set.Set' or similar.+deriving instance Ord ExchangeRateRep++-- | Source currency name.+exchangeRateRepSrcCurrency :: ExchangeRateRep -> String+exchangeRateRepSrcCurrency = _exchangeRateRepSrcCurrency+{-# INLINABLE exchangeRateRepSrcCurrency #-}++-- | Destination currency name.+exchangeRateRepDstCurrency :: ExchangeRateRep -> String+exchangeRateRepDstCurrency = _exchangeRateRepDstCurrency+{-# INLINABLE exchangeRateRepDstCurrency #-}++-- | Exchange rate. Positive, non-zero.+exchangeRateRepRate :: ExchangeRateRep -> Rational+exchangeRateRepRate = \x ->+ exchangeRateRepRateNumerator x % _exchangeRateRepRateDenominator x+{-# INLINABLE exchangeRateRepRate #-}++-- | Exchange rate numerator. Positive, non-zero.+exchangeRateRepRateNumerator :: ExchangeRateRep -> Integer+exchangeRateRepRateNumerator = _exchangeRateRepRateNumerator+{-# INLINABLE exchangeRateRepRateNumerator #-}++-- | Exchange rate denominator. Positive, non-zero.+exchangeRateRepRateDenominator :: ExchangeRateRep -> Integer+exchangeRateRepRateDenominator = _exchangeRateRepRateDenominator+{-# INLINABLE exchangeRateRepRateDenominator #-}++-- | Internal. Build a 'ExchangeRateRep' from raw values.+--+-- This function is intended for deserialization purposes. You need to convert+-- this 'ExchangeRateRep' value to a 'ExchangeRate' value in order to do any+-- arithmetic operation with the exchange rate.+mkExchangeRateRep+ :: String -- ^ Source currency name. ('exchangeRateRepSrcCurrency')+ -> String -- ^ Destination currency name. ('exchangeRateRepDstCurrency')+ -> Integer -- ^ Exchange rate numerator. Positive, non-zero. ('exchangeRateRepRateNumerator')+ -> Integer -- ^ Exchange rate denominator. Positive, non-zero. ('exchangeRateRepRateDenominator')+ -> Maybe ExchangeRateRep+mkExchangeRateRep = \src dst n d -> case (n > 0) && (d > 0) of+ False -> Nothing+ True -> Just (ExchangeRateRep src dst n d)+{-# INLINABLE mkExchangeRateRep #-}++-- | Convert a 'ExchangeRate' to a 'DiscreteRep' for ease of serialization.+toExchangeRateRep+ :: (KnownSymbol src, KnownSymbol dst)+ => ExchangeRate src dst+ -> ExchangeRateRep -- ^+toExchangeRateRep = \(ExchangeRate r0 :: ExchangeRate src dst) ->+ let src = symbolVal (Proxy :: Proxy src)+ dst = symbolVal (Proxy :: Proxy dst)+ in ExchangeRateRep src dst (numerator r0) (denominator r0)+{-# INLINABLE toExchangeRateRep #-}++-- | Attempt to convert a 'ExchangeRateRep' to a 'ExchangeRate', provided you+-- know the target @src@ and @dst@ types.+fromExchangeRateRep+ :: forall src dst+ . (KnownSymbol src, KnownSymbol dst)+ => ExchangeRateRep+ -> Maybe (ExchangeRate src dst) -- ^+fromExchangeRateRep = \x ->+ if (exchangeRateRepSrcCurrency x == symbolVal (Proxy :: Proxy src)) &&+ (exchangeRateRepDstCurrency x == symbolVal (Proxy :: Proxy dst))+ then Just (ExchangeRate (exchangeRateRepRate x))+ else Nothing+{-# INLINABLE fromExchangeRateRep #-}++-- | Convert a 'ExchangeRateRep' 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 'fromExchangeRateRep' directly.+withExchangeRateRep+ :: ExchangeRateRep+ -> ( forall src dst.+ ( KnownSymbol src+ , KnownSymbol dst+ ) => ExchangeRate src dst+ -> r )+ -> r -- ^+withExchangeRateRep x = \f ->+ case someSymbolVal (exchangeRateRepSrcCurrency x) of+ SomeSymbol (Proxy :: Proxy src) ->+ case someSymbolVal (exchangeRateRepDstCurrency x) of+ SomeSymbol (Proxy :: Proxy dst) ->+ f (ExchangeRate (exchangeRateRepRate x) :: ExchangeRate src dst)+{-# INLINABLE withExchangeRateRep #-}++--------------------------------------------------------------------------------+-- 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++--------------------------------------------------------------------------------+-- Extra instances: hashable+#ifdef VERSION_hashable+instance Hashable (Dense currency)+instance Hashable DenseRep+instance GoodScale scale => Hashable (Discrete' currency scale)+instance Hashable DiscreteRep+instance Hashable (ExchangeRate src dst)+instance Hashable ExchangeRateRep+#endif++--------------------------------------------------------------------------------+-- Extra instances: deepseq+#ifdef VERSION_deepseq+instance NFData (Dense currency)+instance NFData DenseRep+instance GoodScale scale => NFData (Discrete' currency scale)+instance NFData DiscreteRep+instance NFData (ExchangeRate src dst)+instance NFData ExchangeRateRep+#endif++--------------------------------------------------------------------------------+-- Extra instances: cereal+#ifdef VERSION_cereal+-- | Compatible with 'DenseRep'.+instance (KnownSymbol currency) => Cereal.Serialize (Dense currency) where+ put = Cereal.put . toDenseRep+ get = maybe empty pure =<< fmap fromDenseRep Cereal.get+-- | Compatible with 'DiscreteRep'.+instance+ ( KnownSymbol currency, GoodScale scale+ ) => Cereal.Serialize (Discrete' currency scale) where+ put = Cereal.put . toDiscreteRep+ get = maybe empty pure =<< fmap fromDiscreteRep Cereal.get+-- | Compatible with 'ExchangeRateRep'.+instance+ ( KnownSymbol src, KnownSymbol dst+ ) => Cereal.Serialize (ExchangeRate src dst) where+ put = Cereal.put . toExchangeRateRep+ get = maybe empty pure =<< fmap fromExchangeRateRep Cereal.get+-- | Compatible with 'Dense'.+instance Cereal.Serialize DenseRep where+ put = \(DenseRep c n d) -> Cereal.put c >> Cereal.put n >> Cereal.put d+ get = maybe empty pure =<< mkDenseRep+ <$> Cereal.get <*> Cereal.get <*> Cereal.get+-- | Compatible with 'Discrete'.+instance Cereal.Serialize DiscreteRep where+ put = \(DiscreteRep c n d a) ->+ Cereal.put c >> Cereal.put n >> Cereal.put d >> Cereal.put a+ get = maybe empty pure =<< mkDiscreteRep+ <$> Cereal.get <*> Cereal.get <*> Cereal.get <*> Cereal.get+-- | Compatible with 'ExchangeRate'.+instance Cereal.Serialize ExchangeRateRep where+ put = \(ExchangeRateRep src dst n d) ->+ Cereal.put src >> Cereal.put dst >> Cereal.put n >> Cereal.put d+ get = maybe empty pure =<< mkExchangeRateRep+ <$> Cereal.get <*> Cereal.get <*> Cereal.get <*> Cereal.get+#endif++--------------------------------------------------------------------------------+-- Extra instances: binary+#ifdef VERSION_binary+-- | Compatible with 'DenseRep'.+instance (KnownSymbol currency) => Binary.Binary (Dense currency) where+ put = Binary.put . toDenseRep+ get = maybe empty pure =<< fmap fromDenseRep Binary.get+-- | Compatible with 'DiscreteRep'.+instance+ ( KnownSymbol currency, GoodScale scale+ ) => Binary.Binary (Discrete' currency scale) where+ put = Binary.put . toDiscreteRep+ get = maybe empty pure =<< fmap fromDiscreteRep Binary.get+-- | Compatible with 'ExchangeRateRep'.+instance+ ( KnownSymbol src, KnownSymbol dst+ ) => Binary.Binary (ExchangeRate src dst) where+ put = Binary.put . toExchangeRateRep+ get = maybe empty pure =<< fmap fromExchangeRateRep Binary.get+-- | Compatible with 'Dense'.+instance Binary.Binary DenseRep where+ put = \(DenseRep c n d) -> Binary.put c >> Binary.put n >> Binary.put d+ get = maybe empty pure =<< mkDenseRep+ <$> Binary.get <*> Binary.get <*> Binary.get+-- | Compatible with 'Discrete'.+instance Binary.Binary DiscreteRep where+ put = \(DiscreteRep c n d a) ->+ Binary.put c >> Binary.put n >> Binary.put d >> Binary.put a+ get = maybe empty pure =<< mkDiscreteRep+ <$> Binary.get <*> Binary.get <*> Binary.get <*> Binary.get+-- | Compatible with 'ExchangeRate'.+instance Binary.Binary ExchangeRateRep where+ put = \(ExchangeRateRep src dst n d) ->+ Binary.put src >> Binary.put dst >> Binary.put n >> Binary.put d+ get = maybe empty pure =<< mkExchangeRateRep+ <$> Binary.get <*> Binary.get <*> Binary.get <*> Binary.get+#endif++--------------------------------------------------------------------------------+-- Extra instances: aeson+#ifdef VERSION_aeson+-- | Compatible with 'DenseRep'+instance KnownSymbol currency => Ae.ToJSON (Dense currency) where+ toJSON = Ae.toJSON . toDenseRep+-- | Compatible with 'DenseRep'+instance KnownSymbol currency => Ae.FromJSON (Dense currency) where+ parseJSON = maybe empty pure <=< fmap fromDenseRep . Ae.parseJSON+-- | Compatible with 'Dense'+instance Ae.ToJSON DenseRep where+ toJSON = \(DenseRep c n d) -> Ae.toJSON ("Dense", c, n, d)+-- | Compatible with 'Dense'+instance Ae.FromJSON DenseRep where+ parseJSON = \v -> do+ ("Dense", c, n, d) <- Ae.parseJSON v+ maybe empty pure (mkDenseRep c n d)+-- | Compatible with 'DiscreteRep'+instance+ ( KnownSymbol currency, GoodScale scale+ ) => Ae.ToJSON (Discrete' currency scale) where+ toJSON = Ae.toJSON . toDiscreteRep+-- | Compatible with 'DiscreteRep'+instance+ ( KnownSymbol currency, GoodScale scale+ ) => Ae.FromJSON (Discrete' currency scale) where+ parseJSON = maybe empty pure <=< fmap fromDiscreteRep . Ae.parseJSON+-- | Compatible with 'Discrete''+instance Ae.ToJSON DiscreteRep where+ toJSON = \(DiscreteRep c n d a) -> Ae.toJSON ("Discrete", c, n, d, a)+-- | Compatible with 'Discrete''+instance Ae.FromJSON DiscreteRep where+ parseJSON = \v -> do+ ("Discrete", c, n, d, a) <- Ae.parseJSON v+ maybe empty pure (mkDiscreteRep c n d a)+-- | Compatible with 'ExchangeRateRep'+instance+ ( KnownSymbol src, KnownSymbol dst+ ) => Ae.ToJSON (ExchangeRate src dst) where+ toJSON = Ae.toJSON . toExchangeRateRep+-- | Compatible with 'ExchangeRateRep'+instance+ ( KnownSymbol src, KnownSymbol dst+ ) => Ae.FromJSON (ExchangeRate src dst) where+ parseJSON = maybe empty pure <=< fmap fromExchangeRateRep . Ae.parseJSON+-- | Compatible with 'ExchangeRate'+instance Ae.ToJSON ExchangeRateRep where+ toJSON = \(ExchangeRateRep src dst n d) ->+ Ae.toJSON ("ExchangeRate", src, dst, n, d)+-- | Compatible with 'ExchangeRate'+instance Ae.FromJSON ExchangeRateRep where+ parseJSON = \v -> do+ ("ExchangeRate", src, dst, n, d) <- Ae.parseJSON v+ maybe empty pure (mkExchangeRateRep src dst n d)+#endif++--------------------------------------------------------------------------------+-- Extra instances: store+#ifdef VERSION_store+-- | Compatible with 'DenseRep'.+instance (KnownSymbol currency) => Store.Store (Dense currency) where+ size = storeContramapSize toDenseRep Store.size+ poke = Store.poke . toDenseRep+ peek = maybe (fail "peek") pure =<< fmap fromDenseRep Store.peek+-- | Compatible with 'Dense'.+instance Store.Store DenseRep where+ poke = \(DenseRep c n d) -> Store.poke c >> Store.poke n >> Store.poke d+ peek = maybe (fail "peek") pure =<< do+ mkDenseRep <$> Store.peek <*> Store.peek <*> Store.peek++-- | Compatible with 'DiscreteRep'.+instance+ ( KnownSymbol currency, GoodScale scale+ ) => Store.Store (Discrete' currency scale) where+ size = storeContramapSize toDiscreteRep Store.size+ poke = Store.poke . toDiscreteRep+ peek = maybe (fail "peek") pure =<< fmap fromDiscreteRep Store.peek+-- | Compatible with 'Discrete''.+instance Store.Store DiscreteRep where+ poke = \(DiscreteRep c n d a) ->+ Store.poke c >> Store.poke n >> Store.poke d >> Store.poke a+ peek = maybe (fail "peek") pure =<< do+ mkDiscreteRep <$> Store.peek <*> Store.peek <*> Store.peek <*> Store.peek+-- | Compatible with 'ExchangeRateRep'.+instance+ ( KnownSymbol src, KnownSymbol dst+ ) => Store.Store (ExchangeRate src dst) where+ size = storeContramapSize toExchangeRateRep Store.size+ poke = Store.poke . toExchangeRateRep+ peek = maybe (fail "peek") pure =<< fmap fromExchangeRateRep Store.peek+-- | Compatible with 'ExchangeRate'.+instance Store.Store ExchangeRateRep where+ poke = \(ExchangeRateRep src dst n d) ->+ Store.poke src >> Store.poke dst >> Store.poke n >> Store.poke d+ peek = maybe (fail "peek") pure =<< mkExchangeRateRep+ <$> Store.peek <*> Store.peek <*> Store.peek <*> Store.peek++storeContramapSize :: (a -> b) -> Store.Size b -> Store.Size a+storeContramapSize f = \case+ Store.VarSize g -> Store.VarSize (g . f)+ Store.ConstSize x -> Store.ConstSize x+{-# INLINABLE storeContramapSize #-}+#endif
+ test/Main.hs view
@@ -0,0 +1,453 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeFamilies #-}++module Main where++import qualified Test.Tasty as Tasty+import qualified Test.Tasty.Runners as Tasty+import Test.Tasty.QuickCheck ((===), (==>))+import qualified Test.Tasty.QuickCheck as QC++import qualified Data.Aeson as Ae+import qualified Data.Binary as Binary+import qualified Data.ByteString.Lazy as BSL+import Data.Maybe (catMaybes, isJust, isNothing)+import Data.Proxy (Proxy(Proxy))+import qualified Data.Serialize as Cereal+import GHC.TypeLits (Nat, Symbol, KnownSymbol, symbolVal)++#ifdef VERSION_store+import qualified Data.Store as Store+#endif++import qualified Money++--------------------------------------------------------------------------------++instance+ ( Money.GoodScale scale+ ) => QC.Arbitrary (Money.Discrete' currency scale) where+ arbitrary = fmap fromInteger QC.arbitrary+ shrink = fmap fromInteger . QC.shrink . toInteger++instance QC.Arbitrary Money.DiscreteRep where+ arbitrary = do+ let md = Money.mkDiscreteRep <$> QC.arbitrary <*> QC.arbitrary+ <*> QC.arbitrary <*> QC.arbitrary+ Just x <- QC.suchThat md isJust+ pure x+ shrink = \x -> Money.withDiscreteRep x (map Money.toDiscreteRep . QC.shrink)++instance QC.Arbitrary (Money.Dense currency) where+ arbitrary = do+ Just x <- QC.suchThat (Money.dense <$> QC.arbitrary) isJust+ pure x+ shrink = catMaybes . fmap Money.dense . QC.shrink . toRational++instance QC.Arbitrary Money.DenseRep where+ arbitrary = do+ let md = Money.mkDenseRep <$> QC.arbitrary <*> QC.arbitrary <*> QC.arbitrary+ Just x <- QC.suchThat md isJust+ pure x+ shrink = \x -> Money.withDenseRep x (map Money.toDenseRep . QC.shrink)++instance QC.Arbitrary (Money.ExchangeRate src dst) where+ arbitrary = do+ Just x <- QC.suchThat (fmap Money.exchangeRate QC.arbitrary) isJust+ pure x+ shrink =+ catMaybes . fmap Money.exchangeRate . QC.shrink . Money.fromExchangeRate++instance QC.Arbitrary Money.ExchangeRateRep where+ arbitrary = do+ let md = Money.mkExchangeRateRep <$> QC.arbitrary <*> QC.arbitrary+ <*> QC.arbitrary <*> QC.arbitrary+ Just x <- QC.suchThat md isJust+ pure x+ shrink = \x ->+ Money.withExchangeRateRep x (map Money.toExchangeRateRep . QC.shrink)++--------------------------------------------------------------------------------++main :: IO ()+main = Tasty.defaultMainWithIngredients+ [ Tasty.consoleTestReporter+ , Tasty.listingTests+ ] tests++tests :: Tasty.TestTree+tests =+ Tasty.testGroup "root"+ [ testCurrencies+ , testCurrencyUnits+ , testExchange+ ]++testCurrencies :: Tasty.TestTree+testCurrencies =+ Tasty.testGroup "Currency"+ [ testDense (Proxy :: Proxy "BTC") -- A cryptocurrency.+ , testDense (Proxy :: Proxy "USD") -- A fiat currency with decimal fractions.+ , testDense (Proxy :: Proxy "VUV") -- A fiat currency with non-decimal fractions.+ , testDense (Proxy :: Proxy "XAU") -- A precious metal.+ ]++testCurrencyUnits :: Tasty.TestTree+testCurrencyUnits =+ Tasty.testGroup "Currency units"+ [ testDiscrete (Proxy :: Proxy "BTC") (Proxy :: Proxy "BTC")+ , testDiscrete (Proxy :: Proxy "BTC") (Proxy :: Proxy "satoshi")+ , testDiscrete (Proxy :: Proxy "BTC") (Proxy :: Proxy "bitcoin")+ , testDiscrete (Proxy :: Proxy "USD") (Proxy :: Proxy "USD")+ , testDiscrete (Proxy :: Proxy "USD") (Proxy :: Proxy "cent")+ , testDiscrete (Proxy :: Proxy "USD") (Proxy :: Proxy "dollar")+ , testDiscrete (Proxy :: Proxy "VUV") (Proxy :: Proxy "vatu")+ , testDiscrete (Proxy :: Proxy "XAU") (Proxy :: Proxy "micrograin")+ , testDiscrete (Proxy :: Proxy "XAU") (Proxy :: Proxy "milligrain")+ , testDiscrete (Proxy :: Proxy "XAU") (Proxy :: Proxy "grain")+ ]++testDense+ :: forall currency+ . KnownSymbol currency+ => Proxy currency+ -> Tasty.TestTree+testDense pc =+ Tasty.testGroup ("Dense " ++ show (symbolVal pc))+ [ QC.testProperty "read . show == id" $+ QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+ x === read (show x)+ , QC.testProperty "fromDenseRep . denseRep == Just" $+ QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+ Just x === Money.fromDenseRep (Money.toDenseRep x)+ , QC.testProperty "fromDenseRep works only for same currency" $+ QC.forAll QC.arbitrary $ \(dr :: Money.DenseRep) ->+ (Money.denseRepCurrency dr /= symbolVal pc)+ ==> isNothing (Money.fromDenseRep dr :: Maybe (Money.Dense currency))+ , QC.testProperty "withDenseRep" $+ QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+ let dr = Money.toDenseRep x+ in Money.withDenseRep dr $ \x' ->+ (show x, dr, Money.toDenseRep (x + 1))+ === (show x', Money.toDenseRep x', Money.toDenseRep (x' + 1))++ , QC.testProperty "Aeson encoding roundtrip" $+ QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+ Just x === Ae.decode (Ae.encode x)+ , QC.testProperty "Aeson encoding roundtrip (DenseRep)" $+ QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+ let x' = Money.toDenseRep x+ in Just x' === Ae.decode (Ae.encode x')+ , QC.testProperty "Aeson encoding roundtrip (Dense through DenseRep)" $+ QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+ Just x === Ae.decode (Ae.encode (Money.toDenseRep x))+ , QC.testProperty "Aeson encoding roundtrip (DenseRep through Dense)" $+ QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+ Just (Money.toDenseRep x) === Ae.decode (Ae.encode x)++ , QC.testProperty "Binary encoding roundtrip" $+ QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+ let Right (_,_,y) = Binary.decodeOrFail (Binary.encode x)+ in x === y+ , QC.testProperty "Binary encoding roundtrip (DenseRep)" $+ QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+ let x' = Money.toDenseRep x+ bs = Binary.encode x'+ in Right (mempty, BSL.length bs, x') === Binary.decodeOrFail bs+ , QC.testProperty "Binary encoding roundtrip (Dense through DenseRep)" $+ QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+ let x' = Money.toDenseRep x+ bs = Binary.encode x'+ in Right (mempty, BSL.length bs, x) === Binary.decodeOrFail bs+ , QC.testProperty "Binary encoding roundtrip (DenseRep through Dense)" $+ QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+ let x' = Money.toDenseRep x+ bs = Binary.encode x+ in Right (mempty, BSL.length bs, x') === Binary.decodeOrFail bs++ , QC.testProperty "Cereal encoding roundtrip" $+ QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+ Right x === Cereal.decode (Cereal.encode x)+ , QC.testProperty "Cereal encoding roundtrip (DenseRep)" $+ QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+ let x' = Money.toDenseRep x+ in Right x' === Cereal.decode (Cereal.encode x')+ , QC.testProperty "Cereal encoding roundtrip (Dense through DenseRep)" $+ QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+ Right x === Cereal.decode (Cereal.encode (Money.toDenseRep x))+ , QC.testProperty "Cereal encoding roundtrip (DenseRep through Dense)" $+ QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+ Right (Money.toDenseRep x) === Cereal.decode (Cereal.encode x)++#ifdef VERSION_store+ , QC.testProperty "Store encoding roundtrip" $+ QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+ Right x === Store.decode (Store.encode x)+ , QC.testProperty "Store encoding roundtrip (DenseRep)" $+ QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+ let x' = Money.toDenseRep x+ in Right x' === Store.decode (Store.encode x')+ , QC.testProperty "Store encoding roundtrip (Dense through DenseRep)" $+ QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+ Right x === Store.decode (Store.encode (Money.toDenseRep x))+ , QC.testProperty "Store encoding roundtrip (DenseRep through Dense)" $+ QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+ Right (Money.toDenseRep x) === Store.decode (Store.encode x)+#endif+ ]++testExchange :: Tasty.TestTree+testExchange =+ Tasty.testGroup "Exchange"+ [ testExchangeRate (Proxy :: Proxy "BTC") (Proxy :: Proxy "BTC")+ , testExchangeRate (Proxy :: Proxy "BTC") (Proxy :: Proxy "USD")+ , testExchangeRate (Proxy :: Proxy "BTC") (Proxy :: Proxy "VUV")+ , testExchangeRate (Proxy :: Proxy "BTC") (Proxy :: Proxy "XAU")+ , testExchangeRate (Proxy :: Proxy "USD") (Proxy :: Proxy "BTC")+ , testExchangeRate (Proxy :: Proxy "USD") (Proxy :: Proxy "USD")+ , testExchangeRate (Proxy :: Proxy "USD") (Proxy :: Proxy "VUV")+ , testExchangeRate (Proxy :: Proxy "USD") (Proxy :: Proxy "XAU")+ , testExchangeRate (Proxy :: Proxy "VUV") (Proxy :: Proxy "BTC")+ , testExchangeRate (Proxy :: Proxy "VUV") (Proxy :: Proxy "USD")+ , testExchangeRate (Proxy :: Proxy "VUV") (Proxy :: Proxy "VUV")+ , testExchangeRate (Proxy :: Proxy "VUV") (Proxy :: Proxy "XAU")+ , testExchangeRate (Proxy :: Proxy "XAU") (Proxy :: Proxy "BTC")+ , testExchangeRate (Proxy :: Proxy "XAU") (Proxy :: Proxy "USD")+ , testExchangeRate (Proxy :: Proxy "XAU") (Proxy :: Proxy "VUV")+ , testExchangeRate (Proxy :: Proxy "XAU") (Proxy :: Proxy "XAU")+ ]++testDiscrete+ :: forall (currency :: Symbol) (unit :: Symbol)+ . ( Money.GoodScale (Money.Scale currency unit)+ , KnownSymbol currency+ , KnownSymbol unit )+ => Proxy currency+ -> Proxy unit+ -> Tasty.TestTree+testDiscrete pc pu =+ Tasty.testGroup ("Discrete " ++ show (symbolVal pc) ++ " "+ ++ show (symbolVal pu))+ [ testRounding pc pu+ , QC.testProperty "read . show == id" $+ QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+ x === read (show x)+ , QC.testProperty "fromDiscreteRep . discreteRep == Just" $+ QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+ Just x === Money.fromDiscreteRep (Money.toDiscreteRep x)+ , QC.testProperty "fromDiscreteRep works only for same currency and scale" $+ QC.forAll QC.arbitrary $ \(dr :: Money.DiscreteRep) ->+ ((Money.discreteRepCurrency dr /= symbolVal pc) &&+ (Money.discreteRepScale dr /=+ Money.scale (Proxy :: Proxy (Money.Scale currency unit)))+ ) ==> isNothing (Money.fromDiscreteRep dr+ :: Maybe (Money.Discrete currency unit))+ , QC.testProperty "withDiscreteRep" $+ QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+ let dr = Money.toDiscreteRep x+ in ( Money.withDiscreteRep dr $ \x' ->+ (show x, dr, Money.toDiscreteRep (x + 1))+ === (show x', Money.toDiscreteRep x', Money.toDiscreteRep (x' + 1))+ ) :: QC.Property++ , QC.testProperty "Aeson encoding roundtrip" $+ QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+ Just x === Ae.decode (Ae.encode x)+ , QC.testProperty "Aeson encoding roundtrip (DiscreteRep)" $+ QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+ let x' = Money.toDiscreteRep x+ in Just x' === Ae.decode (Ae.encode x')+ , QC.testProperty "Aeson encoding roundtrip (Discrete through DiscreteRep)" $+ QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+ Just x === Ae.decode (Ae.encode (Money.toDiscreteRep x))+ , QC.testProperty "Aeson encoding roundtrip (DiscreteRep through Discrete)" $+ QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+ Just (Money.toDiscreteRep x) === Ae.decode (Ae.encode x)++ , QC.testProperty "Binary encoding roundtrip" $+ QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+ let Right (_,_,y) = Binary.decodeOrFail (Binary.encode x)+ in x === y+ , QC.testProperty "Binary encoding roundtrip (DiscreteRep)" $+ QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+ let x' = Money.toDiscreteRep x+ bs = Binary.encode x'+ in Right (mempty, BSL.length bs, x') === Binary.decodeOrFail bs+ , QC.testProperty "Binary encoding roundtrip (Discrete through DiscreteRep)" $+ QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+ let x' = Money.toDiscreteRep x+ bs = Binary.encode x'+ in Right (mempty, BSL.length bs, x) === Binary.decodeOrFail bs+ , QC.testProperty "Binary encoding roundtrip (DiscreteRep through Discrete)" $+ QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+ let x' = Money.toDiscreteRep x+ bs = Binary.encode x+ in Right (mempty, BSL.length bs, x') === Binary.decodeOrFail bs++ , QC.testProperty "Cereal encoding roundtrip" $+ QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+ Right x === Cereal.decode (Cereal.encode x)+ , QC.testProperty "Cereal encoding roundtrip (DiscreteRep)" $+ QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+ let x' = Money.toDiscreteRep x+ in Right x' === Cereal.decode (Cereal.encode x')+ , QC.testProperty "Cereal encoding roundtrip (Discrete through DiscreteRep)" $+ QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+ Right x === Cereal.decode (Cereal.encode (Money.toDiscreteRep x))+ , QC.testProperty "Cereal encoding roundtrip (DiscreteRep through Discrete)" $+ QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+ Right (Money.toDiscreteRep x) === Cereal.decode (Cereal.encode x)++#ifdef VERSION_store+ , QC.testProperty "Store encoding roundtrip" $+ QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+ Right x === Store.decode (Store.encode x)+ , QC.testProperty "Store encoding roundtrip (DiscreteRep)" $+ QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+ let x' = Money.toDiscreteRep x+ in Right x' === Store.decode (Store.encode x')+ , QC.testProperty "Store encoding roundtrip (Discrete through DiscreteRep)" $+ QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+ Right x === Store.decode (Store.encode (Money.toDiscreteRep x))+ , QC.testProperty "Store encoding roundtrip (DiscreteRep through Discrete)" $+ QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+ Right (Money.toDiscreteRep x) === Store.decode (Store.encode x)+#endif+ ]++testExchangeRate+ :: forall (src :: Symbol) (dst :: Symbol)+ . (KnownSymbol src, KnownSymbol dst)+ => Proxy src+ -> Proxy dst+ -> Tasty.TestTree+testExchangeRate ps pd =+ Tasty.testGroup ("ExchangeRate " ++ show (symbolVal ps) ++ " "+ ++ show (symbolVal pd))+ [ QC.testProperty "read . show == id" $+ QC.forAll QC.arbitrary $ \(xr :: Money.ExchangeRate src dst) ->+ xr === read (show xr)+ , QC.testProperty "flipExchangeRate . flipExchangeRate == id" $+ QC.forAll QC.arbitrary $ \(xr :: Money.ExchangeRate src dst) ->+ let xr' = Money.flipExchangeRate xr+ in (Money.fromExchangeRate xr /= Money.fromExchangeRate xr')+ ==> (xr === Money.flipExchangeRate xr')+ , QC.testProperty "exchange (flipExchangeRate x) . exchange x == id" $+ QC.forAll QC.arbitrary $+ \( c0 :: Money.Dense src+ , xr :: Money.ExchangeRate src dst+ ) -> c0 === Money.exchange (Money.flipExchangeRate xr)+ (Money.exchange xr c0)+ , QC.testProperty "x == 1 ===> exchange x == id" $+ QC.forAll QC.arbitrary $+ \( c0 :: Money.Dense src+ ) -> let Just xr = Money.exchangeRate 1+ in toRational c0 === toRational (Money.exchange xr c0)+ , QC.testProperty "x /= 1 ===> exchange x /= id" $+ QC.forAll QC.arbitrary $+ \( c0 :: Money.Dense src+ , xr :: Money.ExchangeRate src dst+ ) -> (Money.fromExchangeRate xr /= 1)+ ==> (toRational c0 /= toRational (Money.exchange xr c0))+ , QC.testProperty "fromExchangeRateRep . exchangeRateRep == Just" $+ QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->+ Just x === Money.fromExchangeRateRep (Money.toExchangeRateRep x)+ , QC.testProperty "fromExchangeRateRep works only for same currencies" $+ QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRateRep) ->+ ((Money.exchangeRateRepSrcCurrency x /= symbolVal ps) &&+ (Money.exchangeRateRepDstCurrency x /= symbolVal pd))+ ==> isNothing (Money.fromExchangeRateRep x+ :: Maybe (Money.ExchangeRate src dst))+ , QC.testProperty "withExchangeRateRep" $+ QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->+ let dr = Money.toExchangeRateRep x+ in Money.withExchangeRateRep dr $ \x' ->+ (show x, dr) === (show x', Money.toExchangeRateRep x')++ , QC.testProperty "Aeson encoding roundtrip" $+ QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->+ Just x === Ae.decode (Ae.encode x)+ , QC.testProperty "Aeson encoding roundtrip (ExchangeRateRep)" $+ QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->+ let x' = Money.toExchangeRateRep x+ in Just x' === Ae.decode (Ae.encode x')+ , QC.testProperty "Aeson encoding roundtrip (ExchangeRate through ExchangeRateRep)" $+ QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->+ Just x === Ae.decode (Ae.encode (Money.toExchangeRateRep x))+ , QC.testProperty "Aeson encoding roundtrip (ExchangeRateRep through ExchangeRate)" $+ QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->+ Just (Money.toExchangeRateRep x) === Ae.decode (Ae.encode x)++ , QC.testProperty "Binary encoding roundtrip" $+ QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->+ let Right (_,_,y) = Binary.decodeOrFail (Binary.encode x)+ in x === y+ , QC.testProperty "Binary encoding roundtrip (ExchangeRateRep)" $+ QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->+ let x' = Money.toExchangeRateRep x+ bs = Binary.encode x'+ in Right (mempty, BSL.length bs, x') === Binary.decodeOrFail bs+ , QC.testProperty "Binary encoding roundtrip (ExchangeRate through ExchangeRateRep)" $+ QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->+ let x' = Money.toExchangeRateRep x+ bs = Binary.encode x'+ in Right (mempty, BSL.length bs, x) === Binary.decodeOrFail bs+ , QC.testProperty "Binary encoding roundtrip (ExchangeRateRep through ExchangeRate)" $+ QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->+ let x' = Money.toExchangeRateRep x+ bs = Binary.encode x+ in Right (mempty, BSL.length bs, x') === Binary.decodeOrFail bs++ , QC.testProperty "Cereal encoding roundtrip" $+ QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->+ Right x === Cereal.decode (Cereal.encode x)+ , QC.testProperty "Cereal encoding roundtrip (ExchangeRateRep)" $+ QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->+ let x' = Money.toExchangeRateRep x+ in Right x' === Cereal.decode (Cereal.encode x')+ , QC.testProperty "Cereal encoding roundtrip (ExchangeRate through ExchangeRateRep)" $+ QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->+ Right x === Cereal.decode (Cereal.encode (Money.toExchangeRateRep x))+ , QC.testProperty "Cereal encoding roundtrip (ExchangeRateRep through ExchangeRate)" $+ QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->+ Right (Money.toExchangeRateRep x) === Cereal.decode (Cereal.encode x)++#ifdef VERSION_store+ , QC.testProperty "Store encoding roundtrip" $+ QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->+ Right x === Store.decode (Store.encode x)+ , QC.testProperty "Store encoding roundtrip (ExchangeRateRep)" $+ QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->+ let x' = Money.toExchangeRateRep x+ in Right x' === Store.decode (Store.encode x')+ , QC.testProperty "Store encoding roundtrip (ExchangeRate through ExchangeRateRep)" $+ QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->+ Right x === Store.decode (Store.encode (Money.toExchangeRateRep x))+ , QC.testProperty "Store encoding roundtrip (ExchangeRateRep through ExchangeRate)" $+ QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->+ Right (Money.toExchangeRateRep x) === Store.decode (Store.encode x)+#endif+ ]++testRounding+ :: forall (currency :: Symbol) (unit :: Symbol)+ . (Money.GoodScale (Money.Scale currency unit), KnownSymbol currency)+ => Proxy currency+ -> Proxy unit+ -> Tasty.TestTree+testRounding _ _ =+ Tasty.testGroup "Rounding"+ [ QC.testProperty "floor" $ QC.forAll QC.arbitrary (g Money.floor)+ , QC.testProperty "ceiling" $ QC.forAll QC.arbitrary (g Money.ceiling)+ , QC.testProperty "round" $ QC.forAll QC.arbitrary (g Money.round)+ , QC.testProperty "truncate" $ QC.forAll QC.arbitrary (g Money.truncate)+ ]+ where+ g f = \(x :: Money.Dense currency) -> x === case f x of+ (y, Nothing) -> Money.fromDiscrete (y :: Money.Discrete currency unit)+ (y, Just z) -> Money.fromDiscrete y + z
− tests/Main.hs
@@ -1,444 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE TypeFamilies #-}--module Main where--import qualified Test.Tasty as Tasty-import qualified Test.Tasty.Runners as Tasty-import Test.Tasty.QuickCheck ((===), (==>))-import qualified Test.Tasty.QuickCheck as QC--import qualified Data.Aeson as Ae-import qualified Data.Binary as Binary-import qualified Data.ByteString.Lazy as BSL-import Data.Maybe (catMaybes, isJust, isNothing)-import Data.Proxy (Proxy(Proxy))-import qualified Data.Serialize as Cereal-import qualified Data.Store as Store-import GHC.TypeLits (Nat, Symbol, KnownSymbol, symbolVal)--import qualified Data.Money as Money-import qualified Data.Money.Internal as Money------------------------------------------------------------------------------------instance- ( Money.GoodScale scale- ) => QC.Arbitrary (Money.Discrete' currency scale) where- arbitrary = fmap fromInteger QC.arbitrary- shrink = fmap fromInteger . QC.shrink . toInteger--instance QC.Arbitrary Money.DiscreteRep where- arbitrary = do- let md = Money.mkDiscreteRep <$> QC.arbitrary <*> QC.arbitrary- <*> QC.arbitrary <*> QC.arbitrary- Just x <- QC.suchThat md isJust- pure x- shrink = \x -> Money.withDiscreteRep x (map Money.discreteRep . QC.shrink)--instance QC.Arbitrary (Money.Dense currency) where- arbitrary = do- Just x <- QC.suchThat (Money.dense <$> QC.arbitrary) isJust- pure x- shrink = catMaybes . fmap Money.dense . QC.shrink . toRational--instance QC.Arbitrary Money.DenseRep where- arbitrary = do- let md = Money.mkDenseRep <$> QC.arbitrary <*> QC.arbitrary <*> QC.arbitrary- Just x <- QC.suchThat md isJust- pure x- shrink = \x -> Money.withDenseRep x (map Money.denseRep . QC.shrink)--instance QC.Arbitrary (Money.ExchangeRate src dst) where- arbitrary = do- Just x <- QC.suchThat (fmap Money.exchangeRate QC.arbitrary) isJust- pure x- shrink =- catMaybes . fmap Money.exchangeRate . QC.shrink . Money.fromExchangeRate--instance QC.Arbitrary Money.ExchangeRateRep where- arbitrary = do- let md = Money.mkExchangeRateRep <$> QC.arbitrary <*> QC.arbitrary- <*> QC.arbitrary <*> QC.arbitrary- Just x <- QC.suchThat md isJust- pure x- shrink = \x ->- Money.withExchangeRateRep x (map Money.exchangeRateRep . QC.shrink)------------------------------------------------------------------------------------main :: IO ()-main = Tasty.defaultMainWithIngredients- [ Tasty.consoleTestReporter- , Tasty.listingTests- ] tests--tests :: Tasty.TestTree-tests =- Tasty.testGroup "root"- [ testCurrencies- , testCurrencyUnits- , testExchange- ]--testCurrencies :: Tasty.TestTree-testCurrencies =- Tasty.testGroup "Currency"- [ testDense (Proxy :: Proxy "BTC") -- A cryptocurrency.- , testDense (Proxy :: Proxy "USD") -- A fiat currency with decimal fractions.- , testDense (Proxy :: Proxy "VUV") -- A fiat currency with non-decimal fractions.- , testDense (Proxy :: Proxy "XAU") -- A precious metal.- ]--testCurrencyUnits :: Tasty.TestTree-testCurrencyUnits =- Tasty.testGroup "Currency units"- [ testDiscrete (Proxy :: Proxy "BTC") (Proxy :: Proxy "BTC")- , testDiscrete (Proxy :: Proxy "BTC") (Proxy :: Proxy "satoshi")- , testDiscrete (Proxy :: Proxy "BTC") (Proxy :: Proxy "bitcoin")- , testDiscrete (Proxy :: Proxy "USD") (Proxy :: Proxy "USD")- , testDiscrete (Proxy :: Proxy "USD") (Proxy :: Proxy "cent")- , testDiscrete (Proxy :: Proxy "USD") (Proxy :: Proxy "dollar")- , testDiscrete (Proxy :: Proxy "VUV") (Proxy :: Proxy "vatu")- , testDiscrete (Proxy :: Proxy "XAU") (Proxy :: Proxy "micrograin")- , testDiscrete (Proxy :: Proxy "XAU") (Proxy :: Proxy "milligrain")- , testDiscrete (Proxy :: Proxy "XAU") (Proxy :: Proxy "grain")- ]--testDense- :: forall currency- . KnownSymbol currency- => Proxy currency- -> Tasty.TestTree-testDense pc =- Tasty.testGroup ("Dense " ++ show (symbolVal pc))- [ QC.testProperty "read . show == id" $- QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->- x === read (show x)- , QC.testProperty "fromDenseRep . denseRep == Just" $- QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->- Just x === Money.fromDenseRep (Money.denseRep x)- , QC.testProperty "fromDenseRep works only for same currency" $- QC.forAll QC.arbitrary $ \(dr :: Money.DenseRep) ->- (Money.denseRepCurrency dr /= symbolVal pc)- ==> isNothing (Money.fromDenseRep dr :: Maybe (Money.Dense currency))- , QC.testProperty "withDenseRep" $- QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->- let dr = Money.denseRep x- in Money.withDenseRep dr $ \x' ->- (show x, dr, Money.denseRep (x + 1))- === (show x', Money.denseRep x', Money.denseRep (x' + 1))-- , QC.testProperty "Aeson encoding roundtrip" $- QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->- Just x === Ae.decode (Ae.encode x)- , QC.testProperty "Aeson encoding roundtrip (DenseRep)" $- QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->- let x' = Money.denseRep x- in Just x' === Ae.decode (Ae.encode x')- , QC.testProperty "Aeson encoding roundtrip (Dense through DenseRep)" $- QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->- Just x === Ae.decode (Ae.encode (Money.denseRep x))- , QC.testProperty "Aeson encoding roundtrip (DenseRep through Dense)" $- QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->- Just (Money.denseRep x) === Ae.decode (Ae.encode x)-- , QC.testProperty "Binary encoding roundtrip" $- QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->- let Right (_,_,y) = Binary.decodeOrFail (Binary.encode x)- in x === y- , QC.testProperty "Binary encoding roundtrip (DenseRep)" $- QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->- let x' = Money.denseRep x- bs = Binary.encode x'- in Right (mempty, BSL.length bs, x') === Binary.decodeOrFail bs- , QC.testProperty "Binary encoding roundtrip (Dense through DenseRep)" $- QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->- let x' = Money.denseRep x- bs = Binary.encode x'- in Right (mempty, BSL.length bs, x) === Binary.decodeOrFail bs- , QC.testProperty "Binary encoding roundtrip (DenseRep through Dense)" $- QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->- let x' = Money.denseRep x- bs = Binary.encode x- in Right (mempty, BSL.length bs, x') === Binary.decodeOrFail bs-- , QC.testProperty "Cereal encoding roundtrip" $- QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->- Right x === Cereal.decode (Cereal.encode x)- , QC.testProperty "Cereal encoding roundtrip (DenseRep)" $- QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->- let x' = Money.denseRep x- in Right x' === Cereal.decode (Cereal.encode x')- , QC.testProperty "Cereal encoding roundtrip (Dense through DenseRep)" $- QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->- Right x === Cereal.decode (Cereal.encode (Money.denseRep x))- , QC.testProperty "Cereal encoding roundtrip (DenseRep through Dense)" $- QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->- Right (Money.denseRep x) === Cereal.decode (Cereal.encode x)-- , QC.testProperty "Store encoding roundtrip" $- QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->- Right x === Store.decode (Store.encode x)- , QC.testProperty "Store encoding roundtrip (DenseRep)" $- QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->- let x' = Money.denseRep x- in Right x' === Store.decode (Store.encode x')- , QC.testProperty "Store encoding roundtrip (Dense through DenseRep)" $- QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->- Right x === Store.decode (Store.encode (Money.denseRep x))- , QC.testProperty "Store encoding roundtrip (DenseRep through Dense)" $- QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->- Right (Money.denseRep x) === Store.decode (Store.encode x)- ]--testExchange :: Tasty.TestTree-testExchange =- Tasty.testGroup "Exchange"- [ testExchangeRate (Proxy :: Proxy "BTC") (Proxy :: Proxy "BTC")- , testExchangeRate (Proxy :: Proxy "BTC") (Proxy :: Proxy "USD")- , testExchangeRate (Proxy :: Proxy "BTC") (Proxy :: Proxy "VUV")- , testExchangeRate (Proxy :: Proxy "BTC") (Proxy :: Proxy "XAU")- , testExchangeRate (Proxy :: Proxy "USD") (Proxy :: Proxy "BTC")- , testExchangeRate (Proxy :: Proxy "USD") (Proxy :: Proxy "USD")- , testExchangeRate (Proxy :: Proxy "USD") (Proxy :: Proxy "VUV")- , testExchangeRate (Proxy :: Proxy "USD") (Proxy :: Proxy "XAU")- , testExchangeRate (Proxy :: Proxy "VUV") (Proxy :: Proxy "BTC")- , testExchangeRate (Proxy :: Proxy "VUV") (Proxy :: Proxy "USD")- , testExchangeRate (Proxy :: Proxy "VUV") (Proxy :: Proxy "VUV")- , testExchangeRate (Proxy :: Proxy "VUV") (Proxy :: Proxy "XAU")- , testExchangeRate (Proxy :: Proxy "XAU") (Proxy :: Proxy "BTC")- , testExchangeRate (Proxy :: Proxy "XAU") (Proxy :: Proxy "USD")- , testExchangeRate (Proxy :: Proxy "XAU") (Proxy :: Proxy "VUV")- , testExchangeRate (Proxy :: Proxy "XAU") (Proxy :: Proxy "XAU")- ]--testDiscrete- :: forall (currency :: Symbol) (unit :: Symbol)- . ( Money.GoodScale (Money.Scale currency unit)- , KnownSymbol currency- , KnownSymbol unit )- => Proxy currency- -> Proxy unit- -> Tasty.TestTree-testDiscrete pc pu =- Tasty.testGroup ("Discrete " ++ show (symbolVal pc) ++ " "- ++ show (symbolVal pu))- [ testRounding pc pu- , QC.testProperty "read . show == id" $- QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->- x === read (show x)- , QC.testProperty "fromDiscreteRep . discreteRep == Just" $- QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->- Just x === Money.fromDiscreteRep (Money.discreteRep x)- , QC.testProperty "fromDiscreteRep works only for same currency and scale" $- QC.forAll QC.arbitrary $ \(dr :: Money.DiscreteRep) ->- ((Money.discreteRepCurrency dr /= symbolVal pc) &&- (Money.discreteRepScale dr /=- Money.scale (Proxy :: Proxy (Money.Scale currency unit)))- ) ==> isNothing (Money.fromDiscreteRep dr- :: Maybe (Money.Discrete currency unit))- , QC.testProperty "withDiscreteRep" $- QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->- let dr = Money.discreteRep x- in ( Money.withDiscreteRep dr $ \x' ->- (show x, dr, Money.discreteRep (x + 1))- === (show x', Money.discreteRep x', Money.discreteRep (x' + 1))- ) :: QC.Property-- , QC.testProperty "Aeson encoding roundtrip" $- QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->- Just x === Ae.decode (Ae.encode x)- , QC.testProperty "Aeson encoding roundtrip (DiscreteRep)" $- QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->- let x' = Money.discreteRep x- in Just x' === Ae.decode (Ae.encode x')- , QC.testProperty "Aeson encoding roundtrip (Discrete through DiscreteRep)" $- QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->- Just x === Ae.decode (Ae.encode (Money.discreteRep x))- , QC.testProperty "Aeson encoding roundtrip (DiscreteRep through Discrete)" $- QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->- Just (Money.discreteRep x) === Ae.decode (Ae.encode x)-- , QC.testProperty "Binary encoding roundtrip" $- QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->- let Right (_,_,y) = Binary.decodeOrFail (Binary.encode x)- in x === y- , QC.testProperty "Binary encoding roundtrip (DiscreteRep)" $- QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->- let x' = Money.discreteRep x- bs = Binary.encode x'- in Right (mempty, BSL.length bs, x') === Binary.decodeOrFail bs- , QC.testProperty "Binary encoding roundtrip (Discrete through DiscreteRep)" $- QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->- let x' = Money.discreteRep x- bs = Binary.encode x'- in Right (mempty, BSL.length bs, x) === Binary.decodeOrFail bs- , QC.testProperty "Binary encoding roundtrip (DiscreteRep through Discrete)" $- QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->- let x' = Money.discreteRep x- bs = Binary.encode x- in Right (mempty, BSL.length bs, x') === Binary.decodeOrFail bs-- , QC.testProperty "Cereal encoding roundtrip" $- QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->- Right x === Cereal.decode (Cereal.encode x)- , QC.testProperty "Cereal encoding roundtrip (DiscreteRep)" $- QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->- let x' = Money.discreteRep x- in Right x' === Cereal.decode (Cereal.encode x')- , QC.testProperty "Cereal encoding roundtrip (Discrete through DiscreteRep)" $- QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->- Right x === Cereal.decode (Cereal.encode (Money.discreteRep x))- , QC.testProperty "Cereal encoding roundtrip (DiscreteRep through Discrete)" $- QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->- Right (Money.discreteRep x) === Cereal.decode (Cereal.encode x)-- , QC.testProperty "Store encoding roundtrip" $- QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->- Right x === Store.decode (Store.encode x)- , QC.testProperty "Store encoding roundtrip (DiscreteRep)" $- QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->- let x' = Money.discreteRep x- in Right x' === Store.decode (Store.encode x')- , QC.testProperty "Store encoding roundtrip (Discrete through DiscreteRep)" $- QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->- Right x === Store.decode (Store.encode (Money.discreteRep x))- , QC.testProperty "Store encoding roundtrip (DiscreteRep through Discrete)" $- QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->- Right (Money.discreteRep x) === Store.decode (Store.encode x)- ]--testExchangeRate- :: forall (src :: Symbol) (dst :: Symbol)- . (KnownSymbol src, KnownSymbol dst)- => Proxy src- -> Proxy dst- -> Tasty.TestTree-testExchangeRate ps pd =- Tasty.testGroup ("ExchangeRate " ++ show (symbolVal ps) ++ " "- ++ show (symbolVal pd))- [ QC.testProperty "read . show == id" $- QC.forAll QC.arbitrary $ \(xr :: Money.ExchangeRate src dst) ->- xr === read (show xr)- , QC.testProperty "flipExchangeRate . flipExchangeRate == id" $- QC.forAll QC.arbitrary $ \(xr :: Money.ExchangeRate src dst) ->- let xr' = Money.flipExchangeRate xr- in (Money.fromExchangeRate xr /= Money.fromExchangeRate xr')- ==> (xr === Money.flipExchangeRate xr')- , QC.testProperty "exchange (flipExchangeRate x) . exchange x == id" $- QC.forAll QC.arbitrary $- \( c0 :: Money.Dense src- , xr :: Money.ExchangeRate src dst- ) -> c0 === Money.exchange (Money.flipExchangeRate xr)- (Money.exchange xr c0)- , QC.testProperty "x == 1 ===> exchange x == id" $- QC.forAll QC.arbitrary $- \( c0 :: Money.Dense src- ) -> let Just xr = Money.exchangeRate 1- in toRational c0 === toRational (Money.exchange xr c0)- , QC.testProperty "x /= 1 ===> exchange x /= id" $- QC.forAll QC.arbitrary $- \( c0 :: Money.Dense src- , xr :: Money.ExchangeRate src dst- ) -> (Money.fromExchangeRate xr /= 1)- ==> (toRational c0 /= toRational (Money.exchange xr c0))- , QC.testProperty "fromExchangeRateRep . exchangeRateRep == Just" $- QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->- Just x === Money.fromExchangeRateRep (Money.exchangeRateRep x)- , QC.testProperty "fromExchangeRateRep works only for same currencies" $- QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRateRep) ->- ((Money.exchangeRateRepSrcCurrency x /= symbolVal ps) &&- (Money.exchangeRateRepDstCurrency x /= symbolVal pd))- ==> isNothing (Money.fromExchangeRateRep x- :: Maybe (Money.ExchangeRate src dst))- , QC.testProperty "withExchangeRateRep" $- QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->- let dr = Money.exchangeRateRep x- in Money.withExchangeRateRep dr $ \x' ->- (show x, dr) === (show x', Money.exchangeRateRep x')-- , QC.testProperty "Aeson encoding roundtrip" $- QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->- Just x === Ae.decode (Ae.encode x)- , QC.testProperty "Aeson encoding roundtrip (ExchangeRateRep)" $- QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->- let x' = Money.exchangeRateRep x- in Just x' === Ae.decode (Ae.encode x')- , QC.testProperty "Aeson encoding roundtrip (ExchangeRate through ExchangeRateRep)" $- QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->- Just x === Ae.decode (Ae.encode (Money.exchangeRateRep x))- , QC.testProperty "Aeson encoding roundtrip (ExchangeRateRep through ExchangeRate)" $- QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->- Just (Money.exchangeRateRep x) === Ae.decode (Ae.encode x)-- , QC.testProperty "Binary encoding roundtrip" $- QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->- let Right (_,_,y) = Binary.decodeOrFail (Binary.encode x)- in x === y- , QC.testProperty "Binary encoding roundtrip (ExchangeRateRep)" $- QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->- let x' = Money.exchangeRateRep x- bs = Binary.encode x'- in Right (mempty, BSL.length bs, x') === Binary.decodeOrFail bs- , QC.testProperty "Binary encoding roundtrip (ExchangeRate through ExchangeRateRep)" $- QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->- let x' = Money.exchangeRateRep x- bs = Binary.encode x'- in Right (mempty, BSL.length bs, x) === Binary.decodeOrFail bs- , QC.testProperty "Binary encoding roundtrip (ExchangeRateRep through ExchangeRate)" $- QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->- let x' = Money.exchangeRateRep x- bs = Binary.encode x- in Right (mempty, BSL.length bs, x') === Binary.decodeOrFail bs-- , QC.testProperty "Cereal encoding roundtrip" $- QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->- Right x === Cereal.decode (Cereal.encode x)- , QC.testProperty "Cereal encoding roundtrip (ExchangeRateRep)" $- QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->- let x' = Money.exchangeRateRep x- in Right x' === Cereal.decode (Cereal.encode x')- , QC.testProperty "Cereal encoding roundtrip (ExchangeRate through ExchangeRateRep)" $- QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->- Right x === Cereal.decode (Cereal.encode (Money.exchangeRateRep x))- , QC.testProperty "Cereal encoding roundtrip (ExchangeRateRep through ExchangeRate)" $- QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->- Right (Money.exchangeRateRep x) === Cereal.decode (Cereal.encode x)-- , QC.testProperty "Store encoding roundtrip" $- QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->- Right x === Store.decode (Store.encode x)- , QC.testProperty "Store encoding roundtrip (ExchangeRateRep)" $- QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->- let x' = Money.exchangeRateRep x- in Right x' === Store.decode (Store.encode x')- , QC.testProperty "Store encoding roundtrip (ExchangeRate through ExchangeRateRep)" $- QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->- Right x === Store.decode (Store.encode (Money.exchangeRateRep x))- , QC.testProperty "Store encoding roundtrip (ExchangeRateRep through ExchangeRate)" $- QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->- Right (Money.exchangeRateRep x) === Store.decode (Store.encode x)- ]--testRounding- :: forall (currency :: Symbol) (unit :: Symbol)- . (Money.GoodScale (Money.Scale currency unit), KnownSymbol currency)- => Proxy currency- -> Proxy unit- -> Tasty.TestTree-testRounding _ _ =- Tasty.testGroup "Rounding"- [ QC.testProperty "floor" $ QC.forAll QC.arbitrary (g Money.floor)- , QC.testProperty "ceiling" $ QC.forAll QC.arbitrary (g Money.ceiling)- , QC.testProperty "round" $ QC.forAll QC.arbitrary (g Money.round)- , QC.testProperty "truncate" $ QC.forAll QC.arbitrary (g Money.truncate)- ]- where- g f = \(x :: Money.Dense currency) -> x === case f x of- (y, Nothing) -> Money.fromDiscrete (y :: Money.Discrete currency unit)- (y, Just z) -> Money.fromDiscrete y + z