{-# 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 "satoshi")
, testDiscrete (Proxy :: Proxy "BTC") (Proxy :: Proxy "bitcoin")
, 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.UnitScale 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 "Dense (negative)" $ do
Right rawDns1 @=? Xmlbf.runParser Xmlbf.fromXml rawDns1_xmlbf
, HU.testCase "Discrete" $ do
Right rawDis0 @=? Xmlbf.runParser Xmlbf.fromXml rawDis0_xmlbf
, HU.testCase "Discrete (negative)" $ do
Right rawDis1 @=? Xmlbf.runParser Xmlbf.fromXml rawDis1_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 "Dense (negative)" $ rawDns1_xmlbf @=? Xmlbf.toXml rawDns1
, HU.testCase "Discrete" $ rawDis0_xmlbf @=? Xmlbf.toXml rawDis0
, HU.testCase "Discrete (negative)" $ rawDis1_xmlbf @=? Xmlbf.toXml rawDis1
, HU.testCase "ExchangeRate" $ rawXr0_xmlbf @=? Xmlbf.toXml rawXr0
]
]
]
rawDns0 :: Money.Dense "USD"
rawDns0 = Money.dense' (26%1)
rawDns1 :: Money.Dense "USD"
rawDns1 = Money.dense' (negate 26 % 1)
rawDis0 :: Money.Discrete "USD" "cent"
rawDis0 = Money.discrete 4
rawDis1 :: Money.Discrete "USD" "cent"
rawDis1 = Money.discrete (negate 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\"/>"
[ either error id $ Xmlbf.element' "money-dense" (fromList [("n","26"), ("d","1"), ("c","USD")]) [] ]
rawDns1_xmlbf :: [Xmlbf.Node]
rawDns1_xmlbf = -- "<money-dense n=\"-26\" d=\"1\" c=\"USD\"/>"
[ either error id $ 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\"/>"
[ either error id $ Xmlbf.element' "money-discrete" (fromList [("n","100"), ("d","1"), ("c","USD"), ("a","4")]) [] ]
rawDis1_xmlbf :: [Xmlbf.Node]
rawDis1_xmlbf = -- "<money-discrete n=\"100\" a=\"-4\" d=\"1\" c=\"USD\"/>"
[ either error id $ 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\"/>"
[ either error id $ Xmlbf.element' "exchange-rate" (fromList [("n","3"), ("d","2"), ("src","USD"), ("dst","BTC")]) [] ]