safe-money 0.6 → 0.7
raw patch · 6 files changed
+274/−1114 lines, 6 filesdep +QuickCheckdep −aesondep −cerealdep −serialisedep ~hashabledep ~vector-space
Dependencies added: QuickCheck
Dependencies removed: aeson, cereal, serialise, store, xmlbf
Dependency ranges changed: hashable, vector-space
Files
- README.md +22/−2
- changelog.md +64/−0
- safe-money.cabal +31/−88
- src/Money.hs +27/−4
- src/Money/Internal.hs +108/−504
- test/Main.hs +22/−516
README.md view
@@ -2,5 +2,25 @@ 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--f release.nix ghc822.safe-money` (or similar, check `release.nix`).+Useful instances for the many types defined by `safe-money` can be found+in these other libraries:++* [safe-money-aeson](https://hackage.haskell.org/package/safe-money-aeson):+ `FromJSON` and `ToJSON` instances (from the+ [aeson](https://hackage.haskell.org/package/aeson) library).++* [safe-money-cereal](https://hackage.haskell.org/package/safe-money-cereal):+ `Serialize` instances (from the+ [cereal](https://hackage.haskell.org/package/cereal) library).++* [safe-money-serialise](https://hackage.haskell.org/package/safe-money-serialise):+ `Serialise` instances (from the+ [serialise](https://hackage.haskell.org/package/serialise) library).++* [safe-money-store](https://hackage.haskell.org/package/safe-money-store):+ `Store` instances (from the+ [store](https://hackage.haskell.org/package/store) library).++* [safe-money-xmlbf](https://hackage.haskell.org/package/safe-money-xmlbf):+ `FromXml` and `ToXml` instances (from the+ [xmlbf](https://hackage.haskell.org/package/xmlbf) library).
changelog.md view
@@ -1,3 +1,67 @@+# Version 0.7++* _IMPORTANT_. All of the changes in this release are fully backwards+ compatible. What happens in this release is that many instances+ previously exported by `safe-money` now live in different libraries so+ that downstream packages can avoid using Cabal flags to specify+ dependencies.++* _COMPILER ASSISTED BREAKING CHANGE_. `FromJSON` and `ToJSON` (from+ `aeson`) instances are not exported from the `safe-money` library+ anymore. Instead, you are now expected to depend on the vetted+ `safe-money-aeson` library and import `Money.Aeson` to get the+ relevant instances. These instances are exactly the same ones+ previously exported by `safe-money`. As a consequence of this change,+ the `aeson` Cabal flag in `safe-money` and the optional dependency on+ `aeson` were removed, which simplifies downstream packaging.++* _COMPILER ASSISTED BREAKING CHANGE_. `Store` (from `store`) instances+ are not exported from the `safe-money` library anymore. Instead, you+ are now expected to depend on the vetted `safe-money-store` library+ and import `Money.Store` to get the relevant instances. These+ instances are exactly the same ones previously exported by+ `safe-money`. As a consequence of this change, the `store` Cabal flag+ in `safe-money` and the optional dependency on `serialise` were+ removed, which simplifies downstream packaging.++* _COMPILER ASSISTED BREAKING CHANGE_. `Serialise` (from `serialise`)+ instances are not exported from the `safe-money` library anymore.+ Instead, you are now expected to depend on the vetted+ `safe-money-serialise` library and import `Money.Serialise` to get the+ relevant instances. These instances are exactly the same ones+ previously exported by `safe-money`. As a consequence of this change,+ the `serialise` Cabal flag in `safe-money` and the optional dependency+ on `serialise` were removed, which simplifies downstream packaging.++* _COMPILER ASSISTED BREAKING CHANGE_. `Serialize` (from `cereal`)+ instances are not exported from the `safe-money` library anymore.+ Instead, you are now expected to depend on the vetted+ `safe-money-cereal` library and import `Money.Serialize` to get the+ relevant instances. These instances are exactly the same ones+ previously exported by `safe-money`. As a consequence of this change,+ the `cereal` Cabal flag in `safe-money` and the optional dependency on+ `cereal` were removed, which simplifies downstream packaging.++* _COMPILER ASSISTED BREAKING CHANGE_. `FromXml` and `ToXml` (from+ `xmlbf`) instances are not exported from the `safe-money` library+ anymore. Instead, you are now expected to depend on the vetted+ `safe-money-xmlbf` library and import `Money.Aeson` to get the+ relevant instances. These instances are exactly the same ones+ previously exported by `safe-money`. As a consequence of this change,+ the `xmlbf` Cabal flag in `safe-money` and the optional dependency on+ `xmlbf` were removed, which simplifies downstream packaging.++* _COMPILER ASSISTED BREAKING CHANGE_. `hashable` and `vector-space` are+ now mandatory dependencies of `safe-money`. `Hashable`, `VectorSpace`+ and `AdditiveGroup` instances for the various `safe-money` datatypes+ are now exported from `Money`. The `hashable` and `vector-space` Cabal+ flags are now gone.++* `Arbitrary` instances (from the `QuickCheck` packages) for the various+ `safe-money` datatypes are now exported from `Money`. `QuickCheck` is+ now a mandatory dependency of `safe-money`.++ # Version 0.6 * _COMPILER ASSISTED BREAKING CHANGE_. `denseToDecimal` now takes a positive
safe-money.cabal view
@@ -1,12 +1,12 @@ name: safe-money-version: 0.6+version: 0.7 license: BSD3 license-file: LICENSE copyright: Copyright (c) Renzo Carbonara 2016-2018 author: Renzo Carbonara maintainer: renλren!zone stability: Experimental-tested-with: GHC==8.2.2, GHC==8.0.2, GHCJS+tested-with: GHC==8.4.1 homepage: https://github.com/k0001/safe-money bug-reports: https://github.com/k0001/safe-money/issues category: Money@@ -14,18 +14,30 @@ cabal-version: >=1.10 extra-source-files: README.md changelog.md synopsis:- Type-safe and lossless encoding and manipulation of money, fiat currencies,- crypto currencies and precious metals.+ Type-safe and lossless encoding and manipulation of money, fiat+ currencies, crypto currencies and precious metals. description:- Type-safe and lossless encoding and manipulation of money, fiat currencies,- crypto currencies and precious metals.+ 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. .- NOTICE that the only mandatory dependencies of this package are @base@,- @binary@, @constraints@, @deepseq@ and @text@. Except for- @constraints@, all of them are included with a standard GHC distribution. The- rest of the dependencies are OPTIONAL but enabled by default (except @store@- which is disabled when building with GHCJS because it doesn't compile ther).- All of the optional dependencies can be disabled with Cabal flags.+ Useful instances for the many types defined by @safe-money@ can be found+ in these other libraries:+ .+ * [safe-money-aeson](https://hackage.haskell.org/package/safe-money-aeson):+ @FromJSON@ and @ToJSON@ instances (from the [aeson](https://hackage.haskell.org/package/aeson) library).+ .+ * [safe-money-cereal](https://hackage.haskell.org/package/safe-money-cereal):+ @Serialize@ instances (from the [cereal](https://hackage.haskell.org/package/cereal) library).+ .+ * [safe-money-serialise](https://hackage.haskell.org/package/safe-money-serialise):+ @Serialise@ instances (from the [serialise](https://hackage.haskell.org/package/serialise) library).+ .+ * [safe-money-store](https://hackage.haskell.org/package/safe-money-store):+ @Store@ instances (from the [store](https://hackage.haskell.org/package/store) library).+ .+ * [safe-money-xmlbf](https://hackage.haskell.org/package/safe-money-xmlbf):+ @FromXml@ and @ToXml@ instances (from the [xmlbf](https://hackage.haskell.org/package/xmlbf) library). source-repository head type: git@@ -39,34 +51,15 @@ base (>=4.8 && <5.0), binary, constraints,+ hashable, deepseq,- text+ QuickCheck,+ text,+ vector-space exposed-modules: Money Money.Internal - if flag(aeson)- build-depends: aeson (>=0.9)- cpp-options: -DHAS_aeson- if flag(cereal)- build-depends: cereal (>=0.5)- cpp-options: -DHAS_cereal- 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(vector-space)- build-depends: vector-space (>=0.12)- cpp-options: -DHAS_vector_space- if flag(xmlbf)- build-depends: xmlbf (>=0.2)- cpp-options: -DHAS_xmlbf- test-suite test default-language: Haskell2010 type: exitcode-stdio-1.0@@ -78,60 +71,10 @@ bytestring, constraints, deepseq,+ hashable, safe-money, tasty, tasty-hunit, tasty-quickcheck,- text-- if flag(aeson)- build-depends: aeson- cpp-options: -DHAS_aeson- if flag(cereal)- build-depends: cereal- cpp-options: -DHAS_cereal- 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(vector-space)- build-depends: vector-space- cpp-options: -DHAS_vector_space- if flag(xmlbf)- build-depends: xmlbf- cpp-options: -DHAS_xmlbf--flag aeson- description: Provide instances for @aeson@- default: True- manual: True-flag cereal- description: Provide instances for @cereal@- default: True- manual: True-flag store- description: Provide instances for @store@- default: True- manual: True-flag hashable- description: Provide instances for @hashable@- default: True- manual: True-flag serialise- description: Provide instances for @serialise@- default: True- manual: True-flag vector-space- description: Provide instances for @vector-space@- default: True- manual: True-flag xmlbf- description: Provide instances for @xmlbf@- default: True- manual: True-+ text,+ vector-space
src/Money.hs view
@@ -9,10 +9,10 @@ -- import qualified Money -- @ ----- Note: This module exports many well-known currencies out-of-the-box, but--- you are not limited to the currencies mentioned here. You can simply create--- a new 'I.Scale' instance, and /voilà/. If you want to add a new currency to the--- out-of-the-box offer, please request so in+-- Note: This module exports support for many well-known currencies+-- out-of-the-box, but you are not limited to the currencies mentioned here. You+-- can simply create a new 'I.Scale' instance, and /voilà/. If you want to add a+-- new currency to the out-of-the-box offer, please request so in -- https://github.com/k0001/safe-money/issues and the authors will see to it. -- -- This module offers plenty of documentation, but for a deep explanation of@@ -21,6 +21,29 @@ -- has changed a bit since that article was written. You can always see the -- [change log](https://github.com/k0001/safe-money/blob/master/changelog.md) to -- understand what has changed.+--+-- Also, keep in mind that useful instances for the many types defined by+-- @safe-money@ can be found in these other libraries:+--+-- * [safe-money-aeson](https://hackage.haskell.org/package/safe-money-aeson):+-- `FromJSON` and `ToJSON` instances (from the+-- [aeson](https://hackage.haskell.org/package/aeson) library).+--+-- * [safe-money-cereal](https://hackage.haskell.org/package/safe-money-cereal):+-- `Serialize` instances (from the+-- [cereal](https://hackage.haskell.org/package/cereal) library).+--+-- * [safe-money-serialise](https://hackage.haskell.org/package/safe-money-serialise):+-- `Serialise` instances (from the+-- [serialise](https://hackage.haskell.org/package/serialise) library).+--+-- * [safe-money-store](https://hackage.haskell.org/package/safe-money-store):+-- `Store` instances (from the+-- [store](https://hackage.haskell.org/package/store) library).+--+-- * [safe-money-xmlbf](https://hackage.haskell.org/package/safe-money-xmlbf):+-- `FromXml` and `ToXml` instances (from the+-- [xmlbf](https://hackage.haskell.org/package/xmlbf) library). module Money ( -- * Dense monetary values I.Dense
src/Money/Internal.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-}@@ -27,6 +26,7 @@ ( -- * Dense monetary values Dense , denseCurrency+ , denseCurrency' , dense , dense' , denseFromDiscrete@@ -37,6 +37,7 @@ , Discrete' , discrete , discreteCurrency+ , discreteCurrency' , discreteFromDense , discreteFromDecimal , discreteToDecimal@@ -57,25 +58,32 @@ , SomeDense , toSomeDense , mkSomeDense+ , mkSomeDense' , fromSomeDense , withSomeDense , someDenseCurrency+ , someDenseCurrency' , someDenseAmount , SomeDiscrete , toSomeDiscrete , mkSomeDiscrete+ , mkSomeDiscrete' , fromSomeDiscrete , withSomeDiscrete , someDiscreteCurrency+ , someDiscreteCurrency' , someDiscreteScale , someDiscreteAmount , SomeExchangeRate , toSomeExchangeRate , mkSomeExchangeRate+ , mkSomeExchangeRate' , fromSomeExchangeRate , withSomeExchangeRate , someExchangeRateSrcCurrency+ , someExchangeRateSrcCurrency' , someExchangeRateDstCurrency+ , someExchangeRateDstCurrency' , someExchangeRateRate -- * Misc , Approximation(Round, Floor, Ceiling, Truncate)@@ -86,19 +94,23 @@ import Control.Applicative ((<|>), empty) import Control.Category (Category((.), id)) import Control.DeepSeq (NFData)-import Control.Monad ((<=<), guard, when)+import Control.Monad (guard, when)+import qualified Data.AdditiveGroup as AG import qualified Data.Binary as Binary import qualified Data.Char as Char import Data.Constraint (Dict(Dict)) import Data.Functor (($>)) import Data.Foldable (for_)+import Data.Hashable (Hashable) import qualified Data.List as List+import Data.Maybe (catMaybes, isJust, fromJust) import Data.Monoid ((<>)) import Data.Proxy (Proxy(..)) import Data.Ratio ((%), numerator, denominator) import qualified Data.Text as T+import qualified Data.VectorSpace as VS import Data.Word (Word8)-import GHC.Exts (Constraint, fromList)+import GHC.Exts (Constraint) import qualified GHC.Generics as GHC import GHC.TypeLits (Symbol, SomeSymbol(..), Nat, SomeNat(..), CmpNat, KnownSymbol, KnownNat,@@ -106,40 +118,13 @@ import qualified GHC.TypeLits as GHC import Numeric.Natural (Natural) import Prelude hiding ((.), id)+import qualified Test.QuickCheck as QC import qualified Text.ParserCombinators.ReadPrec as ReadPrec import qualified Text.ParserCombinators.ReadP as ReadP import qualified Text.Read as Read import Unsafe.Coerce (unsafeCoerce) -#ifdef HAS_aeson-import qualified Data.Aeson as Ae-#endif -#ifdef HAS_cereal-import qualified Data.Serialize as Cereal-#endif--#ifdef HAS_hashable-import Data.Hashable (Hashable)-#endif--#ifdef HAS_serialise-import qualified Codec.Serialise as Ser-#endif--#ifdef HAS_store-import qualified Data.Store as Store-#endif--#ifdef HAS_vector_space-import qualified Data.AdditiveGroup as AG-import qualified Data.VectorSpace as VS-#endif--#ifdef HAS_xmlbf-import qualified Xmlbf-#endif- -------------------------------------------------------------------------------- -- | 'Dense' represents a dense monetary value for @currency@ (usually a -- ISO-4217 currency code, but not necessarily) as a rational number.@@ -194,9 +179,8 @@ -- 'dense'' (1 '%' 4) '*' 'dense'' (1 '%' 2) == 'dense'' (1 '%' 8) -- @ ----- In fact, if you compiled this library with support for--- 'Data.VectorSpace.VectorSpace', then '*' functions exactly as--- 'Data.VectorSpace.*^'.+-- In fact, '*' functions exactly as 'Data.VectorSpace.*^' from the+-- 'Data.VectorSpace' instance. -- -- @ -- ('*') == ('Data.VectorSpace.*^')@@ -296,9 +280,14 @@ -- \"USD\" -- @ denseCurrency :: KnownSymbol currency => Dense currency -> T.Text-denseCurrency = T.pack . symbolVal+denseCurrency = T.pack . denseCurrency' {-# INLINE denseCurrency #-} +-- | Like 'denseCurrency' but returns 'String'.+denseCurrency' :: KnownSymbol currency => Dense currency -> String+denseCurrency' = symbolVal+{-# INLINE denseCurrency' #-}+ -- | 'Discrete' represents a discrete monetary value for a @currency@ expresed -- as an integer amount of a particular @unit@. For example, with @currency ~ -- \"USD\"@ and @unit ~ \"cent\"@ you can represent United States Dollars to@@ -363,9 +352,8 @@ -- 'discrete' 2 '*' 'discrete' 4 == 'discrete' 8 -- @ ----- In fact, if you compiled this library with support for--- 'Data.VectorSpace.VectorSpace', then '*' functions exactly as--- 'Data.VectorSpace.*^'.+-- In fact, '*' functions exactly as 'Data.VectorSpace.*^' from the+-- 'Data.VectorSpace' instance. -- -- @ -- ('*') == ('Data.VectorSpace.*^')@@ -450,13 +438,21 @@ -- \"USD\" -- @ discreteCurrency- :: forall currency scale- . (KnownSymbol currency, GoodScale scale)+ :: (KnownSymbol currency, GoodScale scale) => Discrete' currency scale -> T.Text -- ^-discreteCurrency = \_ -> T.pack (symbolVal (Proxy @ currency))+discreteCurrency = T.pack . discreteCurrency' {-# INLINE discreteCurrency #-} +-- | Like 'discreteCurrency' but returns 'String'.+discreteCurrency'+ :: forall currency scale+ . (KnownSymbol currency, GoodScale scale)+ => Discrete' currency scale+ -> String -- ^+discreteCurrency' = \_ -> symbolVal (Proxy @ currency)+{-# INLINE discreteCurrency' #-}+ -- | Method for approximating a fractional number to an integer number. data Approximation = Round@@ -783,9 +779,14 @@ -- | Currency name. someDenseCurrency :: SomeDense -> T.Text-someDenseCurrency = T.pack . _someDenseCurrency+someDenseCurrency = T.pack . someDenseCurrency' {-# INLINE someDenseCurrency #-} +-- | Like 'someDenseCurrency' but returns 'String'.+someDenseCurrency' :: SomeDense -> String+someDenseCurrency' = _someDenseCurrency+{-# INLINE someDenseCurrency' #-}+ -- | Currency unit amount. someDenseAmount :: SomeDense -> Rational someDenseAmount = _someDenseAmount@@ -880,9 +881,14 @@ -- | Currency name. someDiscreteCurrency :: SomeDiscrete -> T.Text-someDiscreteCurrency = T.pack . _someDiscreteCurrency+someDiscreteCurrency = T.pack . someDiscreteCurrency' {-# INLINE someDiscreteCurrency #-} +-- | Like 'someDiscreteCurrency' but returns 'String'.+someDiscreteCurrency' :: SomeDiscrete -> String+someDiscreteCurrency' = _someDiscreteCurrency+{-# INLINE someDiscreteCurrency' #-}+ -- | Positive, non-zero. someDiscreteScale :: SomeDiscrete -> Rational someDiscreteScale = _someDiscreteScale@@ -1012,14 +1018,24 @@ -- | Source currency name. someExchangeRateSrcCurrency :: SomeExchangeRate -> T.Text-someExchangeRateSrcCurrency = T.pack . _someExchangeRateSrcCurrency+someExchangeRateSrcCurrency = T.pack . someExchangeRateSrcCurrency' {-# INLINE someExchangeRateSrcCurrency #-} +-- | Like 'someExchangeRateSrcCurrency' but returns 'String'.+someExchangeRateSrcCurrency' :: SomeExchangeRate -> String+someExchangeRateSrcCurrency' = _someExchangeRateSrcCurrency+{-# INLINE someExchangeRateSrcCurrency' #-}+ -- | Destination currency name. someExchangeRateDstCurrency :: SomeExchangeRate -> T.Text someExchangeRateDstCurrency = T.pack . _someExchangeRateDstCurrency {-# INLINE someExchangeRateDstCurrency #-} +-- | Like 'someExchangeRateDstCurrency' but returns 'String'.+someExchangeRateDstCurrency' :: SomeExchangeRate -> String+someExchangeRateDstCurrency' = _someExchangeRateDstCurrency+{-# INLINE someExchangeRateDstCurrency' #-}+ -- | Exchange rate. Positive, non-zero. someExchangeRateRate :: SomeExchangeRate -> Rational someExchangeRateRate = _someExchangeRateRate@@ -1103,7 +1119,6 @@ -------------------------------------------------------------------------------- -- vector-space instances -#ifdef HAS_vector_space instance AG.AdditiveGroup (Dense currency) where zeroV = Dense AG.zeroV {-# INLINE zeroV #-}@@ -1137,11 +1152,9 @@ type Scalar (Discrete' currency scale) = Integer s *^ Discrete a = Discrete $! (s VS.*^ a) {-# INLINE (*^) #-}-#endif -------------------------------------------------------------------------------- -- Extra instances: hashable-#ifdef HAS_hashable instance Hashable Approximation instance Hashable (Dense currency) instance Hashable SomeDense@@ -1149,7 +1162,6 @@ instance Hashable SomeDiscrete instance Hashable (ExchangeRate src dst) instance Hashable SomeExchangeRate-#endif -------------------------------------------------------------------------------- -- Extra instances: deepseq@@ -1162,76 +1174,6 @@ instance NFData SomeExchangeRate ----------------------------------------------------------------------------------- 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- -- We go through String for backwards compatibility.- Cereal.put c- Cereal.put (numerator r)- Cereal.put (denominator r)- Cereal.put a- get = maybe empty pure =<< do- -- We go through String for backwards compatibility.- 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- -- We go through String for backwards compatibility.- Cereal.put src- Cereal.put dst- Cereal.put (numerator r)- Cereal.put (denominator r)- get = maybe empty pure =<< do- -- We go through String for backwards compatibility.- 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 -- | Compatible with 'SomeDense'.@@ -1298,392 +1240,6 @@ pure (mkSomeExchangeRate' src dst (n % d)) ----------------------------------------------------------------------------------- Extra instances: serialise-#ifdef HAS_serialise--- | Compatible with 'SomeDense'.-instance (KnownSymbol currency) => Ser.Serialise (Dense currency) where- encode = Ser.encode . toSomeDense- decode = maybe (fail "Dense") pure =<< fmap fromSomeDense Ser.decode---- | Compatible with 'SomeDiscrete'.-instance- ( KnownSymbol currency, GoodScale scale- ) => Ser.Serialise (Discrete' currency scale) where- encode = Ser.encode . toSomeDiscrete- decode = maybe (fail "Discrete'") pure =<< fmap fromSomeDiscrete Ser.decode---- | Compatible with 'SomeExchangeRate'.-instance- ( KnownSymbol src, KnownSymbol dst- ) => Ser.Serialise (ExchangeRate src dst) where- encode = Ser.encode . toSomeExchangeRate- decode = maybe (fail "ExchangeRate") pure- =<< fmap fromSomeExchangeRate Ser.decode---- | Compatible with 'Dense'.-instance Ser.Serialise SomeDense where- encode = \(SomeDense c r) ->- Ser.encode c <>- Ser.encode (numerator r) <>- Ser.encode (denominator r)- decode = maybe (fail "SomeDense") pure =<< do- c :: String <- Ser.decode- n :: Integer <- Ser.decode- d :: Integer <- Ser.decode- when (d == 0) (fail "denominator is zero")- pure (mkSomeDense' c (n % d))---- | Compatible with 'Discrete'.-instance Ser.Serialise SomeDiscrete where- encode = \(SomeDiscrete c r a) ->- Ser.encode c <>- Ser.encode (numerator r) <>- Ser.encode (denominator r) <>- Ser.encode a- decode = maybe (fail "SomeDiscrete") pure =<< do- c :: String <- Ser.decode- n :: Integer <- Ser.decode- d :: Integer <- Ser.decode- when (d == 0) (fail "denominator is zero")- a :: Integer <- Ser.decode- pure (mkSomeDiscrete' c (n % d) a)---- | Compatible with 'ExchangeRate'.-instance Ser.Serialise SomeExchangeRate where- encode = \(SomeExchangeRate src dst r) ->- Ser.encode src <>- Ser.encode dst <>- Ser.encode (numerator r) <>- Ser.encode (denominator r)- decode = maybe (fail "SomeExchangeRate") pure =<< do- src :: String <- Ser.decode- dst :: String <- Ser.decode- n :: Integer <- Ser.decode- d :: Integer <- Ser.decode- when (d == 0) (fail "denominator is zero")- pure (mkSomeExchangeRate' src dst (n % d))-#endif------------------------------------------------------------------------------------- Extra instances: aeson-#ifdef HAS_aeson--- | Compatible with 'SomeDense'------ Example rendering @'dense'' (2 '%' 3) :: 'Dense' \"BTC\"@:------ @--- [\"BTC\", 2, 3]--- @------ Note: The JSON serialization changed in version 0.4 (the leading @"Dense"@--- string was dropped from the rendered 'Ae.Array').-instance KnownSymbol currency => Ae.ToJSON (Dense currency) where- toJSON = Ae.toJSON . toSomeDense---- | Compatible with 'SomeDense'------ Note: The JSON serialization changed in version 0.4. However, this instance--- is still able to cope with the previous format.-instance KnownSymbol currency => Ae.FromJSON (Dense currency) where- parseJSON = maybe empty pure <=< fmap fromSomeDense . Ae.parseJSON---- | Compatible with 'Dense'------ Note: The JSON serialization changed in version 0.4 (the leading @"Dense"@--- string was dropped from the rendered 'Ae.Array').-instance Ae.ToJSON SomeDense where- toJSON = \(SomeDense c r) ->- Ae.toJSON (c, numerator r, denominator r)---- | Compatible with 'Dense'.------ Note: The JSON serialization changed in version 0.4. However, this instance--- is still able to cope with the previous format.-instance Ae.FromJSON SomeDense where- parseJSON = \v -> do- (c, n, d) <- Ae.parseJSON v <|> do- -- Pre 0.4 format.- ("Dense" :: String, c, n, d) <- Ae.parseJSON v- pure (c, n, d)- when (d == 0) (fail "denominator is zero")- maybe empty pure (mkSomeDense' c (n % d))---- | Compatible with 'SomeDiscrete'------ Example rendering @'discrete' 43 :: 'Discrete' \"BTC\" \"satoshi\"@:------ @--- [\"BTC\", 100000000, 1, 43]--- @------ Note: The JSON serialization changed in version 0.4 (the leading @"Discrete"@--- string was dropped from the rendered 'Ae.Array').-instance- ( KnownSymbol currency, GoodScale scale- ) => Ae.ToJSON (Discrete' currency scale) where- toJSON = Ae.toJSON . toSomeDiscrete---- | Compatible with 'SomeDiscrete'------ Note: The JSON serialization changed in version 0.4. However, this instance--- is still able to cope with the previous format.-instance- ( KnownSymbol currency, GoodScale scale- ) => Ae.FromJSON (Discrete' currency scale) where- parseJSON = maybe empty pure <=< fmap fromSomeDiscrete . Ae.parseJSON---- | Compatible with 'Discrete''------ Note: The JSON serialization changed in version 0.4 (the leading @"Discrete"@--- string was dropped from the rendered 'Ae.Array').-instance Ae.ToJSON SomeDiscrete where- toJSON = \(SomeDiscrete c r a) ->- Ae.toJSON (c, numerator r, denominator r, a)---- | Compatible with 'Discrete''------ Note: The JSON serialization changed in version 0.4. However, this instance--- is still able to cope with the previous format.-instance Ae.FromJSON SomeDiscrete where- parseJSON = \v -> do- (c, n, d, a) <- Ae.parseJSON v <|> do- -- Pre 0.4 format.- ("Discrete" :: T.Text, c, n, d, a) <- Ae.parseJSON v- pure (c, n, d, a)- when (d == 0) (fail "denominator is zero")- maybe empty pure (mkSomeDiscrete c (n % d) a)---- | Compatible with 'SomeExchangeRate'------ Example rendering an 'ExchangeRate' constructed with--- @'exchangeRate' (5 '%' 7) :: 'ExchangeRate' \"USD\" \"JPY\"@------ @--- [\"USD\", \"JPY\", 5, 7]--- @------ Note: The JSON serialization changed in version 0.4 (the leading--- @"ExchangeRate"@ string was dropped from the rendered 'Ae.Array').-instance- ( KnownSymbol src, KnownSymbol dst- ) => Ae.ToJSON (ExchangeRate src dst) where- toJSON = Ae.toJSON . toSomeExchangeRate---- | Compatible with 'SomeExchangeRate'------ Note: The JSON serialization changed in version 0.4. However, this instance--- is still able to cope with the previous format.-instance- ( KnownSymbol src, KnownSymbol dst- ) => Ae.FromJSON (ExchangeRate src dst) where- parseJSON = maybe empty pure <=< fmap fromSomeExchangeRate . Ae.parseJSON---- | Compatible with 'ExchangeRate'------ Note: The JSON serialization changed in version 0.4 (the leading--- @"ExchangeRate"@ string was dropped from the rendered 'Ae.Array').-instance Ae.ToJSON SomeExchangeRate where- toJSON = \(SomeExchangeRate src dst r) ->- Ae.toJSON (src, dst, numerator r, denominator r)---- | Compatible with 'ExchangeRate'------ Note: The JSON serialization changed in version 0.4. However, this instance--- is still able to cope with the previous format.-instance Ae.FromJSON SomeExchangeRate where- parseJSON = \v -> do- (src, dst, n, d) <- Ae.parseJSON v <|> do- -- Pre 0.4 format.- ("ExchangeRate" :: T.Text, src, dst, n, d) <- Ae.parseJSON v- pure (src, dst, n, d)- when (d == 0) (fail "denominator is zero")- maybe empty pure (mkSomeExchangeRate src dst (n % d))-#endif------------------------------------------------------------------------------------- Extra instances: xmlbf-#ifdef HAS_xmlbf---- | Compatible with 'SomeDense'------ Example rendering @'dense' (2 '%' 3) :: 'Dense' \"BTC\"@:------ @--- \<money-dense c=\"BTC\" n=\"2\" d=\"3\"/>--- @-instance KnownSymbol currency => Xmlbf.ToXml (Dense currency) where- toXml = Xmlbf.toXml . toSomeDense---- | Compatible with 'SomeDense'-instance KnownSymbol currency => Xmlbf.FromXml (Dense currency) where- fromXml = maybe empty pure =<< fmap fromSomeDense Xmlbf.fromXml---- | Compatible with 'Dense'-instance Xmlbf.ToXml SomeDense where- toXml = \(SomeDense c r) ->- let as = [ (T.pack "c", T.pack c)- , (T.pack "n", T.pack (show (numerator r)))- , (T.pack "d", T.pack (show (denominator r))) ]- in [ Xmlbf.element' (T.pack "money-dense") (fromList as) [] ]---- | Compatible with 'Dense'.-instance Xmlbf.FromXml SomeDense where- fromXml = Xmlbf.pElement (T.pack "money-dense") $ do- c <- Xmlbf.pAttr "c"- n <- Xmlbf.pRead =<< Xmlbf.pAttr "n"- d <- Xmlbf.pRead =<< Xmlbf.pAttr "d"- when (d == 0) (fail "denominator is zero")- maybe empty pure (mkSomeDense c (n % d))---- | Compatible with 'SomeDiscrete'------ Example rendering @'discrete' 43 :: 'Discrete' \"BTC\" \"satoshi\"@:------ @--- \<money-discrete c=\"BTC\" n=\"100000000\" d=\"1\" a=\"43\"/>--- @-instance- ( KnownSymbol currency, GoodScale scale- ) => Xmlbf.ToXml (Discrete' currency scale) where- toXml = Xmlbf.toXml . toSomeDiscrete---- | Compatible with 'SomeDiscrete'-instance- ( KnownSymbol currency, GoodScale scale- ) => Xmlbf.FromXml (Discrete' currency scale) where- fromXml = maybe empty pure =<< fmap fromSomeDiscrete Xmlbf.fromXml---- | Compatible with 'Discrete''-instance Xmlbf.ToXml SomeDiscrete where- toXml = \(SomeDiscrete c r a) ->- let as = [ ("c", T.pack c)- , ("n", T.pack (show (numerator r)))- , ("d", T.pack (show (denominator r)))- , ("a", T.pack (show a)) ]- in [ Xmlbf.element' (T.pack "money-discrete") (fromList as) [] ]---- | Compatible with 'Discrete''-instance Xmlbf.FromXml SomeDiscrete where- fromXml = Xmlbf.pElement (T.pack "money-discrete") $ do- c <- Xmlbf.pAttr "c"- n <- Xmlbf.pRead =<< Xmlbf.pAttr "n"- d <- Xmlbf.pRead =<< Xmlbf.pAttr "d"- when (d == 0) (fail "denominator is zero")- a <- Xmlbf.pRead =<< Xmlbf.pAttr "a"- maybe empty pure (mkSomeDiscrete c (n % d) a)---- | Compatible with 'SomeExchangeRate'------ Example rendering an 'ExchangeRate' constructed with--- @'exchangeRate' (5 '%' 7) :: 'ExchangeRate' \"USD\" \"JPY\"@------ @--- \<exchange-rate src=\"USD\" dst=\"JPY\" n=\"5\" d=\"7\"/>--- @-instance- ( KnownSymbol src, KnownSymbol dst- ) => Xmlbf.ToXml (ExchangeRate src dst) where- toXml = Xmlbf.toXml . toSomeExchangeRate---- | Compatible with 'SomeExchangeRate'-instance- ( KnownSymbol src, KnownSymbol dst- ) => Xmlbf.FromXml (ExchangeRate src dst) where- fromXml = maybe empty pure =<< fmap fromSomeExchangeRate Xmlbf.fromXml---- | Compatible with 'ExchangeRate'-instance Xmlbf.ToXml SomeExchangeRate where- toXml = \(SomeExchangeRate src dst r) ->- let as = [ ("src", T.pack src)- , ("dst", T.pack dst)- , ("n", T.pack (show (numerator r)))- , ("d", T.pack (show (denominator r))) ]- in [ Xmlbf.element' (T.pack "exchange-rate") (fromList as) [] ]---- | Compatible with 'ExchangeRate'-instance Xmlbf.FromXml SomeExchangeRate where- fromXml = Xmlbf.pElement (T.pack "exchange-rate") $ do- src <- Xmlbf.pAttr "src"- dst <- 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- -- We go through String for backwards compatibility.- 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 :: String <- Store.peek- dst :: String <- Store.peek- n :: Integer <- Store.peek- d :: Integer <- Store.peek- when (d == 0) (fail "denominator is zero")- pure (mkSomeExchangeRate' src dst (n % d))--storeContramapSize :: (a -> b) -> Store.Size b -> Store.Size a-storeContramapSize f = \case- Store.VarSize g -> Store.VarSize (g . f)- Store.ConstSize x -> Store.ConstSize x-{-# INLINABLE storeContramapSize #-}-#endif---------------------------------------------------------------------------------- -- Decimal rendering -- | Render a 'Dense' monetary amount as a decimal number in a potentially lossy@@ -2065,3 +1621,51 @@ Nothing -> fromInteger (read ipart) Just fpart -> read (ipart <> fpart) % (10 ^ length fpart) +--------------------------------------------------------------------------------+-- QuickCheck Arbitrary instances++instance+ ( GoodScale scale+ ) => QC.Arbitrary (Discrete' currency scale) where+ arbitrary = fmap fromInteger QC.arbitrary+ shrink = fmap fromInteger . QC.shrink . toInteger++instance QC.Arbitrary SomeDiscrete where+ arbitrary = do+ let md = mkSomeDiscrete+ <$> fmap T.pack QC.arbitrary+ <*> QC.arbitrary+ <*> QC.arbitrary+ fromJust <$> QC.suchThat md isJust+ shrink = \x -> withSomeDiscrete x (map toSomeDiscrete . QC.shrink)++instance QC.Arbitrary (Dense currency) where+ arbitrary = do+ let myd = fmap dense QC.arbitrary+ fromJust <$> QC.suchThat myd isJust+ shrink = catMaybes . map dense . QC.shrink . toRational++instance QC.Arbitrary SomeDense where+ arbitrary = do+ let md = mkSomeDense <$> fmap T.pack QC.arbitrary <*> QC.arbitrary+ fromJust <$> QC.suchThat md isJust+ shrink = \x -> withSomeDense x (map toSomeDense . QC.shrink)++instance QC.Arbitrary (ExchangeRate src dst) where+ arbitrary = do+ let myxr = fmap exchangeRate QC.arbitrary+ fromJust <$> QC.suchThat myxr isJust+ shrink = catMaybes . map exchangeRate+ . QC.shrink . exchangeRateToRational++instance QC.Arbitrary SomeExchangeRate where+ arbitrary = do+ let md = mkSomeExchangeRate+ <$> fmap T.pack QC.arbitrary+ <*> fmap T.pack QC.arbitrary+ <*> QC.arbitrary+ fromJust <$> QC.suchThat md isJust+ shrink = \x -> withSomeExchangeRate x (map toSomeExchangeRate . QC.shrink)++instance QC.Arbitrary Approximation where+ arbitrary = QC.oneof [ pure Round, pure Floor, pure Ceiling, pure Truncate ]
test/Main.hs view
@@ -12,6 +12,7 @@ import Control.Category (Category((.), id)) import Control.DeepSeq (rnf)+import qualified Data.AdditiveGroup as AG import qualified Data.Binary as Binary import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL@@ -20,6 +21,7 @@ import Data.Proxy (Proxy(Proxy)) import Data.Ratio ((%), numerator, denominator) import qualified Data.Text as T+import qualified Data.VectorSpace as VS import Data.Word (Word8) import GHC.Exts (fromList) import GHC.TypeLits (Nat, Symbol, KnownSymbol, symbolVal)@@ -31,87 +33,14 @@ import Test.Tasty.QuickCheck ((===), (==>), (.&&.)) import qualified Test.Tasty.QuickCheck as QC -#ifdef HAS_aeson-import qualified Data.Aeson as Ae-#endif -#ifdef HAS_cereal-import qualified Data.Serialize as Cereal-#endif--#ifdef HAS_serialise-import qualified Codec.Serialise as Ser-#endif--#ifdef HAS_store-import qualified Data.Store as Store-#endif--#ifdef HAS_vector_space-import qualified Data.AdditiveGroup as AG-import qualified Data.VectorSpace as VS-#endif--#ifdef HAS_xmlbf-import qualified Xmlbf-#endif- import qualified Money-import qualified Money.Internal as Money+import qualified Money.Internal as MoneyI (rationalFromDecimal, rationalToDecimal) -------------------------------------------------------------------------------- -instance- ( Money.GoodScale scale- ) => QC.Arbitrary (Money.Discrete' currency scale) where- arbitrary = fmap fromInteger QC.arbitrary- shrink = fmap fromInteger . QC.shrink . toInteger--instance QC.Arbitrary Money.SomeDiscrete where- arbitrary = do- let md = Money.mkSomeDiscrete- <$> QC.arbitrary <*> QC.arbitrary <*> QC.arbitrary- fromJust <$> QC.suchThat md isJust- shrink = \x -> Money.withSomeDiscrete x (map Money.toSomeDiscrete . QC.shrink)--instance QC.Arbitrary (Money.Dense currency) where- arbitrary = do- let myd = fmap Money.dense QC.arbitrary- fromJust <$> QC.suchThat myd isJust- shrink = catMaybes . map Money.dense . QC.shrink . toRational--instance QC.Arbitrary Money.SomeDense where- arbitrary = do- let md = Money.mkSomeDense <$> QC.arbitrary <*> QC.arbitrary- fromJust <$> QC.suchThat md isJust- shrink = \x -> Money.withSomeDense x (map Money.toSomeDense . QC.shrink)--instance QC.Arbitrary (Money.ExchangeRate src dst) where- arbitrary = do- let myxr = fmap Money.exchangeRate QC.arbitrary- fromJust <$> QC.suchThat myxr isJust- shrink = catMaybes . map Money.exchangeRate- . QC.shrink . Money.exchangeRateToRational--instance QC.Arbitrary Money.SomeExchangeRate where- arbitrary = do- let md = Money.mkSomeExchangeRate- <$> QC.arbitrary <*> QC.arbitrary <*> QC.arbitrary- fromJust <$> QC.suchThat md isJust- shrink = \x ->- Money.withSomeExchangeRate x (map Money.toSomeExchangeRate . QC.shrink)--instance QC.Arbitrary Money.Approximation where- arbitrary = QC.oneof [ pure Money.Round- , pure Money.Floor- , pure Money.Ceiling- , pure Money.Truncate ]--instance QC.Arbitrary T.Text where- arbitrary = T.pack <$> QC.arbitrary---- | Generates a valid 'Money.rationalToDecimal' result. Returns the thousand+-- | Generates a valid 'MoneyI.rationalToDecimal' result. Returns the thousand -- and decimal separators as welland decimal separators as well. genDecimal :: QC.Gen (T.Text, Maybe Char, Char) genDecimal = do@@ -120,7 +49,7 @@ digs :: Word8 <- QC.arbitrary r :: Rational <- (%) <$> QC.arbitrary <*> QC.suchThat QC.arbitrary (/= 0) (yts, ds) <- genDecimalSeps- Just dec <- pure (Money.rationalToDecimal aprox plus yts ds digs r)+ Just dec <- pure (MoneyI.rationalToDecimal aprox plus yts ds digs r) pure (dec, yts, ds) -- | Generates valid separators for decimal representations (see genDecimal).@@ -406,14 +335,14 @@ render :: Money.Approximation -> Rational -> [T.Text] render a r =- [ fromJust $ Money.rationalToDecimal a False Nothing '.' 2 r -- 0- , fromJust $ Money.rationalToDecimal a False (Just ',') '.' 2 r -- 1- , fromJust $ Money.rationalToDecimal a True Nothing '.' 2 r -- 2- , fromJust $ Money.rationalToDecimal a True (Just ',') '.' 2 r -- 3- , fromJust $ Money.rationalToDecimal a False Nothing '.' 0 r -- 8- , fromJust $ Money.rationalToDecimal a False (Just ',') '.' 0 r -- 9- , fromJust $ Money.rationalToDecimal a True Nothing '.' 0 r -- 10- , fromJust $ Money.rationalToDecimal a True (Just ',') '.' 0 r -- 11+ [ fromJust $ MoneyI.rationalToDecimal a False Nothing '.' 2 r -- 0+ , fromJust $ MoneyI.rationalToDecimal a False (Just ',') '.' 2 r -- 1+ , fromJust $ MoneyI.rationalToDecimal a True Nothing '.' 2 r -- 2+ , fromJust $ MoneyI.rationalToDecimal a True (Just ',') '.' 2 r -- 3+ , fromJust $ MoneyI.rationalToDecimal a False Nothing '.' 0 r -- 8+ , fromJust $ MoneyI.rationalToDecimal a False (Just ',') '.' 0 r -- 9+ , fromJust $ MoneyI.rationalToDecimal a True Nothing '.' 0 r -- 10+ , fromJust $ MoneyI.rationalToDecimal a True (Just ',') '.' 0 r -- 11 ] testRationalFromDecimal :: Tasty.TestTree@@ -424,7 +353,7 @@ mgoodsep :: QC.Gen Char = QC.suchThat QC.arbitrary (not . Char.isDigit) in QC.forAll ((,,) <$> mbadsep <*> mbadsep <*> mgoodsep) $ \(s1 :: Char, s2 :: Char, s3 :: Char) ->- let f = Money.rationalFromDecimal+ let f = MoneyI.rationalFromDecimal in (f Nothing s1 (error "untouched") === Nothing) .&&. (f (Just s1) s2 (error "untouched") === Nothing) .&&. (f (Just s1) s1 (error "untouched") === Nothing) .&&.@@ -438,8 +367,8 @@ in QC.forAll gen $ \( (yst :: Maybe Char, sd :: Char) , (r :: Rational, plus :: Bool, digs :: Word8, aprox :: Money.Approximation) ) ->- let Just dec = Money.rationalToDecimal aprox plus yst sd digs r- Just r' = Money.rationalFromDecimal yst sd dec+ let Just dec = MoneyI.rationalToDecimal aprox plus yst sd digs r+ Just r' = MoneyI.rationalFromDecimal yst sd dec in 1 > abs (abs r - abs r') ] @@ -489,19 +418,19 @@ digs :: Word8, aprox :: Money.Approximation) ) -> let ydnsd1 = Money.denseToDecimal aprox plus yst sd digs 1 dns ydnsd100 = Money.denseToDecimal aprox plus yst sd digs 100 dns- yrd1 = Money.rationalToDecimal aprox plus yst sd digs (toRational dns)- yrd100 = Money.rationalToDecimal aprox plus yst sd digs (toRational dns * 100)+ yrd1 = MoneyI.rationalToDecimal aprox plus yst sd digs (toRational dns)+ yrd100 = MoneyI.rationalToDecimal aprox plus yst sd digs (toRational dns * 100) in (ydnsd1 === yrd1) .&&. (ydnsd100 === yrd100) , QC.testProperty "denseFromDecimal: Same as rationalFromDecimal" $ QC.forAll genDecimal $ \(dec :: T.Text, yts :: Maybe Char, ds :: Char) ->- let Just r = Money.rationalFromDecimal yts ds dec+ let Just r = MoneyI.rationalFromDecimal yts ds dec Just dns = Money.denseFromDecimal yts ds 1 dec in r === toRational (dns :: Money.Dense currency) , QC.testProperty "denseFromDecimal: Same as rationalFromDecimal" $ QC.forAll genDecimal $ \(dec :: T.Text, yts :: Maybe Char, ds :: Char) ->- let Just r = Money.rationalFromDecimal yts ds dec+ let Just r = MoneyI.rationalFromDecimal yts ds dec Just dns = Money.denseFromDecimal yts ds 1 dec in r === toRational (dns :: Money.Dense currency) @@ -520,7 +449,6 @@ Just dns' = Money.denseFromDecimal yst sd sc dec in Money.dense' 1 > abs (abs dns - abs dns') -#ifdef HAS_vector_space , HU.testCase "AdditiveGroup: zeroV" $ (AG.zeroV :: Money.Dense currency) @?= Money.dense' (0%1) , QC.testProperty "AdditiveGroup: negateV" $@@ -536,32 +464,7 @@ QC.forAll QC.arbitrary $ \(x :: Money.Dense currency, y) -> (toRational x VS.*^ y === x * y) .&&. (toRational y VS.*^ x === x * y)-#endif -#ifdef HAS_aeson- , QC.testProperty "Aeson encoding roundtrip" $- QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->- Just x === Ae.decode (Ae.encode x)- , QC.testProperty "Aeson encoding roundtrip (SomeDense)" $- QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->- let x' = Money.toSomeDense x- in Just x' === Ae.decode (Ae.encode x')- , QC.testProperty "Aeson encoding roundtrip (Dense through SomeDense)" $- QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->- 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.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 = T.unpack (Money.someDenseCurrency sx)- r = Money.someDenseAmount sx- bs = Ae.encode ("Dense" :: String, c, numerator r, denominator r)- in (Just x === Ae.decode bs) .&&.- (Just sx === Ae.decode bs)-#endif- , QC.testProperty "Binary encoding roundtrip" $ QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) -> let Right (_,_,y) = Binary.decodeOrFail (Binary.encode x)@@ -581,70 +484,6 @@ let x' = Money.toSomeDense x bs = Binary.encode x in Right (mempty, BL.length bs, x') === Binary.decodeOrFail bs--#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 (SomeDense)" $- QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->- let x' = Money.toSomeDense x- in Right x' === Cereal.decode (Cereal.encode x')- , QC.testProperty "Cereal encoding roundtrip (Dense through SomeDense)" $- QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->- 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.toSomeDense x) === Cereal.decode (Cereal.encode x)-#endif--#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 (SomeDense)" $- QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->- let x' = Money.toSomeDense x- in Right x' === Store.decode (Store.encode x')- , QC.testProperty "Store encoding roundtrip (Dense through SomeDense)" $- QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->- 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.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@@ -728,7 +567,6 @@ ydec' = Money.denseToDecimal aprox plus yst sd digs sc dns in ydec === ydec' -#ifdef HAS_vector_space , HU.testCase "AdditiveGroup: zeroV" $ (AG.zeroV :: Money.Discrete currency unit) @?= Money.discrete 0 , QC.testProperty "AdditiveGroup: negateV" $@@ -744,33 +582,7 @@ QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit, y) -> (toInteger x VS.*^ y === x * y) .&&. (toInteger y VS.*^ x === x * y)-#endif -#ifdef HAS_aeson- , QC.testProperty "Aeson encoding roundtrip" $- QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->- Just x === Ae.decode (Ae.encode x)- , QC.testProperty "Aeson encoding roundtrip (SomeDiscrete)" $- QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->- let x' = Money.toSomeDiscrete x- in Just x' === Ae.decode (Ae.encode x')- , QC.testProperty "Aeson encoding roundtrip (Discrete through SomeDiscrete)" $- QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->- 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.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 = T.unpack (Money.someDiscreteCurrency sx)- r = Money.someDiscreteScale sx- a = Money.someDiscreteAmount sx- bs = Ae.encode ("Discrete" :: String, c, numerator r, denominator r, a)- in (Just x === Ae.decode bs) .&&.- (Just sx === Ae.decode bs)-#endif- , QC.testProperty "Binary encoding roundtrip" $ QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) -> let Right (_,_,y) = Binary.decodeOrFail (Binary.encode x)@@ -790,70 +602,6 @@ let x' = Money.toSomeDiscrete x bs = Binary.encode x in Right (mempty, BL.length bs, x') === Binary.decodeOrFail bs--#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 (SomeDiscrete)" $- QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->- let x' = Money.toSomeDiscrete x- in Right x' === Cereal.decode (Cereal.encode x')- , QC.testProperty "Cereal encoding roundtrip (Discrete through SomeDiscrete)" $- QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->- 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.toSomeDiscrete x) === Cereal.decode (Cereal.encode x)-#endif--#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 (SomeDiscrete)" $- QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->- let x' = Money.toSomeDiscrete x- in Right x' === Store.decode (Store.encode x')- , QC.testProperty "Store encoding roundtrip (Discrete through SomeDiscrete)" $- QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->- 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.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@@ -931,42 +679,17 @@ , (xr :: Money.ExchangeRate src dst, digs :: Word8, aprox :: Money.Approximation ) ) -> let xrd = Money.exchangeRateToDecimal aprox yst sd digs xr- rd = Money.rationalToDecimal aprox False yst sd digs+ rd = MoneyI.rationalToDecimal aprox False yst sd digs (Money.exchangeRateToRational xr) in xrd === rd , QC.testProperty "exchangeRateFromDecimal: Same as rationalFromDecimal" $ QC.forAll genDecimal $ \(dec :: T.Text, yts :: Maybe Char, ds :: Char) ->- let Just r = Money.rationalFromDecimal yts ds dec+ let Just r = MoneyI.rationalFromDecimal yts ds dec yxr = Money.exchangeRateFromDecimal yts ds dec :: Maybe (Money.ExchangeRate src dst) in (r > 0) ==> (Just r === fmap Money.exchangeRateToRational yxr) -#ifdef HAS_aeson- , QC.testProperty "Aeson encoding roundtrip" $- QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->- Just x === Ae.decode (Ae.encode x)- , QC.testProperty "Aeson encoding roundtrip (SomeExchangeRate)" $- QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->- let x' = Money.toSomeExchangeRate x- in Just x' === Ae.decode (Ae.encode x')- , QC.testProperty "Aeson encoding roundtrip (ExchangeRate through SomeExchangeRate)" $- QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->- 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.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 = T.unpack (Money.someExchangeRateSrcCurrency sx)- dst = T.unpack (Money.someExchangeRateDstCurrency sx)- r = Money.someExchangeRateRate sx- bs = Ae.encode ("ExchangeRate" :: String, src, dst, numerator r, denominator r)- in (Just x === Ae.decode bs) .&&.- (Just sx === Ae.decode bs)-#endif- , QC.testProperty "Binary encoding roundtrip" $ QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) -> let Right (_,_,y) = Binary.decodeOrFail (Binary.encode x)@@ -986,70 +709,6 @@ let x' = Money.toSomeExchangeRate x bs = Binary.encode x in Right (mempty, BL.length bs, x') === Binary.decodeOrFail bs--#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 (SomeExchangeRate)" $- QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->- let x' = Money.toSomeExchangeRate x- in Right x' === Cereal.decode (Cereal.encode x')- , QC.testProperty "Cereal encoding roundtrip (ExchangeRate through SomeExchangeRate)" $- QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->- 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.toSomeExchangeRate x) === Cereal.decode (Cereal.encode x)-#endif--#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 (SomeExchangeRate)" $- QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->- let x' = Money.toSomeExchangeRate x- in Right x' === Store.decode (Store.encode x')- , QC.testProperty "Store encoding roundtrip (ExchangeRate through SomeExchangeRate)" $- QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->- 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.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 ] @@ -1159,99 +818,6 @@ , HU.testCase "ExchangeRate" $ rawXr0_binary @=? Binary.encode rawXr0 ] ]--#ifdef HAS_aeson- , Tasty.testGroup "aeson"- [ Tasty.testGroup "decode"- [ HU.testCase "Dense" $ Just rawDns0 @=? Ae.decode rawDns0_aeson- , HU.testCase "Discrete" $ Just rawDis0 @=? Ae.decode rawDis0_aeson- , HU.testCase "ExchangeRate" $ Just rawXr0 @=? Ae.decode rawXr0_aeson- ]- , Tasty.testGroup "decode (pre-0.4)"- [ HU.testCase "Dense" $ Just rawDns0 @=? Ae.decode rawDns0_aeson_pre04- , HU.testCase "Discrete" $ Just rawDis0 @=? Ae.decode rawDis0_aeson_pre04- , HU.testCase "ExchangeRate" $ Just rawXr0 @=? Ae.decode rawXr0_aeson_pre04- ]- , Tasty.testGroup "encode"- [ HU.testCase "Dense" $ rawDns0_aeson @=? Ae.encode rawDns0- , HU.testCase "Discrete" $ rawDis0_aeson @=? Ae.encode rawDis0- , HU.testCase "ExchangeRate" $ rawXr0_aeson @=? Ae.encode rawXr0- ]- ]-#endif--#ifdef HAS_serialise- , Tasty.testGroup "serialise"- [ Tasty.testGroup "decode"- [ HU.testCase "Dense" $ do- Just rawDns0 @=? hush (Ser.deserialiseOrFail rawDns0_serialise)- , HU.testCase "Discrete" $ do- Just rawDis0 @=? hush (Ser.deserialiseOrFail rawDis0_serialise)- , HU.testCase "ExchangeRate" $ do- Just rawXr0 @=? hush (Ser.deserialiseOrFail rawXr0_serialise)- ]- , Tasty.testGroup "encode"- [ HU.testCase "Dense" $ rawDns0_serialise @=? Ser.serialise rawDns0- , HU.testCase "Discrete" $ rawDis0_serialise @=? Ser.serialise rawDis0- , HU.testCase "ExchangeRate" $ rawXr0_serialise @=? Ser.serialise rawXr0- ]- ]-#endif--#ifdef HAS_cereal- , Tasty.testGroup "cereal"- [ Tasty.testGroup "decode"- [ HU.testCase "Dense" $ do- Right rawDns0 @=? Cereal.decode rawDns0_cereal- , HU.testCase "Discrete" $ do- Right rawDis0 @=? Cereal.decode rawDis0_cereal- , HU.testCase "ExchangeRate" $ do- Right rawXr0 @=? Cereal.decode rawXr0_cereal- ]- , Tasty.testGroup "encode"- [ HU.testCase "Dense" $ rawDns0_cereal @=? Cereal.encode rawDns0- , HU.testCase "Discrete" $ rawDis0_cereal @=? Cereal.encode rawDis0- , HU.testCase "ExchangeRate" $ rawXr0_cereal @=? Cereal.encode rawXr0- ]- ]--#endif--#ifdef HAS_store- , Tasty.testGroup "store"- [ Tasty.testGroup "decode"- [ HU.testCase "Dense" $ do- Right rawDns0 @=? Store.decode rawDns0_store- , HU.testCase "Discrete" $ do- Right rawDis0 @=? Store.decode rawDis0_store- , HU.testCase "ExchangeRate" $ do- Right rawXr0 @=? Store.decode rawXr0_store- ]- , Tasty.testGroup "encode"- [ HU.testCase "Dense" $ rawDns0_store @=? Store.encode rawDns0- , HU.testCase "Discrete" $ rawDis0_store @=? Store.encode rawDis0- , HU.testCase "ExchangeRate" $ rawXr0_store @=? Store.encode rawXr0- ]- ]-#endif--#ifdef HAS_xmlbf- , Tasty.testGroup "xmlbf"- [ Tasty.testGroup "decode"- [ HU.testCase "Dense" $ do- Right rawDns0 @=? Xmlbf.runParser Xmlbf.fromXml rawDns0_xmlbf- , HU.testCase "Discrete" $ do- Right rawDis0 @=? Xmlbf.runParser Xmlbf.fromXml rawDis0_xmlbf- , HU.testCase "ExchangeRate" $ do- Right rawXr0 @=? Xmlbf.runParser Xmlbf.fromXml rawXr0_xmlbf- ]- , Tasty.testGroup "encode"- [ HU.testCase "Dense" $ rawDns0_xmlbf @=? Xmlbf.toXml rawDns0- , HU.testCase "Discrete" $ rawDis0_xmlbf @=? Xmlbf.toXml rawDis0- , HU.testCase "ExchangeRate" $ rawXr0_xmlbf @=? Xmlbf.toXml rawXr0- ]- ]-#endif ] rawDns0 :: Money.Dense "USD"@@ -1270,66 +836,6 @@ rawDis0_binary = "\NUL\NUL\NUL\NUL\NUL\NUL\NUL\ETXUSD\NUL\NUL\NUL\NULd\NUL\NUL\NUL\NUL\SOH\NUL\NUL\NUL\NUL\EOT" rawXr0_binary :: BL.ByteString rawXr0_binary = "\NUL\NUL\NUL\NUL\NUL\NUL\NUL\ETXUSD\NUL\NUL\NUL\NUL\NUL\NUL\NUL\ETXBTC\NUL\NUL\NUL\NUL\ETX\NUL\NUL\NUL\NUL\STX"--#ifdef HAS_aeson-rawDns0_aeson :: BL.ByteString-rawDns0_aeson = "[\"USD\",26,1]"-rawDis0_aeson :: BL.ByteString-rawDis0_aeson = "[\"USD\",100,1,4]"-rawXr0_aeson :: BL.ByteString-rawXr0_aeson = "[\"USD\",\"BTC\",3,2]"---- pre 0.4-rawDns0_aeson_pre04 :: BL.ByteString-rawDns0_aeson_pre04 = "[\"Dense\",\"USD\",26,1]"-rawDis0_aeson_pre04 :: BL.ByteString-rawDis0_aeson_pre04 = "[\"Discrete\",\"USD\",100,1,4]"-rawXr0_aeson_pre04 :: BL.ByteString-rawXr0_aeson_pre04 = "[\"ExchangeRate\",\"USD\",\"BTC\",3,2]"-#endif--#ifdef HAS_serialise-rawDns0_serialise :: BL.ByteString-rawDns0_serialise = "cUSD\CAN\SUB\SOH"-rawDis0_serialise :: BL.ByteString-rawDis0_serialise = "cUSD\CANd\SOH\EOT"-rawXr0_serialise :: BL.ByteString-rawXr0_serialise = "cUSDcBTC\ETX\STX"-#endif--#ifdef HAS_store--- Such a waste of space these many bytes! Can we shrink this and maintain--- backwards compatibility?-rawDns0_cereal :: B.ByteString-rawDns0_cereal = "\NUL\NUL\NUL\NUL\NUL\NUL\NUL\ETXUSD\NUL\NUL\NUL\NUL\SUB\NUL\NUL\NUL\NUL\SOH"-rawDis0_cereal :: B.ByteString-rawDis0_cereal = "\NUL\NUL\NUL\NUL\NUL\NUL\NUL\ETXUSD\NUL\NUL\NUL\NULd\NUL\NUL\NUL\NUL\SOH\NUL\NUL\NUL\NUL\EOT"-rawXr0_cereal :: B.ByteString-rawXr0_cereal = "\NUL\NUL\NUL\NUL\NUL\NUL\NUL\ETXUSD\NUL\NUL\NUL\NUL\NUL\NUL\NUL\ETXBTC\NUL\NUL\NUL\NUL\ETX\NUL\NUL\NUL\NUL\STX"-#endif--#ifdef HAS_store--- Such a waste of space these many bytes! Can we shrink this and maintain--- backwards compatibility?-rawDns0_store :: B.ByteString-rawDns0_store = "\ETX\NUL\NUL\NUL\NUL\NUL\NUL\NULU\NUL\NUL\NULS\NUL\NUL\NULD\NUL\NUL\NUL\NUL\SUB\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\SOH\NUL\NUL\NUL\NUL\NUL\NUL\NUL"-rawDis0_store :: B.ByteString-rawDis0_store = "\ETX\NUL\NUL\NUL\NUL\NUL\NUL\NULU\NUL\NUL\NULS\NUL\NUL\NULD\NUL\NUL\NUL\NULd\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\SOH\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\EOT\NUL\NUL\NUL\NUL\NUL\NUL\NUL"-rawXr0_store :: B.ByteString-rawXr0_store = "\ETX\NUL\NUL\NUL\NUL\NUL\NUL\NULU\NUL\NUL\NULS\NUL\NUL\NULD\NUL\NUL\NUL\ETX\NUL\NUL\NUL\NUL\NUL\NUL\NULB\NUL\NUL\NULT\NUL\NUL\NULC\NUL\NUL\NUL\NUL\ETX\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\STX\NUL\NUL\NUL\NUL\NUL\NUL\NUL"-#endif--#ifdef HAS_xmlbf-rawDns0_xmlbf :: [Xmlbf.Node]-rawDns0_xmlbf = -- "<money-dense n=\"26\" d=\"1\" c=\"USD\"/>"- [ Xmlbf.element' "money-dense" (fromList [("n","26"), ("d","1"), ("c","USD")]) [] ]-rawDis0_xmlbf :: [Xmlbf.Node]-rawDis0_xmlbf = -- "<money-discrete n=\"100\" a=\"4\" d=\"1\" c=\"USD\"/>"- [ Xmlbf.element' "money-discrete" (fromList [("n","100"), ("d","1"), ("c","USD"), ("a","4")]) [] ]-rawXr0_xmlbf :: [Xmlbf.Node]-rawXr0_xmlbf = -- "<exchange-rate dst=\"BTC\" n=\"3\" d=\"2\" src=\"USD\"/>"- [ Xmlbf.element' "exchange-rate" (fromList [("n","3"), ("d","2"), ("src","USD"), ("dst","BTC")]) [] ]-#endif -------------------------------------------------------------------------------- -- Misc