diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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). diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -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 diff --git a/safe-money.cabal b/safe-money.cabal --- a/safe-money.cabal +++ b/safe-money.cabal @@ -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 diff --git a/src/Money.hs b/src/Money.hs --- a/src/Money.hs +++ b/src/Money.hs @@ -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 diff --git a/src/Money/Internal.hs b/src/Money/Internal.hs --- a/src/Money/Internal.hs +++ b/src/Money/Internal.hs @@ -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\"@: --- --- @ --- \ --- @ -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\"@: --- --- @ --- \ --- @ -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\"@ --- --- @ --- \ --- @ -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 ] diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -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 = -- "" - [ Xmlbf.element' "money-dense" (fromList [("n","26"), ("d","1"), ("c","USD")]) [] ] -rawDis0_xmlbf :: [Xmlbf.Node] -rawDis0_xmlbf = -- "" - [ Xmlbf.element' "money-discrete" (fromList [("n","100"), ("d","1"), ("c","USD"), ("a","4")]) [] ] -rawXr0_xmlbf :: [Xmlbf.Node] -rawXr0_xmlbf = -- "" - [ Xmlbf.element' "exchange-rate" (fromList [("n","3"), ("d","2"), ("src","USD"), ("dst","BTC")]) [] ] -#endif -------------------------------------------------------------------------------- -- Misc