summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRenzoCarbonara <>2019-05-19 18:47:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2019-05-19 18:47:00 (GMT)
commitca671525d557538e145967d141b0e74fdb4cb4fb (patch)
treed7adce2f85d3347e2f31d84a6c22cfb4672ad84d
parent806cbae03d68dc1fc9bb73176bdaa6385ab94987 (diff)
version 0.1.2HEAD0.1.2master
-rwxr-xr-x[-rw-r--r--]README.md0
-rwxr-xr-x[-rw-r--r--]changelog.md5
-rw-r--r--safe-money-xmlbf.cabal4
-rw-r--r--src/Money/Xmlbf.hs28
-rw-r--r--test/Main.hs30
5 files changed, 52 insertions, 15 deletions
diff --git a/README.md b/README.md
index 17ac74d..17ac74d 100644..100755
--- a/README.md
+++ b/README.md
diff --git a/changelog.md b/changelog.md
index 2aafa7d..73e6f61 100644..100755
--- a/changelog.md
+++ b/changelog.md
@@ -1,3 +1,8 @@
+# Version 0.1.2
+
+* Require `xmlbf>=0.5`.
+
+
# Version 0.1.1
* Require `safe-money>=0.8`.
diff --git a/safe-money-xmlbf.cabal b/safe-money-xmlbf.cabal
index 8038aad..bef654e 100644
--- a/safe-money-xmlbf.cabal
+++ b/safe-money-xmlbf.cabal
@@ -1,5 +1,5 @@
name: safe-money-xmlbf
-version: 0.1.1
+version: 0.1.2
license: BSD3
license-file: LICENSE
copyright: Copyright (c) Renzo Carbonara 2016-2018
@@ -34,7 +34,7 @@ library
base (>=4.8 && <5.0),
safe-money >=0.8,
text,
- xmlbf
+ xmlbf >=0.5
exposed-modules:
Money.Xmlbf
diff --git a/src/Money/Xmlbf.hs b/src/Money/Xmlbf.hs
index e362d9f..d872221 100644
--- a/src/Money/Xmlbf.hs
+++ b/src/Money/Xmlbf.hs
@@ -22,6 +22,14 @@ import GHC.Exts (fromList)
import GHC.TypeLits (KnownSymbol)
import qualified Money
import qualified Xmlbf
+import qualified Data.Text.Read as TR
+
+pRead :: Integral a => TR.Reader a -> T.Text -> Xmlbf.Parser a
+{-# INLINE pRead #-}
+pRead rdr txt = case rdr txt of
+ Right (a, "") -> pure a
+ Right _ -> fail "Money.Xmblbf.pRead: did not match fully."
+ Left err -> fail err
--------------------------------------------------------------------------------
@@ -46,14 +54,14 @@ instance Xmlbf.ToXml Money.SomeDense where
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) [] ]
+ in [ either error id (Xmlbf.element' "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"
+ n <- pRead (TR.signed TR.decimal) =<< Xmlbf.pAttr "n"
+ d <- pRead TR.decimal =<< Xmlbf.pAttr "d"
when (d == 0) (fail "denominator is zero")
maybe empty pure (Money.mkSomeDense c (n % d))
@@ -83,16 +91,16 @@ instance Xmlbf.ToXml Money.SomeDiscrete where
, ("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) [] ]
+ in [ either error id (Xmlbf.element' "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"
+ n <- pRead TR.decimal =<< Xmlbf.pAttr "n"
+ d <- pRead TR.decimal =<< Xmlbf.pAttr "d"
when (d == 0) (fail "denominator is zero")
- a <- Xmlbf.pRead =<< Xmlbf.pAttr "a"
+ a <- pRead (TR.signed TR.decimal) =<< Xmlbf.pAttr "a"
maybe empty pure (Money.mkSomeDiscrete c <$> Money.scaleFromRational (n % d)
<*> pure a)
@@ -123,15 +131,15 @@ instance Xmlbf.ToXml Money.SomeExchangeRate where
, ("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) [] ]
+ in [ either error id (Xmlbf.element' "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"
+ n <- pRead TR.decimal =<< Xmlbf.pAttr "n"
+ d <- pRead TR.decimal =<< Xmlbf.pAttr "d"
when (d == 0) (fail "denominator is zero")
maybe empty pure (Money.mkSomeExchangeRate src dst (n % d))
diff --git a/test/Main.hs b/test/Main.hs
index 68db52f..5d14f4c 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -171,14 +171,20 @@ testRawSerializations =
[ 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
]
]
@@ -187,20 +193,38 @@ testRawSerializations =
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\"/>"
- [ Xmlbf.element' "money-dense" (fromList [("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\"/>"
- [ Xmlbf.element' "money-discrete" (fromList [("n","100"), ("d","1"), ("c","USD"), ("a","4")]) [] ]
+ [ 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\"/>"
- [ Xmlbf.element' "exchange-rate" (fromList [("n","3"), ("d","2"), ("src","USD"), ("dst","BTC")]) [] ]
+ [ either error id $ Xmlbf.element' "exchange-rate" (fromList [("n","3"), ("d","2"), ("src","USD"), ("dst","BTC")]) [] ]