safe-money-xmlbf (empty) → 0.1
raw patch · 7 files changed
+444/−0 lines, 7 filesdep +basedep +bytestringdep +safe-moneysetup-changed
Dependencies added: base, bytestring, safe-money, safe-money-xmlbf, tasty, tasty-hunit, tasty-quickcheck, text, xmlbf
Files
- LICENSE +30/−0
- README.md +6/−0
- Setup.hs +4/−0
- changelog.md +4/−0
- safe-money-xmlbf.cabal +56/−0
- src/Money/Xmlbf.hs +136/−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 `FromXml` and `ToXml` instances (from the `xmlbf`+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-xmlbf@ includes the same @xmlbf@+ support and tests that were present in @safe-money-0.6@.
+ safe-money-xmlbf.cabal view
@@ -0,0 +1,56 @@+name: safe-money-xmlbf+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 xmlbf library for the safe-money library.+description:+ This library exports @FromXml@ and @ToXml@ instances (from the @xmlbf@+ 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),+ safe-money,+ text,+ xmlbf+ exposed-modules:+ Money.Xmlbf++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-xmlbf,+ tasty,+ tasty-hunit,+ tasty-quickcheck,+ text,+ xmlbf+
+ src/Money/Xmlbf.hs view
@@ -0,0 +1,136 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-- | This module only exports orphan 'Ae.FromXml' and 'Ae.ToXml' instances.+-- Import as:+--+-- @+-- import "Money.Xmlbf" ()+-- @+module Money.Xmlbf () where++import Control.Applicative (empty)+import Control.Monad (when)+import Data.Ratio ((%), numerator, denominator)+import qualified Data.Text as T+import GHC.Exts (fromList)+import GHC.TypeLits (KnownSymbol)+import qualified Money+import qualified Xmlbf++--------------------------------------------------------------------------------++-- | Compatible with 'Money.SomeDense'+--+-- Example rendering @'Money.dense' (2 '%' 3) :: 'Money.Dense' \"BTC\"@:+--+-- @+-- \<money-dense c=\"BTC\" n=\"2\" d=\"3\"/>+-- @+instance KnownSymbol currency => Xmlbf.ToXml (Money.Dense currency) where+ toXml = Xmlbf.toXml . Money.toSomeDense++-- | Compatible with 'Money.SomeDense'+instance KnownSymbol currency => Xmlbf.FromXml (Money.Dense currency) where+ fromXml = maybe empty pure =<< fmap Money.fromSomeDense Xmlbf.fromXml++-- | Compatible with 'Money.Dense'+instance Xmlbf.ToXml Money.SomeDense where+ toXml = \sd ->+ let r = Money.someDenseAmount sd+ as = [ (T.pack "c", Money.someDenseCurrency sd)+ , (T.pack "n", T.pack (show (numerator r)))+ , (T.pack "d", T.pack (show (denominator r))) ]+ in [ Xmlbf.element' (T.pack "money-dense") (fromList as) [] ]++-- | Compatible with 'Money.Dense'.+instance Xmlbf.FromXml Money.SomeDense where+ fromXml = Xmlbf.pElement (T.pack "money-dense") $ do+ c <- Xmlbf.pAttr "c"+ n <- Xmlbf.pRead =<< Xmlbf.pAttr "n"+ d <- Xmlbf.pRead =<< Xmlbf.pAttr "d"+ when (d == 0) (fail "denominator is zero")+ maybe empty pure (Money.mkSomeDense c (n % d))++-- | Compatible with 'Money.SomeDiscrete'+--+-- Example rendering @'Money.discrete' 43 :: 'Money.Discrete' \"BTC\" \"satoshi\"@:+--+-- @+-- \<money-discrete c=\"BTC\" n=\"100000000\" d=\"1\" a=\"43\"/>+-- @+instance+ ( KnownSymbol currency, Money.GoodScale scale+ ) => Xmlbf.ToXml (Money.Discrete' currency scale) where+ toXml = Xmlbf.toXml . Money.toSomeDiscrete++-- | Compatible with 'Money.SomeDiscrete'+instance+ ( KnownSymbol currency, Money.GoodScale scale+ ) => Xmlbf.FromXml (Money.Discrete' currency scale) where+ fromXml = maybe empty pure =<< fmap Money.fromSomeDiscrete Xmlbf.fromXml++-- | Compatible with 'Money.Discrete''+instance Xmlbf.ToXml Money.SomeDiscrete where+ toXml = \sd ->+ let r = Money.someDiscreteScale sd+ as = [ ("c", Money.someDiscreteCurrency sd)+ , ("n", T.pack (show (numerator r)))+ , ("d", T.pack (show (denominator r)))+ , ("a", T.pack (show (Money.someDiscreteAmount sd))) ]+ in [ Xmlbf.element' (T.pack "money-discrete") (fromList as) [] ]++-- | Compatible with 'Money.Discrete''+instance Xmlbf.FromXml Money.SomeDiscrete where+ fromXml = Xmlbf.pElement (T.pack "money-discrete") $ do+ c <- Xmlbf.pAttr "c"+ n <- Xmlbf.pRead =<< Xmlbf.pAttr "n"+ d <- Xmlbf.pRead =<< Xmlbf.pAttr "d"+ when (d == 0) (fail "denominator is zero")+ a <- Xmlbf.pRead =<< Xmlbf.pAttr "a"+ maybe empty pure (Money.mkSomeDiscrete c (n % d) a)++-- | Compatible with 'Money..SomeExchangeRate'+--+-- Example rendering an 'Money.ExchangeRate' constructed with+-- @'Money.exchangeRate' (5 '%' 7) :: 'Money.ExchangeRate' \"USD\" \"JPY\"@+--+-- @+-- \<exchange-rate src=\"USD\" dst=\"JPY\" n=\"5\" d=\"7\"/>+-- @+instance+ ( KnownSymbol src, KnownSymbol dst+ ) => Xmlbf.ToXml (Money.ExchangeRate src dst) where+ toXml = Xmlbf.toXml . Money.toSomeExchangeRate++-- | Compatible with 'Money.SomeExchangeRate'+instance+ ( KnownSymbol src, KnownSymbol dst+ ) => Xmlbf.FromXml (Money.ExchangeRate src dst) where+ fromXml = maybe empty pure =<< fmap Money.fromSomeExchangeRate Xmlbf.fromXml++-- | Compatible with 'Money.ExchangeRate'+instance Xmlbf.ToXml Money.SomeExchangeRate where+ toXml = \ser ->+ let r = Money.someExchangeRateRate ser+ as = [ ("src", Money.someExchangeRateSrcCurrency ser)+ , ("dst", Money.someExchangeRateDstCurrency ser)+ , ("n", T.pack (show (numerator r)))+ , ("d", T.pack (show (denominator r))) ]+ in [ Xmlbf.element' (T.pack "exchange-rate") (fromList as) [] ]++-- | Compatible with 'Money.ExchangeRate'+instance Xmlbf.FromXml Money.SomeExchangeRate where+ fromXml = Xmlbf.pElement (T.pack "exchange-rate") $ do+ src <- Xmlbf.pAttr "src"+ dst <- Xmlbf.pAttr "dst"+ n <- Xmlbf.pRead =<< Xmlbf.pAttr "n"+ d <- Xmlbf.pRead =<< Xmlbf.pAttr "d"+ when (d == 0) (fail "denominator is zero")+ maybe empty pure (Money.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 Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+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 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 qualified Xmlbf++import Money.Xmlbf ()++--------------------------------------------------------------------------------++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 "Xmlbf encoding roundtrip" $+ QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+ Right x === Xmlbf.runParser Xmlbf.fromXml (Xmlbf.toXml x)+ , QC.testProperty "Xmlbf encoding roundtrip (SomeDense)" $+ QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+ let x' = Money.toSomeDense x+ in Right x' === Xmlbf.runParser Xmlbf.fromXml (Xmlbf.toXml x')+ , QC.testProperty "Xmlbf encoding roundtrip (Dense through SomeDense)" $+ QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+ Right x === Xmlbf.runParser Xmlbf.fromXml (Xmlbf.toXml (Money.toSomeDense x))+ , QC.testProperty "Xmlbf encoding roundtrip (SomeDense through Dense)" $+ QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->+ Right (Money.toSomeDense x) === Xmlbf.runParser Xmlbf.fromXml (Xmlbf.toXml x)+ ]++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 "Xmlbf encoding roundtrip" $+ QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+ Right x === Xmlbf.runParser Xmlbf.fromXml (Xmlbf.toXml x)+ , QC.testProperty "Xmlbf encoding roundtrip (SomeDiscrete)" $+ QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+ let x' = Money.toSomeDiscrete x+ in Right x' === Xmlbf.runParser Xmlbf.fromXml (Xmlbf.toXml x')+ , QC.testProperty "Xmlbf encoding roundtrip (Discrete through SomeDiscrete)" $+ QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+ Right x === Xmlbf.runParser Xmlbf.fromXml (Xmlbf.toXml (Money.toSomeDiscrete x))+ , QC.testProperty "Xmlbf encoding roundtrip (SomeDiscrete through Discrete)" $+ QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->+ Right (Money.toSomeDiscrete x) === Xmlbf.runParser Xmlbf.fromXml (Xmlbf.toXml x)+ ]++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 "Xmlbf encoding roundtrip" $+ QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->+ Right x === Xmlbf.runParser Xmlbf.fromXml (Xmlbf.toXml x)+ , QC.testProperty "Xmlbf encoding roundtrip (SomeExchangeRate)" $+ QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->+ let x' = Money.toSomeExchangeRate x+ in Right x' === Xmlbf.runParser Xmlbf.fromXml (Xmlbf.toXml x')+ , QC.testProperty "Xmlbf encoding roundtrip (ExchangeRate through SomeExchangeRate)" $+ QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->+ Right x === Xmlbf.runParser Xmlbf.fromXml (Xmlbf.toXml (Money.toSomeExchangeRate x))+ , QC.testProperty "Xmlbf encoding roundtrip (SomeExchangeRate through ExchangeRate)" $+ QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->+ Right (Money.toSomeExchangeRate x) === Xmlbf.runParser Xmlbf.fromXml (Xmlbf.toXml x)+ ]++--------------------------------------------------------------------------------+-- Raw parsing "golden tests"++testRawSerializations :: Tasty.TestTree+testRawSerializations =+ Tasty.testGroup "Raw serializations"+ [ 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+ ]+ ]+ ]++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_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")]) [] ]++