safe-money 0.3 → 0.4

raw patch · 7 files changed

+1944/−1350 lines, 7 filesdep +serialisedep +textdep +xmlbfPVP ok

version bump matches the API change (PVP)

Dependencies added: serialise, text, xmlbf

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• README.md +3/−0
• changelog.md +35/−0
• safe-money.cabal +50/−12
• src/Money.hs +50/−29
• src/Money/Internal.hs +1492/−1179
• test/Main.hs +313/−129

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

@@ -1,3 +1,6 @@ The Haskell `safe-money` library offers type-safe and lossless encoding and 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`).

@@ -1,3 +1,38 @@+# 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. COMPILER WILL COMPLAIN: Changed the `Rep` suffix for a `Some`+  prefix Everywhere.  For example, `DenseRep` was renamed to `SomeDense`.++* BREAKING CHANGE. COMPILER WILL COMPLAIN: 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+  `round` functions now return just `0` as a reminder if there's no significant+  reminder, instead of `Nothing`.++* Added instances for `serialise`.++* Added instances for `xmlbf`.++* Fixed `Show` instances so that surrounding parentheses are included when+  necessary.++* New currencies: Ripple, Litecoin, Ada, Monero.++ # Version 0.3  * BREAKING CHANGE: The `Data.Money` module was renamed to `Money`.

@@ -1,12 +1,12 @@ name: safe-money-version: 0.3+version: 0.4 license: BSD3 license-file: LICENSE copyright: Copyright (c) Renzo Carbonara 2016-2017 author: Renzo Carbonara maintainer: renλren!zone stability: Experimental-tested-with: GHC==8.0.1+tested-with: GHC==8.2.2, GHC==8.0.2, GHCJS homepage: https://github.com/k0001/safe-money bug-reports: https://github.com/k0001/safe-money/issues category: Money@@ -20,8 +20,8 @@   Type-safe and lossless encoding and manipulation of money, fiat currencies,   crypto currencies and precious metals.   .-  Notice that the only mandatory dependencies of this package are @base@ and-  @constraints@. The rest of the dependencies are optional but enabled by+  NOTICE that the only mandatory dependencies of this package are @base@ and+  @constraints@. The rest of the dependencies are OPTIONAL but enabled by   default (except @store@ which is also disabled when building with GHCJS), they   can be disabled with Cabal flags. @@ -39,16 +39,28 @@    if flag(aeson)     build-depends: aeson (>=0.9)+    cpp-options: -DHAS_aeson   if flag(binary)     build-depends: binary (>=0.7)+    cpp-options: -DHAS_binary   if flag(cereal)     build-depends: cereal (>=0.5)+    cpp-options: -DHAS_cereal   if flag(deepseq)     build-depends: deepseq (>=1.4)+    cpp-options: -DHAS_deepseq   if flag(hashable)     build-depends: hashable (>=1.2)+    cpp-options: -DHAS_hashable+  if flag(serialise)+    build-depends: serialise (>=0.2)+    cpp-options: -DHAS_serialise   if (flag(store) && !impl(ghcjs))     build-depends: store (>=0.2)+    cpp-options: -DHAS_store+  if flag(xmlbf)+    build-depends: xmlbf (>=0.2), text+    cpp-options: -DHAS_xmlbf  test-suite test   default-language: Haskell2010@@ -56,20 +68,38 @@   hs-source-dirs: test   main-is: Main.hs   build-depends:-    aeson,     base,-    binary,     bytestring,-    cereal,     constraints,-    deepseq,-    hashable,     safe-money,     tasty,     tasty-hunit,     tasty-quickcheck-  if (flag(store) || !impl(ghcjs))++  if flag(aeson)+    build-depends: aeson+    cpp-options: -DHAS_aeson+  if flag(binary)+    build-depends: binary+    cpp-options: -DHAS_binary+  if flag(cereal)+    build-depends: cereal+    cpp-options: -DHAS_cereal+  if flag(deepseq)+    build-depends: deepseq+    cpp-options: -DHAS_deepseq+  if flag(hashable)+    build-depends: hashable+    cpp-options: -DHAS_hashable+  if flag(serialise)+    build-depends: serialise+    cpp-options: -DHAS_serialise+  if (flag(store) && !impl(ghcjs))     build-depends: store+    cpp-options: -DHAS_store+  if flag(xmlbf)+    build-depends: xmlbf, text+    cpp-options: -DHAS_xmlbf  flag aeson   description: Provide instances for @aeson@@@ -87,12 +117,20 @@   description: Provide instances for @store@   default: True   manual: True+flag deepseq+  description: Provide instances for @deepseq@+  default: True+  manual: True flag hashable   description: Provide instances for @hashable@   default: True   manual: True-flag deepseq-  description: Provide instances for @deepseq@+flag serialise+  description: Provide instances for @serialise@+  default: True+  manual: True+flag xmlbf+  description: Provide instances for @xmlbf@   default: True   manual: True 

@@ -37,35 +37,29 @@  , I.flipExchangeRate  , I.exchange    -- * Serializable representations- , I.DenseRep- , I.toDenseRep- , I.mkDenseRep- , I.fromDenseRep- , I.withDenseRep- , I.denseRepCurrency- , I.denseRepAmount- , I.denseRepAmountNumerator- , I.denseRepAmountDenominator- , I.DiscreteRep- , I.toDiscreteRep- , I.mkDiscreteRep- , I.fromDiscreteRep- , I.withDiscreteRep- , I.discreteRepCurrency- , I.discreteRepScale- , I.discreteRepScaleNumerator- , I.discreteRepScaleDenominator- , I.discreteRepAmount- , I.ExchangeRateRep- , I.toExchangeRateRep- , I.mkExchangeRateRep- , I.fromExchangeRateRep- , I.withExchangeRateRep- , I.exchangeRateRepSrcCurrency- , I.exchangeRateRepDstCurrency- , I.exchangeRateRepRate- , I.exchangeRateRepRateNumerator- , I.exchangeRateRepRateDenominator+ , I.SomeDense+ , I.toSomeDense+ , I.mkSomeDense+ , I.fromSomeDense+ , I.withSomeDense+ , I.someDenseCurrency+ , I.someDenseAmount+ , I.SomeDiscrete+ , I.toSomeDiscrete+ , I.mkSomeDiscrete+ , I.fromSomeDiscrete+ , I.withSomeDiscrete+ , I.someDiscreteCurrency+ , I.someDiscreteScale+ , I.someDiscreteAmount+ , I.SomeExchangeRate+ , I.toSomeExchangeRate+ , I.mkSomeExchangeRate+ , I.fromSomeExchangeRate+ , I.withSomeExchangeRate+ , I.someExchangeRateSrcCurrency+ , I.someExchangeRateDstCurrency+ , I.someExchangeRateRate  ) where  import qualified Money.Internal as I@@ -791,3 +785,30 @@ type instance I.Scale "ETH" "finney" = '(1000000000000000, 1) type instance I.Scale "ETH" "milliether" = '(1000000000000000, 1) type instance I.Scale "ETH" "wei" = '(1000000000000000000, 1)++-- | Ada+type instance I.Scale "ADA" "ADA" = '(1000000, 1)+type instance I.Scale "ADA" "ada" = '(1, 1)+type instance I.Scale "ADA" "lovelace" = '(1000000, 1)++-- | Litecoin+type instance I.Scale "LTC" "LTC" = '(100000000, 1)+type instance I.Scale "LTC" "litecoin" = '(1, 1)+type instance I.Scale "LTC" "lite" = '(1000, 1)+type instance I.Scale "LTC" "photon" = '(100000000, 1)++-- | Ripple+type instance I.Scale "XRP" "XRP" = '(1000000, 1)+type instance I.Scale "XRP" "ripple" = '(1, 1)+type instance I.Scale "XRP" "drop" = '(1000000, 1)++-- | Monero+type instance I.Scale "XMR" "XMR" = '(1000000000000, 1)+type instance I.Scale "XMR" "monero" = '(1, 1)+type instance I.Scale "XMR" "decinero" = '(10, 1)+type instance I.Scale "XMR" "centinero" = '(100, 1)+type instance I.Scale "XMR" "millinero" = '(1000, 1)+type instance I.Scale "XMR" "micronero" = '(1000000, 1)+type instance I.Scale "XMR" "nanonero" = '(1000000000, 1)+type instance I.Scale "XMR" "piconero" = '(1000000000000, 1)+

@@ -7,1182 +7,1495 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}--#if MIN_VERSION_base(4,9,0)-{-# OPTIONS_GHC -Wno-redundant-constraints #-}-#endif---- | This is an internal module. Import "Money" instead.-module Money.Internal- ( -- * Dense monetary values-   Dense- , dense-   -- * Discrete monetary values- , Discrete- , Discrete'- , fromDiscrete- , round- , ceiling- , floor- , truncate-   -- * Currency scales- , Scale- , GoodScale- , ErrScaleNonCanonical- , scale-   -- * Currency exchange- , ExchangeRate- , exchangeRate- , fromExchangeRate- , flipExchangeRate- , exchange-   -- * Serializable representations- , DenseRep- , toDenseRep- , mkDenseRep- , fromDenseRep- , withDenseRep- , denseRepCurrency- , denseRepAmount- , denseRepAmountNumerator- , denseRepAmountDenominator- , DiscreteRep- , toDiscreteRep- , mkDiscreteRep- , fromDiscreteRep- , withDiscreteRep- , discreteRepCurrency- , discreteRepScale- , discreteRepScaleNumerator- , discreteRepScaleDenominator- , discreteRepAmount- , ExchangeRateRep- , toExchangeRateRep- , mkExchangeRateRep- , fromExchangeRateRep- , withExchangeRateRep- , exchangeRateRepSrcCurrency- , exchangeRateRepDstCurrency- , exchangeRateRepRate- , exchangeRateRepRateNumerator- , exchangeRateRepRateDenominator- ) where--import Control.Applicative (empty)-import Control.Monad ((<=<))-import Data.Constraint (Dict(Dict))-import Data.Proxy (Proxy(..))-import Data.Ratio ((%), numerator, denominator)-import qualified GHC.Generics as GHC-import GHC.Real (infinity, notANumber)-import GHC.TypeLits-  (Symbol, SomeSymbol(..), Nat, SomeNat(..), CmpNat, KnownSymbol, KnownNat,-   natVal, someNatVal, symbolVal, someSymbolVal)-import Prelude hiding (round, ceiling, floor, truncate)-import qualified Prelude-import qualified Text.ParserCombinators.ReadPrec as ReadPrec-import qualified Text.ParserCombinators.ReadP as ReadP-import Text.Read (readPrec)-import Unsafe.Coerce (unsafeCoerce)--#ifdef VERSION_aeson-import qualified Data.Aeson as Ae-#endif--#ifdef VERSION_binary-import qualified Data.Binary as Binary-#endif--#ifdef VERSION_cereal-import qualified Data.Serialize as Cereal-#endif--#ifdef VERSION_deepseq-import Control.DeepSeq (NFData)-#endif--#ifdef VERSION_hashable-import Data.Hashable (Hashable)-#endif--#ifdef VERSION_store-import qualified Data.Store as Store-#endif--#if MIN_VERSION_base(4,9,0)-import qualified GHC.TypeLits as GHC-#endif------------------------------------------------------------------------------------- | 'Dense' represents a dense monetary value for @currency@ (usually a--- ISO-4217 currency code, but not necessarily) as a rational number.------ While monetary values associated with a particular currency are discrete, you--- can still treat monetary values as dense while operating on them. For--- example, the half of @USD 3.41@ is @USD 1.705@, which is not an amount that--- can't be represented as a number of USD cents (the smallest unit that can--- represent USD amounts). Nevertheless, if you eventually multiply @USD 1.705@--- by @4@, for example, you end up with @USD 6.82@, which is again a value--- representable as USD cents. In other words, 'Dense' monetary values--- allow us to perform precise calculations deferring the conversion to a--- 'Discrete' monetary values as much as posible. Once you are ready to--- aproximate a 'Dense' value to a 'Discrete' value you can use one of--- 'round', 'floor', 'ceiling' or 'truncate'. Otherwise, using 'toRational' you--- can obtain a precise 'Rational' representation.------ Construct 'Dense' monetary values using 'dense', or--- 'fromInteger' / 'fromIntegral' if that suffices.------ /WARNING/ if you want to treat a dense monetary value as a /Real/ number (for--- example, to take the square root of that monetary value), then you are on--- your own. We can only guarantee lossless manipulation of rational values, so--- you will need to convert back and forth betwen the 'Rational' representation--- for 'Dense' and your (likely lossy) representation for /Real/ numbers.-newtype Dense (currency :: Symbol) = Dense Rational-  deriving (Eq, Ord, Num, Real, Fractional, GHC.Generic)--instance forall currency. KnownSymbol currency => Show (Dense currency) where-  show = \(Dense r0) ->-    let c = symbolVal (Proxy :: Proxy currency)-    in concat [ "Dense ", show c, " (", show r0, ")" ]--instance forall currency. KnownSymbol currency => Read (Dense currency) where-  readPrec = do-    let c = symbolVal (Proxy :: Proxy currency)-    _ <- ReadPrec.lift (ReadP.string ("Dense " ++ show c ++ " "))-    maybe empty pure =<< fmap dense readPrec---- | Build a 'Dense' monetary value from a 'Rational' value.------ For example, if you want to represent @USD 12.52316@, then you can use:------ @--- 'dense' (125316 % 10000)--- @------ This function returns 'Nothing' in case the given 'Rational' is 'infinity' or--- 'notANumber'.-dense :: Rational -> Maybe (Dense currency)-dense = \r0 ->-  if (infinity == r0 || notANumber == r0)-  then Nothing else Just (Dense r0)-{-# INLINABLE dense #-}---- | 'Discrete' represents a discrete monetary value for a @currency@ expresed--- as an integer amount of a particular @unit@. For example, with @currency ~--- \"USD\"@ and @unit ~ \"cent\"@ you can represent United States Dollars to--- their full extent.------ @currency@ is usually a ISO-4217 currency code, but not necessarily.------ Construct 'Discrete' values using 'fromInteger'.------ For example, if you want to represent @GBP 21.05@, where the smallest--- represetable unit for a GBP (United Kingdom Pound) is the /penny/, and 100--- /pennies/ equal 1 GBP (i.e., @'Scale' \"GBP\" ~ '(100, 1)@), then you can--- use:------ @--- 'fromInteger' 2105 :: Discrete \"GBP\" \"penny\"--- @------ Because @2015 / 100 == 20.15@.-type Discrete (currency :: Symbol) (unit :: Symbol)-  = Discrete' currency (Scale currency unit)---- | 'Discrete'' represents a discrete monetary value for a @currency@ expresed--- as an amount of @scale@, which is a rational number expressed as @(numerator,--- denominator)@.------ You'll be using 'Discrete' instead of 'Discrete'' most of the time, which--- mentions the unit name (such as /cent/ or /centavo/) instead of explicitely--- mentioning the unit scale.-newtype Discrete' (currency :: Symbol) (scale :: (Nat, Nat))-  = Discrete Integer--deriving instance GoodScale scale => Eq (Discrete' currency scale)-deriving instance GoodScale scale => Ord (Discrete' currency scale)-deriving instance GoodScale scale => Enum (Discrete' currency scale)-deriving instance GoodScale scale => Num (Discrete' currency scale)-deriving instance GoodScale scale => Real (Discrete' currency scale)-deriving instance GoodScale scale => Integral (Discrete' currency scale)-deriving instance GoodScale scale => GHC.Generic (Discrete' currency scale)--instance forall currency scale.-  ( KnownSymbol currency, GoodScale scale-  ) => Show (Discrete' currency scale) where-  show = \d0@(Discrete i0) ->-    let c = symbolVal (Proxy :: Proxy currency)-    in concat [ "Discrete ", show c, " (", show (scale d0), ") ", show i0 ]--instance forall currency scale.-  ( KnownSymbol currency, GoodScale scale-  ) => Read (Discrete' currency scale) where-  readPrec = do-    let c = symbolVal (Proxy :: Proxy currency)-        s = scale (Proxy :: Proxy scale)-    _ <- ReadPrec.lift (ReadP.string-           ("Discrete " ++ show c ++ " (" ++ show s ++ ") ") )-    Discrete <$> readPrec--#if MIN_VERSION_base(4,9,0)-instance-  ( GHC.TypeError-      (('GHC.Text "The ") 'GHC.:<>:-       ('GHC.ShowType Discrete') 'GHC.:<>:-       ('GHC.Text " type is deliberately not a ") 'GHC.:<>:-       ('GHC.ShowType Fractional) 'GHC.:$$:-       ('GHC.Text "instance. Convert the ") 'GHC.:<>:-       ('GHC.ShowType Discrete') 'GHC.:<>:-       ('GHC.Text " value to a ") 'GHC.:<>:-       ('GHC.ShowType Dense) 'GHC.:$$:-       ('GHC.Text "value and use the ") 'GHC.:<>:-       ('GHC.ShowType Fractional) 'GHC.:<>:-       ('GHC.Text " features on it instead."))-  , GoodScale scale-  ) => Fractional (Discrete' currency scale) where-  fromRational = undefined-  recip = undefined-#endif---- | Convert currency 'Discrete' monetary value into a 'Dense' monetary--- value.-fromDiscrete-  :: GoodScale scale-  => Discrete' currency scale-  -> Dense currency -- ^-fromDiscrete = \c@(Discrete i) -> Dense (fromInteger i / scale c)-{-# INLINABLE fromDiscrete #-}---- | Internal. Used to implement 'round', 'ceiling', 'floor' and 'truncate'.-roundf-  :: forall currency scale-  .  GoodScale scale-  => (Rational -> Integer) -- ^ 'Prelude.round', 'Prelude.ceiling' or similar.-  -> Dense currency-  -> (Discrete' currency scale, Maybe (Dense currency))-roundf f = \c0 ->-  let !r0 = toRational c0 :: Rational-      !r1 = scale (Proxy :: Proxy scale)-      !i2 = f (r0 * r1) :: Integer-      !r2 = fromInteger i2 / r1 :: Rational-      !ycrest | r0 == r2  = Nothing-              | otherwise = Just (Dense (r0 - r2))-      !d2 = Discrete i2-  in (d2, ycrest)-{-# INLINABLE roundf #-}---- | Round a 'Dense' value @x@ to the nearest value fully representable in--- its @currency@'s @unit@ 'Scale', which might be @x@ itself.------ If @x@ is already fully representable in its @currency@'s @unit@ 'Scale',--- then the following holds:------ @--- 'round' x == (x, 'Nothing')--- @------ Otherwise, if the nearest value to @x@ that is fully representable in its--- @currency@'s @unit@ 'Scale' is greater than @x@, then the following holds:------ @--- 'round' == 'ceiling'--- @------ Otherwise, the nearest value to @x@ that is fully representable in its--- @currency@'s @unit@ 'Scale' is smaller than @x@, and the following holds:------ @--- 'round' == 'floor'--- @------ Proof that 'round' doesn't lose money:------ @--- x == case 'round' x of---        (y, 'Nothing') -> y---        (y, 'Just' z)  -> y + z--- @-round-  :: GoodScale scale-  => Dense currency-  -> (Discrete' currency scale, Maybe (Dense currency)) -- ^-round = roundf Prelude.round-{-# INLINABLE round #-}---- | Round a 'Dense' value @x@ to the nearest value fully representable in--- its @currency@'s @unit@ 'Scale' which is greater than @x@ or equal to @x@.--------- If @x@ is already fully representable in its @currency@'s @unit@ 'Scale',--- then the following holds:------ @--- 'ceiling' x == (x, 'Nothing')--- @------ Otherwise, if @x@ is not representable in its @currency@'s @unit@ 'Scale',--- then the following holds:------ @--- 'ceiling' x == (y, 'Just' z)--- @------ @--- x /= y--- @------ @--- z < 'zero'--- @------ Proof that 'ceiling' doesn't lose money:------ @--- x == case 'ceiling' x of---        (y, 'Nothing') -> y---        (y, 'Just' z)  -> y + z--- @-ceiling-  :: GoodScale scale-  => Dense currency-  -> (Discrete' currency scale, Maybe (Dense currency)) -- ^-ceiling = roundf Prelude.ceiling-{-# INLINABLE ceiling #-}---- | Round a 'Dense' value @x@ to the nearest value fully representable in--- its @currency@'s @unit@ 'Scale' which is smaller than @x@ or equal to @x@.--------- If @x@ is already fully representable in its @currency@'s @unit@ 'Scale',--- then the following holds:------ @--- 'floor' x == (x, 'Nothing')--- @------ Otherwise, if @x@ is not representable in its @currency@'s @unit@ 'Scale',--- then the following holds:------ @--- 'floor' x == (y, 'Just' z)--- @------ @--- x /= y--- @------ @--- z > 'zero'--- @------ Proof that 'floor' doesn't lose money:------ @--- x == case 'floor' x of---        (y, 'Nothing') -> y---        (y, 'Just' z)  -> y + z--- @-floor-  :: GoodScale scale-  => Dense currency-  -> (Discrete' currency scale, Maybe (Dense currency)) -- ^-floor = roundf Prelude.floor-{-# INLINABLE floor #-}---- | Round a 'Dense' value @x@ to the nearest value between zero and--- @x@ (inclusive) which is fully representable in its @currency@'s @unit@--- 'Scale'.------ If @x@ is already fully representable in its @currency@'s @unit@ 'Scale',--- then the following holds:------ @--- 'truncate' x == (x, 'Nothing')--- @------ Otherwise, if @x@ is positive, then the following holds:------ @--- 'truncate' == 'floor'--- @------ Otherwise, if @x@ is negative, the following holds:------ @--- 'truncate' == 'ceiling'--- @------ Proof that 'truncate' doesn't lose money:------ @--- x == case 'truncate' x of---        (y, 'Nothing') -> y---        (y, 'Just' z)  -> y + z--- @-truncate-  :: GoodScale scale-  => Dense currency-  -> (Discrete' currency scale, Maybe (Dense currency)) -- ^-truncate = roundf Prelude.truncate-{-# INLINABLE truncate #-}-------------------------------------------------------------------------------------- | @'Scale' currency unit@ is a rational number (expressed as @'(numerator,--- denominator)@) indicating how many pieces of @unit@ fit in @currency@.------ @currency@ is usually a ISO-4217 currency code, but not necessarily.------ The 'Scale' will determine how to convert a 'Dense' value into a--- 'Discrete' value and vice-versa.------ For example, there are 100 USD cents in 1 USD, so the scale for this--- relationship is:------ @--- type instance 'Scale' \"USD\" \"cent\" = '(100, 1)--- @------ As another example, there is 1 dollar in USD, so the scale for this--- relationship is:------ @--- type instance 'Scale' \"USD\" \"dollar\" = '(1, 1)--- @------ When using 'Discrete' values to represent money, it will be impossible to--- represent an amount of @currency@ smaller than @unit@. So, if you decide to--- use @Scale \"USD\" \"dollar\"@ as your scale, you will not be able to--- represent values such as USD 3.50 or USD 21.87, since they are not exact--- multiples of a dollar.------ If there exists a canonical smallest @unit@ that can fully represent the--- currency, then an instance @'Scale' currency currency@ exists.------ @--- type instance 'Scale' \"USD\" \"USD\" = Scale \"USD\" \"cent\"--- @------ For some monetary values, such as precious metals, the smallest representable--- unit is not obvious, since you can continue to split the precious metal many--- times before it stops being a precious metal. Still, for practical purposes--- we can make a sane arbitrary choice of smallest unit. For example, the base--- unit for XAU (Gold) is the /troy ounce/, which is too big to be considered--- the smallest unit, but we can arbitrarily choose the /milligrain/ as our--- smallest unit, which is about as heavy as a single grain of table salt and--- should be sufficiently precise for all monetary practical purposes. A /troy--- ounce/ equals 480000 /milligrains/.------ @--- type instance 'Scale' \"XAG\" \"milligrain\" = '(480000, 1)--- @------ You can use other units such as /milligrams/ for measuring XAU, for example.--- However, since the amount of /milligrams/ in a /troy ounce/ (31103.477) is--- not integral, we need to use rational number to express it.------ @--- type instance 'Scale' \"XAU\" \"milligram\" = '(31103477, 1000)--- @------ If you try to obtain the 'Scale of a @currency@ without an obvious smallest--- representable @unit@, like XAU, you will get a compile error.-type family Scale (currency :: Symbol) (unit :: Symbol) :: (Nat, Nat)--#if MIN_VERSION_base(4,9,0)--- | A friendly 'GHC.TypeError' to use for a @currency@ that doesn't have a--- canonical small unit.-type family ErrScaleNonCanonical (currency :: Symbol) :: k where-  ErrScaleNonCanonical c = GHC.TypeError-    ( 'GHC.Text c 'GHC.:<>:-      'GHC.Text " is not a currency with a canonical smallest unit," 'GHC.:$$:-      'GHC.Text "be explicit about the currency unit you want to use." )-#else--- | Forbid a @currency@ that doesn't have a canonical small unit.------ In GHC versions before 8.0 we can't provide a nice error message here, so we--- simply set this to a value that will fail to satisfy 'GoodScale'. As a--- consequence, trying to use this 'Scale' will result in a cryptic error saying--- /«@Couldn't match type ‘'EQ’ with ‘'LT’@»/.-type ErrScaleNonCanonical (currency :: Symbol) = '(0, 0)-#endif---- | Constraints to a scale (like the one returned by @'Scale' currency unit@)--- expected to always be satisfied. In particular, the scale is always--- guaranteed to be a positive rational number ('infinity' and 'notANumber' are--- forbidden by 'GoodScale').-type GoodScale (scale :: (Nat, Nat))-   = ( CmpNat 0 (Fst scale) ~ 'LT-     , CmpNat 0 (Snd scale) ~ 'LT-     , KnownNat (Fst scale)-     , KnownNat (Snd scale)-     )---- | If the specified @num@ and @den@ satisfy the expectations of 'GoodScale' at--- the type level, then construct a proof for 'GoodScale'.-mkGoodScale-  :: forall num den-  .  (KnownNat num, KnownNat den)-  => Maybe (Dict (GoodScale '(num, den)))-mkGoodScale =-  let n = natVal (Proxy :: Proxy num)-      d = natVal (Proxy :: Proxy den)-  in if (n > 0) && (d > 0)-     then Just (unsafeCoerce (Dict :: Dict ('LT ~ 'LT, 'LT ~ 'LT,-                                            KnownNat num, KnownNat den)))-     else Nothing-{-# INLINABLE mkGoodScale #-}---- | Term-level representation for the @currency@'s @unit@ 'Scale'.------ For example, the 'Scale' for @\"USD\"@ in @\"cent\"@s is @100/1@.------ The returned 'Rational' is statically guaranteed to be a positive number, and--- to be different from both 'notANumber' and 'infinity'.-scale :: forall proxy scale. GoodScale scale => proxy scale -> Rational -- ^-scale = \_ ->-   natVal (Proxy :: Proxy (Fst scale)) %-   natVal (Proxy :: Proxy (Snd scale))-{-# INLINABLE scale #-}-------------------------------------------------------------------------------------- | Exchange rate for converting monetary values of currency @src@ into--- monetary values of currency @dst@ by multiplying for it.------ For example, if in order to convert USD to GBP we have to multiply by 1.2345,--- then we can represent this situaion using:------ @--- 'exchangeRate' (12345 % 10000) :: 'Maybe' ('ExchangeRate' \"USD\" \"GBP\")--- @-newtype ExchangeRate (src :: Symbol) (dst :: Symbol) = ExchangeRate Rational-  deriving (Eq, Ord, GHC.Generic)--instance forall src dst.-  ( KnownSymbol src, KnownSymbol dst-  ) => Show (ExchangeRate src dst) where-  show = \(ExchangeRate r0) ->-    let s = symbolVal (Proxy :: Proxy src)-        d = symbolVal (Proxy :: Proxy dst)-    in concat [ "ExchangeRate ", show s, " ", show d, " (", show r0, ")" ]--instance forall src dst.-  ( KnownSymbol src, KnownSymbol dst-  ) => Read (ExchangeRate (src :: Symbol) (dst :: Symbol)) where-  readPrec = do-    let s = symbolVal (Proxy :: Proxy src)-        d = symbolVal (Proxy :: Proxy dst)-    _ <- ReadPrec.lift (ReadP.string-            ("ExchangeRate " ++ show s ++ " " ++ show d ++ " "))-    maybe empty pure =<< fmap exchangeRate readPrec---- | Obtain a 'Rational' representation of the 'ExchangeRate'.------ This 'Rational' is statically guaranteed to be greater than 0, different--- from 'infinity' and different from 'notANumber'.-fromExchangeRate :: ExchangeRate src dst -> Rational-fromExchangeRate = \(ExchangeRate r0) -> r0-{-# INLINABLE fromExchangeRate #-}---- | Safely construct an 'ExchangeRate' from a 'Rational' number.------ For construction to succeed, this 'Rational' must be greater than 0,--- different from 'infinity' and different from 'notANumber'.-exchangeRate :: Rational -> Maybe (ExchangeRate src dst)-exchangeRate = \r0 ->-  if (r0 <= 0 || infinity == r0 || notANumber == r0)-  then Nothing else Just (ExchangeRate r0)-{-# INLINABLE exchangeRate #-}---- | Flip the direction of an 'ExchangeRate'.------ Identity law:------ @--- 'flipExchangeRate' . 'flipExchangeRate'   ==  'id'--- @-flipExchangeRate :: ExchangeRate a b -> ExchangeRate b a-flipExchangeRate = \(ExchangeRate x) -> ExchangeRate (1 / x)-{-# INLINABLE flipExchangeRate #-}---- | Apply the 'ExchangeRate' to the given @'Dense' src@ monetary value.------ Identity law:------ @--- 'exchange' ('flipExchangeRate' x) . 'exchange' x  ==  'id'--- @------ Use the /Identity law/ for reasoning about going back and forth between @src@--- and @dst@ in order to manage any leftovers that might not be representable as--- a 'Discrete' monetary value of @src@.-exchange :: ExchangeRate src dst -> Dense src -> Dense dst-exchange = \(ExchangeRate r) -> \(Dense s) -> Dense (r * s)-{-# INLINABLE exchange #-}------------------------------------------------------------------------------------- DenseRep---- | A monomorphic representation of 'Dense' that is easier to serialize and--- deserialize than 'Dense' in case you don't know the type indexes involved.------ If you are trying to construct a value of this type from some raw input, then--- you will need to use the 'mkDenseRep' function.------ In order to be able to effectively serialize a 'DenseRep' value, you--- need to serialize the following three values (which are the eventual--- arguments to 'mkDenseRep'):------ * 'denseRepCurrency'--- * 'denseRepAmountNumerator'--- * 'denseRepAmountDenominator'-data DenseRep = DenseRep-  { _denseRepCurrency          :: !String-  , _denseRepAmountNumerator   :: !Integer-  , _denseRepAmountDenominator :: !Integer  -- ^ Positive, non-zero.-  } deriving (Eq, Show, GHC.Generic)---- | WARNING: This instance does not compare monetary amounts, it just helps you--- sort 'DenseRep' values in case you need to put them in a 'Data.Set.Set' or--- similar.-deriving instance Ord DenseRep---- | Currency name.-denseRepCurrency :: DenseRep -> String-denseRepCurrency = _denseRepCurrency-{-# INLINABLE denseRepCurrency #-}---- | Currency unit amount.-denseRepAmount :: DenseRep -> Rational-denseRepAmount = \dr ->-  denseRepAmountNumerator dr % denseRepAmountDenominator dr-{-# INLINABLE denseRepAmount #-}---- | Currency unit amount numerator.-denseRepAmountNumerator :: DenseRep -> Integer-denseRepAmountNumerator = _denseRepAmountNumerator-{-# INLINABLE denseRepAmountNumerator #-}---- | Currency unit amount denominator. Positive, non-zero.-denseRepAmountDenominator :: DenseRep -> Integer-denseRepAmountDenominator = _denseRepAmountDenominator-{-# INLINABLE denseRepAmountDenominator #-}---- | Build a 'DenseRep' from raw values.------ This function is intended for deserialization purposes. You need to convert--- this 'DenseRep' value to a 'Dense' value in order to do any arithmetic--- operation on the monetary value.-mkDenseRep-  :: String -- ^ Currency. ('denseRepCurrency')-  -> Integer -- ^ Scale numerator. ('denseRepAmountNumerator')-  -> Integer -- ^ Scale denominator (positive, non zero). ('denseRepAmountDenominator')-  -> Maybe DenseRep-mkDenseRep = \c n d -> case d > 0 of-  False -> Nothing-  True -> Just (DenseRep c n d)-{-# INLINABLE mkDenseRep #-}---- | Convert a 'Dense' to a 'DenseRep' for ease of serialization.-toDenseRep :: KnownSymbol currency => Dense currency -> DenseRep-toDenseRep = \(Dense r0 :: Dense currency) ->-  let c = symbolVal (Proxy :: Proxy currency)-  in DenseRep c (numerator r0) (denominator r0)-{-# INLINABLE toDenseRep #-}---- | Attempt to convert a 'DenseRep' to a 'Dense', provided you know the target--- @currency@.-fromDenseRep-  :: forall currency-  .  KnownSymbol currency-  => DenseRep-  -> Maybe (Dense currency)  -- ^-fromDenseRep = \dr ->-  case denseRepCurrency dr == symbolVal (Proxy :: Proxy currency) of-     False -> Nothing-     True -> Just (Dense (denseRepAmount dr))-{-# INLINABLE fromDenseRep #-}---- | Convert a 'DenseRep' to a 'Dense' without knowing the target @currency@.------ Notice that @currency@ here can't leave its intended scope unless you can--- prove equality with some other type at the outer scope, but in that case you--- would be better off using 'fromDenseRep' directly.-withDenseRep-  :: DenseRep-  -> (forall currency. KnownSymbol currency => Dense currency -> r)-  -> r  -- ^-withDenseRep dr = \f ->-   case someSymbolVal (denseRepCurrency dr) of-      SomeSymbol (Proxy :: Proxy currency) ->-         f (Dense (denseRepAmount dr) :: Dense currency)-{-# INLINABLE withDenseRep #-}------------------------------------------------------------------------------------- DiscreteRep---- | A monomorphic representation of 'Discrete' that is easier to serialize and--- deserialize than 'Discrete' in case you don't know the type indexes involved.------ If you are trying to construct a value of this type from some raw input, then--- you will need to use the 'mkDiscreteRep' function.------ In order to be able to effectively serialize a 'DiscreteRep' value, you need--- to serialize the following four values (which are the eventual arguments to--- 'mkDiscreteRep'):------ * 'discreteRepCurrency'--- * 'discreteRepScaleNumerator'--- * 'discreteRepScaleDenominator'--- * 'discreteRepAmount'-data DiscreteRep = DiscreteRep-  { _discreteRepCurrency         :: !String   -- ^ Currency name.-  , _discreteRepScaleNumerator   :: !Integer  -- ^ Positive, non-zero.-  , _discreteRepScaleDenominator :: !Integer  -- ^ Positive, non-zero.-  , _discreteRepAmount           :: !Integer  -- ^ Amount of unit.-  } deriving (Eq, Show, GHC.Generic)---- | WARNING: This instance does not compare monetary amounts, it just helps you--- sort 'DiscreteRep' values in case you need to put them in a 'Data.Set.Set' or--- similar.-deriving instance Ord DiscreteRep---- | Currency name.-discreteRepCurrency :: DiscreteRep -> String-discreteRepCurrency = _discreteRepCurrency-{-# INLINABLE discreteRepCurrency #-}---- | Positive, non-zero.-discreteRepScaleNumerator :: DiscreteRep -> Integer-discreteRepScaleNumerator = _discreteRepScaleNumerator-{-# INLINABLE discreteRepScaleNumerator #-}---- | Positive, non-zero.-discreteRepScaleDenominator :: DiscreteRep -> Integer-discreteRepScaleDenominator = _discreteRepScaleDenominator-{-# INLINABLE discreteRepScaleDenominator #-}---- | Amount of currency unit.-discreteRepAmount :: DiscreteRep -> Integer-discreteRepAmount = _discreteRepAmount-{-# INLINABLE discreteRepAmount #-}---- | Positive, non-zero.-discreteRepScale :: DiscreteRep -> Rational-discreteRepScale = \dr ->-  discreteRepScaleNumerator dr % discreteRepScaleDenominator dr-{-# INLINABLE discreteRepScale #-}----- | Internal. Build a 'DiscreteRep' from raw values.------ This function is intended for deserialization purposes. You need to convert--- this 'DiscreteRep' value to a 'Discrete' vallue in order to do any arithmetic--- operation on the monetary value.-mkDiscreteRep-  :: String   -- ^ Currency name. ('discreteRepCurrency')-  -> Integer  -- ^ Scale numerator. Positive, non-zero. ('discreteRepScaleNumerator')-  -> Integer  -- ^ Scale denominator. Positive, non-zero. ('discreteRepScaleDenominator')-  -> Integer  -- ^ Amount of unit. ('discreteRepAmount')-  -> Maybe DiscreteRep-mkDiscreteRep = \c n d a -> case (n > 0) && (d > 0) of-  False -> Nothing-  True -> Just (DiscreteRep c n d a)-{-# INLINABLE mkDiscreteRep #-}---- | Convert a 'Discrete' to a 'DiscreteRep' for ease of serialization.-toDiscreteRep-  :: (KnownSymbol currency, GoodScale scale)-  => Discrete' currency scale-  -> DiscreteRep -- ^-toDiscreteRep = \(Discrete i0 :: Discrete' currency scale) ->-  let c = symbolVal (Proxy :: Proxy currency)-      n = natVal (Proxy :: Proxy (Fst scale))-      d = natVal (Proxy :: Proxy (Snd scale))-  in DiscreteRep c n d i0-{-# INLINABLE toDiscreteRep #-}---- | Attempt to convert a 'DiscreteRep' to a 'Discrete', provided you know the--- target @currency@ and @unit@.-fromDiscreteRep-  :: forall currency scale-  .  (KnownSymbol currency, GoodScale scale)-  => DiscreteRep-  -> Maybe (Discrete' currency scale)  -- ^-fromDiscreteRep = \dr ->-   if (discreteRepCurrency dr == symbolVal (Proxy :: Proxy currency)) &&-      (discreteRepScaleNumerator dr == natVal (Proxy :: Proxy (Fst scale))) &&-      (discreteRepScaleDenominator dr == natVal (Proxy :: Proxy (Snd scale)))-   then Just (Discrete (discreteRepAmount dr))-   else Nothing-{-# INLINABLE fromDiscreteRep #-}---- | Convert a 'DiscreteRep' to a 'Discrete' without knowing the target--- @currency@ and @unit@.------ Notice that @currency@ and @unit@ here can't leave its intended scope unless--- you can prove equality with some other type at the outer scope, but in that--- case you would be better off using 'fromDiscreteRep' directly.------ Notice that you may need to add an explicit type to the result of this--- function in order to keep the compiler happy.-withDiscreteRep-  :: forall r-  .  DiscreteRep-  -> ( forall currency scale.-         ( KnownSymbol currency-         , GoodScale scale-         ) => Discrete' currency scale-           -> r )-  -> r  -- ^-withDiscreteRep dr = \f ->-  case someSymbolVal (discreteRepCurrency dr) of-    SomeSymbol (Proxy :: Proxy currency) ->-      case someNatVal (discreteRepScaleNumerator dr) of-        Nothing -> error "withDiscreteRep: impossible: numerator < 0"-        Just (SomeNat (Proxy :: Proxy num)) ->-          case someNatVal (discreteRepScaleDenominator dr) of-            Nothing -> error "withDiscreteRep: impossible: denominator < 0"-            Just (SomeNat (Proxy :: Proxy den)) ->-              case mkGoodScale of-                Nothing -> error "withDiscreteRep: impossible: mkGoodScale"-                Just (Dict :: Dict (GoodScale '(num, den))) ->-                  f (Discrete (discreteRepAmount dr)-                       :: Discrete' currency '(num, den))-{-# INLINABLE withDiscreteRep #-}------------------------------------------------------------------------------------- ExchangeRateRep---- | A monomorphic representation of 'ExchangeRate' that is easier to serialize--- and deserialize than 'ExchangeRate' in case you don't know the type indexes--- involved.------ If you are trying to construct a value of this type from some raw input, then--- you will need to use the 'mkExchangeRateRep' function.------ In order to be able to effectively serialize an 'ExchangeRateRep' value, you--- need to serialize the following four values (which are the eventual arguments--- to 'mkExchangeRateRep'):------ * 'exchangeRateRepSrcCurrency'--- * 'exchangeRateRepDstCurrency'--- * 'exchangeRateRepRateNumerator'--- * 'exchangeRateRepRateDenominator'-data ExchangeRateRep = ExchangeRateRep-  { _exchangeRateRepSrcCurrency     :: !String-  , _exchangeRateRepDstCurrency     :: !String-  , _exchangeRateRepRateNumerator   :: !Integer  -- ^ Positive, non-zero.-  , _exchangeRateRepRateDenominator :: !Integer  -- ^ Positive, non-zero.-  } deriving (Eq, Show, GHC.Generic)---- | WARNING: This instance does not compare monetary amounts, it just helps you--- sort 'ExchangeRateRep' values in case you need to put them in a--- 'Data.Set.Set' or similar.-deriving instance Ord ExchangeRateRep---- | Source currency name.-exchangeRateRepSrcCurrency :: ExchangeRateRep -> String-exchangeRateRepSrcCurrency = _exchangeRateRepSrcCurrency-{-# INLINABLE exchangeRateRepSrcCurrency #-}---- | Destination currency name.-exchangeRateRepDstCurrency :: ExchangeRateRep -> String-exchangeRateRepDstCurrency = _exchangeRateRepDstCurrency-{-# INLINABLE exchangeRateRepDstCurrency #-}---- | Exchange rate. Positive, non-zero.-exchangeRateRepRate :: ExchangeRateRep -> Rational-exchangeRateRepRate = \x ->-  exchangeRateRepRateNumerator x % _exchangeRateRepRateDenominator x-{-# INLINABLE exchangeRateRepRate #-}---- | Exchange rate numerator. Positive, non-zero.-exchangeRateRepRateNumerator :: ExchangeRateRep -> Integer-exchangeRateRepRateNumerator = _exchangeRateRepRateNumerator-{-# INLINABLE exchangeRateRepRateNumerator #-}---- | Exchange rate denominator. Positive, non-zero.-exchangeRateRepRateDenominator :: ExchangeRateRep -> Integer-exchangeRateRepRateDenominator = _exchangeRateRepRateDenominator-{-# INLINABLE exchangeRateRepRateDenominator #-}---- | Internal. Build a 'ExchangeRateRep' from raw values.------ This function is intended for deserialization purposes. You need to convert--- this 'ExchangeRateRep' value to a 'ExchangeRate' value in order to do any--- arithmetic operation with the exchange rate.-mkExchangeRateRep-  :: String   -- ^ Source currency name. ('exchangeRateRepSrcCurrency')-  -> String   -- ^ Destination currency name. ('exchangeRateRepDstCurrency')-  -> Integer  -- ^ Exchange rate numerator. Positive, non-zero. ('exchangeRateRepRateNumerator')-  -> Integer  -- ^ Exchange rate denominator. Positive, non-zero. ('exchangeRateRepRateDenominator')-  -> Maybe ExchangeRateRep-mkExchangeRateRep = \src dst n d -> case (n > 0) && (d > 0) of-  False -> Nothing-  True -> Just (ExchangeRateRep src dst n d)-{-# INLINABLE mkExchangeRateRep #-}---- | Convert a 'ExchangeRate' to a 'DiscreteRep' for ease of serialization.-toExchangeRateRep-  :: (KnownSymbol src, KnownSymbol dst)-  => ExchangeRate src dst-  -> ExchangeRateRep -- ^-toExchangeRateRep = \(ExchangeRate r0 :: ExchangeRate src dst) ->-  let src = symbolVal (Proxy :: Proxy src)-      dst = symbolVal (Proxy :: Proxy dst)-  in ExchangeRateRep src dst (numerator r0) (denominator r0)-{-# INLINABLE toExchangeRateRep #-}---- | Attempt to convert a 'ExchangeRateRep' to a 'ExchangeRate', provided you--- know the target @src@ and @dst@ types.-fromExchangeRateRep-  :: forall src dst-  .  (KnownSymbol src, KnownSymbol dst)-  => ExchangeRateRep-  -> Maybe (ExchangeRate src dst)  -- ^-fromExchangeRateRep = \x ->-   if (exchangeRateRepSrcCurrency x == symbolVal (Proxy :: Proxy src)) &&-      (exchangeRateRepDstCurrency x == symbolVal (Proxy :: Proxy dst))-   then Just (ExchangeRate (exchangeRateRepRate x))-   else Nothing-{-# INLINABLE fromExchangeRateRep #-}---- | Convert a 'ExchangeRateRep' to a 'ExchangeRate' without knowing the target--- @currency@ and @unit@.------ Notice that @src@ and @dst@ here can't leave its intended scope unless--- you can prove equality with some other type at the outer scope, but in that--- case you would be better off using 'fromExchangeRateRep' directly.-withExchangeRateRep-  :: ExchangeRateRep-  -> ( forall src dst.-         ( KnownSymbol src-         , KnownSymbol dst-         ) => ExchangeRate src dst-           -> r )-  -> r  -- ^-withExchangeRateRep x = \f ->-  case someSymbolVal (exchangeRateRepSrcCurrency x) of-    SomeSymbol (Proxy :: Proxy src) ->-      case someSymbolVal (exchangeRateRepDstCurrency x) of-        SomeSymbol (Proxy :: Proxy dst) ->-          f (ExchangeRate (exchangeRateRepRate x) :: ExchangeRate src dst)-{-# INLINABLE withExchangeRateRep #-}------------------------------------------------------------------------------------- Miscellaneous--type family Fst (ab :: (ka, kb)) :: ka where Fst '(a,b) = a-type family Snd (ab :: (ka, kb)) :: ka where Snd '(a,b) = b------------------------------------------------------------------------------------- Extra instances: hashable-#ifdef VERSION_hashable-instance Hashable (Dense currency)-instance Hashable DenseRep-instance GoodScale scale => Hashable (Discrete' currency scale)-instance Hashable DiscreteRep-instance Hashable (ExchangeRate src dst)-instance Hashable ExchangeRateRep-#endif------------------------------------------------------------------------------------- Extra instances: deepseq-#ifdef VERSION_deepseq-instance NFData (Dense currency)-instance NFData DenseRep-instance GoodScale scale => NFData (Discrete' currency scale)-instance NFData DiscreteRep-instance NFData (ExchangeRate src dst)-instance NFData ExchangeRateRep-#endif------------------------------------------------------------------------------------- Extra instances: cereal-#ifdef VERSION_cereal--- | Compatible with 'DenseRep'.-instance (KnownSymbol currency) => Cereal.Serialize (Dense currency) where-  put = Cereal.put . toDenseRep-  get = maybe empty pure =<< fmap fromDenseRep Cereal.get--- | Compatible with 'DiscreteRep'.-instance-  ( KnownSymbol currency, GoodScale scale-  ) => Cereal.Serialize (Discrete' currency scale) where-  put = Cereal.put . toDiscreteRep-  get = maybe empty pure =<< fmap fromDiscreteRep Cereal.get--- | Compatible with 'ExchangeRateRep'.-instance-  ( KnownSymbol src, KnownSymbol dst-  ) => Cereal.Serialize (ExchangeRate src dst) where-  put = Cereal.put . toExchangeRateRep-  get = maybe empty pure =<< fmap fromExchangeRateRep Cereal.get--- | Compatible with 'Dense'.-instance Cereal.Serialize DenseRep where-  put = \(DenseRep c n d) -> Cereal.put c >> Cereal.put n >> Cereal.put d-  get = maybe empty pure =<< mkDenseRep-    <$> Cereal.get <*> Cereal.get <*> Cereal.get--- | Compatible with 'Discrete'.-instance Cereal.Serialize DiscreteRep where-  put = \(DiscreteRep c n d a) ->-    Cereal.put c >> Cereal.put n >> Cereal.put d >> Cereal.put a-  get = maybe empty pure =<< mkDiscreteRep-    <$> Cereal.get <*> Cereal.get <*> Cereal.get <*> Cereal.get--- | Compatible with 'ExchangeRate'.-instance Cereal.Serialize ExchangeRateRep where-  put = \(ExchangeRateRep src dst n d) ->-    Cereal.put src >> Cereal.put dst >> Cereal.put n >> Cereal.put d-  get = maybe empty pure =<< mkExchangeRateRep-    <$> Cereal.get <*> Cereal.get <*> Cereal.get <*> Cereal.get-#endif------------------------------------------------------------------------------------- Extra instances: binary-#ifdef VERSION_binary--- | Compatible with 'DenseRep'.-instance (KnownSymbol currency) => Binary.Binary (Dense currency) where-  put = Binary.put . toDenseRep-  get = maybe empty pure =<< fmap fromDenseRep Binary.get--- | Compatible with 'DiscreteRep'.-instance-  ( KnownSymbol currency, GoodScale scale-  ) => Binary.Binary (Discrete' currency scale) where-  put = Binary.put . toDiscreteRep-  get = maybe empty pure =<< fmap fromDiscreteRep Binary.get--- | Compatible with 'ExchangeRateRep'.-instance-  ( KnownSymbol src, KnownSymbol dst-  ) => Binary.Binary (ExchangeRate src dst) where-  put = Binary.put . toExchangeRateRep-  get = maybe empty pure =<< fmap fromExchangeRateRep Binary.get--- | Compatible with 'Dense'.-instance Binary.Binary DenseRep where-  put = \(DenseRep c n d) -> Binary.put c >> Binary.put n >> Binary.put d-  get = maybe empty pure =<< mkDenseRep-    <$> Binary.get <*> Binary.get <*> Binary.get--- | Compatible with 'Discrete'.-instance Binary.Binary DiscreteRep where-  put = \(DiscreteRep c n d a) ->-    Binary.put c >> Binary.put n >> Binary.put d >> Binary.put a-  get = maybe empty pure =<< mkDiscreteRep-    <$> Binary.get <*> Binary.get <*> Binary.get <*> Binary.get--- | Compatible with 'ExchangeRate'.-instance Binary.Binary ExchangeRateRep where-  put = \(ExchangeRateRep src dst n d) ->-    Binary.put src >> Binary.put dst >> Binary.put n >> Binary.put d-  get = maybe empty pure =<< mkExchangeRateRep-    <$> Binary.get <*> Binary.get <*> Binary.get <*> Binary.get-#endif------------------------------------------------------------------------------------- Extra instances: aeson-#ifdef VERSION_aeson--- | Compatible with 'DenseRep'-instance KnownSymbol currency => Ae.ToJSON (Dense currency) where-  toJSON = Ae.toJSON . toDenseRep--- | Compatible with 'DenseRep'-instance KnownSymbol currency => Ae.FromJSON (Dense currency) where-  parseJSON = maybe empty pure <=< fmap fromDenseRep . Ae.parseJSON--- | Compatible with 'Dense'-instance Ae.ToJSON DenseRep where-  toJSON = \(DenseRep c n d) -> Ae.toJSON ("Dense", c, n, d)--- | Compatible with 'Dense'-instance Ae.FromJSON DenseRep where-  parseJSON = \v -> do-    ("Dense", c, n, d) <- Ae.parseJSON v-    maybe empty pure (mkDenseRep c n d)--- | Compatible with 'DiscreteRep'-instance-  ( KnownSymbol currency, GoodScale scale-  ) => Ae.ToJSON (Discrete' currency scale) where-  toJSON = Ae.toJSON . toDiscreteRep--- | Compatible with 'DiscreteRep'-instance-  ( KnownSymbol currency, GoodScale scale-  ) => Ae.FromJSON (Discrete' currency scale) where-  parseJSON = maybe empty pure <=< fmap fromDiscreteRep . Ae.parseJSON--- | Compatible with 'Discrete''-instance Ae.ToJSON DiscreteRep where-  toJSON = \(DiscreteRep c n d a) -> Ae.toJSON ("Discrete", c, n, d, a)--- | Compatible with 'Discrete''-instance Ae.FromJSON DiscreteRep where-  parseJSON = \v -> do-    ("Discrete", c, n, d, a) <- Ae.parseJSON v-    maybe empty pure (mkDiscreteRep c n d a)--- | Compatible with 'ExchangeRateRep'-instance-  ( KnownSymbol src, KnownSymbol dst-  ) => Ae.ToJSON (ExchangeRate src dst) where-  toJSON = Ae.toJSON . toExchangeRateRep--- | Compatible with 'ExchangeRateRep'-instance-  ( KnownSymbol src, KnownSymbol dst-  ) => Ae.FromJSON (ExchangeRate src dst) where-  parseJSON = maybe empty pure <=< fmap fromExchangeRateRep . Ae.parseJSON--- | Compatible with 'ExchangeRate'-instance Ae.ToJSON ExchangeRateRep where-  toJSON = \(ExchangeRateRep src dst n d) ->-    Ae.toJSON ("ExchangeRate", src, dst, n, d)--- | Compatible with 'ExchangeRate'-instance Ae.FromJSON ExchangeRateRep where-  parseJSON = \v -> do-    ("ExchangeRate", src, dst, n, d) <- Ae.parseJSON v-    maybe empty pure (mkExchangeRateRep src dst n d)-#endif------------------------------------------------------------------------------------- Extra instances: store-#ifdef VERSION_store--- | Compatible with 'DenseRep'.-instance (KnownSymbol currency) => Store.Store (Dense currency) where-  size = storeContramapSize toDenseRep Store.size-  poke = Store.poke . toDenseRep-  peek = maybe (fail "peek") pure =<< fmap fromDenseRep Store.peek--- | Compatible with 'Dense'.-instance Store.Store DenseRep where-  poke = \(DenseRep c n d) -> Store.poke c >> Store.poke n >> Store.poke d-  peek = maybe (fail "peek") pure =<< do-    mkDenseRep <$> Store.peek <*> Store.peek <*> Store.peek---- | Compatible with 'DiscreteRep'.-instance-  ( KnownSymbol currency, GoodScale scale-  ) => Store.Store (Discrete' currency scale) where-  size = storeContramapSize toDiscreteRep Store.size-  poke = Store.poke . toDiscreteRep-  peek = maybe (fail "peek") pure =<< fmap fromDiscreteRep Store.peek--- | Compatible with 'Discrete''.-instance Store.Store DiscreteRep where-  poke = \(DiscreteRep c n d a) ->-    Store.poke c >> Store.poke n >> Store.poke d >> Store.poke a-  peek = maybe (fail "peek") pure =<< do-    mkDiscreteRep <$> Store.peek <*> Store.peek <*> Store.peek <*> Store.peek--- | Compatible with 'ExchangeRateRep'.-instance-  ( KnownSymbol src, KnownSymbol dst-  ) => Store.Store (ExchangeRate src dst) where-  size = storeContramapSize toExchangeRateRep Store.size-  poke = Store.poke . toExchangeRateRep-  peek = maybe (fail "peek") pure =<< fmap fromExchangeRateRep Store.peek--- | Compatible with 'ExchangeRate'.-instance Store.Store ExchangeRateRep where-  poke = \(ExchangeRateRep src dst n d) ->-    Store.poke src >> Store.poke dst >> Store.poke n >> Store.poke d-  peek = maybe (fail "peek") pure =<< mkExchangeRateRep-    <$> Store.peek <*> Store.peek <*> Store.peek <*> Store.peek--storeContramapSize :: (a -> b) -> Store.Size b -> Store.Size a-storeContramapSize f = \case-  Store.VarSize g -> Store.VarSize (g . f)-  Store.ConstSize x -> Store.ConstSize x-{-# INLINABLE storeContramapSize #-}-#endif+{-# 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.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, 'Just' z)+-- @+--+-- @+-- x /= y+-- @+--+-- @+-- z < 'zero'+-- @+--+-- 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, 'Just' z)+-- @+--+-- @+-- x /= y+-- @+--+-- @+-- z > 'zero'+-- @+--+-- 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)++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'.+--+-- 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+

@@ -8,23 +8,41 @@  module Main where +import qualified Data.ByteString.Lazy as BSL+import Data.Maybe (catMaybes, isJust, isNothing)+import Data.Proxy (Proxy(Proxy))+import Data.Ratio (numerator, denominator)+import GHC.TypeLits (Nat, Symbol, KnownSymbol, symbolVal) import qualified Test.Tasty as Tasty import qualified Test.Tasty.Runners as Tasty-import Test.Tasty.QuickCheck ((===), (==>))+import Test.Tasty.QuickCheck ((===), (==>), (.&&.)) import qualified Test.Tasty.QuickCheck as QC +#ifdef HAS_aeson import qualified Data.Aeson as Ae+#endif++#ifdef HAS_binary import qualified Data.Binary as Binary-import qualified Data.ByteString.Lazy as BSL-import Data.Maybe (catMaybes, isJust, isNothing)-import Data.Proxy (Proxy(Proxy))+#endif++#ifdef HAS_cereal import qualified Data.Serialize as Cereal-import GHC.TypeLits (Nat, Symbol, KnownSymbol, symbolVal)+#endif -#ifdef VERSION_store+#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+ import qualified Money  --------------------------------------------------------------------------------@@ -35,13 +53,13 @@   arbitrary = fmap fromInteger QC.arbitrary   shrink = fmap fromInteger . QC.shrink . toInteger -instance QC.Arbitrary Money.DiscreteRep where+instance QC.Arbitrary Money.SomeDiscrete where   arbitrary = do-    let md = Money.mkDiscreteRep <$> QC.arbitrary <*> QC.arbitrary-                                 <*> QC.arbitrary <*> QC.arbitrary+    let md = Money.mkSomeDiscrete+               <$> QC.arbitrary <*> QC.arbitrary <*> QC.arbitrary     Just x <- QC.suchThat md isJust     pure x-  shrink = \x -> Money.withDiscreteRep x (map Money.toDiscreteRep . QC.shrink)+  shrink = \x -> Money.withSomeDiscrete x (map Money.toSomeDiscrete . QC.shrink)  instance QC.Arbitrary (Money.Dense currency) where   arbitrary = do@@ -49,12 +67,12 @@     pure x   shrink = catMaybes . fmap Money.dense . QC.shrink . toRational -instance QC.Arbitrary Money.DenseRep where+instance QC.Arbitrary Money.SomeDense where   arbitrary = do-    let md = Money.mkDenseRep <$> QC.arbitrary <*> QC.arbitrary <*> QC.arbitrary+    let md = Money.mkSomeDense <$> QC.arbitrary <*> QC.arbitrary     Just x <- QC.suchThat md isJust     pure x-  shrink = \x -> Money.withDenseRep x (map Money.toDenseRep . QC.shrink)+  shrink = \x -> Money.withSomeDense x (map Money.toSomeDense . QC.shrink)  instance QC.Arbitrary (Money.ExchangeRate src dst) where   arbitrary = do@@ -63,14 +81,14 @@   shrink =     catMaybes . fmap Money.exchangeRate . QC.shrink . Money.fromExchangeRate -instance QC.Arbitrary Money.ExchangeRateRep where+instance QC.Arbitrary Money.SomeExchangeRate where   arbitrary = do-    let md = Money.mkExchangeRateRep <$> QC.arbitrary <*> QC.arbitrary-                                     <*> QC.arbitrary <*> QC.arbitrary+    let md = Money.mkSomeExchangeRate+               <$> QC.arbitrary <*> QC.arbitrary <*> QC.arbitrary     Just x <- QC.suchThat md isJust     pure x   shrink = \x ->-    Money.withExchangeRateRep x (map Money.toExchangeRateRep . QC.shrink)+    Money.withSomeExchangeRate x (map Money.toSomeExchangeRate . QC.shrink)  -------------------------------------------------------------------------------- @@ -122,83 +140,132 @@   [ QC.testProperty "read . show == id" $       QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->          x === read (show x)-  , QC.testProperty "fromDenseRep . denseRep == Just" $+  , QC.testProperty "read . show . Just == Just " $       QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->-         Just x === Money.fromDenseRep (Money.toDenseRep x)-  , QC.testProperty "fromDenseRep works only for same currency" $-      QC.forAll QC.arbitrary $ \(dr :: Money.DenseRep) ->-        (Money.denseRepCurrency dr /= symbolVal pc)-           ==> isNothing (Money.fromDenseRep dr :: Maybe (Money.Dense currency))-  , QC.testProperty "withDenseRep" $+         Just x === read (show (Just x))+  , QC.testProperty "fromSomeDense . someDense == Just" $       QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->-        let dr = Money.toDenseRep x-        in Money.withDenseRep dr $ \x' ->-             (show x, dr, Money.toDenseRep (x + 1))-                === (show x', Money.toDenseRep x', Money.toDenseRep (x' + 1))+         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+        in Money.withSomeDense dr $ \x' ->+             (show x, dr, Money.toSomeDense (x + 1))+                === (show x', Money.toSomeDense x', Money.toSomeDense (x' + 1)) +#ifdef HAS_aeson   , QC.testProperty "Aeson encoding roundtrip" $       QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->          Just x === Ae.decode (Ae.encode x)-  , QC.testProperty "Aeson encoding roundtrip (DenseRep)" $+  , QC.testProperty "Aeson encoding roundtrip (SomeDense)" $       QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->-         let x' = Money.toDenseRep x+         let x' = Money.toSomeDense x          in Just x' === Ae.decode (Ae.encode x')-  , QC.testProperty "Aeson encoding roundtrip (Dense through DenseRep)" $+  , QC.testProperty "Aeson encoding roundtrip (Dense through SomeDense)" $       QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->-         Just x === Ae.decode (Ae.encode (Money.toDenseRep x))-  , QC.testProperty "Aeson encoding roundtrip (DenseRep through Dense)" $+         Just x === Ae.decode (Ae.encode (Money.toSomeDense x))+  , QC.testProperty "Aeson encoding roundtrip (SomeDense through Dense)" $       QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->-         Just (Money.toDenseRep x) === Ae.decode (Ae.encode x)+         Just (Money.toSomeDense x) === Ae.decode (Ae.encode x)+  , QC.testProperty "Aeson decoding of pre-0.4 format (Dense, SomeDense)" $+      QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+        let sx = Money.toSomeDense x+            c = Money.someDenseCurrency sx+            r = Money.someDenseAmount sx+            bs = Ae.encode ("Dense", c, numerator r, denominator r)+        in (Just  x === Ae.decode bs) .&&.+           (Just sx === Ae.decode bs)+#endif +#ifdef HAS_binary   , QC.testProperty "Binary encoding roundtrip" $       QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->          let Right (_,_,y) = Binary.decodeOrFail (Binary.encode x)          in x === y-  , QC.testProperty "Binary encoding roundtrip (DenseRep)" $+  , QC.testProperty "Binary encoding roundtrip (SomeDense)" $       QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->-         let x' = Money.toDenseRep x+         let x' = Money.toSomeDense x              bs = Binary.encode x'          in Right (mempty, BSL.length bs, x') === Binary.decodeOrFail bs-  , QC.testProperty "Binary encoding roundtrip (Dense through DenseRep)" $+  , QC.testProperty "Binary encoding roundtrip (Dense through SomeDense)" $       QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->-         let x' = Money.toDenseRep x+         let x' = Money.toSomeDense x              bs = Binary.encode x'          in Right (mempty, BSL.length bs, x) === Binary.decodeOrFail bs-  , QC.testProperty "Binary encoding roundtrip (DenseRep through Dense)" $+  , QC.testProperty "Binary encoding roundtrip (SomeDense through Dense)" $       QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->-         let x' = Money.toDenseRep x+         let x' = Money.toSomeDense x              bs = Binary.encode x          in Right (mempty, BSL.length bs, x') === Binary.decodeOrFail bs+#endif +#ifdef HAS_cereal   , QC.testProperty "Cereal encoding roundtrip" $       QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->          Right x === Cereal.decode (Cereal.encode x)-  , QC.testProperty "Cereal encoding roundtrip (DenseRep)" $+  , QC.testProperty "Cereal encoding roundtrip (SomeDense)" $       QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->-         let x' = Money.toDenseRep x+         let x' = Money.toSomeDense x          in Right x' === Cereal.decode (Cereal.encode x')-  , QC.testProperty "Cereal encoding roundtrip (Dense through DenseRep)" $+  , QC.testProperty "Cereal encoding roundtrip (Dense through SomeDense)" $       QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->-         Right x === Cereal.decode (Cereal.encode (Money.toDenseRep x))-  , QC.testProperty "Cereal encoding roundtrip (DenseRep through Dense)" $+         Right x === Cereal.decode (Cereal.encode (Money.toSomeDense x))+  , QC.testProperty "Cereal encoding roundtrip (SomeDense through Dense)" $       QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->-         Right (Money.toDenseRep x) === Cereal.decode (Cereal.encode x)+         Right (Money.toSomeDense x) === Cereal.decode (Cereal.encode x)+#endif -#ifdef VERSION_store+#ifdef HAS_serialise+  , QC.testProperty "Serialise encoding roundtrip" $+      QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+         Just x === hush (Ser.deserialiseOrFail (Ser.serialise x))+  , QC.testProperty "Serialise encoding roundtrip (SomeDense)" $+      QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+         let x' = Money.toSomeDense x+         in Just x' === hush (Ser.deserialiseOrFail (Ser.serialise x'))+  , QC.testProperty "Serialise encoding roundtrip (Dense through SomeDense)" $+      QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+         Just x === hush (Ser.deserialiseOrFail (Ser.serialise (Money.toSomeDense x)))+  , QC.testProperty "Serialise encoding roundtrip (SomeDense through Dense)" $+      QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+         Just (Money.toSomeDense x) === hush (Ser.deserialiseOrFail (Ser.serialise x))+#endif++#ifdef HAS_store   , QC.testProperty "Store encoding roundtrip" $       QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->          Right x === Store.decode (Store.encode x)-  , QC.testProperty "Store encoding roundtrip (DenseRep)" $+  , QC.testProperty "Store encoding roundtrip (SomeDense)" $       QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->-         let x' = Money.toDenseRep x+         let x' = Money.toSomeDense x          in Right x' === Store.decode (Store.encode x')-  , QC.testProperty "Store encoding roundtrip (Dense through DenseRep)" $+  , QC.testProperty "Store encoding roundtrip (Dense through SomeDense)" $       QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->-         Right x === Store.decode (Store.encode (Money.toDenseRep x))-  , QC.testProperty "Store encoding roundtrip (DenseRep through Dense)" $+         Right x === Store.decode (Store.encode (Money.toSomeDense x))+  , QC.testProperty "Store encoding roundtrip (SomeDense through Dense)" $       QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->-         Right (Money.toDenseRep x) === Store.decode (Store.encode x)+         Right (Money.toSomeDense x) === Store.decode (Store.encode x) #endif++#ifdef HAS_xmlbf+  , QC.testProperty "Xmlbf encoding roundtrip" $+      QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+         Right x === Xmlbf.runParser Xmlbf.fromXml (Xmlbf.toXml x)+  , QC.testProperty "Xmlbf encoding roundtrip (SomeDense)" $+      QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+         let x' = Money.toSomeDense x+         in Right x' === Xmlbf.runParser Xmlbf.fromXml (Xmlbf.toXml x')+  , QC.testProperty "Xmlbf encoding roundtrip (Dense through SomeDense)" $+      QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+         Right x === Xmlbf.runParser Xmlbf.fromXml (Xmlbf.toXml (Money.toSomeDense x))+  , QC.testProperty "Xmlbf encoding roundtrip (SomeDense through Dense)" $+      QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+         Right (Money.toSomeDense x) === Xmlbf.runParser Xmlbf.fromXml (Xmlbf.toXml x)+#endif   ]  testExchange :: Tasty.TestTree@@ -237,87 +304,137 @@   , QC.testProperty "read . show == id" $       QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->          x === read (show x)-  , QC.testProperty "fromDiscreteRep . discreteRep == Just" $+  , QC.testProperty "read . show . Just == Just" $       QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->-         Just x === Money.fromDiscreteRep (Money.toDiscreteRep x)-  , QC.testProperty "fromDiscreteRep works only for same currency and scale" $-      QC.forAll QC.arbitrary $ \(dr :: Money.DiscreteRep) ->-        ((Money.discreteRepCurrency dr /= symbolVal pc) &&-         (Money.discreteRepScale dr /=+         Just x === read (show (Just x))+  , QC.testProperty "fromSomeDiscrete . someDiscrete == Just" $+      QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+         Just x === Money.fromSomeDiscrete (Money.toSomeDiscrete x)+  , QC.testProperty "fromSomeDiscrete works only for same currency and scale" $+      QC.forAll QC.arbitrary $ \(dr :: Money.SomeDiscrete) ->+        ((Money.someDiscreteCurrency dr /= symbolVal pc) &&+         (Money.someDiscreteScale dr /=              Money.scale (Proxy :: Proxy (Money.Scale currency unit)))-        ) ==> isNothing (Money.fromDiscreteRep dr+        ) ==> isNothing (Money.fromSomeDiscrete dr                           :: Maybe (Money.Discrete currency unit))-  , QC.testProperty "withDiscreteRep" $+  , QC.testProperty "withSomeDiscrete" $       QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->-        let dr = Money.toDiscreteRep x-        in ( Money.withDiscreteRep dr $ \x' ->-                (show x, dr, Money.toDiscreteRep (x + 1))-                   === (show x', Money.toDiscreteRep x', Money.toDiscreteRep (x' + 1))+        let dr = Money.toSomeDiscrete x+        in ( Money.withSomeDiscrete dr $ \x' ->+                (show x, dr, Money.toSomeDiscrete (x + 1))+                   === (show x', Money.toSomeDiscrete x', Money.toSomeDiscrete (x' + 1))            ) :: QC.Property +#ifdef HAS_aeson   , QC.testProperty "Aeson encoding roundtrip" $       QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->          Just x === Ae.decode (Ae.encode x)-  , QC.testProperty "Aeson encoding roundtrip (DiscreteRep)" $+  , QC.testProperty "Aeson encoding roundtrip (SomeDiscrete)" $       QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->-         let x' = Money.toDiscreteRep x+         let x' = Money.toSomeDiscrete x          in Just x' === Ae.decode (Ae.encode x')-  , QC.testProperty "Aeson encoding roundtrip (Discrete through DiscreteRep)" $+  , QC.testProperty "Aeson encoding roundtrip (Discrete through SomeDiscrete)" $       QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->-         Just x === Ae.decode (Ae.encode (Money.toDiscreteRep x))-  , QC.testProperty "Aeson encoding roundtrip (DiscreteRep through Discrete)" $+         Just x === Ae.decode (Ae.encode (Money.toSomeDiscrete x))+  , QC.testProperty "Aeson encoding roundtrip (SomeDiscrete through Discrete)" $       QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->-         Just (Money.toDiscreteRep x) === Ae.decode (Ae.encode x)+         Just (Money.toSomeDiscrete x) === Ae.decode (Ae.encode x)+  , QC.testProperty "Aeson decoding of pre-0.4 format (Discrete, SomeDiscrete)" $+      QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+        let sx = Money.toSomeDiscrete x+            c = Money.someDiscreteCurrency sx+            r = Money.someDiscreteScale sx+            a = Money.someDiscreteAmount sx+            bs = Ae.encode ("Discrete", c, numerator r, denominator r, a)+        in (Just  x === Ae.decode bs) .&&.+           (Just sx === Ae.decode bs)+#endif +#ifdef HAS_binary   , QC.testProperty "Binary encoding roundtrip" $       QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->          let Right (_,_,y) = Binary.decodeOrFail (Binary.encode x)          in x === y-  , QC.testProperty "Binary encoding roundtrip (DiscreteRep)" $+  , QC.testProperty "Binary encoding roundtrip (SomeDiscrete)" $       QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->-         let x' = Money.toDiscreteRep x+         let x' = Money.toSomeDiscrete x              bs = Binary.encode x'          in Right (mempty, BSL.length bs, x') === Binary.decodeOrFail bs-  , QC.testProperty "Binary encoding roundtrip (Discrete through DiscreteRep)" $+  , QC.testProperty "Binary encoding roundtrip (Discrete through SomeDiscrete)" $       QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->-         let x' = Money.toDiscreteRep x+         let x' = Money.toSomeDiscrete x              bs = Binary.encode x'          in Right (mempty, BSL.length bs, x) === Binary.decodeOrFail bs-  , QC.testProperty "Binary encoding roundtrip (DiscreteRep through Discrete)" $+  , QC.testProperty "Binary encoding roundtrip (SomeDiscrete through Discrete)" $       QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->-         let x' = Money.toDiscreteRep x+         let x' = Money.toSomeDiscrete x              bs = Binary.encode x          in Right (mempty, BSL.length bs, x') === Binary.decodeOrFail bs+#endif +#ifdef HAS_cereal   , QC.testProperty "Cereal encoding roundtrip" $       QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->          Right x === Cereal.decode (Cereal.encode x)-  , QC.testProperty "Cereal encoding roundtrip (DiscreteRep)" $+  , QC.testProperty "Cereal encoding roundtrip (SomeDiscrete)" $       QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->-         let x' = Money.toDiscreteRep x+         let x' = Money.toSomeDiscrete x          in Right x' === Cereal.decode (Cereal.encode x')-  , QC.testProperty "Cereal encoding roundtrip (Discrete through DiscreteRep)" $+  , QC.testProperty "Cereal encoding roundtrip (Discrete through SomeDiscrete)" $       QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->-         Right x === Cereal.decode (Cereal.encode (Money.toDiscreteRep x))-  , QC.testProperty "Cereal encoding roundtrip (DiscreteRep through Discrete)" $+         Right x === Cereal.decode (Cereal.encode (Money.toSomeDiscrete x))+  , QC.testProperty "Cereal encoding roundtrip (SomeDiscrete through Discrete)" $       QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->-         Right (Money.toDiscreteRep x) === Cereal.decode (Cereal.encode x)+         Right (Money.toSomeDiscrete x) === Cereal.decode (Cereal.encode x)+#endif -#ifdef VERSION_store+#ifdef HAS_serialise+  , QC.testProperty "Serialise encoding roundtrip" $+      QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+         Just x === hush (Ser.deserialiseOrFail (Ser.serialise x))+  , QC.testProperty "Serialise encoding roundtrip (SomeDiscrete)" $+      QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+         let x' = Money.toSomeDiscrete x+         in Just x' === hush (Ser.deserialiseOrFail (Ser.serialise x'))+  , QC.testProperty "Serialise encoding roundtrip (Discrete through SomeDiscrete)" $+      QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+         Just x === hush (Ser.deserialiseOrFail (Ser.serialise (Money.toSomeDiscrete x)))+  , QC.testProperty "Serialise encoding roundtrip (SomeDiscrete through Discrete)" $+      QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+         Just (Money.toSomeDiscrete x) === hush (Ser.deserialiseOrFail (Ser.serialise x))+#endif++#ifdef HAS_store   , QC.testProperty "Store encoding roundtrip" $       QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->          Right x === Store.decode (Store.encode x)-  , QC.testProperty "Store encoding roundtrip (DiscreteRep)" $+  , QC.testProperty "Store encoding roundtrip (SomeDiscrete)" $       QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->-         let x' = Money.toDiscreteRep x+         let x' = Money.toSomeDiscrete x          in Right x' === Store.decode (Store.encode x')-  , QC.testProperty "Store encoding roundtrip (Discrete through DiscreteRep)" $+  , QC.testProperty "Store encoding roundtrip (Discrete through SomeDiscrete)" $       QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->-         Right x === Store.decode (Store.encode (Money.toDiscreteRep x))-  , QC.testProperty "Store encoding roundtrip (DiscreteRep through Discrete)" $+         Right x === Store.decode (Store.encode (Money.toSomeDiscrete x))+  , QC.testProperty "Store encoding roundtrip (SomeDiscrete through Discrete)" $       QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->-         Right (Money.toDiscreteRep x) === Store.decode (Store.encode x)+         Right (Money.toSomeDiscrete x) === Store.decode (Store.encode x) #endif++#ifdef HAS_xmlbf+  , QC.testProperty "Xmlbf encoding roundtrip" $+      QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+         Right x === Xmlbf.runParser Xmlbf.fromXml (Xmlbf.toXml x)+  , QC.testProperty "Xmlbf encoding roundtrip (SomeDiscrete)" $+      QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+         let x' = Money.toSomeDiscrete x+         in Right x' === Xmlbf.runParser Xmlbf.fromXml (Xmlbf.toXml x')+  , QC.testProperty "Xmlbf encoding roundtrip (Discrete through SomeDiscrete)" $+      QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+         Right x === Xmlbf.runParser Xmlbf.fromXml (Xmlbf.toXml (Money.toSomeDiscrete x))+  , QC.testProperty "Xmlbf encoding roundtrip (SomeDiscrete through Discrete)" $+      QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+         Right (Money.toSomeDiscrete x) === Xmlbf.runParser Xmlbf.fromXml (Xmlbf.toXml x)+#endif   ]  testExchangeRate@@ -332,6 +449,9 @@   [ QC.testProperty "read . show == id" $       QC.forAll QC.arbitrary $ \(xr :: Money.ExchangeRate src dst) ->          xr === read (show xr)+  , QC.testProperty "read . show . Just == Just" $+      QC.forAll QC.arbitrary $ \(xr :: Money.ExchangeRate src dst) ->+         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@@ -354,84 +474,131 @@           , xr :: Money.ExchangeRate src dst           ) -> (Money.fromExchangeRate xr /= 1)                   ==> (toRational c0 /= toRational (Money.exchange xr c0))-  , QC.testProperty "fromExchangeRateRep . exchangeRateRep == Just" $+  , QC.testProperty "fromSomeExchangeRate . someExchangeRate == Just" $       QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->-         Just x === Money.fromExchangeRateRep (Money.toExchangeRateRep x)-  , QC.testProperty "fromExchangeRateRep works only for same currencies" $-      QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRateRep) ->-        ((Money.exchangeRateRepSrcCurrency x /= symbolVal ps) &&-         (Money.exchangeRateRepDstCurrency x /= symbolVal pd))-            ==> isNothing (Money.fromExchangeRateRep x+         Just x === Money.fromSomeExchangeRate (Money.toSomeExchangeRate x)+  , QC.testProperty "fromSomeExchangeRate works only for same currencies" $+      QC.forAll QC.arbitrary $ \(x :: Money.SomeExchangeRate) ->+        ((Money.someExchangeRateSrcCurrency x /= symbolVal ps) &&+         (Money.someExchangeRateDstCurrency x /= symbolVal pd))+            ==> isNothing (Money.fromSomeExchangeRate x                             :: Maybe (Money.ExchangeRate src dst))-  , QC.testProperty "withExchangeRateRep" $+  , QC.testProperty "withSomeExchangeRate" $       QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->-        let dr = Money.toExchangeRateRep x-        in Money.withExchangeRateRep dr $ \x' ->-             (show x, dr) === (show x', Money.toExchangeRateRep x')+        let dr = Money.toSomeExchangeRate x+        in Money.withSomeExchangeRate dr $ \x' ->+             (show x, dr) === (show x', Money.toSomeExchangeRate x') +#ifdef HAS_aeson   , QC.testProperty "Aeson encoding roundtrip" $       QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->          Just x === Ae.decode (Ae.encode x)-  , QC.testProperty "Aeson encoding roundtrip (ExchangeRateRep)" $+  , QC.testProperty "Aeson encoding roundtrip (SomeExchangeRate)" $       QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->-         let x' = Money.toExchangeRateRep x+         let x' = Money.toSomeExchangeRate x          in Just x' === Ae.decode (Ae.encode x')-  , QC.testProperty "Aeson encoding roundtrip (ExchangeRate through ExchangeRateRep)" $+  , QC.testProperty "Aeson encoding roundtrip (ExchangeRate through SomeExchangeRate)" $       QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->-         Just x === Ae.decode (Ae.encode (Money.toExchangeRateRep x))-  , QC.testProperty "Aeson encoding roundtrip (ExchangeRateRep through ExchangeRate)" $+         Just x === Ae.decode (Ae.encode (Money.toSomeExchangeRate x))+  , QC.testProperty "Aeson encoding roundtrip (SomeExchangeRate through ExchangeRate)" $       QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->-         Just (Money.toExchangeRateRep x) === Ae.decode (Ae.encode x)+         Just (Money.toSomeExchangeRate x) === Ae.decode (Ae.encode x)+  , QC.testProperty "Aeson decoding of pre-0.4 format (ExchangeRate, SomeExchangeRate)" $+      QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->+        let sx = Money.toSomeExchangeRate x+            src = Money.someExchangeRateSrcCurrency sx+            dst = Money.someExchangeRateDstCurrency sx+            r = Money.someExchangeRateRate sx+            bs = Ae.encode ("ExchangeRate", src, dst, numerator r, denominator r)+        in (Just  x === Ae.decode bs) .&&.+           (Just sx === Ae.decode bs)+#endif +#ifdef HAS_binary   , QC.testProperty "Binary encoding roundtrip" $       QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->          let Right (_,_,y) = Binary.decodeOrFail (Binary.encode x)          in x === y-  , QC.testProperty "Binary encoding roundtrip (ExchangeRateRep)" $+  , QC.testProperty "Binary encoding roundtrip (SomeExchangeRate)" $       QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->-         let x' = Money.toExchangeRateRep x+         let x' = Money.toSomeExchangeRate x              bs = Binary.encode x'          in Right (mempty, BSL.length bs, x') === Binary.decodeOrFail bs-  , QC.testProperty "Binary encoding roundtrip (ExchangeRate through ExchangeRateRep)" $+  , QC.testProperty "Binary encoding roundtrip (ExchangeRate through SomeExchangeRate)" $       QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->-         let x' = Money.toExchangeRateRep x+         let x' = Money.toSomeExchangeRate x              bs = Binary.encode x'          in Right (mempty, BSL.length bs, x) === Binary.decodeOrFail bs-  , QC.testProperty "Binary encoding roundtrip (ExchangeRateRep through ExchangeRate)" $+  , QC.testProperty "Binary encoding roundtrip (SomeExchangeRate through ExchangeRate)" $       QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->-         let x' = Money.toExchangeRateRep x+         let x' = Money.toSomeExchangeRate x              bs = Binary.encode x          in Right (mempty, BSL.length bs, x') === Binary.decodeOrFail bs+#endif +#ifdef HAS_cereal   , QC.testProperty "Cereal encoding roundtrip" $       QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->          Right x === Cereal.decode (Cereal.encode x)-  , QC.testProperty "Cereal encoding roundtrip (ExchangeRateRep)" $+  , QC.testProperty "Cereal encoding roundtrip (SomeExchangeRate)" $       QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->-         let x' = Money.toExchangeRateRep x+         let x' = Money.toSomeExchangeRate x          in Right x' === Cereal.decode (Cereal.encode x')-  , QC.testProperty "Cereal encoding roundtrip (ExchangeRate through ExchangeRateRep)" $+  , QC.testProperty "Cereal encoding roundtrip (ExchangeRate through SomeExchangeRate)" $       QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->-         Right x === Cereal.decode (Cereal.encode (Money.toExchangeRateRep x))-  , QC.testProperty "Cereal encoding roundtrip (ExchangeRateRep through ExchangeRate)" $+         Right x === Cereal.decode (Cereal.encode (Money.toSomeExchangeRate x))+  , QC.testProperty "Cereal encoding roundtrip (SomeExchangeRate through ExchangeRate)" $       QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->-         Right (Money.toExchangeRateRep x) === Cereal.decode (Cereal.encode x)+         Right (Money.toSomeExchangeRate x) === Cereal.decode (Cereal.encode x)+#endif -#ifdef VERSION_store+#ifdef HAS_serialise+  , QC.testProperty "Serialise encoding roundtrip" $+      QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->+         Just x === hush (Ser.deserialiseOrFail (Ser.serialise x))+  , QC.testProperty "Serialise encoding roundtrip (SomeExchangeRate)" $+      QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->+         let x' = Money.toSomeExchangeRate x+         in Just x' === hush (Ser.deserialiseOrFail (Ser.serialise x'))+  , QC.testProperty "Serialise encoding roundtrip (ExchangeRate through SomeExchangeRate)" $+      QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->+         Just x === hush (Ser.deserialiseOrFail (Ser.serialise (Money.toSomeExchangeRate x)))+  , QC.testProperty "Serialise encoding roundtrip (SomeExchangeRate through ExchangeRate)" $+      QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->+         Just (Money.toSomeExchangeRate x) === hush (Ser.deserialiseOrFail (Ser.serialise x))+#endif++#ifdef HAS_store   , QC.testProperty "Store encoding roundtrip" $       QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->          Right x === Store.decode (Store.encode x)-  , QC.testProperty "Store encoding roundtrip (ExchangeRateRep)" $+  , QC.testProperty "Store encoding roundtrip (SomeExchangeRate)" $       QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->-         let x' = Money.toExchangeRateRep x+         let x' = Money.toSomeExchangeRate x          in Right x' === Store.decode (Store.encode x')-  , QC.testProperty "Store encoding roundtrip (ExchangeRate through ExchangeRateRep)" $+  , QC.testProperty "Store encoding roundtrip (ExchangeRate through SomeExchangeRate)" $       QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->-         Right x === Store.decode (Store.encode (Money.toExchangeRateRep x))-  , QC.testProperty "Store encoding roundtrip (ExchangeRateRep through ExchangeRate)" $+         Right x === Store.decode (Store.encode (Money.toSomeExchangeRate x))+  , QC.testProperty "Store encoding roundtrip (SomeExchangeRate through ExchangeRate)" $       QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->-         Right (Money.toExchangeRateRep x) === Store.decode (Store.encode x)+         Right (Money.toSomeExchangeRate x) === Store.decode (Store.encode x) #endif++#ifdef HAS_xmlbf+  , QC.testProperty "Xmlbf encoding roundtrip" $+      QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->+         Right x === Xmlbf.runParser Xmlbf.fromXml (Xmlbf.toXml x)+  , QC.testProperty "Xmlbf encoding roundtrip (SomeExchangeRate)" $+      QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->+         let x' = Money.toSomeExchangeRate x+         in Right x' === Xmlbf.runParser Xmlbf.fromXml (Xmlbf.toXml x')+  , QC.testProperty "Xmlbf encoding roundtrip (ExchangeRate through SomeExchangeRate)" $+      QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->+         Right x === Xmlbf.runParser Xmlbf.fromXml (Xmlbf.toXml (Money.toSomeExchangeRate x))+  , QC.testProperty "Xmlbf encoding roundtrip (SomeExchangeRate through ExchangeRate)" $+      QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->+         Right (Money.toSomeExchangeRate x) === Xmlbf.runParser Xmlbf.fromXml (Xmlbf.toXml x)+#endif   ]  testRounding@@ -446,8 +613,25 @@     , 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)     ]   where-    g f = \(x :: Money.Dense currency) -> x === case f x of-      (y, Nothing) -> Money.fromDiscrete (y :: Money.Discrete currency unit)-      (y, Just z)  -> Money.fromDiscrete y + z+    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++    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+      (_, _) -> error "testRounding.h: unexpected"++hush :: Either a b -> Maybe b+hush (Left _ ) = Nothing+hush (Right b) = Just b+