safe-money-serialise (empty) → 0.1
raw patch · 7 files changed
+396/−0 lines, 7 filesdep +basedep +bytestringdep +safe-moneysetup-changed
Dependencies added: base, bytestring, safe-money, safe-money-serialise, serialise, tasty, tasty-hunit, tasty-quickcheck
Files
- LICENSE +30/−0
- README.md +6/−0
- Setup.hs +4/−0
- changelog.md +4/−0
- safe-money-serialise.cabal +54/−0
- src/Money/Serialise.hs +90/−0
- test/Main.hs +208/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2016-2018, Renzo Carbonara++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Renzo Carbonara nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,6 @@+This library exports `Serialise` instances (from the `serialise`+library) for many of the types exported by the `safe-money` library.++Note: The code in this library used to be part of the `safe-money`+library itself, so these instances are intended to be backwards+compatible with older versions of `safe-money`.
+ Setup.hs view
@@ -0,0 +1,4 @@+#! /usr/bin/env nix-shell+#! nix-shell ./shell.nix -i runghc+import Distribution.Simple+main = defaultMain
+ changelog.md view
@@ -0,0 +1,4 @@+# Version 0.1++* This first release of @safe-money-serialise@ includes the same+ @serialise@ support and tests that were present in @safe-money-0.6@.
+ safe-money-serialise.cabal view
@@ -0,0 +1,54 @@+name: safe-money-serialise+version: 0.1+license: BSD3+license-file: LICENSE+copyright: Copyright (c) Renzo Carbonara 2016-2018+author: Renzo Carbonara+maintainer: renλren!zone+stability: Experimental+tested-with: GHC==8.4.1+homepage: https://github.com/k0001/safe-money+bug-reports: https://github.com/k0001/safe-money/issues+category: Money+build-type: Simple+cabal-version: >=1.10+extra-source-files: README.md changelog.md+synopsis: Instances from the serialise library for the safe-money library.+description:+ This library exports @Serialise@ instances (from the @serialise@+ library) for many of the types exported by the @safe-money@ library.+ .+ Note: The code in this library used to be part of the @safe-money@+ library itself, so these instances are intended to be backwards+ compatible with older versions of @safe-money@.++source-repository head+ type: git+ location: https://github.com/k0001/safe-money++library+ default-language: Haskell2010+ hs-source-dirs: src+ ghc-options: -Wall -O2+ build-depends:+ base (>=4.8 && <5.0),+ bytestring,+ safe-money,+ serialise+ exposed-modules:+ Money.Serialise++test-suite test+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ build-depends:+ base,+ bytestring,+ safe-money,+ safe-money-serialise,+ serialise,+ tasty,+ tasty-hunit,+ tasty-quickcheck
+ src/Money/Serialise.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-- | This module only exports orphan 'Ser.Serialise' instances. Import as:+--+-- @+-- import "Money.Serialise" ()+-- @+module Money.Serialise () where++import qualified Codec.Serialise as Ser+import Control.Monad (when)+import Data.Ratio ((%), numerator, denominator)+import GHC.TypeLits (KnownSymbol)+import qualified Money+import qualified Money.Internal as MoneyI++--------------------------------------------------------------------------------+-- | Compatible with 'Money.SomeDense'.+instance (KnownSymbol currency) => Ser.Serialise (Money.Dense currency) where+ encode = Ser.encode . Money.toSomeDense+ decode = maybe (fail "Dense") pure =<< fmap Money.fromSomeDense Ser.decode++-- | Compatible with 'Money.SomeDiscrete'.+instance+ ( KnownSymbol currency, Money.GoodScale scale+ ) => Ser.Serialise (Money.Discrete' currency scale) where+ encode = Ser.encode . Money.toSomeDiscrete+ decode = maybe (fail "Discrete'") pure+ =<< fmap Money.fromSomeDiscrete Ser.decode++-- | Compatible with 'Money.SomeExchangeRate'.+instance+ ( KnownSymbol src, KnownSymbol dst+ ) => Ser.Serialise (Money.ExchangeRate src dst) where+ encode = Ser.encode . Money.toSomeExchangeRate+ decode = maybe (fail "ExchangeRate") pure+ =<< fmap Money.fromSomeExchangeRate Ser.decode++-- | Compatible with 'Money.Dense'.+instance Ser.Serialise Money.SomeDense where+ encode = \sd ->+ let r = Money.someDenseAmount sd+ in Ser.encode (MoneyI.someDenseCurrency' sd) <>+ 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 (MoneyI.mkSomeDense' c (n % d))++-- | Compatible with 'Money.Discrete'.+instance Ser.Serialise Money.SomeDiscrete where+ encode = \sd ->+ let r = Money.someDiscreteScale sd+ in Ser.encode (MoneyI.someDiscreteCurrency' sd) <>+ Ser.encode (numerator r) <>+ Ser.encode (denominator r) <>+ Ser.encode (Money.someDiscreteAmount sd)+ decode = maybe (fail "SomeDiscrete") pure =<< do+ c :: String <- Ser.decode+ n :: Integer <- Ser.decode+ d :: Integer <- Ser.decode+ when (d == 0) (fail "denominator is zero")+ a :: Integer <- Ser.decode+ pure (MoneyI.mkSomeDiscrete' c (n % d) a)++-- | Compatible with 'Money.ExchangeRate'.+instance Ser.Serialise Money.SomeExchangeRate where+ encode = \ser ->+ let r = Money.someExchangeRateRate ser+ in Ser.encode (MoneyI.someExchangeRateSrcCurrency' ser) <>+ Ser.encode (MoneyI.someExchangeRateDstCurrency' ser) <>+ Ser.encode (numerator r) <>+ Ser.encode (denominator r)+ decode = maybe (fail "SomeExchangeRate") pure =<< do+ src :: String <- Ser.decode+ dst :: String <- Ser.decode+ n :: Integer <- Ser.decode+ d :: Integer <- Ser.decode+ when (d == 0) (fail "denominator is zero")+ pure (MoneyI.mkSomeExchangeRate' src dst (n % d))+
+ test/Main.hs view
@@ -0,0 +1,208 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeApplications #-}++module Main where++import qualified Codec.Serialise as Ser+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import Data.Proxy (Proxy(Proxy))+import Data.Ratio ((%), numerator, denominator)+import GHC.TypeLits (Nat, Symbol, KnownSymbol, symbolVal)+import qualified Money+import qualified Test.Tasty as Tasty+import Test.Tasty.HUnit ((@?=), (@=?))+import qualified Test.Tasty.HUnit as HU+import qualified Test.Tasty.Runners as Tasty+import Test.Tasty.QuickCheck ((===), (==>), (.&&.))+import qualified Test.Tasty.QuickCheck as QC++import Money.Serialise()++--------------------------------------------------------------------------------++main :: IO ()+main = Tasty.defaultMainWithIngredients+ [ Tasty.consoleTestReporter+ , Tasty.listingTests+ ] (Tasty.localOption (QC.QuickCheckTests 100) tests)++tests :: Tasty.TestTree+tests =+ Tasty.testGroup "root"+ [ testCurrencies+ , testCurrencyUnits+ , testExchange+ , testRawSerializations+ ]++testCurrencies :: Tasty.TestTree+testCurrencies =+ Tasty.testGroup "Currency"+ [ testDense (Proxy :: Proxy "BTC") -- A cryptocurrency.+ , testDense (Proxy :: Proxy "USD") -- A fiat currency with decimal fractions.+ , testDense (Proxy :: Proxy "VUV") -- A fiat currency with non-decimal fractions.+ , testDense (Proxy :: Proxy "XAU") -- A precious metal.+ ]++testCurrencyUnits :: Tasty.TestTree+testCurrencyUnits =+ Tasty.testGroup "Currency units"+ [ testDiscrete (Proxy :: Proxy "BTC") (Proxy :: Proxy "BTC")+ , testDiscrete (Proxy :: Proxy "BTC") (Proxy :: Proxy "satoshi")+ , testDiscrete (Proxy :: Proxy "BTC") (Proxy :: Proxy "bitcoin")+ , testDiscrete (Proxy :: Proxy "USD") (Proxy :: Proxy "USD")+ , testDiscrete (Proxy :: Proxy "USD") (Proxy :: Proxy "cent")+ , testDiscrete (Proxy :: Proxy "USD") (Proxy :: Proxy "dollar")+ , testDiscrete (Proxy :: Proxy "VUV") (Proxy :: Proxy "vatu")+ , testDiscrete (Proxy :: Proxy "XAU") (Proxy :: Proxy "gram")+ , testDiscrete (Proxy :: Proxy "XAU") (Proxy :: Proxy "grain")+ ]++testDense+ :: forall currency+ . KnownSymbol currency+ => Proxy currency+ -> Tasty.TestTree+testDense pc =+ Tasty.testGroup ("Dense " ++ show (symbolVal pc))+ [ QC.testProperty "Serialise encoding roundtrip" $+ QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+ Just x === hush (Ser.deserialiseOrFail (Ser.serialise x))+ , QC.testProperty "Serialise encoding roundtrip (SomeDense)" $+ QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+ let x' = Money.toSomeDense x+ in Just x' === hush (Ser.deserialiseOrFail (Ser.serialise x'))+ , QC.testProperty "Serialise encoding roundtrip (Dense through SomeDense)" $+ QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+ Just x === hush (Ser.deserialiseOrFail (Ser.serialise (Money.toSomeDense x)))+ , QC.testProperty "Serialise encoding roundtrip (SomeDense through Dense)" $+ QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+ Just (Money.toSomeDense x) === hush (Ser.deserialiseOrFail (Ser.serialise x))+ ]++testExchange :: Tasty.TestTree+testExchange =+ Tasty.testGroup "Exchange"+ [ testExchangeRate (Proxy :: Proxy "BTC") (Proxy :: Proxy "BTC")+ , testExchangeRate (Proxy :: Proxy "BTC") (Proxy :: Proxy "USD")+ , testExchangeRate (Proxy :: Proxy "BTC") (Proxy :: Proxy "VUV")+ , testExchangeRate (Proxy :: Proxy "BTC") (Proxy :: Proxy "XAU")+ , testExchangeRate (Proxy :: Proxy "USD") (Proxy :: Proxy "BTC")+ , testExchangeRate (Proxy :: Proxy "USD") (Proxy :: Proxy "USD")+ , testExchangeRate (Proxy :: Proxy "USD") (Proxy :: Proxy "VUV")+ , testExchangeRate (Proxy :: Proxy "USD") (Proxy :: Proxy "XAU")+ , testExchangeRate (Proxy :: Proxy "VUV") (Proxy :: Proxy "BTC")+ , testExchangeRate (Proxy :: Proxy "VUV") (Proxy :: Proxy "USD")+ , testExchangeRate (Proxy :: Proxy "VUV") (Proxy :: Proxy "VUV")+ , testExchangeRate (Proxy :: Proxy "VUV") (Proxy :: Proxy "XAU")+ , testExchangeRate (Proxy :: Proxy "XAU") (Proxy :: Proxy "BTC")+ , testExchangeRate (Proxy :: Proxy "XAU") (Proxy :: Proxy "USD")+ , testExchangeRate (Proxy :: Proxy "XAU") (Proxy :: Proxy "VUV")+ , testExchangeRate (Proxy :: Proxy "XAU") (Proxy :: Proxy "XAU")+ ]+++testDiscrete+ :: forall (currency :: Symbol) (unit :: Symbol)+ . ( Money.GoodScale (Money.Scale currency unit)+ , KnownSymbol currency+ , KnownSymbol unit )+ => Proxy currency+ -> Proxy unit+ -> Tasty.TestTree+testDiscrete pc pu =+ Tasty.testGroup ("Discrete " ++ show (symbolVal pc) ++ " "+ ++ show (symbolVal pu))+ [ QC.testProperty "Serialise encoding roundtrip" $+ QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+ Just x === hush (Ser.deserialiseOrFail (Ser.serialise x))+ , QC.testProperty "Serialise encoding roundtrip (SomeDiscrete)" $+ QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+ let x' = Money.toSomeDiscrete x+ in Just x' === hush (Ser.deserialiseOrFail (Ser.serialise x'))+ , QC.testProperty "Serialise encoding roundtrip (Discrete through SomeDiscrete)" $+ QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+ Just x === hush (Ser.deserialiseOrFail (Ser.serialise (Money.toSomeDiscrete x)))+ , QC.testProperty "Serialise encoding roundtrip (SomeDiscrete through Discrete)" $+ QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+ Just (Money.toSomeDiscrete x) === hush (Ser.deserialiseOrFail (Ser.serialise x))+ ]++testExchangeRate+ :: forall (src :: Symbol) (dst :: Symbol)+ . (KnownSymbol src, KnownSymbol dst)+ => Proxy src+ -> Proxy dst+ -> Tasty.TestTree+testExchangeRate ps pd =+ Tasty.testGroup ("ExchangeRate " ++ show (symbolVal ps) ++ " "+ ++ show (symbolVal pd))+ [ QC.testProperty "Serialise encoding roundtrip" $+ QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->+ Just x === hush (Ser.deserialiseOrFail (Ser.serialise x))+ , QC.testProperty "Serialise encoding roundtrip (SomeExchangeRate)" $+ QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->+ let x' = Money.toSomeExchangeRate x+ in Just x' === hush (Ser.deserialiseOrFail (Ser.serialise x'))+ , QC.testProperty "Serialise encoding roundtrip (ExchangeRate through SomeExchangeRate)" $+ QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->+ Just x === hush (Ser.deserialiseOrFail (Ser.serialise (Money.toSomeExchangeRate x)))+ , QC.testProperty "Serialise encoding roundtrip (SomeExchangeRate through ExchangeRate)" $+ QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->+ Just (Money.toSomeExchangeRate x) === hush (Ser.deserialiseOrFail (Ser.serialise x))+ ]++--------------------------------------------------------------------------------+-- Raw parsing "golden tests"++testRawSerializations :: Tasty.TestTree+testRawSerializations =+ Tasty.testGroup "Raw serializations"+ [ 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+ ]+ ]+ ]++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)++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"++--------------------------------------------------------------------------------+-- Misc++hush :: Either a b -> Maybe b+hush (Left _ ) = Nothing+hush (Right b) = Just b+