safe-money 0.4.1 → 0.5

raw patch · 7 files changed

+2489/−1607 lines, 7 filesdep +vector-spacePVP ok

version bump matches the API change (PVP)

Dependencies added: vector-space

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• README.md +2/−2
• changelog.md +66/−19
• safe-money.cabal +15/−4
• src/Money.hs +21/−8
• src/Money/Internal.hs +1902/−1532
• test/Main.hs +482/−41

@@ -1,4 +1,4 @@-Copyright (c) 2016-2017, Renzo Carbonara+Copyright (c) 2016-2018, Renzo Carbonara  All rights reserved. 

@@ -2,5 +2,5 @@ operations for monetary values in all world currencies, including fiat currencies, precious metals and crypto-currencies. -You can enter a development shell with `nix-shell`, or build with `nix-build-./release.nix -A ghc822.safe-money` (or similar, check `release.nix`).+You can enter a development shell with `nix-shell`, or build with `nix build+-f release.nix ghc822.safe-money` (or similar, check `release.nix`).

@@ -1,3 +1,47 @@+# Version 0.5++* _COMPILER ASSISTED BREAKING CHANGE_. The `round`, `floor`, `ceiling` and+  `truncate` functions were replaced by a single `discreteFromDense` function+  taking an argument of type `Approximation` (`Round`, `Floor`, `Ceiling` or+  `Truncate`) as an argument.++* _COMPILER ASSISTED BREAKING CHANGE_. The `fromDiscrete` function was+  renamed to `denseFromDiscrete`.++* _COMPILER ASSISTED BREAKING CHANGE_. The `fromExchangeRate` function was+  renamed to `exchangeRateToRational`.++* _COMPILER ASSISTED BREAKING CHANGE_. The `flipExchangeRate` function was+  renamed to `exchangeRateRecip`.++* _COMPILER ASSISTED BREAKING CHANGE_. The `Dense` is not an instance of+  `Fractional` anymore because `recip` and `/` could potentially crash.++* Introduced new functions for rendering and parsing decimal reperesentations+  of monetary amounts: `denseCurrency`, `discreteCurrency`, `denseFromDecimal`,+  `denseToDecimal`, `discreteFromDecimal`, `exchangeRateFromDecimal`,+  `exchangeRateToDecimal`.++* Introduced optional `AdditiveGroup` and `VectorSpace` group instances for+  `Dense` and `Discrete`. These type-classes come from the `vector-space`+  library and they can be enabled or disabled via the `vector-space` Cabal flag,+  which is enabled by default.++* Introduced `discrete` constructor which behaves just like `fromInteger`.++* Introduced the `dense'` constructor as an unsafe but convenient version of+  `dense`.++* The `ErrScaleNonCanonical` type is now exported.++* The `Money.Internal` module is now exposed, but hidden from the Haddock+  documentation.++* New scale: `"BTC" "millibitcoin"`.++* Added many tests.++ # Version 0.4.1  * `ExchangeRate` is now a `Category`.@@ -5,26 +49,25 @@  # Version 0.4 -* BREAKING CHANGE. COMPILER WON'T COMPLAIN. HUMAN INTERVENTION POTENTIALLY-  REQUIRED. The JSON serializations for all of `Dense`, `SomeDense`, `Discrete`,-  `SomeDiscrete`, `ExchangeRate` and `SomeExchangeRate` changed. The `FromJSON`-  instances are backwards compatible with the old serializations, but the-  `ToJSON` instances will only generate the new format, which is the same as the-  old format except the leading strings `"Dense"`, `"Discrete"` and-  `"ExchangeRate"`, respectively, are not present in the rendered JSON array-  anymore. So, if you were manually relying on the `ToJSON` instance, please-  update your code.+* **BREAKING CHANGE REQUIRING HUMAN INTERVENTION**. The JSON serializations for+  all of `Dense`, `SomeDense`, `Discrete`, `SomeDiscrete`, `ExchangeRate` and+  `SomeExchangeRate` changed. The `FromJSON` instances are backwards compatible+  with the old serializations, but the `ToJSON` instances will only generate the+  new format, which is the same as the old format except the leading strings+  `"Dense"`, `"Discrete"` and `"ExchangeRate"`, respectively, are not present in+  the rendered JSON array anymore. So, if you were manually relying on the+  `ToJSON` instance, please update your code. -* BREAKING CHANGE. COMPILER WILL COMPLAIN: Changed the `Rep` suffix for a `Some`+* _COMPILER ASSISTED BREAKING CHANGE_. Changed the `Rep` suffix for a `Some`   prefix Everywhere.  For example, `DenseRep` was renamed to `SomeDense`. -* BREAKING CHANGE. COMPILER WILL COMPLAIN: Replaced the+* _COMPILER ASSISTED BREAKING CHANGE_. Replaced the   `someDenseAmountNumerator` and `someDenseAmountDenominator` `Integers` with a   single `someDenseAmount` `Rational` number. Similarly for `someDiscreteScale`   and `someExchangeRateRate`. The `mkSomeDense`, `someDiscreteScale` and   `mkSomeDense` also take a `Rational` now. -* BREAKING CHANGE. COMPILER WILL COMPLAIN: The `truncate`, `floor`, `celing` and+* _COMPILER ASSISTED BREAKING CHANGE_. The `truncate`, `floor`, `celing` and   `round` functions now return just `0` as a reminder if there's no significant   reminder, instead of `Nothing`. @@ -40,18 +83,22 @@  # Version 0.3 -* BREAKING CHANGE: The `Data.Money` module was renamed to `Money`.+* _COMPILER ASSISTED 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.+* _COMPILER ASSISTED 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`.+* _COMPILER ASSISTED BREAKING CHANGE_. Renamed `discreteRep` to+  `toDiscreteRep`. -* BREAKING CHANGE: Renamed `denseRep` to `toDenseRep`.+* _COMPILER ASSISTED BREAKING CHANGE_. Renamed `denseRep` to `toDenseRep`. -* BREAKING CHANGE: Renamed `exchangeRateRep` to `toExchangeRateRep`.+* _COMPILER ASSISTED BREAKING CHANGE_. Renamed `exchangeRateRep` to+  `toExchangeRateRep`. -* BREAKING CHANGE: Renamed Iceleandic currency `"eyir"` to `"eyrir"`+* _COMPILER ASSISTED BREAKING CHANGE_. Renamed Iceleandic currency `"eyir"` to+  `"eyrir"`  * Remove upper bound constraints from all dependencies except `base`. 

@@ -1,8 +1,8 @@ name: safe-money-version: 0.4.1+version: 0.5 license: BSD3 license-file: LICENSE-copyright: Copyright (c) Renzo Carbonara 2016-2017+copyright: Copyright (c) Renzo Carbonara 2016-2018 author: Renzo Carbonara maintainer: renλren!zone stability: Experimental@@ -33,9 +33,10 @@   default-language: Haskell2010   hs-source-dirs: src   ghc-options: -Wall -O2-  exposed-modules: Money-  other-modules: Money.Internal   build-depends: base (>=4.8 && <5.0), constraints+  exposed-modules:+    Money+    Money.Internal    if flag(aeson)     build-depends: aeson (>=0.9)@@ -58,6 +59,9 @@   if (flag(store) && !impl(ghcjs))     build-depends: store (>=0.2)     cpp-options: -DHAS_store+  if flag(vector-space)+    build-depends: vector-space (>=0.12)+    cpp-options: -DHAS_vector_space   if flag(xmlbf)     build-depends: xmlbf (>=0.2), text     cpp-options: -DHAS_xmlbf@@ -97,6 +101,9 @@   if (flag(store) && !impl(ghcjs))     build-depends: store     cpp-options: -DHAS_store+  if flag(vector-space)+    build-depends: vector-space+    cpp-options: -DHAS_vector_space   if flag(xmlbf)     build-depends: xmlbf, text     cpp-options: -DHAS_xmlbf@@ -127,6 +134,10 @@   manual: True flag serialise   description: Provide instances for @serialise@+  default: True+  manual: True+flag vector-space+  description: Provide instances for @vector-space@   default: True   manual: True flag xmlbf

@@ -17,29 +17,39 @@ -- -- This module offers plenty of documentation, but for a deep explanation of -- how all of the pieces fit together, please read--- https://ren.zone/articles/safe-money+-- <https://ren.zone/articles/safe-money>. Notice, however, that this library+-- has changed a bit since that article was written. You can always see the+-- [change log](https://github.com/k0001/safe-money/blob/master/changelog.md) to+-- understand what has changed. module Money  ( -- * Dense monetary values    I.Dense+ , I.denseCurrency  , I.dense+ , I.dense'+ , I.denseFromDiscrete+ , I.denseFromDecimal+ , I.denseToDecimal    -- * Discrete monetary values  , I.Discrete  , I.Discrete'- , I.fromDiscrete- , I.round- , I.ceiling- , I.floor- , I.truncate+ , I.discrete+ , I.discreteCurrency+ , I.discreteFromDense+ , I.discreteFromDecimal    -- * Currency scales  , I.Scale  , I.GoodScale+ , I.ErrScaleNonCanonical  , I.scale    -- * Currency exchange  , I.ExchangeRate  , I.exchangeRate- , I.fromExchangeRate- , I.flipExchangeRate  , I.exchange+ , I.exchangeRateRecip+ , I.exchangeRateFromDecimal+ , I.exchangeRateToDecimal+ , I.exchangeRateToRational    -- * Serializable representations  , I.SomeDense  , I.toSomeDense@@ -64,6 +74,8 @@  , I.someExchangeRateSrcCurrency  , I.someExchangeRateDstCurrency  , I.someExchangeRateRate+ -- * Misc+ , I.Approximation(Round, Floor, Ceiling, Truncate)  ) where  import qualified Money.Internal as I@@ -768,6 +780,7 @@ -- | Bitcoin type instance I.Scale "BTC" "BTC" = '(100000000, 1) type instance I.Scale "BTC" "bitcoin" = '(1, 1)+type instance I.Scale "BTC" "millibitcoin" = '(1000, 1) type instance I.Scale "BTC" "satoshi" = '(100000000, 1)  -- | Bitcoin

