packages feed

safe-money-0.8: test/Main.hs

{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeApplications #-}

module Main where

import Control.Category (Category((.), id))
import Control.DeepSeq (rnf)
import qualified Data.AdditiveGroup as AG
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.Constraint (Dict(Dict))
import Data.Maybe (catMaybes, fromJust, fromMaybe, isJust, isNothing)
import Data.Proxy (Proxy(Proxy))
import Data.Ratio ((%), numerator, denominator)
import qualified Data.Text as T
import qualified Data.VectorSpace as VS
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 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 Money
import qualified Money.Internal as MoneyI

--------------------------------------------------------------------------------

-- | A wrapper around a decimal representation and its 'Money.DecimalConf',
-- mostly just to benefit from its 'QC.Arbitrary' instance.
data Decimal = Decimal Money.DecimalConf T.Text
  deriving (Show)

instance QC.Arbitrary Decimal where
  arbitrary = uncurry (flip Decimal) <$> genDecimal
  shrink (Decimal ds t) = Decimal <$> QC.shrink ds
                                  <*> fmap T.pack (QC.shrink (T.unpack t))

-- | Generates a valid 'MoneyI.rationalToDecimal' result using the returned
-- 'Money.DecimalConf'.
genDecimal :: QC.Gen (T.Text, Money.DecimalConf)
genDecimal = do
  aprox :: Money.Approximation <- QC.arbitrary
  ds :: Money.DecimalConf <- QC.arbitrary
  r :: Rational <- (%) <$> QC.arbitrary <*> QC.suchThat QC.arbitrary (/= 0)
  pure (MoneyI.rationalToDecimal ds aprox r, ds)

--------------------------------------------------------------------------------

main :: IO ()
main =  Tasty.defaultMainWithIngredients
  [ Tasty.consoleTestReporter
  , Tasty.listingTests
  ] (Tasty.localOption (QC.QuickCheckTests 100) tests)

tests :: Tasty.TestTree
tests =
  Tasty.testGroup "root"
  [ testCurrencies
  , testHalfEvenRounding
  , testCurrencyUnits
  , testExchange
  , testRationalToDecimal
  , testRationalFromDecimal
  , testMkSeparators
  , testDiscreteFromDecimal
  , 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")
  ]


testRationalToDecimal :: Tasty.TestTree
testRationalToDecimal =
  Tasty.testGroup "rationalToDecimal"
  [ HU.testCase "Round: r1" $ do
       render Money.Round r1 @?=
         [ "1023004567.90"        --  0
         , "1,023,004,567.90"     --  1
         , "+1023004567.90"       --  2
         , "+1,023,004,567.90"    --  3
         , "1023004568"           --  4
         , "1,023,004,568"        --  5
         , "+1023004568"          --  6
         , "+1,023,004,568"       --  7
         ]
  , HU.testCase "Round: negate r1" $ do
       render Money.Round (negate r1) @?=
         [ "-1023004567.90"       --  0
         , "-1,023,004,567.90"    --  1
         , "-1023004567.90"       --  2
         , "-1,023,004,567.90"    --  3
         , "-1023004568"          --  4
         , "-1,023,004,568"       --  5
         , "-1023004568"          --  6
         , "-1,023,004,568"       --  7
         ]
  , HU.testCase "Round: r2" $ do
       render Money.Round r2 @?=
         [ "1.23"    --  0
         , "1.23"    --  1
         , "+1.23"   --  2
         , "+1.23"   --  3
         , "1"       --  4
         , "1"       --  5
         , "+1"      --  6
         , "+1"      --  7
         ]
  , HU.testCase "Round: negate r2" $ do
       render Money.Round (negate r2) @?=
         [ "-1.23"    --  0
         , "-1.23"    --  1
         , "-1.23"    --  2
         , "-1.23"    --  3
         , "-1"       --  4
         , "-1"       --  5
         , "-1"       --  6
         , "-1"       --  7
         ]
  , HU.testCase "Round: r3" $ do
       render Money.Round r3 @?=
         [ "0.34"   --  0
         , "0.34"   --  1
         , "+0.34"  --  2
         , "+0.34"  --  3
         , "0"      --  4
         , "0"      --  5
         , "0"      --  6
         , "0"      --  7
         ]
  , HU.testCase "Round: negate r3" $ do
       render Money.Round (negate r3) @?=
         [ "-0.34"   --  0
         , "-0.34"   --  1
         , "-0.34"   --  2
         , "-0.34"   --  3
         , "0"       --  4
         , "0"       --  5
         , "0"       --  6
         , "0"       --  7
         ]
  , HU.testCase "Round: r4" $ do
       render Money.Round r4 @?=
         [ "0.01"   --  0
         , "0.01"   --  1
         , "+0.01"  --  2
         , "+0.01"  --  3
         , "0"      --  4
         , "0"      --  5
         , "0"      --  6
         , "0"      --  7
         ]
  , HU.testCase "Round: negate r4" $ do
       render Money.Round (negate r4) @?=
         [ "-0.01"   --  0
         , "-0.01"   --  1
         , "-0.01"   --  2
         , "-0.01"   --  3
         , "0"       --  4
         , "0"       --  5
         , "0"       --  6
         , "0"       --  7
         ]
  , HU.testCase "Round: r5" $ do
       render Money.Round r5 @?=
         [ "0.50"   --  0
         , "0.50"   --  1
         , "+0.50"  --  2
         , "+0.50"  --  3
         , "0"      --  4
         , "0"      --  5
         , "0"      --  6
         , "0"      --  7
         ]
  , HU.testCase "Round: negate r5" $ do
       render Money.Round (negate r5) @?=
         [ "-0.50"   --  0
         , "-0.50"   --  1
         , "-0.50"   --  2
         , "-0.50"   --  3
         , "0"       --  4
         , "0"       --  5
         , "0"       --  6
         , "0"       --  7
         ]

  , HU.testCase "Floor: r1" $ do
       render Money.Floor r1 @?=
         [ "1023004567.89"        --  0
         , "1,023,004,567.89"     --  1
         , "+1023004567.89"       --  2
         , "+1,023,004,567.89"    --  3
         , "1023004567"           --  4
         , "1,023,004,567"        --  5
         , "+1023004567"          --  6
         , "+1,023,004,567"       --  7
         ]
  , HU.testCase "Floor: negate r1" $ do
       render Money.Floor (negate r1) @?=
         [ "-1023004567.90"       --  0
         , "-1,023,004,567.90"    --  1
         , "-1023004567.90"       --  2
         , "-1,023,004,567.90"    --  3
         , "-1023004568"          --  4
         , "-1,023,004,568"       --  5
         , "-1023004568"          --  6
         , "-1,023,004,568"       --  7
         ]
  , HU.testCase "Floor: r2" $ do
       render Money.Floor r2 @?=
         [ "1.23"    --  0
         , "1.23"    --  1
         , "+1.23"   --  2
         , "+1.23"   --  3
         , "1"       --  4
         , "1"       --  5
         , "+1"      --  6
         , "+1"      --  7
         ]
  , HU.testCase "Floor: negate r2" $ do
       render Money.Floor (negate r2) @?=
         [ "-1.23"    --  0
         , "-1.23"    --  1
         , "-1.23"    --  2
         , "-1.23"    --  3
         , "-2"       --  4
         , "-2"       --  5
         , "-2"       --  6
         , "-2"       --  7
         ]
  , HU.testCase "Floor: r3" $ do
       render Money.Floor r3 @?=
         [ "0.34"   --  0
         , "0.34"   --  1
         , "+0.34"  --  2
         , "+0.34"  --  3
         , "0"      --  4
         , "0"      --  5
         , "0"      --  6
         , "0"      --  7
         ]
  , HU.testCase "Floor: negate r3" $ do
       render Money.Floor (negate r3) @?=
         [ "-0.35"   --  0
         , "-0.35"   --  1
         , "-0.35"   --  2
         , "-0.35"   --  3
         , "-1"      --  4
         , "-1"      --  5
         , "-1"      --  6
         , "-1"      --  7
         ]
  , HU.testCase "Floor: r4" $ do
       render Money.Floor r4 @?=
         [ "0.00"   --  0
         , "0.00"   --  1
         , "0.00"   --  2
         , "0.00"   --  3
         , "0"      --  4
         , "0"      --  5
         , "0"      --  6
         , "0"      --  7
         ]
  , HU.testCase "Floor: negate r4" $ do
       render Money.Floor (negate r4) @?=
         [ "-0.01"   --  0
         , "-0.01"   --  1
         , "-0.01"   --  2
         , "-0.01"   --  3
         , "-1"      --  4
         , "-1"      --  5
         , "-1"      --  6
         , "-1"      --  7
         ]
  , HU.testCase "Floor: r5" $ do
       render Money.Floor r5 @?=
         [ "0.50"   --  0
         , "0.50"   --  1
         , "+0.50"   --  2
         , "+0.50"   --  3
         , "0"      --  4
         , "0"      --  5
         , "0"      --  6
         , "0"      --  7
         ]
  , HU.testCase "Floor: negate r5" $ do
       render Money.Floor (negate r5) @?=
         [ "-0.50"   --  0
         , "-0.50"   --  1
         , "-0.50"   --  2
         , "-0.50"   --  3
         , "-1"      --  4
         , "-1"      --  5
         , "-1"      --  6
         , "-1"      --  7
         ]

  , HU.testCase "Ceiling: r1" $ do
       render Money.Ceiling r1 @?=
         [ "1023004567.90"        --  0
         , "1,023,004,567.90"     --  1
         , "+1023004567.90"       --  2
         , "+1,023,004,567.90"    --  3
         , "1023004568"           --  4
         , "1,023,004,568"        --  5
         , "+1023004568"          --  6
         , "+1,023,004,568"       --  7
         ]
  , HU.testCase "Ceiling: negate r1" $ do
       render Money.Ceiling (negate r1) @?=
         [ "-1023004567.89"       --  0
         , "-1,023,004,567.89"    --  1
         , "-1023004567.89"       --  2
         , "-1,023,004,567.89"    --  3
         , "-1023004567"          --  4
         , "-1,023,004,567"       --  5
         , "-1023004567"          --  6
         , "-1,023,004,567"       --  7
         ]
  , HU.testCase "Ceiling: r2" $ do
       render Money.Ceiling r2 @?=
         [ "1.23"    --  0
         , "1.23"    --  1
         , "+1.23"   --  2
         , "+1.23"   --  3
         , "2"       --  4
         , "2"       --  5
         , "+2"      --  6
         , "+2"      --  7
         ]
  , HU.testCase "Ceiling: negate r2" $ do
       render Money.Ceiling (negate r2) @?=
         [ "-1.23"    --  0
         , "-1.23"    --  1
         , "-1.23"    --  2
         , "-1.23"    --  3
         , "-1"       --  4
         , "-1"       --  5
         , "-1"       --  6
         , "-1"       --  7
         ]
  , HU.testCase "Ceiling: r3" $ do
       render Money.Ceiling r3 @?=
         [ "0.35"   --  0
         , "0.35"   --  1
         , "+0.35"  --  2
         , "+0.35"  --  3
         , "1"      --  4
         , "1"      --  5
         , "+1"     --  6
         , "+1"     --  7
         ]
  , HU.testCase "Ceiling: negate r3" $ do
       render Money.Ceiling (negate r3) @?=
         [ "-0.34"   --  0
         , "-0.34"   --  1
         , "-0.34"   --  2
         , "-0.34"   --  3
         , "0"       --  4
         , "0"       --  5
         , "0"       --  6
         , "0"       --  7
         ]
  , HU.testCase "Ceiling: r4" $ do
       render Money.Ceiling r4 @?=
         [ "0.01"   --  0
         , "0.01"   --  1
         , "+0.01"  --  2
         , "+0.01"  --  3
         , "1"      --  4
         , "1"      --  5
         , "+1"     --  6
         , "+1"     --  7
         ]
  , HU.testCase "Ceiling: negate r4" $ do
       render Money.Ceiling (negate r4) @?=
         [ "0.00"   --  0
         , "0.00"   --  1
         , "0.00"   --  2
         , "0.00"   --  3
         , "0"      --  4
         , "0"      --  5
         , "0"      --  6
         , "0"      --  7
         ]
  , HU.testCase "Ceiling: r5" $ do
       render Money.Ceiling r5 @?=
         [ "0.50"   --  0
         , "0.50"   --  1
         , "+0.50"  --  2
         , "+0.50"  --  3
         , "1"      --  4
         , "1"      --  5
         , "+1"     --  6
         , "+1"     --  7
         ]
  , HU.testCase "Ceiling: negate r5" $ do
       render Money.Ceiling (negate r5) @?=
         [ "-0.50"   --  0
         , "-0.50"   --  1
         , "-0.50"   --  2
         , "-0.50"   --  3
         , "0"      --  4
         , "0"      --  5
         , "0"      --  6
         , "0"      --  7
         ]

  , HU.testCase "Truncate: r1" $ do
      render Money.Truncate r1 @?= render Money.Floor r1

  , HU.testCase "Truncate: negate r1" $ do
      render Money.Truncate (negate r1) @?= render Money.Ceiling (negate r1)

  , HU.testCase "Truncate: r2" $ do
      render Money.Truncate r2 @?= render Money.Floor r2

  , HU.testCase "Truncate: negate r2" $ do
      render Money.Truncate (negate r2) @?= render Money.Ceiling (negate r2)

  , HU.testCase "Truncate: r3" $ do
      render Money.Truncate r3 @?= render Money.Floor r3

  , HU.testCase "Truncate: negate r3" $ do
      render Money.Truncate (negate r3) @?= render Money.Ceiling (negate r3)

  , HU.testCase "Truncate: r4" $ do
      render Money.Truncate r4 @?= render Money.Floor r4

  , HU.testCase "Truncate: negate r4" $ do
      render Money.Truncate (negate r4) @?= render Money.Ceiling (negate r4)

  , HU.testCase "Truncate: r5" $ do
      render Money.Truncate r5 @?= render Money.Floor r5

  , HU.testCase "Truncate: negate r5" $ do
      render Money.Truncate (negate r5) @?= render Money.Ceiling (negate r5)

  , HU.testCase "HalfEven: r1" $ do
      render Money.HalfEven r1 @?= render Money.Round r1

  , HU.testCase "HalfEven: negate r1" $ do
      render Money.HalfEven (negate r1) @?= render Money.Round (negate r1)

  , HU.testCase "HalfEven: r2" $ do
      render Money.HalfEven r2 @?= render Money.Round r2

  , HU.testCase "HalfEven: negate r2" $ do
      render Money.HalfEven (negate r2) @?= render Money.Round (negate r2)

  , HU.testCase "HalfEven: r3" $ do
      render Money.HalfEven r3 @?= render Money.Round r3

  , HU.testCase "HalfEven: negate r3" $ do
      render Money.HalfEven (negate r3) @?= render Money.Round (negate r3)

  , HU.testCase "HalfEven: r4" $ do
      render Money.HalfEven r4 @?= render Money.Round r4

  , HU.testCase "HalfEven: negate r4" $ do
      render Money.HalfEven (negate r4) @?= render Money.Round (negate r4)

  , HU.testCase "HalfEven: r5" $ do
       render Money.HalfEven r5 @?=
         [ "0.50"   --  0
         , "0.50"   --  1
         , "+0.50"  --  2
         , "+0.50"  --  3
         , "0"      --  4
         , "0"      --  5
         , "0"      --  6
         , "0"      --  7
         ]
  , HU.testCase "HalfEven: negate r5" $ do
       render Money.HalfEven (negate r5) @?=
         [ "-0.50"   --  0
         , "-0.50"   --  1
         , "-0.50"   --  2
         , "-0.50"   --  3
         , "0"      --  4
         , "0"      --  5
         , "0"      --  6
         , "0"      --  7
         ]

  ]
  where
    r1 :: Rational = 1023004567895 % 1000
    r2 :: Rational = 123 % 100
    r3 :: Rational = 345 % 1000
    r4 :: Rational = 7 % 1000
    r5 :: Rational = 1 % 2

    render :: Money.Approximation -> Rational -> [T.Text]
    render a r =
      [ MoneyI.rationalToDecimal ds_dd_2 a r        -- 0
      , MoneyI.rationalToDecimal ds_tc_dd_2 a r     -- 1
      , MoneyI.rationalToDecimal ds_p_dd_2 a r      -- 2
      , MoneyI.rationalToDecimal ds_p_tc_dd_2 a r   -- 3
      , MoneyI.rationalToDecimal ds_dd_0 a r        -- 4
      , MoneyI.rationalToDecimal ds_tc_dd_0 a r     -- 5
      , MoneyI.rationalToDecimal ds_p_dd_0 a r      -- 6
      , MoneyI.rationalToDecimal ds_p_tc_dd_0 a r   -- 7
      ]

testMkSeparators :: Tasty.TestTree
testMkSeparators =
  Tasty.testGroup "mkSeparators"
  [ QC.testProperty "Unsupported separators" $
      let mbadsep :: QC.Gen Char = QC.suchThat QC.arbitrary $ \c ->
            Char.isDigit c || Char.isControl c
          mgoodsep :: QC.Gen Char = QC.suchThat QC.arbitrary $ \c ->
            not (Char.isDigit c || Char.isControl c)
      in QC.forAll ((,,) <$> mbadsep <*> mbadsep <*> mgoodsep) $
           \(s1 :: Char, s2 :: Char, s3 :: Char) ->
               (Money.mkSeparators s1 Nothing   === Nothing) .&&.
               (Money.mkSeparators s2 (Just s1) === Nothing) .&&.
               (Money.mkSeparators s1 (Just s1) === Nothing) .&&.
               (Money.mkSeparators s3 (Just s3) === Nothing)
  ]

testRationalFromDecimal :: Tasty.TestTree
testRationalFromDecimal =
  Tasty.testGroup "rationalFromDecimal"
  [ 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.
      QC.forAll QC.arbitrary $ \(ds0 :: Money.DecimalConf,
                                 aprox :: Money.Approximation,
                                 r :: Rational) ->
        let Just sr = Money.scaleFromRational
                    $ (+ 1) -- scales less than 1 can't reliably roundtrip.
                    $ Money.scaleToRational
                    $ Money.decimalConf_scale ds0
            ds1 = ds0 { Money.decimalConf_scale = sr }
            dec = MoneyI.rationalToDecimal ds1 aprox r
            Just r' = MoneyI.rationalFromDecimal ds1 dec
        in 1 > abs (abs r - abs r')
  ]

testDense
  :: forall currency
  .  KnownSymbol currency
  => Proxy currency
  -> Tasty.TestTree
testDense pc =
  Tasty.testGroup ("Dense " ++ show (symbolVal pc))
  [ 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 " $
      QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->
         Just x === read (show (Just x))

  , QC.testProperty "fromSomeDense . someDense == Just" $
      QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->
         Just x === Money.fromSomeDense (Money.toSomeDense x)

  , QC.testProperty "fromSomeDense works only for same currency" $
      QC.forAll QC.arbitrary $ \(dr :: Money.SomeDense) ->
        (T.unpack (Money.someDenseCurrency dr) /= symbolVal pc)
           ==> isNothing (Money.fromSomeDense dr :: Maybe (Money.Dense currency))

  , QC.testProperty "withSomeDense" $
      QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->
        let dr = Money.toSomeDense x
        in Money.withSomeDense dr $ \x' ->
             (show x, dr, Money.toSomeDense (x + 1))
                === (show x', Money.toSomeDense x', Money.toSomeDense (x' + 1))

  , QC.testProperty "denseCurrency" $
      QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->
        T.unpack (Money.denseCurrency x) === symbolVal pc

  , QC.testProperty "denseToDecimal: Same as rationalToDecimal" $
      QC.forAll QC.arbitrary $ \(ds :: Money.DecimalConf,
                                 dns :: Money.Dense currency,
                                 aprox :: Money.Approximation) ->
         let Just s100 = Money.scaleFromRational
                    (Money.scaleToRational (Money.decimalConf_scale ds) * 100)
             ds_s100 = ds { Money.decimalConf_scale = s100 }
             ydnsd1 = Money.denseToDecimal ds aprox dns
             ydnsd100 = Money.denseToDecimal ds_s100 aprox dns
             yrd1 = MoneyI.rationalToDecimal ds aprox (toRational dns)
             yrd100 = MoneyI.rationalToDecimal ds aprox (toRational dns * 100)
         in (ydnsd1 === yrd1) .&&. (ydnsd100 === yrd100)

  , QC.testProperty "denseFromDecimal: Same as rationalFromDecimal" $
      QC.forAll QC.arbitrary $ \(Decimal ds dec) ->
         let Just r = MoneyI.rationalFromDecimal ds dec
             Just dns = Money.denseFromDecimal ds 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.
      QC.forAll QC.arbitrary $ \(ds0 :: Money.DecimalConf,
                                 aprox :: Money.Approximation,
                                 dns :: Money.Dense currency) ->
        let Just sr = Money.scaleFromRational
                    $ (+ 1) -- scales less than 1 can't reliably roundtrip.
                    $ Money.scaleToRational
                    $ Money.decimalConf_scale ds0
            ds1 = ds0 { Money.decimalConf_scale = sr }
            dec = Money.denseToDecimal ds1 aprox dns
            Just dns' = Money.denseFromDecimal ds1 dec
        in Money.dense' 1 > abs (abs dns - abs dns')

  , HU.testCase "AdditiveGroup: zeroV" $
      (AG.zeroV :: Money.Dense currency) @?= Money.dense' (0%1)
  , QC.testProperty "AdditiveGroup: negateV" $
      QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->
         AG.negateV x === negate x
  , QC.testProperty "AdditiveGroup: ^+^" $
      QC.forAll QC.arbitrary $ \(x :: Money.Dense currency, y) ->
         x AG.^+^ y === x + y
  , QC.testProperty "AdditiveGroup: ^-^" $
      QC.forAll QC.arbitrary $ \(x :: Money.Dense currency, y) ->
         x AG.^-^ y === x - y
  , QC.testProperty "VectorSpace: *^" $
      QC.forAll QC.arbitrary $ \(x :: Money.Dense currency, y) ->
         (toRational x VS.*^ y === x * y) .&&.
         (toRational y VS.*^ x === x * y)

  , QC.testProperty "Binary encoding roundtrip" $
      QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->
         let Right (_,_,y) = Binary.decodeOrFail (Binary.encode x)
         in x === y
  , QC.testProperty "Binary encoding roundtrip (SomeDense)" $
      QC.forAll QC.arbitrary $ \(x :: Money.Dense currency) ->
         let x' = Money.toSomeDense x
             bs = Binary.encode x'
         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, 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, BL.length bs, x') === Binary.decodeOrFail bs
  ]

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))
  [ 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)
  , QC.testProperty "read . show . Just == Just" $
      QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->
         Just x === read (show (Just x))
  , QC.testProperty "fromSomeDiscrete . someDiscrete == Just" $
      QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->
         Just x === Money.fromSomeDiscrete (Money.toSomeDiscrete x)
  , QC.testProperty "fromSomeDiscrete works only for same currency and scale" $
      QC.forAll QC.arbitrary $ \(dr :: Money.SomeDiscrete) ->
        ((T.unpack (Money.someDiscreteCurrency dr) /= symbolVal pc) &&
         (Money.someDiscreteScale dr /=
             Money.scale (Proxy :: Proxy (Money.UnitScale currency unit)))
        ) ==> isNothing (Money.fromSomeDiscrete dr
                          :: Maybe (Money.Discrete currency unit))
  , QC.testProperty "withSomeDiscrete" $
      QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->
        let dr = Money.toSomeDiscrete x
        in ( Money.withSomeDiscrete dr $ \x' ->
                (show x, dr, Money.toSomeDiscrete (x + 1))
                   === (show x', Money.toSomeDiscrete x', Money.toSomeDiscrete (x' + 1))
           ) :: QC.Property

  , QC.testProperty "discreteCurrency" $
      QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->
        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.
      QC.forAll QC.arbitrary $ \(ds :: Money.DecimalConf,
                                 sc0 :: Rational,
                                 aprox :: Money.Approximation,
                                 dis :: Money.Discrete currency unit) ->
        let sc = abs sc0 + 1  -- scales less than 1 can't reliably roundtrip.
            dns = Money.denseFromDiscrete dis
        in Money.discreteToDecimal ds aprox dis
             === Money.denseToDecimal ds aprox dns

  , HU.testCase "AdditiveGroup: zeroV" $
      (AG.zeroV :: Money.Discrete currency unit) @?= Money.discrete 0
  , QC.testProperty "AdditiveGroup: negateV" $
      QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->
         AG.negateV x === negate x
  , QC.testProperty "AdditiveGroup: ^+^" $
      QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit, y) ->
         x AG.^+^ y === x + y
  , QC.testProperty "AdditiveGroup: ^-^" $
      QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit, y) ->
         x AG.^-^ y === x - y
  , QC.testProperty "VectorSpace: *^" $
      QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit, y) ->
         (toInteger x VS.*^ y === x * y) .&&.
         (toInteger y VS.*^ x === x * y)

  , QC.testProperty "Binary encoding roundtrip" $
      QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->
         let Right (_,_,y) = Binary.decodeOrFail (Binary.encode x)
         in x === y
  , QC.testProperty "Binary encoding roundtrip (SomeDiscrete)" $
      QC.forAll QC.arbitrary $ \(x :: Money.Discrete currency unit) ->
         let x' = Money.toSomeDiscrete x
             bs = Binary.encode x'
         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, 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, BL.length bs, x') === Binary.decodeOrFail bs
  ]

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 "Category: left identity" $
      QC.forAll QC.arbitrary $ \(xr :: Money.ExchangeRate src dst) ->
         xr === id . xr
  , QC.testProperty "Category: right identity" $
      QC.forAll QC.arbitrary $ \(xr :: Money.ExchangeRate src dst) ->
         xr === xr . id
  , QC.testProperty "Category: composition with inverse" $
      QC.forAll QC.arbitrary $ \(xr1 :: Money.ExchangeRate src dst) ->
         (1 === Money.exchangeRateToRational (xr1 . Money.exchangeRateRecip xr1)) .&&.
         (1 === Money.exchangeRateToRational (Money.exchangeRateRecip xr1 . xr1))
  , QC.testProperty "Category: composition with other" $
      QC.forAll QC.arbitrary $ \(xr1 :: Money.ExchangeRate src dst,
                                 xr2 :: Money.ExchangeRate dst src) ->
         let a = Money.exchangeRateToRational xr1 * Money.exchangeRateToRational xr2
         in (a === Money.exchangeRateToRational (xr1 . xr2)) .&&.
            (a === Money.exchangeRateToRational (xr2 . xr1))

  , QC.testProperty "read . show == id" $
      QC.forAll QC.arbitrary $ \(xr :: Money.ExchangeRate src dst) ->
         xr === read (show xr)
  , QC.testProperty "read . show . Just == Just" $
      QC.forAll QC.arbitrary $ \(xr :: Money.ExchangeRate src dst) ->
         Just xr === read (show (Just xr))
  , QC.testProperty "flipExchangeRate . flipExchangeRate == id" $
      QC.forAll QC.arbitrary $ \(xr :: Money.ExchangeRate src dst) ->
         let xr' = Money.exchangeRateRecip xr
         in (Money.exchangeRateToRational xr /= Money.exchangeRateToRational xr')
               ==> (xr === Money.exchangeRateRecip xr')
  , QC.testProperty "exchange (flipExchangeRate x) . exchange x == id" $
      QC.forAll QC.arbitrary $
         \( c0 :: Money.Dense src
          , xr :: Money.ExchangeRate src dst
          ) -> c0 === Money.exchange (Money.exchangeRateRecip xr)
                                     (Money.exchange xr c0)
  , QC.testProperty "x == 1 ==> exchange x == id" $
      QC.forAll QC.arbitrary $
         \( c0 :: Money.Dense src
          ) -> let Just xr = Money.exchangeRate 1
               in toRational c0 === toRational (Money.exchange xr c0)
  , QC.testProperty "x /= 1 ==> exchange x /= id" $
      QC.forAll QC.arbitrary $
         \( c0 :: Money.Dense src
          , xr :: Money.ExchangeRate src dst
          ) -> (Money.exchangeRateToRational xr /= 1 && toRational c0 /= 0)
                  ==> (toRational c0 /= toRational (Money.exchange xr c0))
  , QC.testProperty "fromSomeExchangeRate . someExchangeRate == Just" $
      QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->
         Just x === Money.fromSomeExchangeRate (Money.toSomeExchangeRate x)
  , QC.testProperty "fromSomeExchangeRate works only for same currencies" $
      QC.forAll QC.arbitrary $ \(x :: Money.SomeExchangeRate) ->
        ((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" $
      QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->
        let dr = Money.toSomeExchangeRate x
        in Money.withSomeExchangeRate dr $ \x' ->
             (show x, dr) === (show x', Money.toSomeExchangeRate x')

  , QC.testProperty "exchangeRateToDecimal: Same as rationalToDecimal" $
      QC.forAll QC.arbitrary $ \(ds :: Money.DecimalConf,
                                 xr :: Money.ExchangeRate src dst,
                                 aprox :: Money.Approximation) ->
        Money.exchangeRateToDecimal ds aprox xr
          === MoneyI.rationalToDecimal ds aprox
                (Money.exchangeRateToRational xr)

  , QC.testProperty "exchangeRateFromDecimal: Same as rationalFromDecimal" $
      QC.forAll QC.arbitrary $ \(Decimal ds dec) ->
         let Just r = MoneyI.rationalFromDecimal ds dec
             yxr = Money.exchangeRateFromDecimal ds dec
                      :: Maybe (Money.ExchangeRate src dst)
         in (r > 0) ==> (Just r === fmap Money.exchangeRateToRational yxr)

  , QC.testProperty "Binary encoding roundtrip" $
      QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->
         let Right (_,_,y) = Binary.decodeOrFail (Binary.encode x)
         in x === y
  , QC.testProperty "Binary encoding roundtrip (SomeExchangeRate)" $
      QC.forAll QC.arbitrary $ \(x :: Money.ExchangeRate src dst) ->
         let x' = Money.toSomeExchangeRate x
             bs = Binary.encode x'
         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, 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, BL.length bs, x') === Binary.decodeOrFail bs
  ]


testDiscreteFromDecimal :: Tasty.TestTree
testDiscreteFromDecimal =
  Tasty.testGroup "discreteFromDecimal"
  [ HU.testCase "Too large" $ do
      Money.discreteFromDecimal ds_dd_2 "0.053"
        @?= (Nothing :: Maybe (Money.Discrete "USD" "cent"))
      Money.discreteFromDecimal ds_tc_dd_2 "0.253"
        @?= (Nothing :: Maybe (Money.Discrete "USD" "cent"))

  , HU.testCase "USD cent, small, zero" $ do
      let dis = 0 :: Money.Discrete "USD" "cent"
      Money.discreteFromDecimal ds_dd_2       "0" @?= Just dis
      Money.discreteFromDecimal ds_dd_2      "+0" @?= Just dis
      Money.discreteFromDecimal ds_dd_2      "-0" @?= Just dis
      Money.discreteFromDecimal ds_p_dd_2     "0" @?= Just dis
      Money.discreteFromDecimal ds_p_dd_2    "+0" @?= Just dis
      Money.discreteFromDecimal ds_p_dd_2    "-0" @?= Just dis

  , HU.testCase "USD cent, small, positive" $ do
      let dis = 25 :: Money.Discrete "USD" "cent"
      Money.discreteFromDecimal ds_dd_2      "0.25"  @?= Just dis
      Money.discreteFromDecimal ds_dd_2      "+0.25" @?= Just dis
      Money.discreteFromDecimal ds_tc_dd_2   "0.25"  @?= Just dis
      Money.discreteFromDecimal ds_tc_dd_2   "+0.25" @?= Just dis
      Money.discreteFromDecimal ds_p_dd_2    "0.25"  @?= Just dis
      Money.discreteFromDecimal ds_p_dd_2    "+0.25" @?= Just dis
      Money.discreteFromDecimal ds_p_tc_dd_2 "0.25"  @?= Just dis
      Money.discreteFromDecimal ds_p_tc_dd_2 "+0.25" @?= Just dis

  , HU.testCase "USD cent, small, negative" $ do
      let dis = -25 :: Money.Discrete "USD" "cent"
      Money.discreteFromDecimal ds_dd_2      "-0.25" @?= Just dis
      Money.discreteFromDecimal ds_p_dd_2    "-0.25" @?= Just dis
      Money.discreteFromDecimal ds_tc_dd_2   "-0.25" @?= Just dis
      Money.discreteFromDecimal ds_p_tc_dd_2 "-0.25" @?= Just dis

  , HU.testCase "USD cent, big, positive" $ do
      let dis = 102300456789 :: Money.Discrete "USD" "cent"
      Money.discreteFromDecimal ds_dd_2      "+1023004567.89"    @?= Just dis
      Money.discreteFromDecimal ds_dd_2      "1023004567.89"     @?= Just dis
      Money.discreteFromDecimal ds_p_dd_2    "+1023004567.89"    @?= Just dis
      Money.discreteFromDecimal ds_p_dd_2    "1023004567.89"     @?= Just dis
      Money.discreteFromDecimal ds_p_tc_dd_2 "+1,023,004,567.89" @?= Just dis
      Money.discreteFromDecimal ds_p_tc_dd_2 "1,023,004,567.89"  @?= Just dis
      Money.discreteFromDecimal ds_tc_dd_2   "+1,023,004,567.89" @?= Just dis
      Money.discreteFromDecimal ds_tc_dd_2   "1,023,004,567.89"  @?= Just dis

  , HU.testCase "USD cent, big, negative" $ do
      let dis = -102300456789 :: Money.Discrete "USD" "cent"
      Money.discreteFromDecimal ds_dd_2      "-1023004567.89" @?= Just dis
      Money.discreteFromDecimal ds_p_dd_2    "-1023004567.89" @?= Just dis
      Money.discreteFromDecimal ds_tc_dd_2   "-1,023,004,567.89" @?= Just dis
      Money.discreteFromDecimal ds_p_tc_dd_2 "-1,023,004,567.89" @?= Just dis
  ]

testRounding
  :: forall (currency :: Symbol) (unit :: Symbol)
  .  (Money.GoodScale (Money.UnitScale currency unit), KnownSymbol currency)
  => Proxy currency
  -> Proxy unit
  -> Tasty.TestTree
testRounding _ _ =
    Tasty.testGroup "Rounding"
    [ QC.testProperty "floor"    $ QC.forAll QC.arbitrary (g (Money.discreteFromDense Money.Floor))
    , QC.testProperty "ceiling"  $ QC.forAll QC.arbitrary (g (Money.discreteFromDense Money.Ceiling))
    , QC.testProperty "round"    $ QC.forAll QC.arbitrary (g (Money.discreteFromDense Money.Round))
    , QC.testProperty "truncate" $ QC.forAll QC.arbitrary (g (Money.discreteFromDense Money.Truncate))
    , QC.testProperty "half-even" $ QC.forAll QC.arbitrary (g (Money.discreteFromDense Money.HalfEven))
    , QC.testProperty "floor no reminder"    $ QC.forAll QC.arbitrary (h (Money.discreteFromDense Money.Floor))
    , QC.testProperty "ceiling no reminder"  $ QC.forAll QC.arbitrary (h (Money.discreteFromDense Money.Ceiling))
    , QC.testProperty "round no reminder"    $ QC.forAll QC.arbitrary (h (Money.discreteFromDense Money.Round))
    , QC.testProperty "truncate no reminder" $ QC.forAll QC.arbitrary (h (Money.discreteFromDense Money.Truncate))
    , QC.testProperty "half-even no reminder " $ QC.forAll QC.arbitrary (h (Money.discreteFromDense Money.HalfEven))
    ]
  where
    g :: (Money.Dense currency -> (Money.Discrete' currency (Money.UnitScale currency unit), Money.Dense currency))
      -> Money.Dense currency
      -> QC.Property
    g f = \x -> x === case f x of (y, z) -> Money.denseFromDiscrete y + z

    h :: (Money.Dense currency -> (Money.Discrete' currency (Money.UnitScale currency unit), Money.Dense currency))
      -> Money.Discrete currency unit
      -> QC.Property
    h f = \x -> (Money.denseFromDiscrete x) === case f (Money.denseFromDiscrete x) of
      (y, 0) -> Money.denseFromDiscrete y
      (_, _) -> error "testRounding.h: unexpected"

testHalfEvenRounding :: Tasty.TestTree
testHalfEvenRounding =
    Tasty.testGroup "HalfEven rounding"
    [ HU.testCase "-2.8" $ -3 @=? f (-3152519739159347 % 1125899906842624)

    , HU.testCase "-2.5" $ -2 @=? f (-5 % 2)
    , HU.testCase "-2.2" $ -2 @=? f (-2476979795053773 % 1125899906842624)
    , HU.testCase "-2"   $ -2 @=? f (-2 % 1)
    , HU.testCase "-1.8" $ -2 @=? f (-8106479329266893 % 4503599627370496)
    , HU.testCase "-1.5" $ -2 @=? f (-3 % 2)

    , HU.testCase "-1.2" $ -1 @=? f (-5404319552844595 % 4503599627370496)
    , HU.testCase "-1"   $ -1 @=? f (-1 % 1)
    , HU.testCase "-0.8" $ -1 @=? f (-3602879701896397 % 4503599627370496)

    , HU.testCase "-0.5" $  0 @=? f (-1 % 2)
    , HU.testCase "-0.2" $  0 @=? f (-3602879701896397 % 18014398509481984)
    , HU.testCase  "0"   $  0 @=? f (0 % 1)
    , HU.testCase  "0.2" $  0 @=? f (3602879701896397 % 18014398509481984)
    , HU.testCase  "0.5" $  0 @=? f (1 % 2)

    , HU.testCase  "0.8" $  1 @=? f (3602879701896397 % 4503599627370496)
    , HU.testCase  "1"   $  1 @=? f (1 % 1)
    , HU.testCase  "1.2" $  1 @=? f (5404319552844595 % 4503599627370496)

    , HU.testCase  "1.5" $  2 @=? f (3 % 2)
    , HU.testCase  "1.8" $  2 @=? f (8106479329266893 % 4503599627370496)
    , HU.testCase  "2"   $  2 @=? f (2 % 1)
    , HU.testCase  "2.2" $  2 @=? f (2476979795053773 % 1125899906842624)
    , HU.testCase  "2.5" $  2 @=? f (5 % 2)

    , HU.testCase  "2.8" $  3 @=? f (3152519739159347 % 1125899906842624)
    ]
  where
    f :: Rational -> Integer
    f = MoneyI.approximate MoneyI.HalfEven



-- | Decimal dot, 2 decimals
ds_dd_2 :: Money.DecimalConf
ds_dd_2 = Money.defaultDecimalConf

-- | Leading plus, decimal dot, 2 decimals
ds_p_dd_2 :: Money.DecimalConf
ds_p_dd_2 = ds_dd_2 { Money.decimalConf_leadingPlus = True }

-- | Thousands comma, decimal dot, 2 decimals
ds_tc_dd_2 :: Money.DecimalConf
ds_tc_dd_2 = ds_dd_2 { Money.decimalConf_separators = Money.separatorsDotComma }

-- | Leading plus, thousands comma, decimal dot, 2 decimals
ds_p_tc_dd_2 :: Money.DecimalConf
ds_p_tc_dd_2 = ds_tc_dd_2 { Money.decimalConf_leadingPlus = True }

-- | Decimal dot, 0 decimals
ds_dd_0 :: Money.DecimalConf
ds_dd_0 = ds_dd_2 { Money.decimalConf_digits = 0 }

-- | Leading plus, decimal dot, 0 decimals
ds_p_dd_0 :: Money.DecimalConf
ds_p_dd_0 = ds_p_dd_2 { Money.decimalConf_digits = 0 }

-- | Thousands comma, decimal dot, 0 decimals
ds_tc_dd_0 :: Money.DecimalConf
ds_tc_dd_0 = ds_tc_dd_2 { Money.decimalConf_digits = 0 }

-- | Leading plus, thousands comma, decimal dot, 0 decimals
ds_p_tc_dd_0 :: Money.DecimalConf
ds_p_tc_dd_0 = ds_p_tc_dd_2 { Money.decimalConf_digits = 0 }


--------------------------------------------------------------------------------
-- 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
      ]
    ]
  ]

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"

--------------------------------------------------------------------------------

-- Just checking that this compiles.
_testCurrencyScale
  :: Dict (Money.CurrencyScale "USD" ~ Money.UnitScale "USD" "cent",
           Money.CurrencyScale "BTC" ~ Money.UnitScale "BTC" "satoshi",
           Money.CurrencyScale "VUV" ~ Money.UnitScale "VUV" "vatu",
           Money.CurrencyScale "XAU" ~ Money.ErrScaleNonCanonical "XAU")
_testCurrencyScale = Dict

--------------------------------------------------------------------------------
-- Misc

hush :: Either a b -> Maybe b
hush (Left _ ) = Nothing
hush (Right b) = Just b