diff --git a/changelog.md b/changelog.md --- 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 --- 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 @@ 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 --- a/src/Money/Xmlbf.hs +++ b/src/Money/Xmlbf.hs @@ -22,7 +22,15 @@ 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 + -------------------------------------------------------------------------------- -- | Compatible with 'Money.SomeDense' @@ -46,14 +54,14 @@ 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 @@ , ("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 @@ , ("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 --- a/test/Main.hs +++ b/test/Main.hs @@ -171,14 +171,20 @@ [ 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 @@ 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 = -- "" - [ 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 = -- "" + [ either error id $ Xmlbf.element' "money-dense" (fromList [("n","-26"), ("d","1"), ("c","USD")]) [] ] + rawDis0_xmlbf :: [Xmlbf.Node] rawDis0_xmlbf = -- "" - [ 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 = -- "" + [ either error id $ Xmlbf.element' "money-discrete" (fromList [("n","100"), ("d","1"), ("c","USD"), ("a","-4")]) [] ] + + rawXr0_xmlbf :: [Xmlbf.Node] rawXr0_xmlbf = -- "" - [ 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")]) [] ]