@@ -4,1536 +4,1906 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# 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- , SomeDense- , toSomeDense- , mkSomeDense- , fromSomeDense- , withSomeDense- , someDenseCurrency- , someDenseAmount- , SomeDiscrete- , toSomeDiscrete- , mkSomeDiscrete- , fromSomeDiscrete- , withSomeDiscrete- , someDiscreteCurrency- , someDiscreteScale- , someDiscreteAmount- , SomeExchangeRate- , toSomeExchangeRate- , mkSomeExchangeRate- , fromSomeExchangeRate- , withSomeExchangeRate- , someExchangeRateSrcCurrency- , someExchangeRateDstCurrency- , someExchangeRateRate- ) where--import Control.Applicative ((<|>), empty)-import Control.Category (Category((.), id))-import Control.Monad ((<=<), guard, when)-import Data.Constraint (Dict(Dict))-import Data.Monoid ((<>))-import Data.Proxy (Proxy(..))-import Data.Ratio ((%), numerator, denominator)-import GHC.Exts (fromList)-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 qualified Text.Read as Read-import Unsafe.Coerce (unsafeCoerce)--#ifdef HAS_aeson-import qualified Data.Aeson as Ae-#endif--#ifdef HAS_binary-import qualified Data.Binary as Binary-#endif--#ifdef HAS_cereal-import qualified Data.Serialize as Cereal-#endif--#ifdef HAS_deepseq-import Control.DeepSeq (NFData)-#endif--#ifdef HAS_hashable-import Data.Hashable (Hashable)-#endif--#ifdef HAS_serialise-import qualified Codec.Serialise as Ser-#endif--#ifdef HAS_store-import qualified Data.Store as Store-#endif--#ifdef HAS_xmlbf-import qualified Xmlbf-import qualified Data.Text as Text-#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', 'fromRational',--- 'fromInteger' or 'fromIntegral'.------ /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, GHC.Generic)---- | /WARNING/ if there exists the possibility that the given 'Rational' has a--- zero as a denominator, which although unlikely, is possible if the 'Rational'--- is constructed unsafely using 'GHC.Real.infinity' or 'GHC.Real.notANumber'--- for example, then use 'dense' instead of 'fromRational'.-deriving instance Fractional (Dense (currency :: Symbol))--instance forall currency. KnownSymbol currency => Show (Dense currency) where-  showsPrec n = \(Dense r0) ->-    let c = symbolVal (Proxy :: Proxy currency)-    in showParen (n > 10) $-         showString "Dense " . showsPrec 0 c . showChar ' ' .-         showsPrec 0 (numerator r0) . showChar '%' .-         showsPrec 0 (denominator r0)--instance forall currency. KnownSymbol currency => Read (Dense currency) where-  readPrec = Read.parens $ do-    let c = symbolVal (Proxy :: Proxy currency)-    _ <- ReadPrec.lift (ReadP.string ("Dense " ++ show c ++ " "))-    maybe empty pure =<< fmap dense Read.readPrec---- | Build a 'Dense' monetary value from a 'Rational' value.------ For example, if you want to represent @USD 12.52316@, then you can use:------ @--- 'dense' (125316 % 10000)--- @------ Returns 'Nothing' in case the denominator of the given 'Rational' is zero,--- which although unlikely, is possible if the 'Rational' is constructed--- unsafely using 'GHC.Real.infinity' or 'GHC.Real.notANumber', for example.--- If you don't care about that scenario, you can use `fromRational` to build--- the `Dense` value.-dense :: Rational -> Maybe (Dense currency)-dense = \r0 -> if (denominator r0 == 0) 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-  showsPrec n = \d0@(Discrete i0) ->-    let c = symbolVal (Proxy :: Proxy currency)-        s = scale d0-    in showParen (n > 10) $-         showString "Discrete " .  showsPrec 0 c . showChar ' ' .-         showsPrec 0 (numerator s) . showChar '%' .-         showsPrec 0 (denominator s) . showChar ' ' .-         showsPrec 0 i0--instance forall currency scale.-  ( KnownSymbol currency, GoodScale scale-  ) => Read (Discrete' currency scale) where-  readPrec = Read.parens $ do-    let c = symbolVal (Proxy :: Proxy currency)-        s = scale (Proxy :: Proxy scale)-    _ <- ReadPrec.lift (ReadP.string (concat-           [ "Discrete ", show c, " "-           , show (numerator s), "%"-           , show (denominator s), " "-           ]))-    Discrete <$> Read.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, 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-      !d2 = Discrete i2-      !rest = Dense (r0 - r2)-  in (d2, rest)-{-# 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 == ('fromDiscrete' x, 0)--- @------ 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, z) -> 'fromDiscrete' y + z--- @-round-  :: GoodScale scale-  => Dense currency-  -> (Discrete' currency scale, 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 == ('fromDiscrete' x, 0)--- @------ Otherwise, if @x@ is not representable in its @currency@'s @unit@ 'Scale',--- then the following holds:------ @--- 'ceiling' x == (y, z)--- @------ @--- x /= y--- @------ @--- z < 0--- @------ Proof that 'ceiling' doesn't lose money:------ @--- x == case 'ceiling' x of (y, z) -> 'fromDiscrete' y + z--- @-ceiling-  :: GoodScale scale-  => Dense currency-  -> (Discrete' currency scale, 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 == ('fromDiscrete' x, 0)--- @------ Otherwise, if @x@ is not representable in its @currency@'s @unit@ 'Scale',--- then the following holds:------ @--- 'floor' x == (y, z)--- @------ @--- x /= y--- @------ @--- z > 0--- @------ Proof that 'floor' doesn't lose money:------ @--- x == case 'floor' x of (y, z) -> 'fromDiscrete' y + z--- @-floor-  :: GoodScale scale-  => Dense currency-  -> (Discrete' currency scale, 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 == ('fromDiscrete' x, 0)--- @------ 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, z) -> 'fromDiscrete' y + z--- @-truncate-  :: GoodScale scale-  => Dense currency-  -> (Discrete' currency scale, 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)----- | Composition of 'ExchangeRate's multiplies exchange rates together:------ @--- 'fromExchangeRate' x * 'fromExchangeRate' y  ==  'fromExchangeRate' (x . y)--- @------ Identity:------ @--- x  ==  x . id  ==  id . x--- @------ Associativity:------ @--- x . y . z  ==  x . (y . z)  ==  (x . y) . z--- @------ Conmutativity (provided the types allow for composition):------ @--- x . y  ==  y . x--- @------ Multiplicative inverse:------ @--- 1  ==  'fromExchangeRate' (x . 'flipExchangeRate' x)--- @-instance Category ExchangeRate where-  id = ExchangeRate 1-  {-# INLINE id #-}-  ExchangeRate a . ExchangeRate b = ExchangeRate (a * b)-  {-# INLINE (.) #-}--instance forall src dst.-  ( KnownSymbol src, KnownSymbol dst-  ) => Show (ExchangeRate src dst) where-  showsPrec n = \(ExchangeRate r0) ->-    let s = symbolVal (Proxy :: Proxy src)-        d = symbolVal (Proxy :: Proxy dst)-    in showParen (n > 10) $-         showString "ExchangeRate " . showsPrec 0 s . showChar ' ' .-         showsPrec 0 d . showChar ' ' .-         showsPrec 0 (numerator r0) . showChar '%' .-         showsPrec 0 (denominator r0)--instance forall src dst.-  ( KnownSymbol src, KnownSymbol dst-  ) => Read (ExchangeRate (src :: Symbol) (dst :: Symbol)) where-  readPrec = Read.parens $ 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 Read.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'.------ This function retuns the multiplicative inverse of the given 'ExchangeRate',--- leading to the following 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 #-}------------------------------------------------------------------------------------- SomeDense---- | A monomorphic representation of 'Dense' that is easier to serialize and--- deserialize than 'Dense' in case you don't know the type indexes involved.------ If you are trying to construct a value of this type from some raw input, then--- you will need to use the 'mkSomeDense' function.------ In order to be able to effectively serialize a 'SomeDense' value, you--- need to serialize the following three values (which are the eventual--- arguments to 'mkSomeDense'):------ * 'someDenseCurrency'--- * 'someDenseAmount'-data SomeDense = SomeDense-  { _someDenseCurrency          :: !String-  , _someDenseAmount            :: !Rational-  } deriving (Eq, Show, GHC.Generic)---- | WARNING: This instance does not compare monetary amounts, it just helps you--- sort 'SomeDense' values in case you need to put them in a 'Data.Set.Set' or--- similar.-deriving instance Ord SomeDense---- | Currency name.-someDenseCurrency :: SomeDense -> String-someDenseCurrency = _someDenseCurrency-{-# INLINABLE someDenseCurrency #-}---- | Currency unit amount.-someDenseAmount :: SomeDense -> Rational-someDenseAmount = _someDenseAmount-{-# INLINABLE someDenseAmount #-}---- | Build a 'SomeDense' from raw values.------ This function is intended for deserialization purposes. You need to convert--- this 'SomeDense' value to a 'Dense' value in order to do any arithmetic--- operation on the monetary value.-mkSomeDense-  :: String   -- ^ Currency. ('someDenseCurrency')-  -> Rational -- ^ Scale. ('someDenseAmount')-  -> Maybe SomeDense-mkSomeDense = \c r -> do-  guard (denominator r /= 0)-  Just (SomeDense c r)-{-# INLINABLE mkSomeDense #-}---- | Convert a 'Dense' to a 'SomeDense' for ease of serialization.-toSomeDense :: KnownSymbol currency => Dense currency -> SomeDense-toSomeDense = \(Dense r0 :: Dense currency) ->-  let c = symbolVal (Proxy :: Proxy currency)-  in SomeDense c r0-{-# INLINABLE toSomeDense #-}---- | Attempt to convert a 'SomeDense' to a 'Dense', provided you know the target--- @currency@.-fromSomeDense-  :: forall currency-  .  KnownSymbol currency-  => SomeDense-  -> Maybe (Dense currency)  -- ^-fromSomeDense = \dr -> do-  guard (someDenseCurrency dr == symbolVal (Proxy :: Proxy currency))-  Just (Dense (someDenseAmount dr))-{-# INLINABLE fromSomeDense #-}---- | Convert a 'SomeDense' to a 'Dense' without knowing the target @currency@.------ Notice that @currency@ here can't leave its intended scope unless you can--- prove equality with some other type at the outer scope, but in that case you--- would be better off using 'fromSomeDense' directly.-withSomeDense-  :: SomeDense-  -> (forall currency. KnownSymbol currency => Dense currency -> r)-  -> r  -- ^-withSomeDense dr = \f ->-   case someSymbolVal (someDenseCurrency dr) of-      SomeSymbol (Proxy :: Proxy currency) ->-         f (Dense (someDenseAmount dr) :: Dense currency)-{-# INLINABLE withSomeDense #-}------------------------------------------------------------------------------------- SomeDiscrete---- | A monomorphic representation of 'Discrete' that is easier to serialize and--- deserialize than 'Discrete' in case you don't know the type indexes involved.------ If you are trying to construct a value of this type from some raw input, then--- you will need to use the 'mkSomeDiscrete' function.------ In order to be able to effectively serialize a 'SomeDiscrete' value, you need--- to serialize the following four values (which are the eventual arguments to--- 'mkSomeDiscrete'):------ * 'someDiscreteCurrency'--- * 'someDiscreteScale'--- * 'someDiscreteAmount'-data SomeDiscrete = SomeDiscrete-  { _someDiscreteCurrency :: !String   -- ^ Currency name.-  , _someDiscreteScale    :: !Rational -- ^ Positive, non-zero.-  , _someDiscreteAmount   :: !Integer  -- ^ Amount of unit.-  } deriving (Eq, Show, GHC.Generic)---- | WARNING: This instance does not compare monetary amounts, it just helps you--- sort 'SomeDiscrete' values in case you need to put them in a 'Data.Set.Set' or--- similar.-deriving instance Ord SomeDiscrete---- | Currency name.-someDiscreteCurrency :: SomeDiscrete -> String-someDiscreteCurrency = _someDiscreteCurrency-{-# INLINABLE someDiscreteCurrency #-}---- | Positive, non-zero.-someDiscreteScale :: SomeDiscrete -> Rational-someDiscreteScale = _someDiscreteScale-{-# INLINABLE someDiscreteScale #-}---- | Amount of currency unit.-someDiscreteAmount :: SomeDiscrete -> Integer-someDiscreteAmount = _someDiscreteAmount-{-# INLINABLE someDiscreteAmount #-}---- | Internal. Build a 'SomeDiscrete' from raw values.------ This function is intended for deserialization purposes. You need to convert--- this 'SomeDiscrete' value to a 'Discrete' vallue in order to do any arithmetic--- operation on the monetary value.-mkSomeDiscrete-  :: String   -- ^ Currency name. ('someDiscreteCurrency')-  -> Rational -- ^ Scale. Positive, non-zero. ('someDiscreteScale')-  -> Integer  -- ^ Amount of unit. ('someDiscreteAmount')-  -> Maybe SomeDiscrete-mkSomeDiscrete = \c r a -> do-  guard (denominator r /= 0)-  guard (r > 0)-  Just (SomeDiscrete c r a)-{-# INLINABLE mkSomeDiscrete #-}---- | Convert a 'Discrete' to a 'SomeDiscrete' for ease of serialization.-toSomeDiscrete-  :: (KnownSymbol currency, GoodScale scale)-  => Discrete' currency scale-  -> SomeDiscrete -- ^-toSomeDiscrete = \(Discrete i0 :: Discrete' currency scale) ->-  let c = symbolVal (Proxy :: Proxy currency)-      n = natVal (Proxy :: Proxy (Fst scale))-      d = natVal (Proxy :: Proxy (Snd scale))-  in SomeDiscrete c (n % d) i0-{-# INLINABLE toSomeDiscrete #-}---- | Attempt to convert a 'SomeDiscrete' to a 'Discrete', provided you know the--- target @currency@ and @unit@.-fromSomeDiscrete-  :: forall currency scale-  .  (KnownSymbol currency, GoodScale scale)-  => SomeDiscrete-  -> Maybe (Discrete' currency scale)  -- ^-fromSomeDiscrete = \dr ->-   if (someDiscreteCurrency dr == symbolVal (Proxy :: Proxy currency)) &&-      (someDiscreteScale dr == scale (Proxy :: Proxy scale))-   then Just (Discrete (someDiscreteAmount dr))-   else Nothing-{-# INLINABLE fromSomeDiscrete #-}---- | Convert a 'SomeDiscrete' to a 'Discrete' without knowing the target--- @currency@ and @unit@.------ Notice that @currency@ and @unit@ here can't leave its intended scope unless--- you can prove equality with some other type at the outer scope, but in that--- case you would be better off using 'fromSomeDiscrete' directly.------ Notice that you may need to add an explicit type to the result of this--- function in order to keep the compiler happy.-withSomeDiscrete-  :: forall r-  .  SomeDiscrete-  -> ( forall currency scale.-         ( KnownSymbol currency-         , GoodScale scale-         ) => Discrete' currency scale-           -> r )-  -> r  -- ^-withSomeDiscrete dr = \f ->-  case someSymbolVal (someDiscreteCurrency dr) of-    SomeSymbol (Proxy :: Proxy currency) ->-      case someNatVal (numerator (someDiscreteScale dr)) of-        Nothing -> error "withSomeDiscrete: impossible: numerator < 0"-        Just (SomeNat (Proxy :: Proxy num)) ->-          case someNatVal (denominator (someDiscreteScale dr)) of-            Nothing -> error "withSomeDiscrete: impossible: denominator < 0"-            Just (SomeNat (Proxy :: Proxy den)) ->-              case mkGoodScale of-                Nothing -> error "withSomeDiscrete: impossible: mkGoodScale"-                Just (Dict :: Dict (GoodScale '(num, den))) ->-                  f (Discrete (someDiscreteAmount dr)-                       :: Discrete' currency '(num, den))-{-# INLINABLE withSomeDiscrete #-}------------------------------------------------------------------------------------- SomeExchangeRate---- | A monomorphic representation of 'ExchangeRate' that is easier to serialize--- and deserialize than 'ExchangeRate' in case you don't know the type indexes--- involved.------ If you are trying to construct a value of this type from some raw input, then--- you will need to use the 'mkSomeExchangeRate' function.------ In order to be able to effectively serialize an 'SomeExchangeRate' value, you--- need to serialize the following four values (which are the eventual arguments--- to 'mkSomeExchangeRate'):------ * 'someExchangeRateSrcCurrency'--- * 'someExchangeRateDstCurrency'--- * 'someExchangeRateRate'-data SomeExchangeRate = SomeExchangeRate-  { _someExchangeRateSrcCurrency     :: !String-  , _someExchangeRateDstCurrency     :: !String-  , _someExchangeRateRate            :: !Rational -- ^ Positive, non-zero.-  } deriving (Eq, Show, GHC.Generic)---- | WARNING: This instance does not compare monetary amounts, it just helps you--- sort 'SomeExchangeRate' values in case you need to put them in a--- 'Data.Set.Set' or similar.-deriving instance Ord SomeExchangeRate---- | Source currency name.-someExchangeRateSrcCurrency :: SomeExchangeRate -> String-someExchangeRateSrcCurrency = _someExchangeRateSrcCurrency-{-# INLINABLE someExchangeRateSrcCurrency #-}---- | Destination currency name.-someExchangeRateDstCurrency :: SomeExchangeRate -> String-someExchangeRateDstCurrency = _someExchangeRateDstCurrency-{-# INLINABLE someExchangeRateDstCurrency #-}---- | Exchange rate. Positive, non-zero.-someExchangeRateRate :: SomeExchangeRate -> Rational-someExchangeRateRate = _someExchangeRateRate-{-# INLINABLE someExchangeRateRate #-}---- | Internal. Build a 'SomeExchangeRate' from raw values.------ This function is intended for deserialization purposes. You need to convert--- this 'SomeExchangeRate' value to a 'ExchangeRate' value in order to do any--- arithmetic operation with the exchange rate.-mkSomeExchangeRate-  :: String   -- ^ Source currency name. ('someExchangeRateSrcCurrency')-  -> String   -- ^ Destination currency name. ('someExchangeRateDstCurrency')-  -> Rational -- ^ Exchange rate . Positive, non-zero. ('someExchangeRateRate')-  -> Maybe SomeExchangeRate-mkSomeExchangeRate = \src dst r -> do-  guard (denominator r /= 0)-  guard (r > 0)-  Just (SomeExchangeRate src dst r)-{-# INLINABLE mkSomeExchangeRate #-}---- | Convert a 'ExchangeRate' to a 'SomeDiscrete' for ease of serialization.-toSomeExchangeRate-  :: (KnownSymbol src, KnownSymbol dst)-  => ExchangeRate src dst-  -> SomeExchangeRate -- ^-toSomeExchangeRate = \(ExchangeRate r0 :: ExchangeRate src dst) ->-  let src = symbolVal (Proxy :: Proxy src)-      dst = symbolVal (Proxy :: Proxy dst)-  in SomeExchangeRate src dst r0-{-# INLINABLE toSomeExchangeRate #-}---- | Attempt to convert a 'SomeExchangeRate' to a 'ExchangeRate', provided you--- know the target @src@ and @dst@ types.-fromSomeExchangeRate-  :: forall src dst-  .  (KnownSymbol src, KnownSymbol dst)-  => SomeExchangeRate-  -> Maybe (ExchangeRate src dst)  -- ^-fromSomeExchangeRate = \x ->-   if (someExchangeRateSrcCurrency x == symbolVal (Proxy :: Proxy src)) &&-      (someExchangeRateDstCurrency x == symbolVal (Proxy :: Proxy dst))-   then Just (ExchangeRate (someExchangeRateRate x))-   else Nothing-{-# INLINABLE fromSomeExchangeRate #-}---- | Convert a 'SomeExchangeRate' to a 'ExchangeRate' without knowing the target--- @currency@ and @unit@.------ Notice that @src@ and @dst@ here can't leave its intended scope unless--- you can prove equality with some other type at the outer scope, but in that--- case you would be better off using 'fromSomeExchangeRate' directly.-withSomeExchangeRate-  :: SomeExchangeRate-  -> ( forall src dst.-         ( KnownSymbol src-         , KnownSymbol dst-         ) => ExchangeRate src dst-           -> r )-  -> r  -- ^-withSomeExchangeRate x = \f ->-  case someSymbolVal (someExchangeRateSrcCurrency x) of-    SomeSymbol (Proxy :: Proxy src) ->-      case someSymbolVal (someExchangeRateDstCurrency x) of-        SomeSymbol (Proxy :: Proxy dst) ->-          f (ExchangeRate (someExchangeRateRate x) :: ExchangeRate src dst)-{-# INLINABLE withSomeExchangeRate #-}------------------------------------------------------------------------------------- Miscellaneous--type family Fst (ab :: (ka, kb)) :: ka where Fst '(a,b) = a-type family Snd (ab :: (ka, kb)) :: ka where Snd '(a,b) = b------------------------------------------------------------------------------------- Extra instances: hashable-#ifdef HAS_hashable-instance Hashable (Dense currency)-instance Hashable SomeDense-instance GoodScale scale => Hashable (Discrete' currency scale)-instance Hashable SomeDiscrete-instance Hashable (ExchangeRate src dst)-instance Hashable SomeExchangeRate-#endif------------------------------------------------------------------------------------- Extra instances: deepseq-#ifdef HAS_deepseq-instance NFData (Dense currency)-instance NFData SomeDense-instance GoodScale scale => NFData (Discrete' currency scale)-instance NFData SomeDiscrete-instance NFData (ExchangeRate src dst)-instance NFData SomeExchangeRate-#endif------------------------------------------------------------------------------------- Extra instances: cereal-#ifdef HAS_cereal--- | Compatible with 'SomeDense'.-instance (KnownSymbol currency) => Cereal.Serialize (Dense currency) where-  put = Cereal.put . toSomeDense-  get = maybe empty pure =<< fmap fromSomeDense Cereal.get---- | Compatible with 'SomeDiscrete'.-instance-  ( KnownSymbol currency, GoodScale scale-  ) => Cereal.Serialize (Discrete' currency scale) where-  put = Cereal.put . toSomeDiscrete-  get = maybe empty pure =<< fmap fromSomeDiscrete Cereal.get---- | Compatible with 'SomeExchangeRate'.-instance-  ( KnownSymbol src, KnownSymbol dst-  ) => Cereal.Serialize (ExchangeRate src dst) where-  put = Cereal.put . toSomeExchangeRate-  get = maybe empty pure =<< fmap fromSomeExchangeRate Cereal.get---- | Compatible with 'Dense'.-instance Cereal.Serialize SomeDense where-  put = \(SomeDense c r) -> do-    Cereal.put c-    Cereal.put (numerator r)-    Cereal.put (denominator r)-  get = maybe empty pure =<< do-    c :: String <- Cereal.get-    n :: Integer <- Cereal.get-    d :: Integer <- Cereal.get-    when (d == 0) (fail "denominator is zero")-    pure (mkSomeDense c (n % d))---- | Compatible with 'Discrete'.-instance Cereal.Serialize SomeDiscrete where-  put = \(SomeDiscrete c r a) -> do-    Cereal.put c-    Cereal.put (numerator r)-    Cereal.put (denominator r)-    Cereal.put a-  get = maybe empty pure =<< do-    c :: String <- Cereal.get-    n :: Integer <- Cereal.get-    d :: Integer <- Cereal.get-    when (d == 0) (fail "denominator is zero")-    a :: Integer <- Cereal.get-    pure (mkSomeDiscrete c (n % d) a)---- | Compatible with 'ExchangeRate'.-instance Cereal.Serialize SomeExchangeRate where-  put = \(SomeExchangeRate src dst r) -> do-    Cereal.put src-    Cereal.put dst-    Cereal.put (numerator r)-    Cereal.put (denominator r)-  get = maybe empty pure =<< do-    src :: String <- Cereal.get-    dst :: String <- Cereal.get-    n :: Integer <- Cereal.get-    d :: Integer <- Cereal.get-    when (d == 0) (fail "denominator is zero")-    pure (mkSomeExchangeRate src dst (n % d))-#endif----------------------------------------------------------------------------------- Extra instances: binary-#ifdef HAS_binary--- | Compatible with 'SomeDense'.-instance (KnownSymbol currency) => Binary.Binary (Dense currency) where-  put = Binary.put . toSomeDense-  get = maybe empty pure =<< fmap fromSomeDense Binary.get---- | Compatible with 'SomeDiscrete'.-instance-  ( KnownSymbol currency, GoodScale scale-  ) => Binary.Binary (Discrete' currency scale) where-  put = Binary.put . toSomeDiscrete-  get = maybe empty pure =<< fmap fromSomeDiscrete Binary.get---- | Compatible with 'SomeExchangeRate'.-instance-  ( KnownSymbol src, KnownSymbol dst-  ) => Binary.Binary (ExchangeRate src dst) where-  put = Binary.put . toSomeExchangeRate-  get = maybe empty pure =<< fmap fromSomeExchangeRate Binary.get---- | Compatible with 'Dense'.-instance Binary.Binary SomeDense where-  put = \(SomeDense c r) ->-    Binary.put c >> Binary.put (numerator r) >> Binary.put (denominator r)-  get = maybe empty pure =<< do-    c :: String <- Binary.get-    n :: Integer <- Binary.get-    d :: Integer <- Binary.get-    when (d == 0) (fail "denominator is zero")-    pure (mkSomeDense c (n % d))---- | Compatible with 'Discrete'.-instance Binary.Binary SomeDiscrete where-  put = \(SomeDiscrete c r a) ->-    Binary.put c <>-    Binary.put (numerator r) <>-    Binary.put (denominator r) <>-    Binary.put a-  get = maybe empty pure =<< do-    c :: String <- Binary.get-    n :: Integer <- Binary.get-    d :: Integer <- Binary.get-    when (d == 0) (fail "denominator is zero")-    a :: Integer <- Binary.get-    pure (mkSomeDiscrete c (n % d) a)---- | Compatible with 'ExchangeRate'.-instance Binary.Binary SomeExchangeRate where-  put = \(SomeExchangeRate src dst r) -> do-    Binary.put src-    Binary.put dst-    Binary.put (numerator r)-    Binary.put (denominator r)-  get = maybe empty pure =<< do-    src :: String <- Binary.get-    dst :: String <- Binary.get-    n :: Integer <- Binary.get-    d :: Integer <- Binary.get-    when (d == 0) (fail "denominator is zero")-    pure (mkSomeExchangeRate src dst (n % d))-#endif------------------------------------------------------------------------------------- Extra instances: serialise-#ifdef HAS_serialise--- | Compatible with 'SomeDense'.-instance (KnownSymbol currency) => Ser.Serialise (Dense currency) where-  encode = Ser.encode . toSomeDense-  decode = maybe (fail "Dense") pure =<< fmap fromSomeDense Ser.decode---- | Compatible with 'SomeDiscrete'.-instance-  ( KnownSymbol currency, GoodScale scale-  ) => Ser.Serialise (Discrete' currency scale) where-  encode = Ser.encode . toSomeDiscrete-  decode = maybe (fail "Discrete'") pure =<< fmap fromSomeDiscrete Ser.decode---- | Compatible with 'SomeExchangeRate'.-instance-  ( KnownSymbol src, KnownSymbol dst-  ) => Ser.Serialise (ExchangeRate src dst) where-  encode = Ser.encode . toSomeExchangeRate-  decode = maybe (fail "ExchangeRate") pure-             =<< fmap fromSomeExchangeRate Ser.decode---- | Compatible with 'Dense'.-instance Ser.Serialise SomeDense where-  encode = \(SomeDense c r) ->-    Ser.encode c <> Ser.encode (numerator r) <> Ser.encode (denominator r)-  decode = maybe (fail "SomeDense") pure =<< do-    c :: String <- Ser.decode-    n :: Integer <- Ser.decode-    d :: Integer <- Ser.decode-    when (d == 0) (fail "denominator is zero")-    pure (mkSomeDense c (n % d))---- | Compatible with 'Discrete'.-instance Ser.Serialise SomeDiscrete where-  encode = \(SomeDiscrete c r a) ->-    Ser.encode c <>-    Ser.encode (numerator r) <>-    Ser.encode (denominator r) <>-    Ser.encode a-  decode = maybe (fail "SomeDiscrete") pure =<< do-    c :: String <- Ser.decode-    n :: Integer <- Ser.decode-    d :: Integer <- Ser.decode-    when (d == 0) (fail "denominator is zero")-    a :: Integer <- Ser.decode-    pure (mkSomeDiscrete c (n % d) a)---- | Compatible with 'ExchangeRate'.-instance Ser.Serialise SomeExchangeRate where-  encode = \(SomeExchangeRate src dst r) ->-    Ser.encode src <>-    Ser.encode dst <>-    Ser.encode (numerator r) <>-    Ser.encode (denominator r)-  decode = maybe (fail "SomeExchangeRate") pure =<< do-    src :: String <- Ser.decode-    dst :: String <- Ser.decode-    n :: Integer <- Ser.decode-    d :: Integer <- Ser.decode-    when (d == 0) (fail "denominator is zero")-    pure (mkSomeExchangeRate src dst (n % d))-#endif------------------------------------------------------------------------------------- Extra instances: aeson-#ifdef HAS_aeson--- | Compatible with 'SomeDense'------ Example rendering @'fromRational' (2 % 3) :: 'Dense' \"BTC\"@:------ @--- [\"BTC\", 2, 3]--- @------ Note: The JSON serialization changed in version 0.4 (the leading @"Dense"@--- string was dropped from the rendered 'Ae.Array').-instance KnownSymbol currency => Ae.ToJSON (Dense currency) where-  toJSON = Ae.toJSON . toSomeDense---- | Compatible with 'SomeDense'------ Note: The JSON serialization changed in version 0.4. However, this instance--- is still able to cope with the previous format.-instance KnownSymbol currency => Ae.FromJSON (Dense currency) where-  parseJSON = maybe empty pure <=< fmap fromSomeDense . Ae.parseJSON---- | Compatible with 'Dense'------ Note: The JSON serialization changed in version 0.4 (the leading @"Dense"@--- string was dropped from the rendered 'Ae.Array').-instance Ae.ToJSON SomeDense where-  toJSON = \(SomeDense c r) ->-    Ae.toJSON (c, numerator r, denominator r)---- | Compatible with 'Dense'.------ Note: The JSON serialization changed in version 0.4. However, this instance--- is still able to cope with the previous format.-instance Ae.FromJSON SomeDense where-  parseJSON = \v -> do-    (c, n, d) <- Ae.parseJSON v <|> do-       -- Pre 0.4 format.-       ("Dense" :: String, c, n, d) <- Ae.parseJSON v-       pure (c, n, d)-    when (d == 0) (fail "denominator is zero")-    maybe empty pure (mkSomeDense c (n % d))---- | Compatible with 'SomeDiscrete'------ Example rendering @43 :: 'Discrete' \"BTC\" \"satoshi\"@:------ @--- [\"BTC\", 100000000, 1, 43]--- @------ Note: The JSON serialization changed in version 0.4 (the leading @"Discrete"@--- string was dropped from the rendered 'Ae.Array').-instance-  ( KnownSymbol currency, GoodScale scale-  ) => Ae.ToJSON (Discrete' currency scale) where-  toJSON = Ae.toJSON . toSomeDiscrete---- | Compatible with 'SomeDiscrete'------ Note: The JSON serialization changed in version 0.4. However, this instance--- is still able to cope with the previous format.-instance-  ( KnownSymbol currency, GoodScale scale-  ) => Ae.FromJSON (Discrete' currency scale) where-  parseJSON = maybe empty pure <=< fmap fromSomeDiscrete . Ae.parseJSON---- | Compatible with 'Discrete''------ Note: The JSON serialization changed in version 0.4 (the leading @"Discrete"@--- string was dropped from the rendered 'Ae.Array').-instance Ae.ToJSON SomeDiscrete where-  toJSON = \(SomeDiscrete c r a) ->-    Ae.toJSON (c, numerator r, denominator r, a)---- | Compatible with 'Discrete''------ Note: The JSON serialization changed in version 0.4. However, this instance--- is still able to cope with the previous format.-instance Ae.FromJSON SomeDiscrete where-  parseJSON = \v -> do-    (c, n, d, a) <- Ae.parseJSON v <|> do-       -- Pre 0.4 format.-       ("Discrete" :: String, c, n, d, a) <- Ae.parseJSON v-       pure (c, n, d, a)-    when (d == 0) (fail "denominator is zero")-    maybe empty pure (mkSomeDiscrete c (n % d) a)---- | Compatible with 'SomeExchangeRate'------ Example rendering an 'ExchangeRate' constructed with--- @'exchangeRate' (5 % 7) :: 'Maybe' ('ExchangeRate' \"USD\" \"JPY\")@------ @--- [\"USD\", \"JPY\", 5, 7]--- @------ Note: The JSON serialization changed in version 0.4 (the leading--- @"ExchangeRate"@ string was dropped from the rendered 'Ae.Array').-instance-  ( KnownSymbol src, KnownSymbol dst-  ) => Ae.ToJSON (ExchangeRate src dst) where-  toJSON = Ae.toJSON . toSomeExchangeRate---- | Compatible with 'SomeExchangeRate'------ Note: The JSON serialization changed in version 0.4. However, this instance--- is still able to cope with the previous format.-instance-  ( KnownSymbol src, KnownSymbol dst-  ) => Ae.FromJSON (ExchangeRate src dst) where-  parseJSON = maybe empty pure <=< fmap fromSomeExchangeRate . Ae.parseJSON---- | Compatible with 'ExchangeRate'------ Note: The JSON serialization changed in version 0.4 (the leading--- @"ExchangeRate"@ string was dropped from the rendered 'Ae.Array').-instance Ae.ToJSON SomeExchangeRate where-  toJSON = \(SomeExchangeRate src dst r) ->-    Ae.toJSON (src, dst, numerator r, denominator r)---- | Compatible with 'ExchangeRate'------ Note: The JSON serialization changed in version 0.4. However, this instance--- is still able to cope with the previous format.-instance Ae.FromJSON SomeExchangeRate where-  parseJSON = \v -> do-    (src, dst, n, d) <- Ae.parseJSON v <|> do-       -- Pre 0.4 format.-       ("ExchangeRate" :: String, src, dst, n, d) <- Ae.parseJSON v-       pure (src, dst, n, d)-    when (d == 0) (fail "denominator is zero")-    maybe empty pure (mkSomeExchangeRate src dst (n % d))-#endif------------------------------------------------------------------------------------- Extra instances: xmlbf-#ifdef HAS_xmlbf---- | Compatible with 'SomeDense'------ Example rendering @'fromRational' (2 % 3) :: 'Dense' \"BTC\"@:------ @--- \<money-dense c=\"BTC\" n=\"2\" d=\"3\"/>--- @-instance KnownSymbol currency => Xmlbf.ToXml (Dense currency) where-  toXml = Xmlbf.toXml . toSomeDense---- | Compatible with 'SomeDense'-instance KnownSymbol currency => Xmlbf.FromXml (Dense currency) where-  fromXml = maybe empty pure =<< fmap fromSomeDense Xmlbf.fromXml---- | Compatible with 'Dense'-instance Xmlbf.ToXml SomeDense where-  toXml = \(SomeDense c r) ->-    let as = [ (Text.pack "c", Text.pack c)-             , (Text.pack "n", Text.pack (show (numerator r)))-             , (Text.pack "d", Text.pack (show (denominator r))) ]-        Right e = Xmlbf.element (Text.pack "money-dense") (fromList as) []-    in [e]---- | Compatible with 'Dense'.-instance Xmlbf.FromXml SomeDense where-  fromXml = Xmlbf.pElement (Text.pack "money-dense") $ do-    c <- Text.unpack <$> Xmlbf.pAttr "c"-    n <- Xmlbf.pRead =<< Xmlbf.pAttr "n"-    d <- Xmlbf.pRead =<< Xmlbf.pAttr "d"-    when (d == 0) (fail "denominator is zero")-    maybe empty pure (mkSomeDense c (n % d))---- | Compatible with 'SomeDiscrete'------ Example rendering @43 :: 'Discrete' \"BTC\" \"satoshi\"@:------ @--- \<money-discrete c=\"BTC\" n=\"100000000\" d=\"1\" a=\"43\"/>--- @-instance-  ( KnownSymbol currency, GoodScale scale-  ) => Xmlbf.ToXml (Discrete' currency scale) where-  toXml = Xmlbf.toXml . toSomeDiscrete---- | Compatible with 'SomeDiscrete'-instance-  ( KnownSymbol currency, GoodScale scale-  ) => Xmlbf.FromXml (Discrete' currency scale) where-  fromXml = maybe empty pure =<< fmap fromSomeDiscrete Xmlbf.fromXml---- | Compatible with 'Discrete''-instance Xmlbf.ToXml SomeDiscrete where-  toXml = \(SomeDiscrete c r a) ->-    let as = [ (Text.pack "c", Text.pack c)-             , (Text.pack "n", Text.pack (show (numerator r)))-             , (Text.pack "d", Text.pack (show (denominator r)))-             , (Text.pack "a", Text.pack (show a)) ]-        Right e = Xmlbf.element (Text.pack "money-discrete") (fromList as) []-    in [e]---- | Compatible with 'Discrete''-instance Xmlbf.FromXml SomeDiscrete where-  fromXml = Xmlbf.pElement (Text.pack "money-discrete") $ do-    c <- Text.unpack <$> Xmlbf.pAttr "c"-    n <- Xmlbf.pRead =<< Xmlbf.pAttr "n"-    d <- Xmlbf.pRead =<< Xmlbf.pAttr "d"-    when (d == 0) (fail "denominator is zero")-    a <- Xmlbf.pRead =<< Xmlbf.pAttr "a"-    maybe empty pure (mkSomeDiscrete c (n % d) a)---- | Compatible with 'SomeExchangeRate'------ Example rendering an 'ExchangeRate' constructed with--- @'exchangeRate' (5 % 7) :: 'Maybe' ('ExchangeRate' \"USD\" \"JPY\")@------ @--- \<exchange-rate src=\"USD\" dst=\"JPY\" n=\"5\" d=\"7\"/>--- @-instance-  ( KnownSymbol src, KnownSymbol dst-  ) => Xmlbf.ToXml (ExchangeRate src dst) where-  toXml = Xmlbf.toXml . toSomeExchangeRate---- | Compatible with 'SomeExchangeRate'-instance-  ( KnownSymbol src, KnownSymbol dst-  ) => Xmlbf.FromXml (ExchangeRate src dst) where-  fromXml = maybe empty pure =<< fmap fromSomeExchangeRate Xmlbf.fromXml---- | Compatible with 'ExchangeRate'-instance Xmlbf.ToXml SomeExchangeRate where-  toXml = \(SomeExchangeRate src dst r) ->-    let as = [ (Text.pack "src", Text.pack src)-             , (Text.pack "dst", Text.pack dst)-             , (Text.pack "n", Text.pack (show (numerator r)))-             , (Text.pack "d", Text.pack (show (denominator r))) ]-        Right e = Xmlbf.element (Text.pack "exchange-rate") (fromList as) []-    in [e]---- | Compatible with 'ExchangeRate'-instance Xmlbf.FromXml SomeExchangeRate where-  fromXml = Xmlbf.pElement (Text.pack "exchange-rate") $ do-    src <- Text.unpack <$> Xmlbf.pAttr "src"-    dst <- Text.unpack <$> Xmlbf.pAttr "dst"-    n <- Xmlbf.pRead =<< Xmlbf.pAttr "n"-    d <- Xmlbf.pRead =<< Xmlbf.pAttr "d"-    when (d == 0) (fail "denominator is zero")-    maybe empty pure (mkSomeExchangeRate src dst (n % d))-#endif------------------------------------------------------------------------------------- Extra instances: store-#ifdef HAS_store--- | Compatible with 'SomeDense'.-instance (KnownSymbol currency) => Store.Store (Dense currency) where-  size = storeContramapSize toSomeDense Store.size-  poke = Store.poke . toSomeDense-  peek = maybe (fail "peek") pure =<< fmap fromSomeDense Store.peek--- | Compatible with 'Dense'.-instance Store.Store SomeDense where-  poke = \(SomeDense c r) -> do-    Store.poke c-    Store.poke (numerator r)-    Store.poke (denominator r)-  peek = maybe (fail "peek") pure =<< do-    c :: String <- Store.peek-    n :: Integer <- Store.peek-    d :: Integer <- Store.peek-    when (d == 0) (fail "denominator is zero")-    pure (mkSomeDense c (n % d))---- | Compatible with 'SomeDiscrete'.-instance-  ( KnownSymbol currency, GoodScale scale-  ) => Store.Store (Discrete' currency scale) where-  size = storeContramapSize toSomeDiscrete Store.size-  poke = Store.poke . toSomeDiscrete-  peek = maybe (fail "peek") pure =<< fmap fromSomeDiscrete Store.peek--- | Compatible with 'Discrete''.-instance Store.Store SomeDiscrete where-  poke = \(SomeDiscrete c r a) ->do-    Store.poke c-    Store.poke (numerator r)-    Store.poke (denominator r)-    Store.poke a-  peek = maybe (fail "peek") pure =<< do-    c :: String <- Store.peek-    n :: Integer <- Store.peek-    d :: Integer <- Store.peek-    when (d == 0) (fail "denominator is zero")-    a :: Integer <- Store.peek-    pure (mkSomeDiscrete c (n % d) a)--- | Compatible with 'SomeExchangeRate'.-instance-  ( KnownSymbol src, KnownSymbol dst-  ) => Store.Store (ExchangeRate src dst) where-  size = storeContramapSize toSomeExchangeRate Store.size-  poke = Store.poke . toSomeExchangeRate-  peek = maybe (fail "peek") pure =<< fmap fromSomeExchangeRate Store.peek--- | Compatible with 'ExchangeRate'.-instance Store.Store SomeExchangeRate where-  poke = \(SomeExchangeRate src dst r) -> do-    Store.poke src-    Store.poke dst-    Store.poke (numerator r)-    Store.poke (denominator r)-  peek = maybe (fail "peek") pure =<< do-    src <- Store.peek-    dst <- Store.peek-    n <- Store.peek-    d <- Store.peek-    when (d == 0) (fail "denominator is zero")-    pure (mkSomeExchangeRate src dst (n % d))--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+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_HADDOCK hide #-}+{-# OPTIONS_GHC -Wno-redundant-constraints #-}++-- | This is an internal module. You may use stuff exported from here, but we+-- can't garantee their stability.+module Money.Internal+ ( -- * Dense monetary values+   Dense+ , denseCurrency+ , dense+ , dense'+ , denseFromDiscrete+ , denseFromDecimal+ , denseToDecimal+   -- * Discrete monetary values+ , Discrete+ , Discrete'+ , discrete+ , discreteCurrency+ , discreteFromDense+ , discreteFromDecimal+   -- * Currency scales+ , Scale+ , GoodScale+ , ErrScaleNonCanonical+ , scale+   -- * Currency exchange+ , ExchangeRate+ , exchangeRate+ , exchange+ , exchangeRateFromDecimal+ , exchangeRateToDecimal+ , exchangeRateToRational+ , exchangeRateRecip+   -- * Serializable representations+ , SomeDense+ , toSomeDense+ , mkSomeDense+ , fromSomeDense+ , withSomeDense+ , someDenseCurrency+ , someDenseAmount+ , SomeDiscrete+ , toSomeDiscrete+ , mkSomeDiscrete+ , fromSomeDiscrete+ , withSomeDiscrete+ , someDiscreteCurrency+ , someDiscreteScale+ , someDiscreteAmount+ , SomeExchangeRate+ , toSomeExchangeRate+ , mkSomeExchangeRate+ , fromSomeExchangeRate+ , withSomeExchangeRate+ , someExchangeRateSrcCurrency+ , someExchangeRateDstCurrency+ , someExchangeRateRate+ -- * Misc+ , Approximation(Round, Floor, Ceiling, Truncate)+ , rationalToDecimal+ , rationalFromDecimal+ ) where++import Control.Applicative ((<|>), empty)+import Control.Category (Category((.), id))+import Control.Monad ((<=<), guard, when)+import qualified Data.Char as Char+import Data.Constraint (Dict(Dict))+import Data.Functor (($>))+import Data.Foldable (for_)+import qualified Data.List as List+import Data.Monoid ((<>))+import Data.Proxy (Proxy(..))+import Data.Ratio ((%), numerator, denominator)+import Data.Word (Word8)+import GHC.Exts (Constraint, fromList)+import qualified GHC.Generics as GHC+import GHC.TypeLits+  (Symbol, SomeSymbol(..), Nat, SomeNat(..), CmpNat, KnownSymbol, KnownNat,+   natVal, someNatVal, symbolVal, someSymbolVal)+import qualified GHC.TypeLits as GHC+import Numeric.Natural (Natural)+import Prelude hiding ((.), id)+import qualified Text.ParserCombinators.ReadPrec as ReadPrec+import qualified Text.ParserCombinators.ReadP as ReadP+import qualified Text.Read as Read+import Unsafe.Coerce (unsafeCoerce)++#ifdef HAS_aeson+import qualified Data.Aeson as Ae+import qualified Data.Text as T+#endif++#ifdef HAS_binary+import qualified Data.Binary as Binary+#endif++#ifdef HAS_cereal+import qualified Data.Serialize as Cereal+#endif++#ifdef HAS_deepseq+import Control.DeepSeq (NFData)+#endif++#ifdef HAS_hashable+import Data.Hashable (Hashable)+#endif++#ifdef HAS_serialise+import qualified Codec.Serialise as Ser+#endif++#ifdef HAS_store+import qualified Data.Store as Store+#endif++#ifdef HAS_vector_space+import qualified Data.AdditiveGroup as AG+import qualified Data.VectorSpace as VS+#endif++#ifdef HAS_xmlbf+import qualified Xmlbf+#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 (e.g., an exact number of coins and bills), you can still treat+-- monetary values as dense while operating on them. For example, the half+-- of @USD 3.41@ is @USD 1.705@, which is not an amount that can't be+-- represented as a number of USD cents (the smallest unit that can+-- represent USD amounts). Nevertheless, if you do manage to represent @USD+-- 1.709@ somehow, and you eventually multiply @USD 1.705@ by @4@ for+-- example, then you end up with @USD 6.82@, which is again a value+-- representable as USD cents. In other words, 'Dense' monetary values+-- allow us to perform precise calculations deferring the conversion to a+-- 'Discrete' monetary values as much as posible. Once you are ready to+-- approximate a 'Dense' value to a 'Discrete' value you can use one+-- 'discreteFromDense'. Otherwise, using 'toRational' you can obtain a+-- precise 'Rational' representation.++-- Construct 'Dense' monetary values using 'dense', 'dense'',+-- 'denseFromDiscrete', 'denseFromDecimal'.+--+-- /WARNING/ if you want to treat a dense monetary value as a /Real/ number+-- like 'Float' or 'Double', then you are on your own. We can only+-- guarantee lossless manipulation of rational values, so you will need to+-- convert back and forth betwen the 'Rational' representation for 'Dense'+-- and your (likely lossy) representation for /Real/ numbers.+newtype Dense (currency :: Symbol) = Dense Rational+  deriving (Eq, Ord, Real, GHC.Generic)++-- | Notice that multiplication of 'Dense' values doesn't make sense:+--+-- @+-- ('*') :: 'Dense' currency -> 'Dense' currency -> 'Dense' currency+-- @+--+-- How is '*' implemented, then? It behaves as the /scalar multiplication/ of a+-- 'Dense' amount by a 'Rational' scalar. That is, you can think of '*' as+-- having one of the the following types:+--+-- @+-- ('*') :: 'Rational' -> 'Dense' currency -> 'Dense' currency+-- @+--+-- @+-- ('*') :: 'Dense' currency -> 'Rational' -> 'Dense' currency@+-- @+--+-- That is:+--+-- @+-- 'dense'' (1 '%' 4) '*' 'dense'' (1 '%' 2)  ==  'dense'' (1 '%' 8)+-- @+--+-- In fact, if you compiled this library with support for+-- 'Data.VectorSpace.VectorSpace', then '*' functions exactly as+-- 'Data.VectorSpace.*^'.+--+-- @+-- ('*')  ==  ('Data.VectorSpace.*^')+-- @+--+-- @+-- ('*')  ==  'flip' ('Data.VectorSpace.*^')+-- @+deriving instance Num (Dense currency)++type family ErrFractionalDense :: Constraint where+  ErrFractionalDense+    = GHC.TypeError+      (('GHC.Text "The ") 'GHC.:<>:+       ('GHC.ShowType Dense) 'GHC.:<>:+       ('GHC.Text " type is deliberately not an instance of ") 'GHC.:<>:+       ('GHC.ShowType Fractional) 'GHC.:$$:+       ('GHC.Text "because functions like 'recip' and '/' can diverge.") 'GHC.:$$:+       ('GHC.Text "Temporarily convert the ") 'GHC.:<>:+       ('GHC.ShowType Dense) 'GHC.:<>:+       ('GHC.Text " value to a ") 'GHC.:<>:+       ('GHC.ShowType Rational) 'GHC.:$$:+       ('GHC.Text " if you know what you are doing."))++instance ErrFractionalDense => Fractional (Dense currency) where+  fromRational = undefined+  recip = undefined++-- |+-- @+-- > 'show' ('dense'' (1 '%' 3) :: 'Dense' \"USD\")+-- \"Dense \\\"USD\\\" 1%3\"+-- @+instance forall currency. KnownSymbol currency => Show (Dense currency) where+  showsPrec n = \(Dense r0) ->+    let c = symbolVal (Proxy :: Proxy currency)+    in showParen (n > 10) $+         showString "Dense " . showsPrec 0 c . showChar ' ' .+         showsPrec 0 (numerator r0) . showChar '%' .+         showsPrec 0 (denominator r0)++instance forall currency. KnownSymbol currency => Read (Dense currency) where+  readPrec = Read.parens $ do+    let c = symbolVal (Proxy :: Proxy currency)+    _ <- ReadPrec.lift (ReadP.string ("Dense " ++ show c ++ " "))+    maybe empty pure =<< fmap dense Read.readPrec++-- | Build a 'Dense' monetary value from a 'Rational' value.+--+-- For example, if you want to represent @USD 12.52316@, then you can use:+--+-- @+-- 'dense' (125316 '%' 10000)+-- @+--+-- Notice that 'dense' returns 'Nothing' in case the given 'Rational''s+-- denominator is zero, which although unlikely, it is possible if the+-- 'Rational' was unsafely constructed. When dealing with hardcoded or trusted+-- 'Rational' values, you can use 'dense'' instead of 'dense' which unsafely+-- constructs a 'Dense'.+dense :: Rational -> Maybe (Dense currency)+dense = \r ->+  if denominator r /= 0+  then Just (Dense r)+  else Nothing+{-# INLINE dense #-}++-- | Unsafely build a 'Dense' monetary value from a 'Rational' value. Contrary+-- to 'dense', this function *crashes* if the given 'Rational' has zero as a+-- denominator, which is something very unlikely to happen unless the given+-- 'Rational' was itself unsafely constructed. Other than that, 'dense' and+-- 'dense'' behave the same.+--+-- Prefer to use 'dense' when dealing with 'Rational' inputs from untrusted+-- sources.+--+-- @+-- 'denominator' x /= 0+--   ⇒ 'dense' x == 'Just' ('dense'' x)+-- @+--+-- @+-- 'denominator' x == 0+--   ⇒ 'undefined' == 'dense'' x+-- @+dense' :: Rational -> Dense currency+dense' = \r ->+  if denominator r /= 0+  then Dense r+  else error "dense': malformed Rational given (denominator is zero)."+{-# INLINABLE dense' #-}++-- | 'Dense' currency identifier.+--+-- @+-- > 'denseCurrency' ('dense'' 4 :: 'Dense' \"USD\")+-- \"USD\"+-- @+denseCurrency :: KnownSymbol currency => Dense currency -> String+denseCurrency = symbolVal+{-# INLINE denseCurrency #-}++-- | 'Discrete' represents a discrete monetary value for a @currency@ expresed+-- as an integer amount of a particular @unit@. For example, with @currency ~+-- \"USD\"@ and @unit ~ \"cent\"@ you can represent United States Dollars to+-- their full extent.+--+-- @currency@ is usually a ISO-4217 currency code, but not necessarily.+--+-- Construct 'Discrete' values using 'discrete', 'fromIntegral', 'fromInteger',+-- 'discreteFromDense', 'discreteFromDecimal'.+--+-- For example, if you want to represent @GBP 21.05@, where the smallest+-- represetable unit for a GBP (United Kingdom Pound) is the /penny/, and 100+-- /pennies/ equal 1 GBP (i.e., @'Scale' \"GBP\" ~ '(100, 1)@), then you can+-- use:+--+-- @+-- 'discrete' 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 amount of @scale@, which is a rational number expressed as @(numerator,+-- denominator)@.+--+-- You'll be using 'Discrete' instead of 'Discrete'' most of the time, which+-- mentions the unit name (such as /cent/ or /centavo/) instead of explicitely+-- mentioning the unit scale.+newtype Discrete' (currency :: Symbol) (scale :: (Nat, Nat))+  = Discrete Integer++deriving instance GoodScale scale => Eq (Discrete' currency scale)+deriving instance GoodScale scale => Ord (Discrete' currency scale)+deriving instance GoodScale scale => Enum (Discrete' currency scale)+deriving instance GoodScale scale => Real (Discrete' currency scale)+deriving instance GoodScale scale => Integral (Discrete' currency scale)+deriving instance GoodScale scale => GHC.Generic (Discrete' currency scale)++-- | Notice that multiplication of 'Discrete'' values doesn't make sense:+--+-- @+-- ('*') :: 'Discrete'' currency scale -> 'Discrete'' currency scale -> 'Discrete'' currency scale+-- @+--+-- How is '*' implemented, then? It behaves as the /scalar multiplication/ of a+-- 'Discrete'' amount by an 'Integer' scalar. That is, you can think of '*' as+-- having one of the the following types:+--+-- @+-- ('*') :: 'Integer' -> 'Discrete'' currency scale -> 'Discrete'' currency scale+-- @+--+-- @+-- ('*') :: 'Discrete'' currency scale -> 'Integer' -> 'Discrete'' currency scale@+-- @+--+-- That is:+--+-- @+-- 'discrete' 2 '*' 'discrete' 4  ==  'discrete' 8+-- @+--+-- In fact, if you compiled this library with support for+-- 'Data.VectorSpace.VectorSpace', then '*' functions exactly as+-- 'Data.VectorSpace.*^'.+--+-- @+-- ('*')  ==  ('Data.VectorSpace.*^')+-- @+--+-- @+-- ('*')  ==  'flip' ('Data.VectorSpace.*^')+-- @+deriving instance GoodScale scale => Num (Discrete' currency scale)++-- |+-- @+-- > 'show' ('discrete' 123 :: 'Discrete' \"USD\" \"cent\")+-- \"Discrete \\\"USD\\\" 100%1 123\"+-- @+instance forall currency scale.+  ( KnownSymbol currency, GoodScale scale+  ) => Show (Discrete' currency scale) where+  showsPrec n = \d0@(Discrete i0) ->+    let c = symbolVal (Proxy :: Proxy currency)+        s = scale d0+    in showParen (n > 10) $+         showString "Discrete " .  showsPrec 0 c . showChar ' ' .+         showsPrec 0 (numerator s) . showChar '%' .+         showsPrec 0 (denominator s) . showChar ' ' .+         showsPrec 0 i0++instance forall currency scale.+  ( KnownSymbol currency, GoodScale scale+  ) => Read (Discrete' currency scale) where+  readPrec = Read.parens $ do+    let c = symbolVal (Proxy :: Proxy currency)+        s = scale (Proxy :: Proxy scale)+    _ <- ReadPrec.lift (ReadP.string (concat+           [ "Discrete ", show c, " "+           , show (numerator s), "%"+           , show (denominator s), " "+           ]))+    fmap Discrete Read.readPrec++type family ErrFractionalDiscrete :: Constraint where+  ErrFractionalDiscrete+    = GHC.TypeError+        (('GHC.Text "The ") 'GHC.:<>:+         ('GHC.ShowType Discrete') 'GHC.:<>:+         ('GHC.Text " type is deliberately not a ") 'GHC.:<>:+         ('GHC.ShowType Fractional) 'GHC.:$$:+         ('GHC.Text "instance. Convert the ") 'GHC.:<>:+         ('GHC.ShowType Discrete') 'GHC.:<>:+         ('GHC.Text " value to a ") 'GHC.:<>:+         ('GHC.ShowType Dense) 'GHC.:$$:+         ('GHC.Text "value and use the ") 'GHC.:<>:+         ('GHC.ShowType Fractional) 'GHC.:<>:+         ('GHC.Text " features on it instead."))++instance+  ( ErrFractionalDiscrete+  , GoodScale scale+  ) => Fractional (Discrete' currency scale) where+  fromRational = undefined+  recip = undefined++-- | Construct a 'Discrete' value.+discrete :: GoodScale scale => Integer -> Discrete' currency scale+discrete = Discrete+{-# INLINE discrete #-}+++-- | Convert currency 'Discrete' monetary value into a 'Dense' monetary+-- value.+denseFromDiscrete+  :: GoodScale scale+  => Discrete' currency scale+  -> Dense currency -- ^+denseFromDiscrete = \c@(Discrete i) -> Dense (fromInteger i / scale c)+{-# INLINE denseFromDiscrete #-}++-- | 'Discrete' currency identifier.+--+-- @+-- > 'discreteCurrency' ('discrete' 4 :: 'Discrete' \"USD\" \"cent\")+-- \"USD\"+-- @+discreteCurrency+  :: forall currency scale+  .  (KnownSymbol currency, GoodScale scale)+  => Discrete' currency scale+  -> String -- ^+discreteCurrency = \_ -> symbolVal (Proxy :: Proxy currency)+{-# INLINE discreteCurrency #-}++-- | Method for approximating a fractional number to an integer number.+data Approximation+  = Round+  -- ^ Approximate @x@ to the nearest integer, or to the nearest even integer if+  -- @x@ is equidistant between two integers.+  | Floor+  -- ^ Approximate @x@ to the nearest integer less than or equal to @x@.+  | Ceiling+  -- ^ Approximate @x@ to the nearest integer greater than or equal to @x@.+  | Truncate+  -- ^ Approximate @x@ to the nearest integer betwen @0@ and @x@, inclusive.+  deriving (Eq, Ord, Show, Read, GHC.Generic)+++approximate :: Approximation -> Rational -> Integer+{-# INLINE approximate #-}+approximate = \case+  Round -> round+  Floor -> floor+  Ceiling -> ceiling+  Truncate -> truncate++-- | Approximate a 'Dense' value @x@ to the nearest value fully representable a+-- given @scale@.+--+-- If the given 'Dense' doesn't fit entirely in the @scale@, then a non-zero+-- 'Dense' reminder is returned alongside the 'Discrete' approximation.+--+-- Proof that 'discreteFromDense' doesn't lose money:+--+-- @+-- x == case 'discreteFromDense' a x of+--         (y, z) -> 'denseFromDiscrete' y + z+-- @+discreteFromDense+  :: forall currency scale+  .  GoodScale scale+  => Approximation+  -- ^ Approximation to use if necesary in order to fit the 'Dense' amount in+  -- the requested @scale@.+  -> Dense currency+  -> (Discrete' currency scale, Dense currency)+discreteFromDense a = \c0 ->+  let !r0 = toRational c0 :: Rational+      !r1 = scale (Proxy :: Proxy scale)+      !i2 = approximate a (r0 * r1) :: Integer+      !r2 = fromInteger i2 / r1 :: Rational+      !d2 = Discrete i2+      !rest = Dense (r0 - r2)+  in (d2, rest)+{-# INLINABLE discreteFromDense #-}++--------------------------------------------------------------------------------++-- | @'Scale' currency unit@ is an rational number (expressed as @'(numerator,+-- denominator)@) indicating how many pieces of @unit@ fit in @currency@.+--+-- @currency@ is usually a ISO-4217 currency code, but not necessarily.+--+-- The '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 becacuse they are not exact+-- multiples of a dollar.+--+-- If there exists a canonical smallest @unit@ that can fully represent the+-- currency in all its denominations, then an instance @'Scale' currency+-- currency@ exists.+--+-- @+-- type instance 'Scale' \"USD\" \"USD\" = 'Scale' \"USD\" \"cent\"+-- @+--+-- For some monetary values, such as precious metals, there is no smallest+-- representable unit, since you can repeatedly split the precious metal many+-- times before it stops being a precious metal. Nevertheless, for practical+-- purposes we can make a sane arbitrary choice of smallest unit. For example,+-- the base unit for XAU (Gold) is the /troy ounce/, which is too big to be+-- considered the smallest unit, but we can arbitrarily choose the /milligrain/+-- as our smallest unit, which is about as heavy as a single grain of table salt+-- and should be sufficiently precise for all monetary practical purposes. A+-- /troy ounce/ equals 480000 /milligrains/.+--+-- @+-- type instance 'Scale' \"XAU\" \"milligrain\" = '(480000, 1)+-- @+--+-- You can use other units such as /milligrams/ for measuring XAU, for example.+-- However, since the amount of /milligrams/ in a /troy ounce/ (31103.477) is+-- not integral, we need to use rational with a denominator different than 1 to+-- express it.+--+-- @+-- type instance '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)++-- | A friendly 'GHC.TypeError' to use for a @currency@ that doesn't have a+-- canonical small unit.+type family ErrScaleNonCanonical (currency :: Symbol) :: k where+  ErrScaleNonCanonical c = GHC.TypeError+    ( 'GHC.Text c 'GHC.:<>:+      'GHC.Text " is not a currency with a canonical smallest unit," 'GHC.:$$:+      'GHC.Text "be explicit about the currency unit you want to use." )++-- | Constraints to a scale (like the one returned by @'Scale' currency unit@)+-- expected to always be satisfied. In particular, the scale is always+-- guaranteed to be a positive rational number ('GHC.Real.infinity' and+-- 'GHC.Real.notANumber' are forbidden by 'GoodScale').+type GoodScale (scale :: (Nat, Nat))+   = ( CmpNat 0 (Fst scale) ~ 'LT+     , CmpNat 0 (Snd scale) ~ 'LT+     , KnownNat (Fst scale)+     , KnownNat (Snd scale)+     )++-- | If the specified @num@ and @den@ satisfy the expectations of 'GoodScale' at+-- the type level, then construct a proof for 'GoodScale'.+mkGoodScale+  :: forall num den+  .  (KnownNat num, KnownNat den)+  => Maybe (Dict (GoodScale '(num, den)))+mkGoodScale =+  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 of a currrency @scale@.+--+-- For example, the 'Scale' for @\"USD\"@ in @\"cent\"@s is @100/1@.+--+-- @+-- > 'scale' ('Proxy' :: 'Proxy' ('Scale' \"USD\" \"cent\"))+-- 100 '%' 1+-- @+--+-- @+-- > 'scale' (x :: 'Discrete' \"USD\" \"cent\")+-- 100 '%' 1+-- @+--+-- The returned 'Rational' is statically guaranteed to be a positive number.+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)+++-- | Composition of 'ExchangeRate's multiplies exchange rates together:+--+-- @+-- 'exchangeRateToRational' x * 'exchangeRateToRational' y  ==  'exchangeRateToRational' (x . y)+-- @+--+-- Identity:+--+-- @+-- x  ==  x . id  ==  id . x+-- @+--+-- Associativity:+--+-- @+-- x . y . z  ==  x . (y . z)  ==  (x . y) . z+-- @+--+-- Conmutativity (provided the types allow for composition):+--+-- @+-- x . y  ==  y . x+-- @+--+-- Reciprocal:+--+-- @+-- 1  ==  'exchangeRateToRational' (x . 'exchangeRateRecip' x)+-- @+instance Category ExchangeRate where+  id = ExchangeRate 1+  {-# INLINE id #-}+  ExchangeRate a . ExchangeRate b = ExchangeRate (a * b)+  {-# INLINE (.) #-}++-- |+-- @+-- > 'show' ('exchangeRate' (5 '%' 7) :: 'Maybe' ('ExchangeRate' \"USD\" \"JPY\"))@+-- Just \"ExchangeRate \\\"USD\\\" \\\"JPY\\\" 5%7\"+-- @+instance forall src dst.+  ( KnownSymbol src, KnownSymbol dst+  ) => Show (ExchangeRate src dst) where+  showsPrec n = \(ExchangeRate r0) ->+    let s = symbolVal (Proxy :: Proxy src)+        d = symbolVal (Proxy :: Proxy dst)+    in showParen (n > 10) $+         showString "ExchangeRate " . showsPrec 0 s . showChar ' ' .+         showsPrec 0 d . showChar ' ' .+         showsPrec 0 (numerator r0) . showChar '%' .+         showsPrec 0 (denominator r0)++instance forall src dst.+  ( KnownSymbol src, KnownSymbol dst+  ) => Read (ExchangeRate (src :: Symbol) (dst :: Symbol)) where+  readPrec = Read.parens $ 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 Read.readPrec+++-- | Obtain a 'Rational' representation of the 'ExchangeRate'.+--+-- This 'Rational' is guaranteed to be a positive number.+exchangeRateToRational :: ExchangeRate src dst -> Rational+exchangeRateToRational = \(ExchangeRate r0) -> r0+{-# INLINE exchangeRateToRational #-}++-- | Safely construct an 'ExchangeRate' from a *positive* 'Rational' number.+exchangeRate :: Rational -> Maybe (ExchangeRate src dst)+exchangeRate = \r ->+  if denominator r /= 0 && r > 0+  then Just (ExchangeRate r)+  else Nothing+{-# INLINE exchangeRate #-}++-- | Reciprocal 'ExchangeRate'.+--+-- This function retuns the reciprocal or multiplicative inverse of the given+-- 'ExchangeRate', leading to the following identity law:+--+-- @+-- 'exchangeRateRecip' . 'exchangeRateRecip'   ==  'id'+-- @+--+-- Note: If 'ExchangeRate' had a 'Fractional' instance, then 'exchangeRateRecip'+-- would be the implementation of 'recip'.+exchangeRateRecip :: ExchangeRate a b -> ExchangeRate b a+exchangeRateRecip = \(ExchangeRate x) ->+   ExchangeRate (1 / x)   -- 'exchangeRate' guarantees that @x@ isn't zero.+{-# INLINE exchangeRateRecip #-}++-- | Apply the 'ExchangeRate' to the given @'Dense' src@ monetary value.+--+-- Identity law:+--+-- @+-- 'exchange' ('exchangeRateRecip' x) . 'exchange' x  ==  'id'+-- @+--+-- Use the /Identity law/ for reasoning about going back and forth between @src@+-- and @dst@ in order to manage any leftovers that might not be representable as+-- a 'Discrete' monetary value of @src@.+exchange :: ExchangeRate src dst -> Dense src -> Dense dst+exchange (ExchangeRate r) = \(Dense s) -> Dense (r * s)+{-# INLINE exchange #-}++--------------------------------------------------------------------------------+-- SomeDense++-- | A monomorphic representation of 'Dense' that is easier to serialize and+-- deserialize than 'Dense' in case you don't know the type indexes involved.+--+-- If you are trying to construct a value of this type from some raw input, then+-- you will need to use the 'mkSomeDense' function.+--+-- In order to be able to effectively serialize a 'SomeDense' value, you+-- need to serialize the following three values (which are the eventual+-- arguments to 'mkSomeDense'):+--+-- * 'someDenseCurrency'+-- * 'someDenseAmount'+data SomeDense = SomeDense+  { _someDenseCurrency          :: !String+  , _someDenseAmount            :: !Rational+  } deriving (Eq, Show, GHC.Generic)++-- | __WARNING__ This instance does not compare monetary amounts, it just helps+-- you sort 'SomeDense' values in case you need to put them in a 'Data.Set.Set'+-- or similar.+deriving instance Ord SomeDense++-- | Currency name.+someDenseCurrency :: SomeDense -> String+someDenseCurrency = _someDenseCurrency+{-# INLINE someDenseCurrency #-}++-- | Currency unit amount.+someDenseAmount :: SomeDense -> Rational+someDenseAmount = _someDenseAmount+{-# INLINE someDenseAmount #-}++-- | Build a 'SomeDense' from raw values.+--+-- This function is intended for deserialization purposes. You need to convert+-- this 'SomeDense' value to a 'Dense' value in order to do any arithmetic+-- operation on the monetary value.+mkSomeDense+  :: String   -- ^ Currency. ('someDenseCurrency')+  -> Rational -- ^ Scale. ('someDenseAmount')+  -> Maybe SomeDense+mkSomeDense = \c r ->+  if (denominator r /= 0)+  then Just (SomeDense c r)+  else Nothing+{-# INLINABLE mkSomeDense #-}++-- | Convert a 'Dense' to a 'SomeDense' for ease of serialization.+toSomeDense :: KnownSymbol currency => Dense currency -> SomeDense+toSomeDense = \(Dense r0 :: Dense currency) ->+  let c = symbolVal (Proxy :: Proxy currency)+  in SomeDense c r0+{-# INLINE toSomeDense #-}++-- | Attempt to convert a 'SomeDense' to a 'Dense', provided you know the target+-- @currency@.+fromSomeDense+  :: forall currency+  .  KnownSymbol currency+  => SomeDense+  -> Maybe (Dense currency)  -- ^+fromSomeDense = \dr ->+  if (someDenseCurrency dr == symbolVal (Proxy :: Proxy currency))+  then Just (Dense (someDenseAmount dr))+  else Nothing+{-# INLINABLE fromSomeDense #-}++-- | Convert a 'SomeDense' to a 'Dense' without knowing the target @currency@.+--+-- Notice that @currency@ here can't leave its intended scope unless you can+-- prove equality with some other type at the outer scope, but in that case you+-- would be better off using 'fromSomeDense' directly.+withSomeDense+  :: SomeDense+  -> (forall currency. KnownSymbol currency => Dense currency -> r)+  -> r  -- ^+withSomeDense dr = \f ->+   case someSymbolVal (someDenseCurrency dr) of+      SomeSymbol (Proxy :: Proxy currency) ->+         f (Dense (someDenseAmount dr) :: Dense currency)+{-# INLINABLE withSomeDense #-}++--------------------------------------------------------------------------------+-- SomeDiscrete++-- | A monomorphic representation of 'Discrete' that is easier to serialize and+-- deserialize than 'Discrete' in case you don't know the type indexes involved.+--+-- If you are trying to construct a value of this type from some raw input, then+-- you will need to use the 'mkSomeDiscrete' function.+--+-- In order to be able to effectively serialize a 'SomeDiscrete' value, you need+-- to serialize the following four values (which are the eventual arguments to+-- 'mkSomeDiscrete'):+--+-- * 'someDiscreteCurrency'+-- * 'someDiscreteScale'+-- * 'someDiscreteAmount'+data SomeDiscrete = SomeDiscrete+  { _someDiscreteCurrency :: !String   -- ^ Currency name.+  , _someDiscreteScale    :: !Rational -- ^ Positive, non-zero.+  , _someDiscreteAmount   :: !Integer  -- ^ Amount of unit.+  } deriving (Eq, Show, GHC.Generic)++-- | __WARNING__ This instance does not compare monetary amounts, it just helps+-- you sort 'SomeDiscrete' values in case you need to put them in a+-- 'Data.Set.Set' or similar.+deriving instance Ord SomeDiscrete++-- | Currency name.+someDiscreteCurrency :: SomeDiscrete -> String+someDiscreteCurrency = _someDiscreteCurrency+{-# INLINE someDiscreteCurrency #-}++-- | Positive, non-zero.+someDiscreteScale :: SomeDiscrete -> Rational+someDiscreteScale = _someDiscreteScale+{-# INLINE someDiscreteScale #-}++-- | Amount of currency unit.+someDiscreteAmount :: SomeDiscrete -> Integer+someDiscreteAmount = _someDiscreteAmount+{-# INLINE someDiscreteAmount #-}++-- | Internal. Build a 'SomeDiscrete' from raw values.+--+-- This function is intended for deserialization purposes. You need to convert+-- this 'SomeDiscrete' value to a 'Discrete' vallue in order to do any arithmetic+-- operation on the monetary value.+mkSomeDiscrete+  :: String   -- ^ Currency name. ('someDiscreteCurrency')+  -> Rational -- ^ Scale. Positive, non-zero. ('someDiscreteScale')+  -> Integer  -- ^ Amount of unit. ('someDiscreteAmount')+  -> Maybe SomeDiscrete+mkSomeDiscrete = \c r a ->+  if (denominator r /= 0) && (r > 0)+  then Just (SomeDiscrete c r a)+  else Nothing+{-# INLINABLE mkSomeDiscrete #-}++-- | Convert a 'Discrete' to a 'SomeDiscrete' for ease of serialization.+toSomeDiscrete+  :: (KnownSymbol currency, GoodScale scale)+  => Discrete' currency scale+  -> SomeDiscrete -- ^+toSomeDiscrete = \(Discrete i0 :: Discrete' currency scale) ->+  let c = symbolVal (Proxy :: Proxy currency)+      n = natVal (Proxy :: Proxy (Fst scale))+      d = natVal (Proxy :: Proxy (Snd scale))+  in SomeDiscrete c (n % d) i0+{-# INLINABLE toSomeDiscrete #-}++-- | Attempt to convert a 'SomeDiscrete' to a 'Discrete', provided you know the+-- target @currency@ and @unit@.+fromSomeDiscrete+  :: forall currency scale+  .  (KnownSymbol currency, GoodScale scale)+  => SomeDiscrete+  -> Maybe (Discrete' currency scale)  -- ^+fromSomeDiscrete = \dr ->+   if (someDiscreteCurrency dr == symbolVal (Proxy :: Proxy currency)) &&+      (someDiscreteScale dr == scale (Proxy :: Proxy scale))+   then Just (Discrete (someDiscreteAmount dr))+   else Nothing+{-# INLINABLE fromSomeDiscrete #-}++-- | Convert a 'SomeDiscrete' to a 'Discrete' without knowing the target+-- @currency@ and @unit@.+--+-- Notice that @currency@ and @unit@ here can't leave its intended scope unless+-- you can prove equality with some other type at the outer scope, but in that+-- case you would be better off using 'fromSomeDiscrete' directly.+--+-- Notice that you may need to add an explicit type to the result of this+-- function in order to keep the compiler happy.+withSomeDiscrete+  :: forall r+  .  SomeDiscrete+  -> ( forall currency scale.+         ( KnownSymbol currency+         , GoodScale scale+         ) => Discrete' currency scale+           -> r )+  -> r  -- ^+withSomeDiscrete dr = \f ->+  case someSymbolVal (someDiscreteCurrency dr) of+    SomeSymbol (Proxy :: Proxy currency) ->+      case someNatVal (numerator (someDiscreteScale dr)) of+        Nothing -> error "withSomeDiscrete: impossible: numerator < 0"+        Just (SomeNat (Proxy :: Proxy num)) ->+          case someNatVal (denominator (someDiscreteScale dr)) of+            Nothing -> error "withSomeDiscrete: impossible: denominator < 0"+            Just (SomeNat (Proxy :: Proxy den)) ->+              case mkGoodScale of+                Nothing -> error "withSomeDiscrete: impossible: mkGoodScale"+                Just (Dict :: Dict (GoodScale '(num, den))) ->+                  f (Discrete (someDiscreteAmount dr)+                       :: Discrete' currency '(num, den))+{-# INLINABLE withSomeDiscrete #-}++--------------------------------------------------------------------------------+-- SomeExchangeRate++-- | A monomorphic representation of 'ExchangeRate' that is easier to serialize+-- and deserialize than 'ExchangeRate' in case you don't know the type indexes+-- involved.+--+-- If you are trying to construct a value of this type from some raw input, then+-- you will need to use the 'mkSomeExchangeRate' function.+--+-- In order to be able to effectively serialize an 'SomeExchangeRate' value, you+-- need to serialize the following four values (which are the eventual arguments+-- to 'mkSomeExchangeRate'):+--+-- * 'someExchangeRateSrcCurrency'+-- * 'someExchangeRateDstCurrency'+-- * 'someExchangeRateRate'+data SomeExchangeRate = SomeExchangeRate+  { _someExchangeRateSrcCurrency     :: !String+  , _someExchangeRateDstCurrency     :: !String+  , _someExchangeRateRate            :: !Rational -- ^ Positive, non-zero.+  } deriving (Eq, Show, GHC.Generic)++-- | __WARNING__ This instance does not compare monetary amounts, it just helps+-- you sort 'SomeExchangeRate' values in case you need to put them in a+-- 'Data.Set.Set' or similar.+deriving instance Ord SomeExchangeRate++-- | Source currency name.+someExchangeRateSrcCurrency :: SomeExchangeRate -> String+someExchangeRateSrcCurrency = _someExchangeRateSrcCurrency+{-# INLINE someExchangeRateSrcCurrency #-}++-- | Destination currency name.+someExchangeRateDstCurrency :: SomeExchangeRate -> String+someExchangeRateDstCurrency = _someExchangeRateDstCurrency+{-# INLINE someExchangeRateDstCurrency #-}++-- | Exchange rate. Positive, non-zero.+someExchangeRateRate :: SomeExchangeRate -> Rational+someExchangeRateRate = _someExchangeRateRate+{-# INLINE someExchangeRateRate #-}++-- | Internal. Build a 'SomeExchangeRate' from raw values.+--+-- This function is intended for deserialization purposes. You need to convert+-- this 'SomeExchangeRate' value to a 'ExchangeRate' value in order to do any+-- arithmetic operation with the exchange rate.+mkSomeExchangeRate+  :: String   -- ^ Source currency name. ('someExchangeRateSrcCurrency')+  -> String   -- ^ Destination currency name. ('someExchangeRateDstCurrency')+  -> Rational -- ^ Exchange rate . Positive, non-zero. ('someExchangeRateRate')+  -> Maybe SomeExchangeRate+mkSomeExchangeRate = \src dst r ->+  if (denominator r /= 0) && (r > 0)+  then Just (SomeExchangeRate src dst r)+  else Nothing+{-# INLINABLE mkSomeExchangeRate #-}++-- | Convert a 'ExchangeRate' to a 'SomeDiscrete' for ease of serialization.+toSomeExchangeRate+  :: (KnownSymbol src, KnownSymbol dst)+  => ExchangeRate src dst+  -> SomeExchangeRate -- ^+toSomeExchangeRate = \(ExchangeRate r0 :: ExchangeRate src dst) ->+  let src = symbolVal (Proxy :: Proxy src)+      dst = symbolVal (Proxy :: Proxy dst)+  in SomeExchangeRate src dst r0+{-# INLINABLE toSomeExchangeRate #-}++-- | Attempt to convert a 'SomeExchangeRate' to a 'ExchangeRate', provided you+-- know the target @src@ and @dst@ types.+fromSomeExchangeRate+  :: forall src dst+  .  (KnownSymbol src, KnownSymbol dst)+  => SomeExchangeRate+  -> Maybe (ExchangeRate src dst)  -- ^+fromSomeExchangeRate = \x ->+   if (someExchangeRateSrcCurrency x == symbolVal (Proxy :: Proxy src)) &&+      (someExchangeRateDstCurrency x == symbolVal (Proxy :: Proxy dst))+   then Just (ExchangeRate (someExchangeRateRate x))+   else Nothing+{-# INLINABLE fromSomeExchangeRate #-}++-- | Convert a 'SomeExchangeRate' to a 'ExchangeRate' without knowing the target+-- @currency@ and @unit@.+--+-- Notice that @src@ and @dst@ here can't leave its intended scope unless+-- you can prove equality with some other type at the outer scope, but in that+-- case you would be better off using 'fromSomeExchangeRate' directly.+withSomeExchangeRate+  :: SomeExchangeRate+  -> ( forall src dst.+         ( KnownSymbol src+         , KnownSymbol dst+         ) => ExchangeRate src dst+           -> r )+  -> r  -- ^+withSomeExchangeRate x = \f ->+  case someSymbolVal (someExchangeRateSrcCurrency x) of+    SomeSymbol (Proxy :: Proxy src) ->+      case someSymbolVal (someExchangeRateDstCurrency x) of+        SomeSymbol (Proxy :: Proxy dst) ->+          f (ExchangeRate (someExchangeRateRate x) :: ExchangeRate src dst)+{-# INLINABLE withSomeExchangeRate #-}++--------------------------------------------------------------------------------+-- Miscellaneous++type family Fst (ab :: (ka, kb)) :: ka where Fst '(a,b) = a+type family Snd (ab :: (ka, kb)) :: ka where Snd '(a,b) = b++--------------------------------------------------------------------------------+-- vector-space instances++#ifdef HAS_vector_space+instance AG.AdditiveGroup (Dense currency) where+  zeroV = Dense AG.zeroV+  {-# INLINE zeroV #-}+  Dense a ^+^ Dense b = Dense $! (a AG.^+^ b)+  {-# INLINE (^+^) #-}+  negateV (Dense a) = Dense $! (AG.negateV a)+  {-# INLINE negateV #-}+  Dense a ^-^ Dense b = Dense $! (a AG.^-^ b)+  {-# INLINE (^-^) #-}++-- | __WARNING__ a scalar with a zero denominator will cause 'VS.*^' to crash.+instance VS.VectorSpace (Dense currency) where+  type Scalar (Dense currency) = Rational+  s *^ Dense a =+    if denominator s /= 0+    then Dense $! s VS.*^ a+    else error "(*^)': malformed Rational given (denominator is zero)."+  {-# INLINE (*^) #-}++instance GoodScale scale => AG.AdditiveGroup (Discrete' currency scale) where+  zeroV = Discrete AG.zeroV+  {-# INLINE zeroV #-}+  Discrete a ^+^ Discrete b = Discrete $! (a AG.^+^ b)+  {-# INLINE (^+^) #-}+  negateV (Discrete a) = Discrete $! (AG.negateV a)+  {-# INLINE negateV #-}+  Discrete a ^-^ Discrete b = Discrete $! (a AG.^-^ b)+  {-# INLINE (^-^) #-}++instance GoodScale scale => VS.VectorSpace (Discrete' currency scale) where+  type Scalar (Discrete' currency scale) = Integer+  s *^ Discrete a = Discrete $! (s VS.*^ a)+  {-# INLINE (*^) #-}+#endif++--------------------------------------------------------------------------------+-- Extra instances: hashable+#ifdef HAS_hashable+instance Hashable Approximation+instance Hashable (Dense currency)+instance Hashable SomeDense+instance GoodScale scale => Hashable (Discrete' currency scale)+instance Hashable SomeDiscrete+instance Hashable (ExchangeRate src dst)+instance Hashable SomeExchangeRate+#endif++--------------------------------------------------------------------------------+-- Extra instances: deepseq+#ifdef HAS_deepseq+instance NFData Approximation+instance NFData (Dense currency)+instance NFData SomeDense+instance GoodScale scale => NFData (Discrete' currency scale)+instance NFData SomeDiscrete+instance NFData (ExchangeRate src dst)+instance NFData SomeExchangeRate+#endif++--------------------------------------------------------------------------------+-- Extra instances: cereal+#ifdef HAS_cereal+-- | Compatible with 'SomeDense'.+instance (KnownSymbol currency) => Cereal.Serialize (Dense currency) where+  put = Cereal.put . toSomeDense+  get = maybe empty pure =<< fmap fromSomeDense Cereal.get++-- | Compatible with 'SomeDiscrete'.+instance+  ( KnownSymbol currency, GoodScale scale+  ) => Cereal.Serialize (Discrete' currency scale) where+  put = Cereal.put . toSomeDiscrete+  get = maybe empty pure =<< fmap fromSomeDiscrete Cereal.get++-- | Compatible with 'SomeExchangeRate'.+instance+  ( KnownSymbol src, KnownSymbol dst+  ) => Cereal.Serialize (ExchangeRate src dst) where+  put = Cereal.put . toSomeExchangeRate+  get = maybe empty pure =<< fmap fromSomeExchangeRate Cereal.get++-- | Compatible with 'Dense'.+instance Cereal.Serialize SomeDense where+  put = \(SomeDense c r) -> do+    Cereal.put c+    Cereal.put (numerator r)+    Cereal.put (denominator r)+  get = maybe empty pure =<< do+    c :: String <- Cereal.get+    n :: Integer <- Cereal.get+    d :: Integer <- Cereal.get+    when (d == 0) (fail "denominator is zero")+    pure (mkSomeDense c (n % d))++-- | Compatible with 'Discrete'.+instance Cereal.Serialize SomeDiscrete where+  put = \(SomeDiscrete c r a) -> do+    Cereal.put c+    Cereal.put (numerator r)+    Cereal.put (denominator r)+    Cereal.put a+  get = maybe empty pure =<< do+    c :: String <- Cereal.get+    n :: Integer <- Cereal.get+    d :: Integer <- Cereal.get+    when (d == 0) (fail "denominator is zero")+    a :: Integer <- Cereal.get+    pure (mkSomeDiscrete c (n % d) a)++-- | Compatible with 'ExchangeRate'.+instance Cereal.Serialize SomeExchangeRate where+  put = \(SomeExchangeRate src dst r) -> do+    Cereal.put src+    Cereal.put dst+    Cereal.put (numerator r)+    Cereal.put (denominator r)+  get = maybe empty pure =<< do+    src :: String <- Cereal.get+    dst :: String <- Cereal.get+    n :: Integer <- Cereal.get+    d :: Integer <- Cereal.get+    when (d == 0) (fail "denominator is zero")+    pure (mkSomeExchangeRate src dst (n % d))+#endif++------------------------------------------------------------------------------+-- Extra instances: binary+#ifdef HAS_binary+-- | Compatible with 'SomeDense'.+instance (KnownSymbol currency) => Binary.Binary (Dense currency) where+  put = Binary.put . toSomeDense+  get = maybe empty pure =<< fmap fromSomeDense Binary.get++-- | Compatible with 'SomeDiscrete'.+instance+  ( KnownSymbol currency, GoodScale scale+  ) => Binary.Binary (Discrete' currency scale) where+  put = Binary.put . toSomeDiscrete+  get = maybe empty pure =<< fmap fromSomeDiscrete Binary.get++-- | Compatible with 'SomeExchangeRate'.+instance+  ( KnownSymbol src, KnownSymbol dst+  ) => Binary.Binary (ExchangeRate src dst) where+  put = Binary.put . toSomeExchangeRate+  get = maybe empty pure =<< fmap fromSomeExchangeRate Binary.get++-- | Compatible with 'Dense'.+instance Binary.Binary SomeDense where+  put = \(SomeDense c r) ->+    Binary.put c >> Binary.put (numerator r) >> Binary.put (denominator r)+  get = maybe empty pure =<< do+    c :: String <- Binary.get+    n :: Integer <- Binary.get+    d :: Integer <- Binary.get+    when (d == 0) (fail "denominator is zero")+    pure (mkSomeDense c (n % d))++-- | Compatible with 'Discrete'.+instance Binary.Binary SomeDiscrete where+  put = \(SomeDiscrete c r a) ->+    Binary.put c <>+    Binary.put (numerator r) <>+    Binary.put (denominator r) <>+    Binary.put a+  get = maybe empty pure =<< do+    c :: String <- Binary.get+    n :: Integer <- Binary.get+    d :: Integer <- Binary.get+    when (d == 0) (fail "denominator is zero")+    a :: Integer <- Binary.get+    pure (mkSomeDiscrete c (n % d) a)++-- | Compatible with 'ExchangeRate'.+instance Binary.Binary SomeExchangeRate where+  put = \(SomeExchangeRate src dst r) -> do+    Binary.put src+    Binary.put dst+    Binary.put (numerator r)+    Binary.put (denominator r)+  get = maybe empty pure =<< do+    src :: String <- Binary.get+    dst :: String <- Binary.get+    n :: Integer <- Binary.get+    d :: Integer <- Binary.get+    when (d == 0) (fail "denominator is zero")+    pure (mkSomeExchangeRate src dst (n % d))+#endif++--------------------------------------------------------------------------------+-- Extra instances: serialise+#ifdef HAS_serialise+-- | Compatible with 'SomeDense'.+instance (KnownSymbol currency) => Ser.Serialise (Dense currency) where+  encode = Ser.encode . toSomeDense+  decode = maybe (fail "Dense") pure =<< fmap fromSomeDense Ser.decode++-- | Compatible with 'SomeDiscrete'.+instance+  ( KnownSymbol currency, GoodScale scale+  ) => Ser.Serialise (Discrete' currency scale) where+  encode = Ser.encode . toSomeDiscrete+  decode = maybe (fail "Discrete'") pure =<< fmap fromSomeDiscrete Ser.decode++-- | Compatible with 'SomeExchangeRate'.+instance+  ( KnownSymbol src, KnownSymbol dst+  ) => Ser.Serialise (ExchangeRate src dst) where+  encode = Ser.encode . toSomeExchangeRate+  decode = maybe (fail "ExchangeRate") pure+             =<< fmap fromSomeExchangeRate Ser.decode++-- | Compatible with 'Dense'.+instance Ser.Serialise SomeDense where+  encode = \(SomeDense c r) ->+    Ser.encode c <> Ser.encode (numerator r) <> Ser.encode (denominator r)+  decode = maybe (fail "SomeDense") pure =<< do+    c :: String <- Ser.decode+    n :: Integer <- Ser.decode+    d :: Integer <- Ser.decode+    when (d == 0) (fail "denominator is zero")+    pure (mkSomeDense c (n % d))++-- | Compatible with 'Discrete'.+instance Ser.Serialise SomeDiscrete where+  encode = \(SomeDiscrete c r a) ->+    Ser.encode c <>+    Ser.encode (numerator r) <>+    Ser.encode (denominator r) <>+    Ser.encode a+  decode = maybe (fail "SomeDiscrete") pure =<< do+    c :: String <- Ser.decode+    n :: Integer <- Ser.decode+    d :: Integer <- Ser.decode+    when (d == 0) (fail "denominator is zero")+    a :: Integer <- Ser.decode+    pure (mkSomeDiscrete c (n % d) a)++-- | Compatible with 'ExchangeRate'.+instance Ser.Serialise SomeExchangeRate where+  encode = \(SomeExchangeRate src dst r) ->+    Ser.encode src <>+    Ser.encode dst <>+    Ser.encode (numerator r) <>+    Ser.encode (denominator r)+  decode = maybe (fail "SomeExchangeRate") pure =<< do+    src :: String <- Ser.decode+    dst :: String <- Ser.decode+    n :: Integer <- Ser.decode+    d :: Integer <- Ser.decode+    when (d == 0) (fail "denominator is zero")+    pure (mkSomeExchangeRate src dst (n % d))+#endif++--------------------------------------------------------------------------------+-- Extra instances: aeson+#ifdef HAS_aeson+-- | Compatible with 'SomeDense'+--+-- Example rendering @'dense'' (2 '%' 3) :: 'Dense' \"BTC\"@:+--+-- @+-- [\"BTC\", 2, 3]+-- @+--+-- Note: The JSON serialization changed in version 0.4 (the leading @"Dense"@+-- string was dropped from the rendered 'Ae.Array').+instance KnownSymbol currency => Ae.ToJSON (Dense currency) where+  toJSON = Ae.toJSON . toSomeDense++-- | Compatible with 'SomeDense'+--+-- Note: The JSON serialization changed in version 0.4. However, this instance+-- is still able to cope with the previous format.+instance KnownSymbol currency => Ae.FromJSON (Dense currency) where+  parseJSON = maybe empty pure <=< fmap fromSomeDense . Ae.parseJSON++-- | Compatible with 'Dense'+--+-- Note: The JSON serialization changed in version 0.4 (the leading @"Dense"@+-- string was dropped from the rendered 'Ae.Array').+instance Ae.ToJSON SomeDense where+  toJSON = \(SomeDense c r) ->+    Ae.toJSON (c, numerator r, denominator r)++-- | Compatible with 'Dense'.+--+-- Note: The JSON serialization changed in version 0.4. However, this instance+-- is still able to cope with the previous format.+instance Ae.FromJSON SomeDense where+  parseJSON = \v -> do+    (c, n, d) <- Ae.parseJSON v <|> do+       -- Pre 0.4 format.+       ("Dense" :: String, c, n, d) <- Ae.parseJSON v+       pure (c, n, d)+    when (d == 0) (fail "denominator is zero")+    maybe empty pure (mkSomeDense c (n % d))++-- | Compatible with 'SomeDiscrete'+--+-- Example rendering @'discrete' 43 :: 'Discrete' \"BTC\" \"satoshi\"@:+--+-- @+-- [\"BTC\", 100000000, 1, 43]+-- @+--+-- Note: The JSON serialization changed in version 0.4 (the leading @"Discrete"@+-- string was dropped from the rendered 'Ae.Array').+instance+  ( KnownSymbol currency, GoodScale scale+  ) => Ae.ToJSON (Discrete' currency scale) where+  toJSON = Ae.toJSON . toSomeDiscrete++-- | Compatible with 'SomeDiscrete'+--+-- Note: The JSON serialization changed in version 0.4. However, this instance+-- is still able to cope with the previous format.+instance+  ( KnownSymbol currency, GoodScale scale+  ) => Ae.FromJSON (Discrete' currency scale) where+  parseJSON = maybe empty pure <=< fmap fromSomeDiscrete . Ae.parseJSON++-- | Compatible with 'Discrete''+--+-- Note: The JSON serialization changed in version 0.4 (the leading @"Discrete"@+-- string was dropped from the rendered 'Ae.Array').+instance Ae.ToJSON SomeDiscrete where+  toJSON = \(SomeDiscrete c r a) ->+    Ae.toJSON (c, numerator r, denominator r, a)++-- | Compatible with 'Discrete''+--+-- Note: The JSON serialization changed in version 0.4. However, this instance+-- is still able to cope with the previous format.+instance Ae.FromJSON SomeDiscrete where+  parseJSON = \v -> do+    (c, n, d, a) <- Ae.parseJSON v <|> do+       -- Pre 0.4 format.+       ("Discrete" :: String, c, n, d, a) <- Ae.parseJSON v+       pure (c, n, d, a)+    when (d == 0) (fail "denominator is zero")+    maybe empty pure (mkSomeDiscrete c (n % d) a)++-- | Compatible with 'SomeExchangeRate'+--+-- Example rendering an 'ExchangeRate' constructed with+-- @'exchangeRate' (5 '%' 7) :: 'ExchangeRate' \"USD\" \"JPY\"@+--+-- @+-- [\"USD\", \"JPY\", 5, 7]+-- @+--+-- Note: The JSON serialization changed in version 0.4 (the leading+-- @"ExchangeRate"@ string was dropped from the rendered 'Ae.Array').+instance+  ( KnownSymbol src, KnownSymbol dst+  ) => Ae.ToJSON (ExchangeRate src dst) where+  toJSON = Ae.toJSON . toSomeExchangeRate++-- | Compatible with 'SomeExchangeRate'+--+-- Note: The JSON serialization changed in version 0.4. However, this instance+-- is still able to cope with the previous format.+instance+  ( KnownSymbol src, KnownSymbol dst+  ) => Ae.FromJSON (ExchangeRate src dst) where+  parseJSON = maybe empty pure <=< fmap fromSomeExchangeRate . Ae.parseJSON++-- | Compatible with 'ExchangeRate'+--+-- Note: The JSON serialization changed in version 0.4 (the leading+-- @"ExchangeRate"@ string was dropped from the rendered 'Ae.Array').+instance Ae.ToJSON SomeExchangeRate where+  toJSON = \(SomeExchangeRate src dst r) ->+    Ae.toJSON (src, dst, numerator r, denominator r)++-- | Compatible with 'ExchangeRate'+--+-- Note: The JSON serialization changed in version 0.4. However, this instance+-- is still able to cope with the previous format.+instance Ae.FromJSON SomeExchangeRate where+  parseJSON = \v -> do+    (src, dst, n, d) <- Ae.parseJSON v <|> do+       -- Pre 0.4 format.+       ("ExchangeRate" :: String, src, dst, n, d) <- Ae.parseJSON v+       pure (src, dst, n, d)+    when (d == 0) (fail "denominator is zero")+    maybe empty pure (mkSomeExchangeRate src dst (n % d))+#endif++--------------------------------------------------------------------------------+-- Extra instances: xmlbf+#ifdef HAS_xmlbf++-- | Compatible with 'SomeDense'+--+-- Example rendering @'dense' (2 '%' 3) :: 'Dense' \"BTC\"@:+--+-- @+-- \<money-dense c=\"BTC\" n=\"2\" d=\"3\"/>+-- @+instance KnownSymbol currency => Xmlbf.ToXml (Dense currency) where+  toXml = Xmlbf.toXml . toSomeDense++-- | Compatible with 'SomeDense'+instance KnownSymbol currency => Xmlbf.FromXml (Dense currency) where+  fromXml = maybe empty pure =<< fmap fromSomeDense Xmlbf.fromXml++-- | Compatible with 'Dense'+instance Xmlbf.ToXml SomeDense where+  toXml = \(SomeDense c r) ->+    let as = [ (T.pack "c", T.pack c)+             , (T.pack "n", T.pack (show (numerator r)))+             , (T.pack "d", T.pack (show (denominator r))) ]+        Right e = Xmlbf.element (T.pack "money-dense") (fromList as) []+    in [e]++-- | Compatible with 'Dense'.+instance Xmlbf.FromXml SomeDense where+  fromXml = Xmlbf.pElement (T.pack "money-dense") $ do+    c <- T.unpack <$> Xmlbf.pAttr "c"+    n <- Xmlbf.pRead =<< Xmlbf.pAttr "n"+    d <- Xmlbf.pRead =<< Xmlbf.pAttr "d"+    when (d == 0) (fail "denominator is zero")+    maybe empty pure (mkSomeDense c (n % d))++-- | Compatible with 'SomeDiscrete'+--+-- Example rendering @'discrete' 43 :: 'Discrete' \"BTC\" \"satoshi\"@:+--+-- @+-- \<money-discrete c=\"BTC\" n=\"100000000\" d=\"1\" a=\"43\"/>+-- @+instance+  ( KnownSymbol currency, GoodScale scale+  ) => Xmlbf.ToXml (Discrete' currency scale) where+  toXml = Xmlbf.toXml . toSomeDiscrete++-- | Compatible with 'SomeDiscrete'+instance+  ( KnownSymbol currency, GoodScale scale+  ) => Xmlbf.FromXml (Discrete' currency scale) where+  fromXml = maybe empty pure =<< fmap fromSomeDiscrete Xmlbf.fromXml++-- | Compatible with 'Discrete''+instance Xmlbf.ToXml SomeDiscrete where+  toXml = \(SomeDiscrete c r a) ->+    let as = [ (T.pack "c", T.pack c)+             , (T.pack "n", T.pack (show (numerator r)))+             , (T.pack "d", T.pack (show (denominator r)))+             , (T.pack "a", T.pack (show a)) ]+        Right e = Xmlbf.element (T.pack "money-discrete") (fromList as) []+    in [e]++-- | Compatible with 'Discrete''+instance Xmlbf.FromXml SomeDiscrete where+  fromXml = Xmlbf.pElement (T.pack "money-discrete") $ do+    c <- T.unpack <$> Xmlbf.pAttr "c"+    n <- Xmlbf.pRead =<< Xmlbf.pAttr "n"+    d <- Xmlbf.pRead =<< Xmlbf.pAttr "d"+    when (d == 0) (fail "denominator is zero")+    a <- Xmlbf.pRead =<< Xmlbf.pAttr "a"+    maybe empty pure (mkSomeDiscrete c (n % d) a)++-- | Compatible with 'SomeExchangeRate'+--+-- Example rendering an 'ExchangeRate' constructed with+-- @'exchangeRate' (5 '%' 7) :: 'ExchangeRate' \"USD\" \"JPY\"@+--+-- @+-- \<exchange-rate src=\"USD\" dst=\"JPY\" n=\"5\" d=\"7\"/>+-- @+instance+  ( KnownSymbol src, KnownSymbol dst+  ) => Xmlbf.ToXml (ExchangeRate src dst) where+  toXml = Xmlbf.toXml . toSomeExchangeRate++-- | Compatible with 'SomeExchangeRate'+instance+  ( KnownSymbol src, KnownSymbol dst+  ) => Xmlbf.FromXml (ExchangeRate src dst) where+  fromXml = maybe empty pure =<< fmap fromSomeExchangeRate Xmlbf.fromXml++-- | Compatible with 'ExchangeRate'+instance Xmlbf.ToXml SomeExchangeRate where+  toXml = \(SomeExchangeRate src dst r) ->+    let as = [ (T.pack "src", T.pack src)+             , (T.pack "dst", T.pack dst)+             , (T.pack "n", T.pack (show (numerator r)))+             , (T.pack "d", T.pack (show (denominator r))) ]+        Right e = Xmlbf.element (T.pack "exchange-rate") (fromList as) []+    in [e]++-- | Compatible with 'ExchangeRate'+instance Xmlbf.FromXml SomeExchangeRate where+  fromXml = Xmlbf.pElement (T.pack "exchange-rate") $ do+    src <- T.unpack <$> Xmlbf.pAttr "src"+    dst <- T.unpack <$> Xmlbf.pAttr "dst"+    n <- Xmlbf.pRead =<< Xmlbf.pAttr "n"+    d <- Xmlbf.pRead =<< Xmlbf.pAttr "d"+    when (d == 0) (fail "denominator is zero")+    maybe empty pure (mkSomeExchangeRate src dst (n % d))+#endif++--------------------------------------------------------------------------------+-- Extra instances: store+#ifdef HAS_store+-- | Compatible with 'SomeDense'.+instance (KnownSymbol currency) => Store.Store (Dense currency) where+  size = storeContramapSize toSomeDense Store.size+  poke = Store.poke . toSomeDense+  peek = maybe (fail "peek") pure =<< fmap fromSomeDense Store.peek+-- | Compatible with 'Dense'.+instance Store.Store SomeDense where+  poke = \(SomeDense c r) -> do+    Store.poke c+    Store.poke (numerator r)+    Store.poke (denominator r)+  peek = maybe (fail "peek") pure =<< do+    c :: String <- Store.peek+    n :: Integer <- Store.peek+    d :: Integer <- Store.peek+    when (d == 0) (fail "denominator is zero")+    pure (mkSomeDense c (n % d))++-- | Compatible with 'SomeDiscrete'.+instance+  ( KnownSymbol currency, GoodScale scale+  ) => Store.Store (Discrete' currency scale) where+  size = storeContramapSize toSomeDiscrete Store.size+  poke = Store.poke . toSomeDiscrete+  peek = maybe (fail "peek") pure =<< fmap fromSomeDiscrete Store.peek+-- | Compatible with 'Discrete''.+instance Store.Store SomeDiscrete where+  poke = \(SomeDiscrete c r a) ->do+    Store.poke c+    Store.poke (numerator r)+    Store.poke (denominator r)+    Store.poke a+  peek = maybe (fail "peek") pure =<< do+    c :: String <- Store.peek+    n :: Integer <- Store.peek+    d :: Integer <- Store.peek+    when (d == 0) (fail "denominator is zero")+    a :: Integer <- Store.peek+    pure (mkSomeDiscrete c (n % d) a)+-- | Compatible with 'SomeExchangeRate'.+instance+  ( KnownSymbol src, KnownSymbol dst+  ) => Store.Store (ExchangeRate src dst) where+  size = storeContramapSize toSomeExchangeRate Store.size+  poke = Store.poke . toSomeExchangeRate+  peek = maybe (fail "peek") pure =<< fmap fromSomeExchangeRate Store.peek+-- | Compatible with 'ExchangeRate'.+instance Store.Store SomeExchangeRate where+  poke = \(SomeExchangeRate src dst r) -> do+    Store.poke src+    Store.poke dst+    Store.poke (numerator r)+    Store.poke (denominator r)+  peek = maybe (fail "peek") pure =<< do+    src <- Store.peek+    dst <- Store.peek+    n <- Store.peek+    d <- Store.peek+    when (d == 0) (fail "denominator is zero")+    pure (mkSomeExchangeRate src dst (n % d))++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++--------------------------------------------------------------------------------+-- Decimal rendering++-- | Render a 'Dense' monetary amount as a decimal number in a potentially lossy+-- manner.+--+-- @+-- > 'denseToDecimal' 'Round' 'True' ('Just' \',\') \'.\' 2+--      ('Proxy' :: 'Proxy' ('Scale' \"USD\" \"dollar\"))+--      ('dense'' (123456 '%' 100) :: 'Dense' \"USD\")+-- Just \"+1,234.56\"+-- @+--+-- @+-- > 'denseToDecimal' 'Round' 'True' ('Just' \',\') \'.\' 2+--      ('Proxy' :: 'Proxy' ('Scale' \"USD\" \"cent\"))+--      ('dense'' (123456 '%' 100) :: 'Dense' \"USD\")+-- Just \"+123,456.00\"+-- @+--+-- This function returns 'Nothing' if it is not possible to reliably render the+-- decimal string due to a bad choice of separators. That is, if the separators+-- are digits or equal among themselves, this function returns 'Nothing'.+denseToDecimal+  :: GoodScale scale+  => Approximation+  -- ^ Approximation to use if necesary in order to fit the 'Dense' amount in+  -- as many decimal numbers as requested.+  -> Bool+  -- ^ Whether to render a leading @\'+\'@ sign in case the amount is positive.+  -> Maybe Char+  -- ^ Thousands separator for the integer part, if any (i.e., the @\',\'@ in+  -- @1,234.56789@).+  -> Char+  -- ^ Decimal separator (i.e., the @\'.\'@ in @1,234.56789@)+  -> Word8+  -- ^ Number of decimal numbers to render, if any.+  -> Proxy scale+  -- ^ Scale used by the integer part of the decimal number. For example, a when+  -- rendering render @'dense'' (123 '%' 100) :: 'Dense' "USD"@ as a decimal+  -- number with three decimal places, a scale of @1@ (i.e. @'Scale' \"USD\"+  -- \"dollar\"@) would render @1@ as the integer part and @230@ as the+  -- fractional part, whereas a scale of @100@ (i.e., @'Scale' \"USD\"+  -- \"cent\"@) would render @123@ as the integer part and @000@ as the+  -- fractional part.+  -> Dense currency+  -- ^ The dense monetary amount to render.+  -> Maybe String+  -- ^ Returns 'Nothing' is the given separators are not acceptable (i.e., they+  -- are digits, or they are equal).+{-# INLINABLE denseToDecimal #-}+denseToDecimal a plus ytsep dsep fdigs0 ps = \(Dense r0) ->+  rationalToDecimal a plus ytsep dsep fdigs0 (scale ps * r0)++-- | Render a 'ExchangeRate' as a decimal number in a potentially lossy manner.+--+-- @+-- > 'exchangeRateToDecimal' 'Round' 'True' ('Just' \',\') \'.\' 2+--       '=<<' ('exchangeRate' (123456 '%' 100) :: 'Maybe' ('ExchangeRate' \"USD\" \"EUR\"))+-- Just \"1,234.56\"+-- @+--+-- This function returns 'Nothing' if it is not possible to reliably render the+-- decimal string due to a bad choice of separators. That is, if the separators+-- are digits or equal among themselves, this function returns 'Nothing'.+exchangeRateToDecimal+  :: Approximation+  -- ^ Approximation to use if necesary in order to fit the 'Dense' amount in+  -- as many decimal numbers as requested.+  -> Maybe Char+  -- ^ Thousands separator for the integer part, if any (i.e., the @\',\'@ in+  -- @1,234.56789@).+  -> Char+  -- ^ Decimal separator (i.e., the @\'.\'@ in @1,234.56789@)+  -> Word8+  -- ^ Number of decimal numbers to render, if any.+  -> ExchangeRate src dst+  -- ^ The 'ExchangeRate' to render.+  -> Maybe String+  -- ^ Returns 'Nothing' is the given separators are not acceptable (i.e., they+  -- are digits, or they are equal).+{-# INLINABLE exchangeRateToDecimal #-}+exchangeRateToDecimal a ytsep dsep fdigs0 = \(ExchangeRate r0) ->+  rationalToDecimal a False ytsep dsep fdigs0 r0++-- | Render a 'Rational' number as a decimal approximation.+--+-- This function returns 'Nothing' if it is not possible to reliably render the+-- decimal string due to a bad choice of separators. That is, if the separators+-- are digits or equal among themselves, this function returns 'Nothing'.+rationalToDecimal+  :: Approximation+  -- ^ Approximation to use if necesary in order to fit the 'Dense' amount in+  -- as many decimal numbers as requested.+  -> Bool+  -- ^ Whether to render a leading @\'+\'@ sign in case the amount is positive.+  -> Maybe Char+  -- ^ Thousands separator for the integer part, if any (i.e., the @\',\'@ in+  -- @1,234.56789@).+  -> Char+  -- ^ Decimal separator (i.e., the @\'.\'@ in @1,234.56789@)+  -> Word8+  -- ^ Number of decimal numbers to render, if any.+  -> Rational+  -- ^ The dense monetary amount to render.+  -> Maybe String+  -- ^ Returns 'Nothing' is the given separators are not acceptable (i.e., they+  -- are digits, or they are equal).+{-# INLINABLE rationalToDecimal #-}+rationalToDecimal a plus ytsep dsep fdigs0 = \r0 -> do+  for_ ytsep $ \tsep ->+     guard (tsep /= dsep && not (Char.isDigit tsep))+  guard (not (Char.isDigit dsep))+  -- this string-fu is not particularly efficient.+  let parts = approximate a (r0 * (10 ^ fdigs0)) :: Integer+      ipart = fromInteger (abs parts) `div` (10 ^ fdigs0) :: Natural+      ftext | ipart == 0 = show (abs parts) :: String+            | otherwise = drop (length (show ipart)) (show (abs parts))+      itext = maybe (show ipart) (renderThousands ipart) ytsep :: String+      fpad0 = List.replicate (fromIntegral fdigs0 - length ftext) '0' :: String+  Just $ mconcat+    [ if | parts < 0 -> "-"+         | plus && parts > 0 -> "+"+         | otherwise -> ""+    , itext+    , if | fdigs0 > 0 -> dsep : ftext <> fpad0+         | otherwise -> ""+    ]+++-- | Render a 'Natural' number with thousand markers.+--+-- @+-- > 'renderThousands' 12045 \',\'+-- \"12,045\"+-- @+renderThousands :: Natural -> Char -> String+{-# INLINABLE renderThousands #-}+renderThousands n0+  | n0 < 1000 = \_ -> show n0+  | otherwise = \c -> List.foldl' (flip mappend) mempty (List.unfoldr (f c) n0)+      where f :: Char -> Natural -> Maybe (String, Natural)+            f c = \x -> case divMod x 1000 of+                        (0, 0) -> Nothing+                        (0, z) -> Just (show z, 0)+                        (y, z) | z <  10   -> Just (c:'0':'0':show z, y)+                               | z < 100   -> Just (c:'0':show z, y)+                               | otherwise -> Just (c:show z, y)++--------------------------------------------------------------------------------+-- Decimal parsing++-- | Parses a decimal representation of a 'Dense'.+--+-- Leading @\'-\'@ and @\'+\'@ characters are considered.+denseFromDecimal+  :: Maybe Char+  -- ^ Thousands separator for the integer part, if any (i.e., the @\',\'@ in+  -- @-1,234.56789@).+  -> Char+  -- ^ Decimal separator (i.e., the @\'.\'@ in @-1,234.56789@)+  -> String+  -- ^ The raw string containing the decimal representation (e.g.,+  -- @"-1,234.56789"@).+  -> Maybe (Dense currency)+denseFromDecimal yst sf = fmap Dense . rationalFromDecimal yst sf++-- | Parses a decimal representation of a 'Discrete'.+--+-- Leading @\'-\'@ and @\'+\'@ characters are considered.+--+-- Notice that parsing will fail unless the entire precision of the decimal+-- number can be represented in the desired @scale@.+discreteFromDecimal+  :: GoodScale scale+  => Maybe Char+  -- ^ Thousands separator for the integer part, if any (i.e., the @\',\'@ in+  -- @-1,234.56789@).+  -> Char+  -- ^ Decimal separator (i.e., the @\'.\'@ in @-1,234.56789@)+  -> String+  -- ^ The raw string containing the decimal representation (e.g.,+  -- @"-1,234.56789"@).+  -> Maybe (Discrete' currency scale)+discreteFromDecimal yst sf = \s -> do+  dns <- denseFromDecimal yst sf s+  case discreteFromDense Truncate dns of+    (x, 0) -> Just x+    _ -> Nothing -- We fail for decimals that don't fit exactly in our scale.++-- | Parses a decimal representation of an 'ExchangeRate'.+exchangeRateFromDecimal+  :: Maybe Char+  -- ^ Thousands separator for the integer part, if any (i.e., the @\',\'@ in+  -- @1,234.56789@).+  -> Char+  -- ^ Decimal separator (i.e., the @\'.\'@ in @1,234.56789@)+  -> String+  -- ^ The raw string containing the decimal representation (e.g.,+  -- @"1,234.56789"@).+  -> Maybe (ExchangeRate src dst)+exchangeRateFromDecimal yst sf = \case+  ('-':_) -> Nothing+  str -> exchangeRate =<< rationalFromDecimal yst sf str++rationalFromDecimal+  :: Maybe Char+  -- ^ Thousands separator for the integer part, if any (i.e., the @\',\'@ in+  -- @-1,234.56789@).+  -> Char+  -- ^ Decimal separator (i.e., the @\'.\'@ in @-1,234.56789@)+  -> String+  -- ^ The raw string containing the decimal representation (e.g.,+  -- @"-1,234.56789"@).+  -> Maybe Rational+rationalFromDecimal yst sf = \s ->+  case ReadP.readP_to_S (rationalFromDecimalP yst sf) s of+    [(x,"")] -> Just x+    _ -> Nothing++-- TODO limit number of digits parsed to prevent DoS+rationalFromDecimalP+  :: Maybe Char+  -- ^ Thousands separator for the integer part, if any (i.e., the @\',\'@ in+  -- @-1,234.56789@).+  --+  -- The separator can't be a digit or control character. If it is, then parsing+  -- will always fail.+  -> Char+  -- ^ Decimal separator (i.e., the @\'.\'@ in @-1,234.56789@).+  --+  -- The separator can't be a digit or control character. If it is, then parsing+  -- will always fail.+  -> ReadP.ReadP Rational+rationalFromDecimalP ytsep dsep = do+   for_ ytsep $ \tsep ->+      guard (tsep /= dsep && not (Char.isDigit tsep))+   guard (not (Char.isDigit dsep))+   sig :: Rational -> Rational <-+     (ReadP.char '-' $> negate) <|>+     (ReadP.char '+' $> id) <|>+     (pure id)+   ipart :: String <- case ytsep of+     Nothing -> ReadP.munch1 Char.isDigit+     Just tsep -> mappend+       <$> (ReadP.count 3 (ReadP.satisfy Char.isDigit) <|>+            ReadP.count 2 (ReadP.satisfy Char.isDigit) <|>+            ReadP.count 1 (ReadP.satisfy Char.isDigit))+       <*> (fmap concat $ ReadP.many+              (ReadP.char tsep *> ReadP.count 3 (ReadP.satisfy Char.isDigit)))+   yfpart :: Maybe String <-+     (ReadP.char dsep *> fmap Just (ReadP.munch1 Char.isDigit) <* ReadP.eof) <|>+     (ReadP.eof $> Nothing)+   pure $! sig $ case yfpart of+     Nothing -> fromInteger (read ipart)+     Just fpart -> read (ipart <> fpart) % (10 ^ length fpart) 

