safe-decimal 0.2.0.0 → 0.2.1.0

raw patch · 8 files changed

+243/−80 lines, 8 filesdep −template-haskelldep ~doctestsetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: template-haskell

Dependency ranges changed: doctest

API changes (from Hackage documentation)

Files

• ChangeLog.md +7/−0
• Setup.hs +0/−30
• safe-decimal.cabal +5/−12
• src/Numeric/Decimal.hs +167/−12
• src/Numeric/Decimal/BoundedArithmetic.hs +16/−0
• src/Numeric/Decimal/Internal.hs +16/−12
• tests/Numeric/DecimalSpec.hs +21/−7
• tests/doctests.hs +11/−7

@@ -1,5 +1,12 @@ # Changelog for safe-decimal +## 0.2.1++* Add `arithError`+* Add `RoundHalfToZero` and `RoundHalfFromZero` rounding strategies.+* Conversion from `Scientific` normalizes the input and is more resilient to unbounded+  computation for bounded `Decimal` result.+ ## 0.2.0  * Add `Arith` monad and corresponding functions.

@@ -1,34 +1,4 @@-{-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -Wall #-}-module Main (main) where--#ifndef MIN_VERSION_cabal_doctest-#define MIN_VERSION_cabal_doctest(x,y,z) 0-#endif--#if MIN_VERSION_cabal_doctest(1,0,0)--import Distribution.Extra.Doctest ( defaultMainWithDoctests )-main :: IO ()-main = defaultMainWithDoctests "doctests"--#else--#ifdef MIN_VERSION_Cabal--- If the macro is defined, we have new cabal-install,--- but for some reason we don't have cabal-doctest in package-db------ Probably we are running cabal sdist, when otherwise using new-build--- workflow-#warning You are configuring this package without cabal-doctest installed. \-         The doctests test-suite will not work as a result. \-         To fix this, install cabal-doctest before configuring.-#endif- import Distribution.Simple  main :: IO () main = defaultMain--#endif-

@@ -1,16 +1,16 @@ name:           safe-decimal-version:        0.2.0.0+version:        0.2.1.0 description:    Please see the README on GitHub at <https://github.com/fpco/safe-decimal#readme> synopsis:       Safe and very efficient arithmetic operations on fixed decimal point numbers category:       Math, Numeric, Numerical homepage:       https://github.com/fpco/safe-decimal#readme bug-reports:    https://github.com/fpco/safe-decimal/issues author:         Alexey Kuleshevich-maintainer:     alexey@fpcomplete.com-copyright:      2018-2019 FP Complete+maintainer:     alexey@kuleshevi.ch+copyright:      2018-2020 FP Complete, 2021 Alexey Kuleshevich license:        BSD3 license-file:   LICENSE-build-type:     Custom+build-type:     Simple cabal-version:  >= 1.10 extra-source-files: ChangeLog.md                     README.md@@ -19,11 +19,6 @@   type: git   location: https://github.com/fpco/safe-decimal -custom-setup-  setup-depends:-      base-    , Cabal-    , cabal-doctest >=1.0.6  library   exposed-modules: Numeric.Decimal@@ -42,10 +37,8 @@   hs-source-dirs:   tests   main-is:          doctests.hs   build-depends: base-               , doctest >=0.15-               , QuickCheck+               , doctest >=0.16                , safe-decimal-               , template-haskell   default-language:    Haskell2010   ghc-options:        -Wall                       -Wincomplete-record-updates

@@ -1,5 +1,5 @@-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -12,7 +12,7 @@     module Numeric.Decimal.BoundedArithmetic   , module Numeric.Decimal.Internal   -- * Rounding-    -- ** Round half up+  -- ** Round half up   , RoundHalfUp   , roundHalfUp   -- ** Round half down@@ -21,6 +21,12 @@   -- ** Round half even   , RoundHalfEven   , roundHalfEven+  -- ** Round half to zero+  , RoundHalfToZero+  , roundHalfToZero+  -- ** Round half from zero+  , RoundHalfFromZero+  , roundHalfFromZero   -- ** Round down   , RoundDown   , Floor@@ -51,9 +57,9 @@ import Data.Coerce import Data.Fixed import Data.Int-import Data.Word import Data.Proxy import Data.Scientific+import Data.Word import GHC.TypeLits import Numeric.Decimal.BoundedArithmetic import Numeric.Decimal.Internal@@ -294,6 +300,144 @@       (q, r) = (2 *) <$> quotRem x s1 {-# INLINABLE roundHalfEven #-} +-- | [Round half towards zero](https://en.wikipedia.org/wiki/Rounding#Round_half_towards_zero) rounding+-- strategy. If the fraction of x is exactly 0.5, then y = x − 0.5 if x is positive, and y = x + 0.5 if x is negative.+--+-- >>> :set -XDataKinds+-- >>> :set -XTypeApplications+-- >>> arithRoundD @1 @RoundHalfToZero @3 @Int 3.650+-- Arith 3.6+-- >>> arithRoundD @1 @RoundHalfToZero @3 @Int 3.740+-- Arith 3.7+-- >>> arithRoundD @1 @RoundHalfToZero @4 @Int 3.7501+-- Arith 3.8+-- >>> arithRoundD @1 @RoundHalfToZero @3 @Int (-3.650)+-- Arith -3.6+-- >>> arithRoundD @1 @RoundHalfToZero @3 @Int (-3.740)+-- Arith -3.7+-- >>> arithRoundD @1 @RoundHalfToZero @4 @Int (-3.7501)+-- Arith -3.8+-- >>> arithRoundD @1 @RoundHalfToZero @3 @Int (-3.760)+-- Arith -3.8++-- @since 0.2.0+data RoundHalfToZero++instance Round RoundHalfToZero Integer where+  roundDecimal = roundHalfToZero+  {-# INLINABLE roundDecimal #-}+instance Round RoundHalfToZero Int where+  roundDecimal = roundHalfToZero+  {-# INLINABLE roundDecimal #-}+instance Round RoundHalfToZero Int8 where+  roundDecimal = roundHalfToZero+  {-# INLINABLE roundDecimal #-}+instance Round RoundHalfToZero Int16 where+  roundDecimal = roundHalfToZero+  {-# INLINABLE roundDecimal #-}+instance Round RoundHalfToZero Int32 where+  roundDecimal = roundHalfToZero+  {-# INLINABLE roundDecimal #-}+instance Round RoundHalfToZero Int64 where+  roundDecimal = roundHalfToZero+  {-# INLINABLE roundDecimal #-}+instance Round RoundHalfToZero Word where+  roundDecimal = roundHalfToZero+  {-# INLINABLE roundDecimal #-}+instance Round RoundHalfToZero Word8 where+  roundDecimal = roundHalfToZero+  {-# INLINABLE roundDecimal #-}+instance Round RoundHalfToZero Word16 where+  roundDecimal = roundHalfToZero+  {-# INLINABLE roundDecimal #-}+instance Round RoundHalfToZero Word32 where+  roundDecimal = roundHalfToZero+  {-# INLINABLE roundDecimal #-}+instance Round RoundHalfToZero Word64 where+  roundDecimal = roundHalfToZero+  {-# INLINABLE roundDecimal #-}++roundHalfToZero :: forall r n k p . (Integral p, KnownNat k) => Decimal r (n + k) p -> Decimal r n p+roundHalfToZero (Decimal x)+    | k == 0                     = Decimal x+    | r > s1                     = Decimal (q + 1)+    | signum r < 0 && abs r > s1 = Decimal (q - 1)+    | otherwise                  = Decimal q+    where+      k = fromIntegral (natVal (Proxy :: Proxy k)) :: Int+      s1 = 10 ^ k+      (q, r) = (2 *) <$> quotRem x s1+{-# INLINABLE roundHalfToZero #-}++-- | [Round half away from zero](https://en.wikipedia.org/wiki/Rounding#Round_half_away_from_zero) rounding+-- strategy. If the fraction of x is exactly 0.5, then y = x + 0.5 if x is positive, and y = x − 0.5 if x is negative.+--+-- >>> :set -XDataKinds+-- >>> :set -XTypeApplications+-- >>> arithRoundD @1 @RoundHalfFromZero @3 @Int 3.650+-- Arith 3.7+-- >>> arithRoundD @1 @RoundHalfFromZero @3 @Int 3.740+-- Arith 3.7+-- >>> arithRoundD @1 @RoundHalfFromZero @3 @Int 3.751+-- Arith 3.8+-- >>> arithRoundD @1 @RoundHalfFromZero @3 @Int (-3.650)+-- Arith -3.7+-- >>> arithRoundD @1 @RoundHalfFromZero @3 @Int (-3.740)+-- Arith -3.7+-- >>> arithRoundD @1 @RoundHalfFromZero @3 @Int (-3.751)+-- Arith -3.8+-- >>> arithRoundD @1 @RoundHalfFromZero @3 @Int (-3.760)+-- Arith -3.8++-- @since 0.2.0+data RoundHalfFromZero++instance Round RoundHalfFromZero Integer where+  roundDecimal = roundHalfFromZero+  {-# INLINABLE roundDecimal #-}+instance Round RoundHalfFromZero Int where+  roundDecimal = roundHalfFromZero+  {-# INLINABLE roundDecimal #-}+instance Round RoundHalfFromZero Int8 where+  roundDecimal = roundHalfFromZero+  {-# INLINABLE roundDecimal #-}+instance Round RoundHalfFromZero Int16 where+  roundDecimal = roundHalfFromZero+  {-# INLINABLE roundDecimal #-}+instance Round RoundHalfFromZero Int32 where+  roundDecimal = roundHalfFromZero+  {-# INLINABLE roundDecimal #-}+instance Round RoundHalfFromZero Int64 where+  roundDecimal = roundHalfFromZero+  {-# INLINABLE roundDecimal #-}+instance Round RoundHalfFromZero Word where+  roundDecimal = roundHalfFromZero+  {-# INLINABLE roundDecimal #-}+instance Round RoundHalfFromZero Word8 where+  roundDecimal = roundHalfFromZero+  {-# INLINABLE roundDecimal #-}+instance Round RoundHalfFromZero Word16 where+  roundDecimal = roundHalfFromZero+  {-# INLINABLE roundDecimal #-}+instance Round RoundHalfFromZero Word32 where+  roundDecimal = roundHalfFromZero+  {-# INLINABLE roundDecimal #-}+instance Round RoundHalfFromZero Word64 where+  roundDecimal = roundHalfFromZero+  {-# INLINABLE roundDecimal #-}++roundHalfFromZero :: forall r n k p . (Integral p, KnownNat k) => Decimal r (n + k) p -> Decimal r n p+roundHalfFromZero (Decimal x)+    | k == 0                      = Decimal x+    | r >= s1                     = Decimal (q + 1)+    | signum r < 0 && abs r >= s1 = Decimal (q - 1)+    | otherwise                   = Decimal q+    where+      k = fromIntegral (natVal (Proxy :: Proxy k)) :: Int+      s1 = 10 ^ k+      (q, r) = (2 *) <$> quotRem x s1+{-# INLINABLE roundHalfFromZero #-}+ -- | [Round down](https://en.wikipedia.org/wiki/Rounding#Rounding_down) rounding -- startegy. This the strategy that is implemented by `floor`. Round towards minus -- infinity:@@ -497,23 +641,34 @@      forall m r s. (MonadThrow m, KnownNat s)   => Scientific   -> m (Decimal r s Integer)-fromScientificDecimal num-  | point10 > s = throwM Underflow-  | otherwise = pure (Decimal (coefficient num * 10 ^ (s - point10)))+fromScientificDecimal numNonNormal+  | exp10 > s = throwM Underflow+  | otherwise = pure (Decimal (coefficient num * 10 ^ (s - exp10)))   where-      s = natVal (Proxy :: Proxy s)-      point10 = toInteger (negate (base10Exponent num))+    num = normalize numNonNormal+    s = natVal (Proxy :: Proxy s)+    exp10 = negate (toInteger (base10Exponent num)) --- | Convert from Scientific to Decimal while checking for Overflow/Underflow+-- | Convert from Scientific to bounded Decimal while checking for Overflow/Underflow -- -- @since 0.1.0 fromScientificDecimalBounded ::      forall m r s p. (MonadThrow m, Integral p, Bounded p, KnownNat s)   => Scientific   -> m (Decimal r s p)-fromScientificDecimalBounded num = do-  Decimal integer :: Decimal r s Integer <- fromScientificDecimal num-  Decimal <$> fromIntegerBounded integer+fromScientificDecimalBounded numNonNormal = do+  when (coeff < toInteger (minBound :: p) || exp10 > s) $ throwM Underflow+  when (coeff > imax || posExp10 > upperExponentBound || scaledCoeff > imax) $ throwM Overflow+  pure (Decimal (fromInteger scaledCoeff))+  where+    num = normalize numNonNormal+    s = natVal (Proxy :: Proxy s)+    posExp10 = toInteger (base10Exponent num)+    exp10 = negate posExp10+    imax = toInteger (maxBound :: p)+    coeff = coefficient num+    scaledCoeff = coefficient num * 10 ^ (s - exp10)+    upperExponentBound = ceiling (logBase 10 $ fromIntegral (maxBound :: p) :: Double) - s   type family FixedScale e :: Nat

@@ -7,6 +7,7 @@   , arithM   , arithMaybe   , arithEither+  , arithError   -- * Bounded   , plusBounded   , minusBounded@@ -20,12 +21,16 @@  import Control.Exception import Control.Monad.Catch+import GHC.Stack  -- | Monad for performing safe computation data Arith a   = Arith !a   | ArithError !SomeException +instance Bounded a => Bounded (Arith a) where+  maxBound = Arith maxBound+  minBound = Arith minBound  -- | Convert `Arith` computation to any `MonadThrow` --@@ -55,6 +60,17 @@ -- @since 0.2.0 arithEither :: Arith a -> Either SomeException a arithEither = arithM+++-- | Throws a `userError` on any `Arith` failure. Should only be used as a helper for+-- testing and development.+--+-- @since 0.2.1+arithError :: HasCallStack => Arith a -> a+arithError = \case+  Arith a -> a+  ArithError exc -> error $ displayException exc+   instance Show a => Show (Arith a) where

@@ -4,7 +4,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE KindSignatures #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -437,7 +436,7 @@   {-# INLINABLE signum #-}   abs = (>>= absDecimalBounded)   {-# INLINABLE abs #-}-  fromInteger = fmap Decimal . fromIntegerScaleBounded (Proxy :: Proxy s)+  fromInteger = fromIntegerDecimalBoundedIntegral   {-# INLINABLE fromInteger #-}  instance (KnownNat s) => Num (Arith (Decimal r s Int8)) where@@ -451,7 +450,7 @@   {-# INLINABLE signum #-}   abs = (>>= absDecimalBounded)   {-# INLINABLE abs #-}-  fromInteger = fmap Decimal . fromIntegerScaleBounded (Proxy :: Proxy s)+  fromInteger = fromIntegerDecimalBoundedIntegral   {-# INLINABLE fromInteger #-}  instance (KnownNat s) => Num (Arith (Decimal r s Int16)) where@@ -465,7 +464,7 @@   {-# INLINABLE signum #-}   abs = (>>= absDecimalBounded)   {-# INLINABLE abs #-}-  fromInteger = fmap Decimal . fromIntegerScaleBounded (Proxy :: Proxy s)+  fromInteger = fromIntegerDecimalBoundedIntegral   {-# INLINABLE fromInteger #-}  instance (KnownNat s) => Num (Arith (Decimal r s Int32)) where@@ -479,7 +478,7 @@   {-# INLINABLE signum #-}   abs = (>>= absDecimalBounded)   {-# INLINABLE abs #-}-  fromInteger = fmap Decimal . fromIntegerScaleBounded (Proxy :: Proxy s)+  fromInteger = fromIntegerDecimalBoundedIntegral   {-# INLINABLE fromInteger #-}  instance (KnownNat s) => Num (Arith (Decimal r s Int64)) where@@ -493,7 +492,7 @@   {-# INLINABLE signum #-}   abs = (>>= absDecimalBounded)   {-# INLINABLE abs #-}-  fromInteger = fmap Decimal . fromIntegerScaleBounded (Proxy :: Proxy s)+  fromInteger = fromIntegerDecimalBoundedIntegral   {-# INLINABLE fromInteger #-}  instance (KnownNat s) => Num (Arith (Decimal r s Word)) where@@ -507,7 +506,7 @@   {-# INLINABLE signum #-}   abs = id   {-# INLINABLE abs #-}-  fromInteger = fmap Decimal . fromIntegerScaleBounded (Proxy :: Proxy s)+  fromInteger = fromIntegerDecimalBoundedIntegral   {-# INLINABLE fromInteger #-}  instance (KnownNat s) => Num (Arith (Decimal r s Word8)) where@@ -521,7 +520,7 @@   {-# INLINABLE signum #-}   abs = id   {-# INLINABLE abs #-}-  fromInteger = fmap Decimal . fromIntegerScaleBounded (Proxy :: Proxy s)+  fromInteger = fromIntegerDecimalBoundedIntegral   {-# INLINABLE fromInteger #-}  instance (KnownNat s) => Num (Arith (Decimal r s Word16)) where@@ -535,7 +534,7 @@   {-# INLINABLE signum #-}   abs = id   {-# INLINABLE abs #-}-  fromInteger = fmap Decimal . fromIntegerScaleBounded (Proxy :: Proxy s)+  fromInteger = fromIntegerDecimalBoundedIntegral   {-# INLINABLE fromInteger #-}  instance (KnownNat s) => Num (Arith (Decimal r s Word32)) where@@ -549,7 +548,7 @@   {-# INLINABLE signum #-}   abs = id   {-# INLINABLE abs #-}-  fromInteger = fmap Decimal . fromIntegerScaleBounded (Proxy :: Proxy s)+  fromInteger = fromIntegerDecimalBoundedIntegral   {-# INLINABLE fromInteger #-}  instance (KnownNat s) => Num (Arith (Decimal r s Word64)) where@@ -563,7 +562,7 @@   {-# INLINABLE signum #-}   abs = id   {-# INLINABLE abs #-}-  fromInteger = fmap Decimal . fromIntegerScaleBounded (Proxy :: Proxy s)+  fromInteger = fromIntegerDecimalBoundedIntegral   {-# INLINABLE fromInteger #-}  instance (KnownNat s) => Fractional (Arith (Decimal r s Int)) where@@ -587,7 +586,7 @@ instance (KnownNat s) => Fractional (Arith (Decimal r s Int32)) where   (/) = bindM2 divideDecimalBoundedWithoutLoss   {-# INLINABLE (/) #-}-  fromRational  =fromRationalDecimalBoundedWithoutLoss+  fromRational = fromRationalDecimalBoundedWithoutLoss   {-# INLINABLE fromRational #-}  @@ -699,6 +698,7 @@       pure (Decimal q, Decimal r) {-# INLINABLE quotRemDecimalBounded #-} + fromIntegerScaleBounded ::      forall m a s. (MonadThrow m, Integral a, Bounded a, KnownNat s)   => Proxy s@@ -722,6 +722,10 @@ {-# INLINABLE fromIntegersScaleBounded #-}  +-- | Convert an Integer to a Decimal backed by a bounded integral while doing proper+-- scaling and checking the bounds.+--+-- @since 0.2.0 fromIntegerDecimalBoundedIntegral ::      forall m r s p. (MonadThrow m, Integral p, Bounded p, KnownNat s)   => Integer

@@ -172,6 +172,8 @@      , Round RoundHalfUp a      , Round RoundHalfDown a      , Round RoundHalfEven a+     , Round RoundHalfToZero a+     , Round RoundHalfFromZero a      , Round RoundDown a      , Round RoundToZero a      )@@ -235,6 +237,8 @@      , Round RoundHalfUp p      , Round RoundHalfDown p      , Round RoundHalfEven p+     , Round RoundHalfToZero p+     , Round RoundHalfFromZero p      , Round RoundDown p      , Round RoundToZero p      )@@ -249,9 +253,15 @@   prop (propNamePrefix . showsDecimalType @RoundHalfEven @(s + k) @p $ "") $     prop_Rounding @RoundHalfEven @s @k @p     (roundHalfEvenTo (fromIntegral (natVal (Proxy :: Proxy s))))+  prop (propNamePrefix . showsDecimalType @RoundHalfToZero @(s + k) @p $ "") $+    prop_Rounding @RoundHalfToZero @s @k @p+    (roundHalfToZeroTo (fromIntegral (natVal (Proxy :: Proxy s))))+  prop (propNamePrefix . showsDecimalType @RoundHalfFromZero @(s + k) @p $ "") $+    prop_Rounding @RoundHalfFromZero @s @k @p+    (roundHalfFromZeroTo (fromIntegral (natVal (Proxy :: Proxy s))))   prop (propNamePrefix . showsDecimalType @RoundToZero @(s + k) @p $ "") $     prop_Rounding @RoundToZero @s @k @p-    (roundRoundToZeroTo (fromIntegral (natVal (Proxy :: Proxy s))))+    (roundToZeroTo (fromIntegral (natVal (Proxy :: Proxy s))))   prop (propNamePrefix . showsDecimalType @RoundDown @(s + k) @p $ "") $     prop_Rounding @RoundDown @s @k @p     (roundFloorTo (fromIntegral (natVal (Proxy :: Proxy s))))@@ -275,7 +285,7 @@       throwDecimal (fromRationalDecimalWithoutLoss (roundTo r))  showsDecimalType ::-     forall r (s :: Nat) p. (Typeable r, Typeable s, Typeable p)+     forall r (s :: Nat) p. (Typeable r, KnownNat s, Typeable p)   => ShowS showsDecimalType = ("(Decimal " ++)                    . showsType @r . (' ':)@@ -423,14 +433,18 @@   where     s10 = 10 ^ to :: Integer -roundRoundToZeroTo :: Natural -> Rational -> Rational-roundRoundToZeroTo to rational = (truncate (rational * (s10 % 1)) :: Integer) % s10+roundToZeroTo :: Natural -> Rational -> Rational+roundToZeroTo to rational = (truncate (rational * (s10 % 1)) :: Integer) % s10   where     s10 = 10 ^ to :: Integer --- Use for testing once HalfAwayFromZero is implemented-_roundCommercial :: Natural -> Rational -> Rational-_roundCommercial to rational+roundHalfToZeroTo :: Natural -> Rational -> Rational+roundHalfToZeroTo to rational+  | rational < 0 = negate (roundHalfDownTo to (negate rational))+  | otherwise = roundHalfDownTo to rational++roundHalfFromZeroTo :: Natural -> Rational -> Rational+roundHalfFromZeroTo to rational   | rational < 0 = negate (roundPositive (negate rational))   | otherwise = roundPositive rational   where

@@ -1,12 +1,16 @@+{-# LANGUAGE CPP #-} module Main where -import Build_doctests (flags, pkgs, module_sources)-import Data.Foldable (traverse_)+#if __GLASGOW_HASKELL__ >= 802+ import Test.DocTest (doctest)  main :: IO ()-main = do-    traverse_ putStrLn args-    doctest args-  where-    args = flags ++ pkgs ++ module_sources+main = doctest ["src"]++#else++main :: IO ()+main = putStrLn "\nDoctests are not supported for older ghc version\n"++#endif