diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -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 diff --git a/safe-money.cabal b/safe-money.cabal --- a/safe-money.cabal +++ b/safe-money.cabal @@ -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 diff --git a/src/Money.hs b/src/Money.hs --- a/src/Money.hs +++ b/src/Money.hs @@ -37,6 +37,7 @@ , I.discreteCurrency , I.discreteFromDense , I.discreteFromDecimal + , I.discreteToDecimal -- * Currency scales , I.Scale , I.GoodScale diff --git a/src/Money/Internal.hs b/src/Money/Internal.hs --- a/src/Money/Internal.hs +++ b/src/Money/Internal.hs @@ -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 diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -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 = -- "" + [ 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 hush :: Either a b -> Maybe b hush (Left _ ) = Nothing