@@ -5,17 +5,22 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeApplications #-}  module Main where  import Control.Category (Category((.), id)) import qualified Data.ByteString.Lazy as BSL-import Data.Maybe (catMaybes, isJust, isNothing)+import qualified Data.Char as Char+import Data.Maybe (catMaybes, isJust, isNothing, fromJust) import Data.Proxy (Proxy(Proxy))-import Data.Ratio (numerator, denominator)+import Data.Ratio ((%), numerator, denominator)+import Data.Word (Word8) import GHC.TypeLits (Nat, Symbol, KnownSymbol, symbolVal) import Prelude hiding ((.), id) import qualified Test.Tasty as Tasty+import Test.Tasty.HUnit ((@?=))+import qualified Test.Tasty.HUnit as HU import qualified Test.Tasty.Runners as Tasty import Test.Tasty.QuickCheck ((===), (==>), (.&&.)) import qualified Test.Tasty.QuickCheck as QC@@ -40,12 +45,19 @@ import qualified Data.Store as Store #endif +#ifdef HAS_vector_space+import qualified Data.AdditiveGroup as AG+import qualified Data.VectorSpace as VS+#endif+ #ifdef HAS_xmlbf import qualified Xmlbf import qualified Data.Text as Text #endif  import qualified Money+import qualified Money.Internal as Money+  (rationalFromDecimal, rationalToDecimal)  -------------------------------------------------------------------------------- @@ -59,46 +71,73 @@   arbitrary = do     let md = Money.mkSomeDiscrete                <$> QC.arbitrary <*> QC.arbitrary <*> QC.arbitrary-    Just x <- QC.suchThat md isJust-    pure x+    fromJust <$> QC.suchThat md isJust   shrink = \x -> Money.withSomeDiscrete x (map Money.toSomeDiscrete . 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+     let myd = fmap Money.dense QC.arbitrary+     fromJust <$> QC.suchThat myd isJust+  shrink = catMaybes . map Money.dense . QC.shrink . toRational  instance QC.Arbitrary Money.SomeDense where   arbitrary = do     let md = Money.mkSomeDense <$> QC.arbitrary <*> QC.arbitrary-    Just x <- QC.suchThat md isJust-    pure x+    fromJust <$> QC.suchThat md isJust   shrink = \x -> Money.withSomeDense x (map Money.toSomeDense . 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+    let myxr = fmap Money.exchangeRate QC.arbitrary+    fromJust <$> QC.suchThat myxr isJust+  shrink = catMaybes . map Money.exchangeRate+         . QC.shrink . Money.exchangeRateToRational  instance QC.Arbitrary Money.SomeExchangeRate where   arbitrary = do     let md = Money.mkSomeExchangeRate                <$> QC.arbitrary <*> QC.arbitrary <*> QC.arbitrary-    Just x <- QC.suchThat md isJust-    pure x+    fromJust <$> QC.suchThat md isJust   shrink = \x ->     Money.withSomeExchangeRate x (map Money.toSomeExchangeRate . QC.shrink) +instance QC.Arbitrary Money.Approximation where+  arbitrary = QC.oneof [ pure Money.Round+                       , pure Money.Floor+                       , pure Money.Ceiling+                       , pure Money.Truncate ]++-- | Generates a valid 'Money.rationalToDecimal' result. Returns the thousand+-- and decimal separators as welland decimal separators as well.+genDecimal :: QC.Gen (String, Maybe Char, Char)+genDecimal = do+  aprox :: Money.Approximation <- QC.arbitrary+  plus :: Bool <- QC.arbitrary+  digs :: Word8 <- QC.arbitrary+  r :: Rational <- (%) <$> QC.arbitrary <*> QC.suchThat QC.arbitrary (/= 0)+  (yts, ds) <- genDecimalSeps+  Just dec <- pure (Money.rationalToDecimal aprox plus yts ds digs r)+  pure (dec, yts, ds)++-- | Generates valid separators for decimal representations (see genDecimal).+genDecimalSeps :: QC.Gen (Maybe Char, Char)+genDecimalSeps = do+  let msep = QC.suchThat QC.arbitrary (not . Char.isDigit)+  ds :: Char <- msep+  yts :: Maybe Char <- genMaybe (QC.suchThat msep (/= ds))+  pure (yts, ds)+++genMaybe :: QC.Gen a -> QC.Gen (Maybe a)+genMaybe m = QC.oneof [pure Nothing, fmap Just m]+ --------------------------------------------------------------------------------  main :: IO () main =  Tasty.defaultMainWithIngredients   [ Tasty.consoleTestReporter   , Tasty.listingTests-  ] tests+  ] (Tasty.localOption (QC.QuickCheckTests 500) tests)  tests :: Tasty.TestTree tests =@@ -106,6 +145,9 @@   [ testCurrencies   , testCurrencyUnits   , testExchange+  , testRationalToDecimal+  , testRationalFromDecimal+  , testDiscreteFromDecimal   ]  testCurrencies :: Tasty.TestTree@@ -127,11 +169,274 @@   , 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 "gram")   , testDiscrete (Proxy :: Proxy "XAU") (Proxy :: Proxy "grain")   ] ++testRationalToDecimal :: Tasty.TestTree+testRationalToDecimal =+  Tasty.testGroup "rationalToDecimal"+  [ HU.testCase "Round: r1" $ do+       render Money.Round r1 @?=+         [ "1023004567.90"        --  0+         , "1,023,004,567.90"     --  1+         , "+1023004567.90"       --  2+         , "+1,023,004,567.90"    --  3+         , "1023004568"           --  8+         , "1,023,004,568"        --  9+         , "+1023004568"          -- 10+         , "+1,023,004,568"       -- 11+         ]+  , HU.testCase "Round: negate r1" $ do+       render Money.Round (negate r1) @?=+         [ "-1023004567.90"       --  0+         , "-1,023,004,567.90"    --  1+         , "-1023004567.90"       --  2+         , "-1,023,004,567.90"    --  3+         , "-1023004568"          --  8+         , "-1,023,004,568"       --  9+         , "-1023004568"          -- 10+         , "-1,023,004,568"       -- 11+         ]+  , HU.testCase "Round: r2" $ do+       render Money.Round r2 @?=+         [ "1.23"    --  0+         , "1.23"    --  1+         , "+1.23"   --  2+         , "+1.23"   --  3+         , "1"       --  8+         , "1"       --  9+         , "+1"      -- 10+         , "+1"      -- 11+         ]+  , HU.testCase "Round: negate r2" $ do+       render Money.Round (negate r2) @?=+         [ "-1.23"    --  0+         , "-1.23"    --  1+         , "-1.23"    --  2+         , "-1.23"    --  3+         , "-1"       --  8+         , "-1"       --  9+         , "-1"       -- 10+         , "-1"       -- 11+         ]+  , HU.testCase "Round: r3" $ do+       render Money.Round r3 @?=+         [ "0.34"   --  0+         , "0.34"   --  1+         , "+0.34"  --  2+         , "+0.34"  --  3+         , "0"      --  8+         , "0"      --  9+         , "0"      -- 10+         , "0"      -- 11+         ]+  , HU.testCase "Round: negate r3" $ do+       render Money.Round (negate r3) @?=+         [ "-0.34"   --  0+         , "-0.34"   --  1+         , "-0.34"   --  2+         , "-0.34"   --  3+         , "0"       --  8+         , "0"       --  9+         , "0"       -- 10+         , "0"       -- 11+         ]+  , HU.testCase "Floor: r1" $ do+       render Money.Floor r1 @?=+         [ "1023004567.89"        --  0+         , "1,023,004,567.89"     --  1+         , "+1023004567.89"       --  2+         , "+1,023,004,567.89"    --  3+         , "1023004567"           --  8+         , "1,023,004,567"        --  9+         , "+1023004567"          -- 10+         , "+1,023,004,567"       -- 11+         ]+  , HU.testCase "Floor: negate r1" $ do+       render Money.Floor (negate r1) @?=+         [ "-1023004567.90"       --  0+         , "-1,023,004,567.90"    --  1+         , "-1023004567.90"       --  2+         , "-1,023,004,567.90"    --  3+         , "-1023004568"          --  8+         , "-1,023,004,568"       --  9+         , "-1023004568"          -- 10+         , "-1,023,004,568"       -- 11+         ]+  , HU.testCase "Floor: r2" $ do+       render Money.Floor r2 @?=+         [ "1.23"    --  0+         , "1.23"    --  1+         , "+1.23"   --  2+         , "+1.23"   --  3+         , "1"       --  8+         , "1"       --  9+         , "+1"      -- 10+         , "+1"      -- 11+         ]+  , HU.testCase "Floor: negate r2" $ do+       render Money.Floor (negate r2) @?=+         [ "-1.23"    --  0+         , "-1.23"    --  1+         , "-1.23"    --  2+         , "-1.23"    --  3+         , "-2"       --  8+         , "-2"       --  9+         , "-2"       -- 10+         , "-2"       -- 11+         ]+  , HU.testCase "Floor: r3" $ do+       render Money.Floor r3 @?=+         [ "0.34"   --  0+         , "0.34"   --  1+         , "+0.34"  --  2+         , "+0.34"  --  3+         , "0"      --  8+         , "0"      --  9+         , "0"      -- 10+         , "0"      -- 11+         ]+  , HU.testCase "Floor: negate r3" $ do+       render Money.Floor (negate r3) @?=+         [ "-0.35"   --  0+         , "-0.35"   --  1+         , "-0.35"   --  2+         , "-0.35"   --  3+         , "-1"      --  8+         , "-1"      --  9+         , "-1"      -- 10+         , "-1"      -- 11+         ]+  , HU.testCase "Ceiling: r1" $ do+       render Money.Ceiling r1 @?=+         [ "1023004567.90"        --  0+         , "1,023,004,567.90"     --  1+         , "+1023004567.90"       --  2+         , "+1,023,004,567.90"    --  3+         , "1023004568"           --  8+         , "1,023,004,568"        --  9+         , "+1023004568"          -- 10+         , "+1,023,004,568"       -- 11+         ]+  , HU.testCase "Ceiling: negate r1" $ do+       render Money.Ceiling (negate r1) @?=+         [ "-1023004567.89"       --  0+         , "-1,023,004,567.89"    --  1+         , "-1023004567.89"       --  2+         , "-1,023,004,567.89"    --  3+         , "-1023004567"          --  8+         , "-1,023,004,567"       --  9+         , "-1023004567"          -- 10+         , "-1,023,004,567"       -- 11+         ]+  , HU.testCase "Ceiling: r2" $ do+       render Money.Ceiling r2 @?=+         [ "1.23"    --  0+         , "1.23"    --  1+         , "+1.23"   --  2+         , "+1.23"   --  3+         , "2"       --  8+         , "2"       --  9+         , "+2"      -- 10+         , "+2"      -- 11+         ]+  , HU.testCase "Ceiling: negate r2" $ do+       render Money.Ceiling (negate r2) @?=+         [ "-1.23"    --  0+         , "-1.23"    --  1+         , "-1.23"    --  2+         , "-1.23"    --  3+         , "-1"       --  8+         , "-1"       --  9+         , "-1"       -- 10+         , "-1"       -- 11+         ]+  , HU.testCase "Ceiling: r3" $ do+       render Money.Ceiling r3 @?=+         [ "0.35"   --  0+         , "0.35"   --  1+         , "+0.35"  --  2+         , "+0.35"  --  3+         , "1"      --  8+         , "1"      --  9+         , "+1"     -- 10+         , "+1"     -- 11+         ]+  , HU.testCase "Ceiling: negate r3" $ do+       render Money.Ceiling (negate r3) @?=+         [ "-0.34"   --  0+         , "-0.34"   --  1+         , "-0.34"   --  2+         , "-0.34"   --  3+         , "0"       --  8+         , "0"       --  9+         , "0"       -- 10+         , "0"       -- 11+         ]++  , HU.testCase "Truncate: r1" $ do+      render Money.Truncate r1 @?= render Money.Floor r1++  , HU.testCase "Truncate: negate r1" $ do+      render Money.Truncate (negate r1) @?= render Money.Ceiling (negate r1)++  , HU.testCase "Truncate: r2" $ do+      render Money.Truncate r2 @?= render Money.Floor r2++  , HU.testCase "Truncate: negate r2" $ do+      render Money.Truncate (negate r2) @?= render Money.Ceiling (negate r2)++  , HU.testCase "Truncate: r3" $ do+      render Money.Truncate r3 @?= render Money.Floor r3++  , HU.testCase "Truncate: negate r3" $ do+      render Money.Truncate (negate r3) @?= render Money.Ceiling (negate r3)+  ]+  where+    r1 :: Rational = 1023004567895 % 1000+    r2 :: Rational = 123 % 100+    r3 :: Rational = 345 % 1000++    render :: Money.Approximation -> Rational -> [String]+    render a r =+      [ fromJust $ Money.rationalToDecimal a False Nothing    '.' 2 r  --  0+      , fromJust $ Money.rationalToDecimal a False (Just ',') '.' 2 r  --  1+      , fromJust $ Money.rationalToDecimal a True  Nothing    '.' 2 r  --  2+      , fromJust $ Money.rationalToDecimal a True  (Just ',') '.' 2 r  --  3+      , fromJust $ Money.rationalToDecimal a False Nothing    '.' 0 r  --  8+      , fromJust $ Money.rationalToDecimal a False (Just ',') '.' 0 r  --  9+      , fromJust $ Money.rationalToDecimal a True  Nothing    '.' 0 r  -- 10+      , fromJust $ Money.rationalToDecimal a True  (Just ',') '.' 0 r  -- 11+      ]++testRationalFromDecimal :: Tasty.TestTree+testRationalFromDecimal =+  Tasty.testGroup "rationalFromDecimal"+  [ QC.testProperty "Unsupported separators" $+      let mbadsep :: QC.Gen Char = QC.suchThat QC.arbitrary Char.isDigit+          mgoodsep :: QC.Gen Char = QC.suchThat QC.arbitrary (not . Char.isDigit)+      in QC.forAll ((,,) <$> mbadsep <*> mbadsep <*> mgoodsep) $+           \(s1 :: Char, s2 :: Char, s3 :: Char) ->+              let f = Money.rationalFromDecimal+              in (f Nothing s1 (error "untouched") === Nothing) .&&.+                 (f (Just s1) s2 (error "untouched") === Nothing) .&&.+                 (f (Just s1) s1 (error "untouched") === Nothing) .&&.+                 (f (Just s3) s3 (error "untouched") === Nothing)++  , QC.testProperty "Lossy roundtrip" $+      -- We check that the roundtrip results in a close amount with a fractional+      -- difference of up to one.+      let gen = (,) <$> genDecimalSeps <*> QC.arbitrary+      in QC.forAll gen $ \( (yst :: Maybe Char, sd :: Char)+                       , (r :: Rational, plus :: Bool, digs :: Word8,+                          aprox :: Money.Approximation) ) ->+           let Just dec = Money.rationalToDecimal aprox plus yst sd digs r+               Just r' = Money.rationalFromDecimal yst sd dec+           in 1 > abs (abs r - abs r')+  ]+ testDense   :: forall currency   .  KnownSymbol currency@@ -142,16 +447,20 @@   [ QC.testProperty "read . show == id" $       QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->          x === read (show x)+   , QC.testProperty "read . show . Just == Just " $       QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->          Just x === read (show (Just x))+   , QC.testProperty "fromSomeDense . someDense == Just" $       QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->          Just x === Money.fromSomeDense (Money.toSomeDense x)+   , QC.testProperty "fromSomeDense works only for same currency" $       QC.forAll QC.arbitrary $ \(dr :: Money.SomeDense) ->         (Money.someDenseCurrency dr /= symbolVal pc)            ==> isNothing (Money.fromSomeDense dr :: Maybe (Money.Dense currency))+   , QC.testProperty "withSomeDense" $       QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->         let dr = Money.toSomeDense x@@ -159,6 +468,45 @@              (show x, dr, Money.toSomeDense (x + 1))                 === (show x', Money.toSomeDense x', Money.toSomeDense (x' + 1)) +  , QC.testProperty "denseCurrency" $+      QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+        Money.denseCurrency x === symbolVal pc++  , QC.testProperty "denseToDecimal: Same as rationalToDecimal" $+      let gen = (,) <$> genDecimalSeps <*> QC.arbitrary+      in QC.forAll gen $ \( (yst :: Maybe Char, sd :: Char)+                          , (dns :: Money.Dense currency, plus :: Bool,+                             digs :: Word8, aprox :: Money.Approximation) ) ->+            let ydnsd1 = Money.denseToDecimal aprox plus yst sd digs (Proxy :: Proxy '(1,1)) dns+                ydnsd100 = Money.denseToDecimal aprox plus yst sd digs (Proxy :: Proxy '(100,1)) dns+                yrd1 = Money.rationalToDecimal aprox plus yst sd digs (toRational dns)+                yrd100 = Money.rationalToDecimal aprox plus yst sd digs (toRational dns * 100)+            in (ydnsd1 === yrd1) .&&. (ydnsd100 === yrd100)++  , QC.testProperty "denseFromDecimal: Same as rationalFromDecimal" $+      QC.forAll genDecimal $ \(dec :: String, yts :: Maybe Char, ds :: Char) ->+         let Just r = Money.rationalFromDecimal yts ds dec+             Just dns = Money.denseFromDecimal yts ds dec+         in r === toRational (dns :: Money.Dense currency)++#ifdef HAS_vector_space+  , HU.testCase "AdditiveGroup: zeroV" $+      (AG.zeroV :: Money.Dense currency) @?= Money.dense' (0%1)+  , QC.testProperty "AdditiveGroup: negateV" $+      QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+         AG.negateV x === negate x+  , QC.testProperty "AdditiveGroup: ^+^" $+      QC.forAll QC.arbitrary $ \(x :: Money.Dense currency, y) ->+         x AG.^+^ y === x + y+  , QC.testProperty "AdditiveGroup: ^-^" $+      QC.forAll QC.arbitrary $ \(x :: Money.Dense currency, y) ->+         x AG.^-^ y === x - y+  , QC.testProperty "VectorSpace: *^" $+      QC.forAll QC.arbitrary $ \(x :: Money.Dense currency, y) ->+         (toRational x VS.*^ y === x * y) .&&.+         (toRational y VS.*^ x === x * y)+#endif+ #ifdef HAS_aeson   , QC.testProperty "Aeson encoding roundtrip" $       QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->@@ -291,6 +639,7 @@   , testExchangeRate (Proxy :: Proxy "XAU") (Proxy :: Proxy "XAU")   ] + testDiscrete   :: forall (currency :: Symbol) (unit :: Symbol)   .  ( Money.GoodScale (Money.Scale currency unit)@@ -327,6 +676,28 @@                    === (show x', Money.toSomeDiscrete x', Money.toSomeDiscrete (x' + 1))            ) :: QC.Property +  , QC.testProperty "discreteCurrency" $+      QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+        Money.discreteCurrency x === symbolVal pc++#ifdef HAS_vector_space+  , HU.testCase "AdditiveGroup: zeroV" $+      (AG.zeroV :: Money.Discrete currency unit) @?= Money.discrete 0+  , QC.testProperty "AdditiveGroup: negateV" $+      QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+         AG.negateV x === negate x+  , QC.testProperty "AdditiveGroup: ^+^" $+      QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit, y) ->+         x AG.^+^ y === x + y+  , QC.testProperty "AdditiveGroup: ^-^" $+      QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit, y) ->+         x AG.^-^ y === x - y+  , QC.testProperty "VectorSpace: *^" $+      QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit, y) ->+         (toInteger x VS.*^ y === x * y) .&&.+         (toInteger y VS.*^ x === x * y)+#endif+ #ifdef HAS_aeson   , QC.testProperty "Aeson encoding roundtrip" $       QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->@@ -456,14 +827,14 @@          xr === xr . id   , QC.testProperty "Category: composition with inverse" $       QC.forAll QC.arbitrary $ \(xr1 :: Money.ExchangeRate src dst) ->-         (1 === Money.fromExchangeRate (xr1 . Money.flipExchangeRate xr1)) .&&.-         (1 === Money.fromExchangeRate (Money.flipExchangeRate xr1 . xr1))+         (1 === Money.exchangeRateToRational (xr1 . Money.exchangeRateRecip xr1)) .&&.+         (1 === Money.exchangeRateToRational (Money.exchangeRateRecip xr1 . xr1))   , QC.testProperty "Category: composition with other" $       QC.forAll QC.arbitrary $ \(xr1 :: Money.ExchangeRate src dst,                                  xr2 :: Money.ExchangeRate dst src) ->-         let a = Money.fromExchangeRate xr1 * Money.fromExchangeRate xr2-         in (a === Money.fromExchangeRate (xr1 . xr2)) .&&.-            (a === Money.fromExchangeRate (xr2 . xr1))+         let a = Money.exchangeRateToRational xr1 * Money.exchangeRateToRational xr2+         in (a === Money.exchangeRateToRational (xr1 . xr2)) .&&.+            (a === Money.exchangeRateToRational (xr2 . xr1))    , QC.testProperty "read . show == id" $       QC.forAll QC.arbitrary $ \(xr :: Money.ExchangeRate src dst) ->@@ -473,25 +844,25 @@          Just xr === read (show (Just 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')+         let xr' = Money.exchangeRateRecip xr+         in (Money.exchangeRateToRational xr /= Money.exchangeRateToRational xr')+               ==> (xr === Money.exchangeRateRecip 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)+          ) -> c0 === Money.exchange (Money.exchangeRateRecip xr)                                      (Money.exchange xr c0)-  , QC.testProperty "x == 1 ===> exchange x == id" $+  , 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.testProperty "x /= 1 ==> exchange x /= id" $       QC.forAll QC.arbitrary $          \( c0 :: Money.Dense src           , xr :: Money.ExchangeRate src dst-          ) -> (Money.fromExchangeRate xr /= 1)+          ) -> (Money.exchangeRateToRational xr /= 1 && toRational c0 /= 0)                   ==> (toRational c0 /= toRational (Money.exchange xr c0))   , QC.testProperty "fromSomeExchangeRate . someExchangeRate == Just" $       QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->@@ -508,6 +879,23 @@         in Money.withSomeExchangeRate dr $ \x' ->              (show x, dr) === (show x', Money.toSomeExchangeRate x') +  , QC.testProperty "exchangeRateToDecimal: Same as rationalToDecimal" $+      let gen = (,) <$> genDecimalSeps <*> QC.arbitrary+      in QC.forAll gen $ \( (yst :: Maybe Char, sd :: Char)+                          , (xr :: Money.ExchangeRate src dst, digs :: Word8,+                             aprox :: Money.Approximation ) ) ->+           let xrd = Money.exchangeRateToDecimal aprox yst sd digs xr+               rd = Money.rationalToDecimal aprox False yst sd digs+                       (Money.exchangeRateToRational xr)+           in xrd === rd++  , QC.testProperty "exchangeRateFromDecimal: Same as rationalFromDecimal" $+      QC.forAll genDecimal $ \(dec :: String, yts :: Maybe Char, ds :: Char) ->+         let Just r = Money.rationalFromDecimal yts ds dec+             yxr = Money.exchangeRateFromDecimal yts ds dec+                      :: Maybe (Money.ExchangeRate src dst)+         in (r > 0) ==> (Just r === fmap Money.exchangeRateToRational yxr)+ #ifdef HAS_aeson   , QC.testProperty "Aeson encoding roundtrip" $       QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->@@ -620,6 +1008,59 @@ #endif   ] ++testDiscreteFromDecimal :: Tasty.TestTree+testDiscreteFromDecimal =+  Tasty.testGroup "discreteFromDecimal"+  [ HU.testCase "Too large" $ do+      Money.discreteFromDecimal Nothing '.' "0.053"+        @?= (Nothing :: Maybe (Money.Discrete "USD" "cent"))+      Money.discreteFromDecimal (Just ',') '.' "0.253"+        @?= (Nothing :: Maybe (Money.Discrete "USD" "cent"))++  , HU.testCase "USD cent, small, zero" $ do+      let dis = 0 :: Money.Discrete "USD" "cent"+          f = Money.discreteFromDecimal+      f Nothing '.' "0" @?= Just dis+      f Nothing '.' "+0" @?= Just dis+      f Nothing '.' "-0" @?= Just dis+      f (Just ',') '.' "0" @?= Just dis+      f (Just ',') '.' "+0" @?= Just dis+      f (Just ',') '.' "-0" @?= Just dis++  , HU.testCase "USD cent, small, positive" $ do+      let dis = 25 :: Money.Discrete "USD" "cent"+          f = Money.discreteFromDecimal+      f Nothing '.' "0.25" @?= Just dis+      f Nothing '.' "+0.25" @?= Just dis+      f (Just ',') '.' "0.25" @?= Just dis+      f (Just ',') '.' "+0.25" @?= Just dis++  , HU.testCase "USD cent, small, negative" $ do+      let dis = -25 :: Money.Discrete "USD" "cent"+          f = Money.discreteFromDecimal+      f Nothing '.' "-0.25" @?= Just dis+      f Nothing '.' "-0.25" @?= Just dis+      f (Just ',') '.' "-0.25" @?= Just dis+      f (Just ',') '.' "-0.25" @?= Just dis++  , HU.testCase "USD cent, big, positive" $ do+      let dis = 102300456789 :: Money.Discrete "USD" "cent"+          f = Money.discreteFromDecimal+      f Nothing '.' "1023004567.89" @?= Just dis+      f Nothing '.' "+1023004567.89" @?= Just dis+      f (Just ',') '.' "1,023,004,567.89" @?= Just dis+      f (Just ',') '.' "+1,023,004,567.89" @?= Just dis++  , HU.testCase "USD cent, big, negative" $ do+      let dis = -102300456789 :: Money.Discrete "USD" "cent"+          f = Money.discreteFromDecimal+      f Nothing '.' "-1023004567.89" @?= Just dis+      f Nothing '.' "-1023004567.89" @?= Just dis+      f (Just ',') '.' "-1,023,004,567.89" @?= Just dis+      f (Just ',') '.' "-1,023,004,567.89" @?= Just dis+  ]+ testRounding   :: forall (currency :: Symbol) (unit :: Symbol)   .  (Money.GoodScale (Money.Scale currency unit), KnownSymbol currency)@@ -628,26 +1069,26 @@   -> 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)-    , QC.testProperty "floor no reminder"    $ QC.forAll QC.arbitrary (h Money.floor)-    , QC.testProperty "ceiling no reminder"  $ QC.forAll QC.arbitrary (h Money.ceiling)-    , QC.testProperty "round no reminder"    $ QC.forAll QC.arbitrary (h Money.round)-    , QC.testProperty "truncate no reminder" $ QC.forAll QC.arbitrary (h Money.truncate)+    [ QC.testProperty "floor"    $ QC.forAll QC.arbitrary (g (Money.discreteFromDense Money.Floor))+    , QC.testProperty "ceiling"  $ QC.forAll QC.arbitrary (g (Money.discreteFromDense Money.Ceiling))+    , QC.testProperty "round"    $ QC.forAll QC.arbitrary (g (Money.discreteFromDense Money.Round))+    , QC.testProperty "truncate" $ QC.forAll QC.arbitrary (g (Money.discreteFromDense Money.Truncate))+    , QC.testProperty "floor no reminder"    $ QC.forAll QC.arbitrary (h (Money.discreteFromDense Money.Floor))+    , QC.testProperty "ceiling no reminder"  $ QC.forAll QC.arbitrary (h (Money.discreteFromDense Money.Ceiling))+    , QC.testProperty "round no reminder"    $ QC.forAll QC.arbitrary (h (Money.discreteFromDense Money.Round))+    , QC.testProperty "truncate no reminder" $ QC.forAll QC.arbitrary (h (Money.discreteFromDense Money.Truncate))     ]   where     g :: (Money.Dense currency -> (Money.Discrete' currency (Money.Scale currency unit), Money.Dense currency))       -> Money.Dense currency       -> QC.Property-    g f = \x -> x === case f x of (y, z) -> Money.fromDiscrete y + z+    g f = \x -> x === case f x of (y, z) -> Money.denseFromDiscrete y + z      h :: (Money.Dense currency -> (Money.Discrete' currency (Money.Scale currency unit), Money.Dense currency))       -> Money.Discrete currency unit       -> QC.Property-    h f = \x -> (Money.fromDiscrete x) === case f (Money.fromDiscrete x) of-      (y, 0) -> Money.fromDiscrete y+    h f = \x -> (Money.denseFromDiscrete x) === case f (Money.denseFromDiscrete x) of+      (y, 0) -> Money.denseFromDiscrete y       (_, _) -> error "testRounding.h: unexpected"  hush :: Either a b -> Maybe b