safe-money 0.5 → 0.6
raw patch · 5 files changed
+646/−231 lines, 5 filesdep ~binarydep ~deepseq
Dependency ranges changed: binary, deepseq
Files
- changelog.md +23/−0
- safe-money.cabal +19/−29
- src/Money.hs +1/−0
- src/Money/Internal.hs +289/−131
- test/Main.hs +314/−71
changelog.md view
@@ -1,3 +1,26 @@+# Version 0.6++* _COMPILER ASSISTED BREAKING CHANGE_. `denseToDecimal` now takes a positive+ `Rational` rather than a `Proxy scale`.++* _COMPILER ASSISTED BREAKING CHANGE_. `denseFromDecimal` and+ `discreteFromDecimal` now take a positive `Rational` scale, like their+ `xxxToDecimal` counterparts.++* _COMPILE ASSISTED BREAKING CHANGE_. `binary`, `deepseq` and `text` are now+ mandatory dependencies since they are included with the standard GHC+ distribution. Thus, the tags for disabling them have been removed.++* _COMPILE ASSISTED BREAKING CHANGE_. `Text` replaced the use of `String` in the+ public API. For example, `denseCurrency` now returns `Text`, instead of+ `String`. This change doesn't break backwards compatibilility with binary+ serializations.++* Introduced a new function `discreteToDecimal`.++* Added tests to ensure backwards compatibility of serializations.++ # Version 0.5 * _COMPILER ASSISTED BREAKING CHANGE_. The `round`, `floor`, `ceiling` and
safe-money.cabal view
@@ -1,5 +1,5 @@ name: safe-money-version: 0.5+version: 0.6 license: BSD3 license-file: LICENSE copyright: Copyright (c) Renzo Carbonara 2016-2018@@ -20,10 +20,12 @@ Type-safe and lossless encoding and manipulation of money, fiat currencies, crypto currencies and precious metals. .- NOTICE that the only mandatory dependencies of this package are @base@ and- @constraints@. The rest of the dependencies are OPTIONAL but enabled by- default (except @store@ which is also disabled when building with GHCJS), they- can be disabled with Cabal flags.+ 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. source-repository head type: git@@ -33,7 +35,12 @@ default-language: Haskell2010 hs-source-dirs: src ghc-options: -Wall -O2- build-depends: base (>=4.8 && <5.0), constraints+ build-depends:+ base (>=4.8 && <5.0),+ binary,+ constraints,+ deepseq,+ text exposed-modules: Money Money.Internal@@ -41,15 +48,9 @@ if flag(aeson) build-depends: aeson (>=0.9) cpp-options: -DHAS_aeson- if flag(binary)- build-depends: binary (>=0.7)- cpp-options: -DHAS_binary if flag(cereal) build-depends: cereal (>=0.5) cpp-options: -DHAS_cereal- if flag(deepseq)- build-depends: deepseq (>=1.4)- cpp-options: -DHAS_deepseq if flag(hashable) build-depends: hashable (>=1.2) cpp-options: -DHAS_hashable@@ -63,7 +64,7 @@ build-depends: vector-space (>=0.12) cpp-options: -DHAS_vector_space if flag(xmlbf)- build-depends: xmlbf (>=0.2), text+ build-depends: xmlbf (>=0.2) cpp-options: -DHAS_xmlbf test-suite test@@ -73,25 +74,22 @@ main-is: Main.hs build-depends: base,+ binary, bytestring, constraints,+ deepseq, safe-money, tasty, tasty-hunit,- tasty-quickcheck+ tasty-quickcheck,+ text if flag(aeson) build-depends: aeson cpp-options: -DHAS_aeson- if flag(binary)- build-depends: binary- cpp-options: -DHAS_binary if flag(cereal) build-depends: cereal cpp-options: -DHAS_cereal- if flag(deepseq)- build-depends: deepseq- cpp-options: -DHAS_deepseq if flag(hashable) build-depends: hashable cpp-options: -DHAS_hashable@@ -105,27 +103,19 @@ build-depends: vector-space cpp-options: -DHAS_vector_space if flag(xmlbf)- build-depends: xmlbf, text+ build-depends: xmlbf cpp-options: -DHAS_xmlbf flag aeson description: Provide instances for @aeson@ default: True manual: True-flag binary- description: Provide instances for @binary@- 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 deepseq- description: Provide instances for @deepseq@ default: True manual: True flag hashable
src/Money.hs view
@@ -37,6 +37,7 @@ , I.discreteCurrency , I.discreteFromDense , I.discreteFromDecimal+ , I.discreteToDecimal -- * Currency scales , I.Scale , I.GoodScale
src/Money/Internal.hs view
@@ -14,6 +14,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-}@@ -38,6 +39,7 @@ , discreteCurrency , discreteFromDense , discreteFromDecimal+ , discreteToDecimal -- * Currency scales , Scale , GoodScale@@ -83,7 +85,9 @@ import Control.Applicative ((<|>), empty) import Control.Category (Category((.), id))+import Control.DeepSeq (NFData) import Control.Monad ((<=<), guard, when)+import qualified Data.Binary as Binary import qualified Data.Char as Char import Data.Constraint (Dict(Dict)) import Data.Functor (($>))@@ -92,6 +96,7 @@ import Data.Monoid ((<>)) import Data.Proxy (Proxy(..)) import Data.Ratio ((%), numerator, denominator)+import qualified Data.Text as T import Data.Word (Word8) import GHC.Exts (Constraint, fromList) import qualified GHC.Generics as GHC@@ -108,21 +113,12 @@ #ifdef HAS_aeson import qualified Data.Aeson as Ae-import qualified Data.Text as T #endif -#ifdef HAS_binary-import qualified Data.Binary as Binary-#endif- #ifdef HAS_cereal import qualified Data.Serialize as Cereal #endif -#ifdef HAS_deepseq-import Control.DeepSeq (NFData)-#endif- #ifdef HAS_hashable import Data.Hashable (Hashable) #endif@@ -299,8 +295,8 @@ -- > 'denseCurrency' ('dense'' 4 :: 'Dense' \"USD\") -- \"USD\" -- @-denseCurrency :: KnownSymbol currency => Dense currency -> String-denseCurrency = symbolVal+denseCurrency :: KnownSymbol currency => Dense currency -> T.Text+denseCurrency = T.pack . symbolVal {-# INLINE denseCurrency #-} -- | 'Discrete' represents a discrete monetary value for a @currency@ expresed@@ -457,8 +453,8 @@ :: forall currency scale . (KnownSymbol currency, GoodScale scale) => Discrete' currency scale- -> String -- ^-discreteCurrency = \_ -> symbolVal (Proxy :: Proxy currency)+ -> T.Text -- ^+discreteCurrency = \_ -> T.pack (symbolVal (Proxy @ currency)) {-# INLINE discreteCurrency #-} -- | Method for approximating a fractional number to an integer number.@@ -773,6 +769,10 @@ -- * 'someDenseAmount' data SomeDense = SomeDense { _someDenseCurrency :: !String+ -- ^ This is a 'String' rather than 'T.Text' because it makes it easier for+ -- us to derive serialization instances maintaining backwards compatiblity+ -- with pre-0.6 versions of this library, when 'String' was the prefered+ -- string type, and not 'T.Text'. , _someDenseAmount :: !Rational } deriving (Eq, Show, GHC.Generic) @@ -782,8 +782,8 @@ deriving instance Ord SomeDense -- | Currency name.-someDenseCurrency :: SomeDense -> String-someDenseCurrency = _someDenseCurrency+someDenseCurrency :: SomeDense -> T.Text+someDenseCurrency = T.pack . _someDenseCurrency {-# INLINE someDenseCurrency #-} -- | Currency unit amount.@@ -797,20 +797,24 @@ -- this 'SomeDense' value to a 'Dense' value in order to do any arithmetic -- operation on the monetary value. mkSomeDense- :: String -- ^ Currency. ('someDenseCurrency')+ :: T.Text -- ^ Currency. ('someDenseCurrency') -> Rational -- ^ Scale. ('someDenseAmount') -> Maybe SomeDense-mkSomeDense = \c r ->+{-# INLINE mkSomeDense #-}+mkSomeDense = \c r -> mkSomeDense' (T.unpack c) r++-- | Like 'mkSomeDense' but takes 'String' rather than 'T.Text'.+mkSomeDense' :: String -> Rational -> Maybe SomeDense+{-# INLINABLE mkSomeDense' #-}+mkSomeDense' = \c r -> if (denominator r /= 0) then Just (SomeDense c r) else Nothing-{-# INLINABLE mkSomeDense #-} -- | Convert a 'Dense' to a 'SomeDense' for ease of serialization. toSomeDense :: KnownSymbol currency => Dense currency -> SomeDense toSomeDense = \(Dense r0 :: Dense currency) ->- let c = symbolVal (Proxy :: Proxy currency)- in SomeDense c r0+ SomeDense (symbolVal (Proxy @ currency)) r0 {-# INLINE toSomeDense #-} -- | Attempt to convert a 'SomeDense' to a 'Dense', provided you know the target@@ -821,7 +825,7 @@ => SomeDense -> Maybe (Dense currency) -- ^ fromSomeDense = \dr ->- if (someDenseCurrency dr == symbolVal (Proxy :: Proxy currency))+ if (_someDenseCurrency dr == symbolVal (Proxy :: Proxy currency)) then Just (Dense (someDenseAmount dr)) else Nothing {-# INLINABLE fromSomeDense #-}@@ -836,7 +840,7 @@ -> (forall currency. KnownSymbol currency => Dense currency -> r) -> r -- ^ withSomeDense dr = \f ->- case someSymbolVal (someDenseCurrency dr) of+ case someSymbolVal (_someDenseCurrency dr) of SomeSymbol (Proxy :: Proxy currency) -> f (Dense (someDenseAmount dr) :: Dense currency) {-# INLINABLE withSomeDense #-}@@ -858,7 +862,13 @@ -- * 'someDiscreteScale' -- * 'someDiscreteAmount' data SomeDiscrete = SomeDiscrete- { _someDiscreteCurrency :: !String -- ^ Currency name.+ { _someDiscreteCurrency :: !String+ -- ^ Currency name.+ --+ -- This is a 'String' rather than 'T.Text' because it makes it easier for+ -- us to derive serialization instances maintaining backwards compatiblity+ -- with pre-0.6 versions of this library, when 'String' was the prefered+ -- string type, and not 'T.Text'. , _someDiscreteScale :: !Rational -- ^ Positive, non-zero. , _someDiscreteAmount :: !Integer -- ^ Amount of unit. } deriving (Eq, Show, GHC.Generic)@@ -869,8 +879,8 @@ deriving instance Ord SomeDiscrete -- | Currency name.-someDiscreteCurrency :: SomeDiscrete -> String-someDiscreteCurrency = _someDiscreteCurrency+someDiscreteCurrency :: SomeDiscrete -> T.Text+someDiscreteCurrency = T.pack . _someDiscreteCurrency {-# INLINE someDiscreteCurrency #-} -- | Positive, non-zero.@@ -889,15 +899,20 @@ -- this 'SomeDiscrete' value to a 'Discrete' vallue in order to do any arithmetic -- operation on the monetary value. mkSomeDiscrete- :: String -- ^ Currency name. ('someDiscreteCurrency')+ :: T.Text -- ^ Currency name. ('someDiscreteCurrency') -> Rational -- ^ Scale. Positive, non-zero. ('someDiscreteScale') -> Integer -- ^ Amount of unit. ('someDiscreteAmount') -> Maybe SomeDiscrete-mkSomeDiscrete = \c r a ->+{-# INLINE mkSomeDiscrete #-}+mkSomeDiscrete = \c r a -> mkSomeDiscrete' (T.unpack c) r a++-- | Like 'mkSomeDiscrete' but takes 'String' rather than 'T.Text'.+mkSomeDiscrete' :: String -> Rational -> Integer -> Maybe SomeDiscrete+{-# INLINABLE mkSomeDiscrete' #-}+mkSomeDiscrete' = \c r a -> if (denominator r /= 0) && (r > 0) then Just (SomeDiscrete c r a) else Nothing-{-# INLINABLE mkSomeDiscrete #-} -- | Convert a 'Discrete' to a 'SomeDiscrete' for ease of serialization. toSomeDiscrete@@ -919,8 +934,8 @@ => SomeDiscrete -> Maybe (Discrete' currency scale) -- ^ fromSomeDiscrete = \dr ->- if (someDiscreteCurrency dr == symbolVal (Proxy :: Proxy currency)) &&- (someDiscreteScale dr == scale (Proxy :: Proxy scale))+ if (_someDiscreteCurrency dr == symbolVal (Proxy @ currency)) &&+ (someDiscreteScale dr == scale (Proxy @ scale)) then Just (Discrete (someDiscreteAmount dr)) else Nothing {-# INLINABLE fromSomeDiscrete #-}@@ -944,7 +959,7 @@ -> r ) -> r -- ^ withSomeDiscrete dr = \f ->- case someSymbolVal (someDiscreteCurrency dr) of+ case someSymbolVal (_someDiscreteCurrency dr) of SomeSymbol (Proxy :: Proxy currency) -> case someNatVal (numerator (someDiscreteScale dr)) of Nothing -> error "withSomeDiscrete: impossible: numerator < 0"@@ -978,7 +993,15 @@ -- * 'someExchangeRateRate' data SomeExchangeRate = SomeExchangeRate { _someExchangeRateSrcCurrency :: !String+ -- ^ This is a 'String' rather than 'T.Text' because it makes it easier for+ -- us to derive serialization instances maintaining backwards compatiblity+ -- with pre-0.6 versions of this library, when 'String' was the prefered+ -- string type, and not 'T.Text'. , _someExchangeRateDstCurrency :: !String+ -- ^ This is a 'String' rather than 'T.Text' because it makes it easier for+ -- us to derive serialization instances maintaining backwards compatiblity+ -- with pre-0.6 versions of this library, when 'String' was the prefered+ -- string type, and not 'T.Text'. , _someExchangeRateRate :: !Rational -- ^ Positive, non-zero. } deriving (Eq, Show, GHC.Generic) @@ -988,13 +1011,13 @@ deriving instance Ord SomeExchangeRate -- | Source currency name.-someExchangeRateSrcCurrency :: SomeExchangeRate -> String-someExchangeRateSrcCurrency = _someExchangeRateSrcCurrency+someExchangeRateSrcCurrency :: SomeExchangeRate -> T.Text+someExchangeRateSrcCurrency = T.pack . _someExchangeRateSrcCurrency {-# INLINE someExchangeRateSrcCurrency #-} -- | Destination currency name.-someExchangeRateDstCurrency :: SomeExchangeRate -> String-someExchangeRateDstCurrency = _someExchangeRateDstCurrency+someExchangeRateDstCurrency :: SomeExchangeRate -> T.Text+someExchangeRateDstCurrency = T.pack . _someExchangeRateDstCurrency {-# INLINE someExchangeRateDstCurrency #-} -- | Exchange rate. Positive, non-zero.@@ -1008,15 +1031,21 @@ -- this 'SomeExchangeRate' value to a 'ExchangeRate' value in order to do any -- arithmetic operation with the exchange rate. mkSomeExchangeRate- :: String -- ^ Source currency name. ('someExchangeRateSrcCurrency')- -> String -- ^ Destination currency name. ('someExchangeRateDstCurrency')+ :: T.Text -- ^ Source currency name. ('someExchangeRateSrcCurrency')+ -> T.Text -- ^ Destination currency name. ('someExchangeRateDstCurrency') -> Rational -- ^ Exchange rate . Positive, non-zero. ('someExchangeRateRate') -> Maybe SomeExchangeRate+{-# INLINE mkSomeExchangeRate #-} mkSomeExchangeRate = \src dst r ->+ mkSomeExchangeRate' (T.unpack src) (T.unpack dst) r++-- | Like 'mkSomeExchangeRate' but takes 'String' rather than 'T.Text'.+mkSomeExchangeRate' :: String -> String -> Rational -> Maybe SomeExchangeRate+{-# INLINABLE mkSomeExchangeRate' #-}+mkSomeExchangeRate' = \src dst r -> if (denominator r /= 0) && (r > 0) then Just (SomeExchangeRate src dst r) else Nothing-{-# INLINABLE mkSomeExchangeRate #-} -- | Convert a 'ExchangeRate' to a 'SomeDiscrete' for ease of serialization. toSomeExchangeRate@@ -1037,8 +1066,8 @@ => SomeExchangeRate -> Maybe (ExchangeRate src dst) -- ^ fromSomeExchangeRate = \x ->- if (someExchangeRateSrcCurrency x == symbolVal (Proxy :: Proxy src)) &&- (someExchangeRateDstCurrency x == symbolVal (Proxy :: Proxy dst))+ if (_someExchangeRateSrcCurrency x == symbolVal (Proxy @ src)) &&+ (_someExchangeRateDstCurrency x == symbolVal (Proxy @ dst)) then Just (ExchangeRate (someExchangeRateRate x)) else Nothing {-# INLINABLE fromSomeExchangeRate #-}@@ -1058,9 +1087,9 @@ -> r ) -> r -- ^ withSomeExchangeRate x = \f ->- case someSymbolVal (someExchangeRateSrcCurrency x) of+ case someSymbolVal (_someExchangeRateSrcCurrency x) of SomeSymbol (Proxy :: Proxy src) ->- case someSymbolVal (someExchangeRateDstCurrency x) of+ case someSymbolVal (_someExchangeRateDstCurrency x) of SomeSymbol (Proxy :: Proxy dst) -> f (ExchangeRate (someExchangeRateRate x) :: ExchangeRate src dst) {-# INLINABLE withSomeExchangeRate #-}@@ -1124,7 +1153,6 @@ -------------------------------------------------------------------------------- -- Extra instances: deepseq-#ifdef HAS_deepseq instance NFData Approximation instance NFData (Dense currency) instance NFData SomeDense@@ -1132,7 +1160,6 @@ instance NFData SomeDiscrete instance NFData (ExchangeRate src dst) instance NFData SomeExchangeRate-#endif -------------------------------------------------------------------------------- -- Extra instances: cereal@@ -1167,42 +1194,46 @@ n :: Integer <- Cereal.get d :: Integer <- Cereal.get when (d == 0) (fail "denominator is zero")- pure (mkSomeDense c (n % d))+ 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)+ 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))+ pure (mkSomeExchangeRate' src dst (n % d)) #endif ------------------------------------------------------------------------------ -- Extra instances: binary-#ifdef HAS_binary+ -- | Compatible with 'SomeDense'. instance (KnownSymbol currency) => Binary.Binary (Dense currency) where put = Binary.put . toSomeDense@@ -1224,18 +1255,21 @@ -- | Compatible with 'Dense'. instance Binary.Binary SomeDense where- put = \(SomeDense c r) ->- Binary.put c >> Binary.put (numerator r) >> Binary.put (denominator r)+ put = \(SomeDense c r) -> do+ Binary.put c+ Binary.put (numerator r)+ Binary.put (denominator r) get = maybe empty pure =<< do c :: String <- Binary.get n :: Integer <- Binary.get d :: Integer <- Binary.get when (d == 0) (fail "denominator is zero")- pure (mkSomeDense c (n % d))+ pure (mkSomeDense' c (n % d)) -- | Compatible with 'Discrete'. instance Binary.Binary SomeDiscrete where put = \(SomeDiscrete c r a) ->+ -- We go through String for backwards compatibility. Binary.put c <> Binary.put (numerator r) <> Binary.put (denominator r) <>@@ -1246,7 +1280,7 @@ d :: Integer <- Binary.get when (d == 0) (fail "denominator is zero") a :: Integer <- Binary.get- pure (mkSomeDiscrete c (n % d) a)+ pure (mkSomeDiscrete' c (n % d) a) -- | Compatible with 'ExchangeRate'. instance Binary.Binary SomeExchangeRate where@@ -1261,8 +1295,7 @@ n :: Integer <- Binary.get d :: Integer <- Binary.get when (d == 0) (fail "denominator is zero")- pure (mkSomeExchangeRate src dst (n % d))-#endif+ pure (mkSomeExchangeRate' src dst (n % d)) -------------------------------------------------------------------------------- -- Extra instances: serialise@@ -1290,13 +1323,15 @@ -- | Compatible with 'Dense'. instance Ser.Serialise SomeDense where encode = \(SomeDense c r) ->- Ser.encode c <> Ser.encode (numerator r) <> Ser.encode (denominator 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))+ pure (mkSomeDense' c (n % d)) -- | Compatible with 'Discrete'. instance Ser.Serialise SomeDiscrete where@@ -1311,7 +1346,7 @@ d :: Integer <- Ser.decode when (d == 0) (fail "denominator is zero") a :: Integer <- Ser.decode- pure (mkSomeDiscrete c (n % d) a)+ pure (mkSomeDiscrete' c (n % d) a) -- | Compatible with 'ExchangeRate'. instance Ser.Serialise SomeExchangeRate where@@ -1326,7 +1361,7 @@ n :: Integer <- Ser.decode d :: Integer <- Ser.decode when (d == 0) (fail "denominator is zero")- pure (mkSomeExchangeRate src dst (n % d))+ pure (mkSomeExchangeRate' src dst (n % d)) #endif --------------------------------------------------------------------------------@@ -1371,7 +1406,7 @@ ("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))+ maybe empty pure (mkSomeDense' c (n % d)) -- | Compatible with 'SomeDiscrete' --@@ -1413,7 +1448,7 @@ parseJSON = \v -> do (c, n, d, a) <- Ae.parseJSON v <|> do -- Pre 0.4 format.- ("Discrete" :: String, c, n, d, a) <- Ae.parseJSON v+ ("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)@@ -1459,7 +1494,7 @@ parseJSON = \v -> do (src, dst, n, d) <- Ae.parseJSON v <|> do -- Pre 0.4 format.- ("ExchangeRate" :: String, src, dst, n, d) <- Ae.parseJSON v+ ("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))@@ -1489,13 +1524,12 @@ let as = [ (T.pack "c", T.pack c) , (T.pack "n", T.pack (show (numerator r))) , (T.pack "d", T.pack (show (denominator r))) ]- Right e = Xmlbf.element (T.pack "money-dense") (fromList as) []- in [e]+ 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 <- T.unpack <$> Xmlbf.pAttr "c"+ c <- Xmlbf.pAttr "c" n <- Xmlbf.pRead =<< Xmlbf.pAttr "n" d <- Xmlbf.pRead =<< Xmlbf.pAttr "d" when (d == 0) (fail "denominator is zero")@@ -1522,17 +1556,16 @@ -- | Compatible with 'Discrete'' instance Xmlbf.ToXml SomeDiscrete where toXml = \(SomeDiscrete c r a) ->- let as = [ (T.pack "c", T.pack c)- , (T.pack "n", T.pack (show (numerator r)))- , (T.pack "d", T.pack (show (denominator r)))- , (T.pack "a", T.pack (show a)) ]- Right e = Xmlbf.element (T.pack "money-discrete") (fromList as) []- in [e]+ 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 <- T.unpack <$> Xmlbf.pAttr "c"+ c <- Xmlbf.pAttr "c" n <- Xmlbf.pRead =<< Xmlbf.pAttr "n" d <- Xmlbf.pRead =<< Xmlbf.pAttr "d" when (d == 0) (fail "denominator is zero")@@ -1561,18 +1594,17 @@ -- | Compatible with 'ExchangeRate' instance Xmlbf.ToXml SomeExchangeRate where toXml = \(SomeExchangeRate src dst r) ->- let as = [ (T.pack "src", T.pack src)- , (T.pack "dst", T.pack dst)- , (T.pack "n", T.pack (show (numerator r)))- , (T.pack "d", T.pack (show (denominator r))) ]- Right e = Xmlbf.element (T.pack "exchange-rate") (fromList as) []- in [e]+ 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 <- T.unpack <$> Xmlbf.pAttr "src"- dst <- T.unpack <$> Xmlbf.pAttr "dst"+ 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")@@ -1598,7 +1630,7 @@ n :: Integer <- Store.peek d :: Integer <- Store.peek when (d == 0) (fail "denominator is zero")- pure (mkSomeDense c (n % d))+ pure (mkSomeDense' c (n % d)) -- | Compatible with 'SomeDiscrete'. instance@@ -1615,12 +1647,13 @@ 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)+ pure (mkSomeDiscrete' c (n % d) a) -- | Compatible with 'SomeExchangeRate'. instance ( KnownSymbol src, KnownSymbol dst@@ -1636,12 +1669,12 @@ Store.poke (numerator r) Store.poke (denominator r) peek = maybe (fail "peek") pure =<< do- src <- Store.peek- dst <- Store.peek- n <- Store.peek- d <- Store.peek+ 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))+ pure (mkSomeExchangeRate' src dst (n % d)) storeContramapSize :: (a -> b) -> Store.Size b -> Store.Size a storeContramapSize f = \case@@ -1657,25 +1690,23 @@ -- manner. -- -- @--- > 'denseToDecimal' 'Round' 'True' ('Just' \',\') \'.\' 2--- ('Proxy' :: 'Proxy' ('Scale' \"USD\" \"dollar\"))+-- > 'denseToDecimal' 'Round' 'True' ('Just' \',\') \'.\' 2 (1 '%' 1) -- ('dense'' (123456 '%' 100) :: 'Dense' \"USD\") -- Just \"+1,234.56\" -- @ -- -- @--- > 'denseToDecimal' 'Round' 'True' ('Just' \',\') \'.\' 2--- ('Proxy' :: 'Proxy' ('Scale' \"USD\" \"cent\"))+-- > 'denseToDecimal' 'Round' 'True' ('Just' \',\') \'.\' 2 (100 '%' 1) -- ('dense'' (123456 '%' 100) :: 'Dense' \"USD\") -- Just \"+123,456.00\" -- @ ----- This function returns 'Nothing' if it is not possible to reliably render the--- decimal string due to a bad choice of separators. That is, if the separators--- are digits or equal among themselves, this function returns 'Nothing'.+-- This function returns 'Nothing' if the scale is less than @1@, or if it's not+-- possible to reliably render the decimal string due to a bad choice of+-- separators. That is, if the separators are digits or equal among themselves,+-- this function returns 'Nothing'. denseToDecimal- :: GoodScale scale- => Approximation+ :: Approximation -- ^ Approximation to use if necesary in order to fit the 'Dense' amount in -- as many decimal numbers as requested. -> Bool@@ -1683,27 +1714,131 @@ -> Maybe Char -- ^ Thousands separator for the integer part, if any (i.e., the @\',\'@ in -- @1,234.56789@).+ --+ -- If the given separator is a digit, or if it is equal to the decimal+ -- separator, then this functions returns 'Nothing'. -> Char- -- ^ Decimal separator (i.e., the @\'.\'@ in @1,234.56789@)+ -- ^ Decimal separator (i.e., the @\'.\'@ in @1,234.56789@).+ --+ -- If the given separator is a digit, or if it is equal to the thousands+ -- separator, then this functions returns 'Nothing'. -> Word8 -- ^ Number of decimal numbers to render, if any.- -> Proxy scale- -- ^ Scale used by the integer part of the decimal number. For example, a when- -- rendering render @'dense'' (123 '%' 100) :: 'Dense' "USD"@ as a decimal- -- number with three decimal places, a scale of @1@ (i.e. @'Scale' \"USD\"- -- \"dollar\"@) would render @1@ as the integer part and @230@ as the- -- fractional part, whereas a scale of @100@ (i.e., @'Scale' \"USD\"- -- \"cent\"@) would render @123@ as the integer part and @000@ as the- -- fractional part.+ -> Rational+ -- ^ Scale used to when rendering the decimal number. This is useful if you+ -- want to render a “number of cents” rather than a “number of dollars” when+ -- rendering a USD amount, for example.+ --+ -- Set this to @1 '%' 1@ if you don't care.+ --+ -- For example, when rendering render @'dense'' (123 '%' 100) :: 'Dense'+ -- "USD"@ as a decimal number with three decimal places, a scale of @1 '%' 1@+ -- (analogous to @'Scale' \"USD\" \"dollar\"@) would render @1@ as the+ -- integer part and @230@ as the fractional part, whereas a scale of @100 '%'+ -- 1@ (analogous @'Scale' \"USD\" \"cent\"@) would render @123@ as the integer+ -- part and @000@ as the fractional part.+ --+ -- You can easily obtain the scale for a particular currency and unit+ -- combination using the 'scale' function. Otherwise, you are free to pass in+ -- any other /positive/ 'Rational' number. If a non-positive scale is given,+ -- then this function returns 'Nothing'.+ --+ -- Specifying scales other than @1 '%' 1@ is particularly useful for+ -- currencies whose main unit is too big. For example, the main unit of gold+ -- (XAU) is the troy-ounce, which is too big for day to day accounting, so+ -- using the gram or the grain as the unit when rendering decimal amounts+ -- could be useful.+ --+ -- Be careful when using a scale smaller than @1 '%' 1@, since it may become+ -- impossible to parse back a meaningful amount from the rendered decimal+ -- representation unless a big number of fractional digits is used. -> Dense currency -- ^ The dense monetary amount to render.- -> Maybe String+ -> Maybe T.Text -- ^ Returns 'Nothing' is the given separators are not acceptable (i.e., they -- are digits, or they are equal). {-# INLINABLE denseToDecimal #-}-denseToDecimal a plus ytsep dsep fdigs0 ps = \(Dense r0) ->- rationalToDecimal a plus ytsep dsep fdigs0 (scale ps * r0)+denseToDecimal a plus ytsep dsep fdigs scal = \(Dense r0) -> do+ guard (scal > 0)+ rationalToDecimal a plus ytsep dsep fdigs (r0 * scal) +-- | Render a 'Discrete'' monetary amount as a decimal number in a potentially+-- lossy manner.+--+-- This is simply a convenient wrapper around 'denseToDecimal':+--+-- @+-- 'discreteToDecimal' a b c d e f (dis :: 'Discrete'' currency scale)+-- == 'denseToDecimal' a b c d e f ('denseFromDiscrete' dis :: 'Dense' currency)+-- @+--+-- In particular, the @scale@ in @'Discrete'' currency scale@ has no influence+-- over the scale in which the decimal number is rendered. Use the 'Rational'+-- parameter to this function for modifying that behavior.+--+-- Please refer to 'denseToDecimal' for further documentation.+--+-- This function returns 'Nothing' if the scale is less than @1@, or if it's not+-- possible to reliably render the decimal string due to a bad choice of+-- separators. That is, if the separators are digits or equal among themselves,+-- this function returns 'Nothing'.+discreteToDecimal+ :: GoodScale scale+ => Approximation+ -- ^ Approximation to use if necesary in order to fit the 'Discrete' amount in+ -- as many decimal numbers as requested.+ -> Bool+ -- ^ Whether to render a leading @\'+\'@ sign in case the amount is positive.+ -> Maybe Char+ -- ^ Thousands separator for the integer part, if any (i.e., the @\',\'@ in+ -- @1,234.56789@).+ --+ -- If the given separator is a digit, or if it is equal to the decimal+ -- separator, then this functions returns 'Nothing'.+ -> Char+ -- ^ Decimal separator (i.e., the @\'.\'@ in @1,234.56789@).+ --+ -- If the given separator is a digit, or if it is equal to the thousands+ -- separator, then this functions returns 'Nothing'.+ -> Word8+ -- ^ Number of decimal numbers to render, if any.+ -> Rational+ -- ^ Scale used to when rendering the decimal number. This is useful if you+ -- want to render a “number of cents” rather than a “number of dollars” when+ -- rendering a USD amount, for example.+ --+ -- Set this to @1 '%' 1@ if you don't care.+ --+ -- For example, when rendering render @'discrete' 123 :: 'Dense' \"USD\"+ -- \"cent\"@ as a decimal number with three decimal places, a scale of @1 '%'+ -- 1@ (analogous to @'Scale' \"USD\" \"dollar\"@) would render @1@ as the+ -- integer part and @230@ as the fractional part, whereas a scale of @100 '%'+ -- 1@ (analogous @'Scale' \"USD\" \"cent\"@) would render @123@ as the integer+ -- part and @000@ as the fractional part.+ --+ -- You can easily obtain the scale for a particular currency and unit+ -- combination using the 'scale' function. Otherwise, you are free to pass in+ -- any other /positive/ 'Rational' number. If a non-positive scale is+ -- given, then this function returns 'Nothing'.+ --+ -- Specifying scales other than @1 '%' 1@ is particularly useful for+ -- currencies whose main unit is too big. For example, the main unit of gold+ -- (XAU) is the troy-ounce, which is too big for day to day accounting, so+ -- using the gram or the grain as the unit when rendering decimal amounts+ -- could be useful.+ --+ -- Be careful when using a scale smaller than @1 '%' 1@, since it may become+ -- impossible to parse back a meaningful amount from the rendered decimal+ -- representation unless a big number of fractional digits is used.+ -> Discrete' currency scale+ -- ^ The monetary amount to render.+ -> Maybe T.Text+ -- ^ Returns 'Nothing' is the given separators are not acceptable (i.e., they+ -- are digits, or they are equal).+{-# INLINABLE discreteToDecimal #-}+discreteToDecimal a plus ytsep dsep fdigs scal = \dns ->+ denseToDecimal a plus ytsep dsep fdigs scal (denseFromDiscrete dns)+ -- | Render a 'ExchangeRate' as a decimal number in a potentially lossy manner. -- -- @@@ -1728,8 +1863,8 @@ -- ^ Number of decimal numbers to render, if any. -> ExchangeRate src dst -- ^ The 'ExchangeRate' to render.- -> Maybe String- -- ^ Returns 'Nothing' is the given separators are not acceptable (i.e., they+ -> Maybe T.Text+ -- ^ Returns 'Nothing' if the given separators are not acceptable (i.e., they -- are digits, or they are equal). {-# INLINABLE exchangeRateToDecimal #-} exchangeRateToDecimal a ytsep dsep fdigs0 = \(ExchangeRate r0) ->@@ -1755,14 +1890,14 @@ -- ^ Number of decimal numbers to render, if any. -> Rational -- ^ The dense monetary amount to render.- -> Maybe String- -- ^ Returns 'Nothing' is the given separators are not acceptable (i.e., they+ -> Maybe T.Text+ -- ^ Returns 'Nothing' if the given separators are not acceptable (i.e., they -- are digits, or they are equal). {-# INLINABLE rationalToDecimal #-} rationalToDecimal a plus ytsep dsep fdigs0 = \r0 -> do+ guard (not (Char.isDigit dsep)) for_ ytsep $ \tsep -> guard (tsep /= dsep && not (Char.isDigit tsep))- guard (not (Char.isDigit dsep)) -- this string-fu is not particularly efficient. let parts = approximate a (r0 * (10 ^ fdigs0)) :: Integer ipart = fromInteger (abs parts) `div` (10 ^ fdigs0) :: Natural@@ -1770,7 +1905,7 @@ | otherwise = drop (length (show ipart)) (show (abs parts)) itext = maybe (show ipart) (renderThousands ipart) ytsep :: String fpad0 = List.replicate (fromIntegral fdigs0 - length ftext) '0' :: String- Just $ mconcat+ Just $ T.pack $ mconcat [ if | parts < 0 -> "-" | plus && parts > 0 -> "+" | otherwise -> ""@@ -1788,16 +1923,16 @@ -- @ renderThousands :: Natural -> Char -> String {-# INLINABLE renderThousands #-}-renderThousands n0+renderThousands n0 -- TODO better use text | n0 < 1000 = \_ -> show n0 | otherwise = \c -> List.foldl' (flip mappend) mempty (List.unfoldr (f c) n0) where f :: Char -> Natural -> Maybe (String, Natural) f c = \x -> case divMod x 1000 of- (0, 0) -> Nothing- (0, z) -> Just (show z, 0)- (y, z) | z < 10 -> Just (c:'0':'0':show z, y)- | z < 100 -> Just (c:'0':show z, y)- | otherwise -> Just (c:show z, y)+ (0, 0) -> Nothing+ (0, z) -> Just (show z, 0)+ (y, z) | z < 10 -> Just (c:'0':'0':show z, y)+ | z < 100 -> Just (c:'0':show z, y)+ | otherwise -> Just (c:show z, y) -------------------------------------------------------------------------------- -- Decimal parsing@@ -1811,11 +1946,24 @@ -- @-1,234.56789@). -> Char -- ^ Decimal separator (i.e., the @\'.\'@ in @-1,234.56789@)- -> String+ -> Rational+ -- ^ Scale used by the rendered decimal. It is important to get this number+ -- correctly, otherwise the resulting 'Dense' amount will be wrong. Please+ -- refer to the documentation for 'denseToDecimal' to understand the meaning+ -- of this scale.+ --+ -- In summary, this scale will have a value of @1@ unless the decimal amount+ -- represents a unit other than the main unit for the currency (e.g., cents+ -- rather than dollars for USD, or grams rather than troy-ounces for XAU, or+ -- millibitcoins rather than bitcoins for BTC).+ -> T.Text -- ^ The raw string containing the decimal representation (e.g., -- @"-1,234.56789"@). -> Maybe (Dense currency)-denseFromDecimal yst sf = fmap Dense . rationalFromDecimal yst sf+denseFromDecimal yst sf scal str = do+ guard (scal > 0)+ r <- rationalFromDecimal yst sf str+ pure (Dense $! (r / scal)) -- | Parses a decimal representation of a 'Discrete'. --@@ -1830,12 +1978,22 @@ -- @-1,234.56789@). -> Char -- ^ Decimal separator (i.e., the @\'.\'@ in @-1,234.56789@)- -> String+ -> Rational+ -- ^ Scale used by the rendered decimal. It is important to get this number+ -- correctly, otherwise the resulting 'Dense' amount will be wrong. Please+ -- refer to the documentation for 'denseToDecimal' to understand the meaning+ -- of this scale.+ --+ -- In summary, this scale will have a value of @1@ unless the decimal amount+ -- represents a unit other than the main unit for the currency (e.g., cents+ -- rather than dollars for USD, or grams rather than troy-ounces for XAU, or+ -- millibitcoins rather than bitcoins for BTC).+ -> T.Text -- ^ The raw string containing the decimal representation (e.g., -- @"-1,234.56789"@). -> Maybe (Discrete' currency scale)-discreteFromDecimal yst sf = \s -> do- dns <- denseFromDecimal yst sf s+discreteFromDecimal yst sf scal = \str -> do+ dns <- denseFromDecimal yst sf scal str case discreteFromDense Truncate dns of (x, 0) -> Just x _ -> Nothing -- We fail for decimals that don't fit exactly in our scale.@@ -1847,13 +2005,13 @@ -- @1,234.56789@). -> Char -- ^ Decimal separator (i.e., the @\'.\'@ in @1,234.56789@)- -> String+ -> T.Text -- ^ The raw string containing the decimal representation (e.g., -- @"1,234.56789"@). -> Maybe (ExchangeRate src dst)-exchangeRateFromDecimal yst sf = \case- ('-':_) -> Nothing- str -> exchangeRate =<< rationalFromDecimal yst sf str+exchangeRateFromDecimal yst sf t+ | T.isPrefixOf "-" t = Nothing+ | otherwise = exchangeRate =<< rationalFromDecimal yst sf t rationalFromDecimal :: Maybe Char@@ -1861,12 +2019,12 @@ -- @-1,234.56789@). -> Char -- ^ Decimal separator (i.e., the @\'.\'@ in @-1,234.56789@)- -> String+ -> T.Text -- ^ The raw string containing the decimal representation (e.g., -- @"-1,234.56789"@). -> Maybe Rational-rationalFromDecimal yst sf = \s ->- case ReadP.readP_to_S (rationalFromDecimalP yst sf) s of+rationalFromDecimal yst sf = \t ->+ case ReadP.readP_to_S (rationalFromDecimalP yst sf) (T.unpack t) of [(x,"")] -> Just x _ -> Nothing
test/Main.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-}@@ -10,16 +11,21 @@ module Main where import Control.Category (Category((.), id))-import qualified Data.ByteString.Lazy as BSL+import Control.DeepSeq (rnf)+import qualified Data.Binary as Binary+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL import qualified Data.Char as Char import Data.Maybe (catMaybes, isJust, isNothing, fromJust) import Data.Proxy (Proxy(Proxy)) import Data.Ratio ((%), numerator, denominator)+import qualified Data.Text as T import Data.Word (Word8)+import GHC.Exts (fromList) import GHC.TypeLits (Nat, Symbol, KnownSymbol, symbolVal) import Prelude hiding ((.), id) import qualified Test.Tasty as Tasty-import Test.Tasty.HUnit ((@?=))+import Test.Tasty.HUnit ((@?=), (@=?)) import qualified Test.Tasty.HUnit as HU import qualified Test.Tasty.Runners as Tasty import Test.Tasty.QuickCheck ((===), (==>), (.&&.))@@ -29,10 +35,6 @@ import qualified Data.Aeson as Ae #endif -#ifdef HAS_binary-import qualified Data.Binary as Binary-#endif- #ifdef HAS_cereal import qualified Data.Serialize as Cereal #endif@@ -52,7 +54,6 @@ #ifdef HAS_xmlbf import qualified Xmlbf-import qualified Data.Text as Text #endif import qualified Money@@ -107,9 +108,12 @@ , 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 -- and decimal separators as welland decimal separators as well.-genDecimal :: QC.Gen (String, Maybe Char, Char)+genDecimal :: QC.Gen (T.Text, Maybe Char, Char) genDecimal = do aprox :: Money.Approximation <- QC.arbitrary plus :: Bool <- QC.arbitrary@@ -137,7 +141,7 @@ main = Tasty.defaultMainWithIngredients [ Tasty.consoleTestReporter , Tasty.listingTests- ] (Tasty.localOption (QC.QuickCheckTests 500) tests)+ ] (Tasty.localOption (QC.QuickCheckTests 100) tests) tests :: Tasty.TestTree tests =@@ -148,6 +152,7 @@ , testRationalToDecimal , testRationalFromDecimal , testDiscreteFromDecimal+ , testRawSerializations ] testCurrencies :: Tasty.TestTree@@ -399,7 +404,7 @@ r2 :: Rational = 123 % 100 r3 :: Rational = 345 % 1000 - render :: Money.Approximation -> Rational -> [String]+ 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@@ -425,13 +430,14 @@ (f (Just s1) s1 (error "untouched") === Nothing) .&&. (f (Just s3) s3 (error "untouched") === Nothing) - , QC.testProperty "Lossy roundtrip" $+ , Tasty.localOption (QC.QuickCheckTests 1000) $+ QC.testProperty "Lossy roundtrip" $ -- We check that the roundtrip results in a close amount with a fractional -- difference of up to one. let gen = (,) <$> genDecimalSeps <*> QC.arbitrary in QC.forAll gen $ \( (yst :: Maybe Char, sd :: Char)- , (r :: Rational, plus :: Bool, digs :: Word8,- aprox :: Money.Approximation) ) ->+ , (r :: Rational, plus :: Bool, digs :: Word8,+ aprox :: Money.Approximation) ) -> let Just dec = Money.rationalToDecimal aprox plus yst sd digs r Just r' = Money.rationalFromDecimal yst sd dec in 1 > abs (abs r - abs r')@@ -444,8 +450,12 @@ -> Tasty.TestTree testDense pc = Tasty.testGroup ("Dense " ++ show (symbolVal pc))- [ QC.testProperty "read . show == id" $+ [ QC.testProperty "rnf" $ QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+ () === rnf x++ , QC.testProperty "read . show == id" $+ QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) -> x === read (show x) , QC.testProperty "read . show . Just == Just " $@@ -458,7 +468,7 @@ , QC.testProperty "fromSomeDense works only for same currency" $ QC.forAll QC.arbitrary $ \(dr :: Money.SomeDense) ->- (Money.someDenseCurrency dr /= symbolVal pc)+ (T.unpack (Money.someDenseCurrency dr) /= symbolVal pc) ==> isNothing (Money.fromSomeDense dr :: Maybe (Money.Dense currency)) , QC.testProperty "withSomeDense" $@@ -470,25 +480,46 @@ , QC.testProperty "denseCurrency" $ QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->- Money.denseCurrency x === symbolVal pc+ T.unpack (Money.denseCurrency x) === symbolVal pc , QC.testProperty "denseToDecimal: Same as rationalToDecimal" $ let gen = (,) <$> genDecimalSeps <*> QC.arbitrary in QC.forAll gen $ \( (yst :: Maybe Char, sd :: Char) , (dns :: Money.Dense currency, plus :: Bool, digs :: Word8, aprox :: Money.Approximation) ) ->- let ydnsd1 = Money.denseToDecimal aprox plus yst sd digs (Proxy :: Proxy '(1,1)) dns- ydnsd100 = Money.denseToDecimal aprox plus yst sd digs (Proxy :: Proxy '(100,1)) dns+ 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) in (ydnsd1 === yrd1) .&&. (ydnsd100 === yrd100) , QC.testProperty "denseFromDecimal: Same as rationalFromDecimal" $- QC.forAll genDecimal $ \(dec :: String, yts :: Maybe Char, ds :: Char) ->+ QC.forAll genDecimal $ \(dec :: T.Text, yts :: Maybe Char, ds :: Char) -> let Just r = Money.rationalFromDecimal yts ds dec- Just dns = Money.denseFromDecimal 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+ Just dns = Money.denseFromDecimal yts ds 1 dec+ in r === toRational (dns :: Money.Dense currency)+++ , Tasty.localOption (QC.QuickCheckTests 1000) $+ QC.testProperty "denseToDecimal/denseFromDiscrete: Lossy roundtrip" $+ -- We check that the roundtrip results in a close amount with a fractional+ -- difference of up to one.+ let gen = (,) <$> genDecimalSeps <*> QC.arbitrary+ in QC.forAll gen $ \( (yst :: Maybe Char, sd :: Char)+ , (sc0 :: Rational, plus :: Bool,+ digs :: Word8, aprox :: Money.Approximation,+ dns :: Money.Dense currency) ) ->+ let sc = abs sc0 + 1 -- smaller scales can't reliably be parsed back+ Just dec = Money.denseToDecimal aprox plus yst sd digs sc dns+ 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)@@ -524,14 +555,13 @@ , QC.testProperty "Aeson decoding of pre-0.4 format (Dense, SomeDense)" $ QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) -> let sx = Money.toSomeDense x- c = Money.someDenseCurrency sx+ c = T.unpack (Money.someDenseCurrency sx) r = Money.someDenseAmount sx- bs = Ae.encode ("Dense", c, numerator r, denominator r)+ bs = Ae.encode ("Dense" :: String, c, numerator r, denominator r) in (Just x === Ae.decode bs) .&&. (Just sx === Ae.decode bs) #endif -#ifdef HAS_binary , QC.testProperty "Binary encoding roundtrip" $ QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) -> let Right (_,_,y) = Binary.decodeOrFail (Binary.encode x)@@ -540,18 +570,17 @@ QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) -> let x' = Money.toSomeDense x bs = Binary.encode x'- in Right (mempty, BSL.length bs, x') === Binary.decodeOrFail bs+ in Right (mempty, BL.length bs, x') === Binary.decodeOrFail bs , QC.testProperty "Binary encoding roundtrip (Dense through SomeDense)" $ QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) -> let x' = Money.toSomeDense x bs = Binary.encode x'- in Right (mempty, BSL.length bs, x) === Binary.decodeOrFail bs+ in Right (mempty, BL.length bs, x) === Binary.decodeOrFail bs , QC.testProperty "Binary encoding roundtrip (SomeDense through Dense)" $ QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) -> let x' = Money.toSomeDense x bs = Binary.encode x- in Right (mempty, BSL.length bs, x') === Binary.decodeOrFail bs-#endif+ in Right (mempty, BL.length bs, x') === Binary.decodeOrFail bs #ifdef HAS_cereal , QC.testProperty "Cereal encoding roundtrip" $@@ -652,6 +681,11 @@ Tasty.testGroup ("Discrete " ++ show (symbolVal pc) ++ " " ++ show (symbolVal pu)) [ testRounding pc pu++ , QC.testProperty "rnf" $+ QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+ () === rnf x+ , QC.testProperty "read . show == id" $ QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) -> x === read (show x)@@ -663,7 +697,7 @@ Just x === Money.fromSomeDiscrete (Money.toSomeDiscrete x) , QC.testProperty "fromSomeDiscrete works only for same currency and scale" $ QC.forAll QC.arbitrary $ \(dr :: Money.SomeDiscrete) ->- ((Money.someDiscreteCurrency dr /= symbolVal pc) &&+ ((T.unpack (Money.someDiscreteCurrency dr) /= symbolVal pc) && (Money.someDiscreteScale dr /= Money.scale (Proxy :: Proxy (Money.Scale currency unit))) ) ==> isNothing (Money.fromSomeDiscrete dr@@ -678,8 +712,22 @@ , QC.testProperty "discreteCurrency" $ QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->- Money.discreteCurrency x === symbolVal pc+ T.unpack (Money.discreteCurrency x) === symbolVal pc + , QC.testProperty "discreteToDecimal/discreteFromDecimal: Same as denseToDecimal/denseFromDecimal" $+ -- We check that the roundtrip results in a close amount with a fractional+ -- difference of up to one.+ let gen = (,) <$> genDecimalSeps <*> QC.arbitrary+ in QC.forAll gen $ \( (yst :: Maybe Char, sd :: Char)+ , (sc0 :: Rational, plus :: Bool,+ digs :: Word8, aprox :: Money.Approximation,+ dis :: Money.Discrete currency unit) ) ->+ let sc = abs sc0 + 1 -- scale can't be less than 1+ dns = Money.denseFromDiscrete dis+ ydec = Money.discreteToDecimal aprox plus yst sd digs sc dis+ 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@@ -715,15 +763,14 @@ , QC.testProperty "Aeson decoding of pre-0.4 format (Discrete, SomeDiscrete)" $ QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) -> let sx = Money.toSomeDiscrete x- c = Money.someDiscreteCurrency sx+ c = T.unpack (Money.someDiscreteCurrency sx) r = Money.someDiscreteScale sx a = Money.someDiscreteAmount sx- bs = Ae.encode ("Discrete", c, numerator r, denominator r, a)+ bs = Ae.encode ("Discrete" :: String, c, numerator r, denominator r, a) in (Just x === Ae.decode bs) .&&. (Just sx === Ae.decode bs) #endif -#ifdef HAS_binary , QC.testProperty "Binary encoding roundtrip" $ QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) -> let Right (_,_,y) = Binary.decodeOrFail (Binary.encode x)@@ -732,18 +779,17 @@ QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) -> let x' = Money.toSomeDiscrete x bs = Binary.encode x'- in Right (mempty, BSL.length bs, x') === Binary.decodeOrFail bs+ in Right (mempty, BL.length bs, x') === Binary.decodeOrFail bs , QC.testProperty "Binary encoding roundtrip (Discrete through SomeDiscrete)" $ QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) -> let x' = Money.toSomeDiscrete x bs = Binary.encode x'- in Right (mempty, BSL.length bs, x) === Binary.decodeOrFail bs+ in Right (mempty, BL.length bs, x) === Binary.decodeOrFail bs , QC.testProperty "Binary encoding roundtrip (SomeDiscrete through Discrete)" $ QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) -> let x' = Money.toSomeDiscrete x bs = Binary.encode x- in Right (mempty, BSL.length bs, x') === Binary.decodeOrFail bs-#endif+ in Right (mempty, BL.length bs, x') === Binary.decodeOrFail bs #ifdef HAS_cereal , QC.testProperty "Cereal encoding roundtrip" $@@ -869,8 +915,8 @@ Just x === Money.fromSomeExchangeRate (Money.toSomeExchangeRate x) , QC.testProperty "fromSomeExchangeRate works only for same currencies" $ QC.forAll QC.arbitrary $ \(x :: Money.SomeExchangeRate) ->- ((Money.someExchangeRateSrcCurrency x /= symbolVal ps) &&- (Money.someExchangeRateDstCurrency x /= symbolVal pd))+ ((T.unpack (Money.someExchangeRateSrcCurrency x) /= symbolVal ps) &&+ (T.unpack (Money.someExchangeRateDstCurrency x) /= symbolVal pd)) ==> isNothing (Money.fromSomeExchangeRate x :: Maybe (Money.ExchangeRate src dst)) , QC.testProperty "withSomeExchangeRate" $@@ -890,7 +936,7 @@ in xrd === rd , QC.testProperty "exchangeRateFromDecimal: Same as rationalFromDecimal" $- QC.forAll genDecimal $ \(dec :: String, yts :: Maybe Char, ds :: Char) ->+ QC.forAll genDecimal $ \(dec :: T.Text, yts :: Maybe Char, ds :: Char) -> let Just r = Money.rationalFromDecimal yts ds dec yxr = Money.exchangeRateFromDecimal yts ds dec :: Maybe (Money.ExchangeRate src dst)@@ -913,15 +959,14 @@ , QC.testProperty "Aeson decoding of pre-0.4 format (ExchangeRate, SomeExchangeRate)" $ QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) -> let sx = Money.toSomeExchangeRate x- src = Money.someExchangeRateSrcCurrency sx- dst = Money.someExchangeRateDstCurrency sx+ src = T.unpack (Money.someExchangeRateSrcCurrency sx)+ dst = T.unpack (Money.someExchangeRateDstCurrency sx) r = Money.someExchangeRateRate sx- bs = Ae.encode ("ExchangeRate", src, dst, numerator r, denominator r)+ bs = Ae.encode ("ExchangeRate" :: String, src, dst, numerator r, denominator r) in (Just x === Ae.decode bs) .&&. (Just sx === Ae.decode bs) #endif -#ifdef HAS_binary , QC.testProperty "Binary encoding roundtrip" $ QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) -> let Right (_,_,y) = Binary.decodeOrFail (Binary.encode x)@@ -930,18 +975,17 @@ QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) -> let x' = Money.toSomeExchangeRate x bs = Binary.encode x'- in Right (mempty, BSL.length bs, x') === Binary.decodeOrFail bs+ in Right (mempty, BL.length bs, x') === Binary.decodeOrFail bs , QC.testProperty "Binary encoding roundtrip (ExchangeRate through SomeExchangeRate)" $ QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) -> let x' = Money.toSomeExchangeRate x bs = Binary.encode x'- in Right (mempty, BSL.length bs, x) === Binary.decodeOrFail bs+ in Right (mempty, BL.length bs, x) === Binary.decodeOrFail bs , QC.testProperty "Binary encoding roundtrip (SomeExchangeRate through ExchangeRate)" $ QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) -> let x' = Money.toSomeExchangeRate x bs = Binary.encode x- in Right (mempty, BSL.length bs, x') === Binary.decodeOrFail bs-#endif+ in Right (mempty, BL.length bs, x') === Binary.decodeOrFail bs #ifdef HAS_cereal , QC.testProperty "Cereal encoding roundtrip" $@@ -1013,52 +1057,52 @@ testDiscreteFromDecimal = Tasty.testGroup "discreteFromDecimal" [ HU.testCase "Too large" $ do- Money.discreteFromDecimal Nothing '.' "0.053"+ Money.discreteFromDecimal Nothing '.' 1 "0.053" @?= (Nothing :: Maybe (Money.Discrete "USD" "cent"))- Money.discreteFromDecimal (Just ',') '.' "0.253"+ Money.discreteFromDecimal (Just ',') '.' 1 "0.253" @?= (Nothing :: Maybe (Money.Discrete "USD" "cent")) , HU.testCase "USD cent, small, zero" $ do let dis = 0 :: Money.Discrete "USD" "cent" f = Money.discreteFromDecimal- f Nothing '.' "0" @?= Just dis- f Nothing '.' "+0" @?= Just dis- f Nothing '.' "-0" @?= Just dis- f (Just ',') '.' "0" @?= Just dis- f (Just ',') '.' "+0" @?= Just dis- f (Just ',') '.' "-0" @?= Just dis+ f Nothing '.' 1 "0" @?= Just dis+ f Nothing '.' 1 "+0" @?= Just dis+ f Nothing '.' 1 "-0" @?= Just dis+ f (Just ',') '.' 1 "0" @?= Just dis+ f (Just ',') '.' 1 "+0" @?= Just dis+ f (Just ',') '.' 1 "-0" @?= Just dis , HU.testCase "USD cent, small, positive" $ do let dis = 25 :: Money.Discrete "USD" "cent" f = Money.discreteFromDecimal- f Nothing '.' "0.25" @?= Just dis- f Nothing '.' "+0.25" @?= Just dis- f (Just ',') '.' "0.25" @?= Just dis- f (Just ',') '.' "+0.25" @?= Just dis+ f Nothing '.' 1 "0.25" @?= Just dis+ f Nothing '.' 1 "+0.25" @?= Just dis+ f (Just ',') '.' 1 "0.25" @?= Just dis+ f (Just ',') '.' 1 "+0.25" @?= Just dis , HU.testCase "USD cent, small, negative" $ do let dis = -25 :: Money.Discrete "USD" "cent" f = Money.discreteFromDecimal- f Nothing '.' "-0.25" @?= Just dis- f Nothing '.' "-0.25" @?= Just dis- f (Just ',') '.' "-0.25" @?= Just dis- f (Just ',') '.' "-0.25" @?= Just dis+ f Nothing '.' 1 "-0.25" @?= Just dis+ f Nothing '.' 1 "-0.25" @?= Just dis+ f (Just ',') '.' 1 "-0.25" @?= Just dis+ f (Just ',') '.' 1 "-0.25" @?= Just dis , HU.testCase "USD cent, big, positive" $ do let dis = 102300456789 :: Money.Discrete "USD" "cent" f = Money.discreteFromDecimal- f Nothing '.' "1023004567.89" @?= Just dis- f Nothing '.' "+1023004567.89" @?= Just dis- f (Just ',') '.' "1,023,004,567.89" @?= Just dis- f (Just ',') '.' "+1,023,004,567.89" @?= Just dis+ f Nothing '.' 1 "1023004567.89" @?= Just dis+ f Nothing '.' 1 "+1023004567.89" @?= Just dis+ f (Just ',') '.' 1 "1,023,004,567.89" @?= Just dis+ f (Just ',') '.' 1 "+1,023,004,567.89" @?= Just dis , HU.testCase "USD cent, big, negative" $ do let dis = -102300456789 :: Money.Discrete "USD" "cent" f = Money.discreteFromDecimal- f Nothing '.' "-1023004567.89" @?= Just dis- f Nothing '.' "-1023004567.89" @?= Just dis- f (Just ',') '.' "-1,023,004,567.89" @?= Just dis- f (Just ',') '.' "-1,023,004,567.89" @?= Just dis+ f Nothing '.' 1 "-1023004567.89" @?= Just dis+ f Nothing '.' 1 "-1023004567.89" @?= Just dis+ f (Just ',') '.' 1 "-1,023,004,567.89" @?= Just dis+ f (Just ',') '.' 1 "-1,023,004,567.89" @?= Just dis ] testRounding@@ -1090,6 +1134,205 @@ h f = \x -> (Money.denseFromDiscrete x) === case f (Money.denseFromDiscrete x) of (y, 0) -> Money.denseFromDiscrete y (_, _) -> error "testRounding.h: unexpected"++--------------------------------------------------------------------------------+-- Raw parsing "golden tests"++testRawSerializations :: Tasty.TestTree+testRawSerializations =+ Tasty.testGroup "Raw serializations"+ [ Tasty.testGroup "binary"+ [ Tasty.testGroup "encode"+ [ HU.testCase "Dense" $ do+ Right rawDns0 @=?+ fmap (\(_,_,a) -> a) (Binary.decodeOrFail rawDns0_binary)+ , HU.testCase "Discrete" $ do+ Right rawDis0 @=?+ fmap (\(_,_,a) -> a) (Binary.decodeOrFail rawDis0_binary)+ , HU.testCase "ExchangeRate" $ do+ Right rawXr0 @=?+ fmap (\(_,_,a) -> a) (Binary.decodeOrFail rawXr0_binary)+ ]+ , Tasty.testGroup "encode"+ [ HU.testCase "Dense" $ rawDns0_binary @=? Binary.encode rawDns0+ , HU.testCase "Discrete" $ rawDis0_binary @=? Binary.encode rawDis0+ , 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"+rawDns0 = Money.dense' (26%1)++rawDis0 :: Money.Discrete "USD" "cent"+rawDis0 = Money.discrete 4++rawXr0 :: Money.ExchangeRate "USD" "BTC"+Just rawXr0 = Money.exchangeRate (3%2)++-- binary+rawDns0_binary :: BL.ByteString+rawDns0_binary = "\NUL\NUL\NUL\NUL\NUL\NUL\NUL\ETXUSD\NUL\NUL\NUL\NUL\SUB\NUL\NUL\NUL\NUL\SOH"+rawDis0_binary :: BL.ByteString+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 hush :: Either a b -> Maybe b hush (Left _ ) = Nothing