diff --git a/HasBigDecimal.cabal b/HasBigDecimal.cabal new file mode 100644 --- /dev/null +++ b/HasBigDecimal.cabal @@ -0,0 +1,37 @@ +name: HasBigDecimal +version: 0.1.1 +synopsis: A library for arbitrary precision decimal numbers. +description: A native Haskell implementation of arbitrary precicion decimal numbers, based on Haskell Integers. Inspired by Java BigDecimals + +homepage: https://github.com/thma/HasBigDecimal#readme +license: Apache-2.0 +license-file: LICENSE +author: Thomas Mahler +maintainer: thma@apache.org +copyright: 2018 Thomas Mahler +category: Math +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + exposed-modules: Data.BigDecimal, Data.BigFloating + build-depends: base >= 4.7 && < 5 + default-language: Haskell2010 + +test-suite HasBigDecimal-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + other-modules: Data.BigDecimalSpec, Data.BigFloatingSpec, Data.TestUtils + build-depends: base + , HasBigDecimal + , hspec + , QuickCheck + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/thma/HasBigDecimal diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,201 @@ + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "[]" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + + Copyright [yyyy] [name of copyright owner] + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,59 @@ +[![Build Status](https://travis-ci.org/thma/HasBigDecimal.svg?branch=master)](https://travis-ci.org/thma/HasBigDecimal) + +# HasBigDecimal + +This module defines the type 'BigDecimal' which provides a representation of arbitrary precision decimal numbers. +'BigDecimal' is a native Haskell implementation based on arbitrary sized 'Integer' values. +The implementation was inspired by Java BigDecimals. + +BigDecimal instantiates the typeclasses 'Num', 'Fractional' and 'Real'. It is thus possible to use all common operators like '+', '-', '*', '/', '^' on them. + +# Some examples from a ghci REPL +```haskell +λ> a = BigDecimal 144 2 +λ> toString a +"1.44" +λ> b = sqrt a +λ> toString b +"1.2" +λ> b * b +BigDecimal 144 2 +λ> b * b * b +BigDecimal 1728 3 +λ> b^2 +BigDecimal 144 2 +λ> c = fromString "123.4567890" +λ> c +BigDecimal 1234567890 7 +λ> a / c +BigDecimal 1166400010614240096589584878965222398584 41 +λ> roundBD it (halfUp 10) +BigDecimal 116640001 10 +λ> divide (a, c) $ halfUp 20 +BigDecimal 1166400010614240097 20 +``` + +# BigFloating +in addition to the pretty complete BigDecimal module there is the rather scetchy BigFloating module. +BigFloating contains a few first step to let BigDecimal instantiate the Floating typeclass. +As of now it contains arbitrary precision implementations for pi (based on Chudnovskis algorithm), sqrt and nthroot (based on Newtons classic algorithm). +All trigonometric functions, log and exp are still missing. +All code contributions are most welcome! +Here are some working examples: + +```haskell +λ> r = sqrt (BigDecimal 2 0) +λ> toString r +"1.4142135623730950488016887242096980785696718753769480731766797379907324784621070388503875343276415727" +λ> r^2*pi +BigDecimal 6283185307179586476925286766559005768394338798750211641949889184615632812572417997256069650684234135488875159962758271904785109490094314219117662951460673928547017151357805018682925970564827587058974690236729643325013696514697383143361638452329945607739055327681644609147889519349178329780951524191191 300 +λ> toString it +"6.283185307179586476925286766559005768394338798750211641949889184615632812572417997256069650684234135488875159962758271904785109490094314219117662951460673928547017151357805018682925970564827587058974690236729643325013696514697383143361638452329945607739055327681644609147889519349178329780951524191191" + +λ> sqr 2 (halfUp 50) +BigDecimal 141421356237309504880168872420969807856967187537695 50 +λ> sqr 2 (halfUp 500) +BigDecimal 141421356237309504880168872420969807856967187537694807317667973799073247846210703885038753432764157273501384623091229702492483605585073721264412149709993583141322266592750559275579995050115278206057147010955997160597027453459686201472851741864088919860955232923048430871432145083976260362799525140798968725339654633180882964062061525835239505474575028775996172983557522033753185701135437460340849884716038689997069900481503054402779031645424782306849293691862158057846311159666871301301561856898723724 500 + +``` + diff --git a/src/Data/BigDecimal.hs b/src/Data/BigDecimal.hs new file mode 100644 --- /dev/null +++ b/src/Data/BigDecimal.hs @@ -0,0 +1,214 @@ +{- | This module defines the type 'BigDecimal' which provides a representation of arbitrary precision decimal numbers. + 'BigDecimal' is a native Haskell implementation based on arbitrary sized 'Integer' values. + The implementation was inspired by Java BigDecimals. + + BigDecimal instantiates the typeclasses 'Num', 'Fractional' and 'Real'. It is thus possible to use all common + operators like '+', '-', '*', '/', '^' on them. + + Here are a few examples from an interactive GHCI session: + + > λ> a = BigDecimal 144 2 + > λ> toString a + > "1.44" + > λ> b = sqrt a + > λ> toString b + > "1.2" + > λ> b * b + > BigDecimal 144 2 + > λ> b * b * b + > BigDecimal 1728 3 + > λ> b^2 + > BigDecimal 144 2 + > λ> c = fromString "123.4567890" + > λ> c + > BigDecimal 1234567890 7 + > λ> a / c + > BigDecimal 1166400010614240096589584878965222398584 41 + > λ> roundBD it (halfUp 10) + > BigDecimal 116640001 10 + > λ> divide (a, c) $ halfUp 20 + > BigDecimal 1166400010614240097 20 + +-} +module Data.BigDecimal + ( BigDecimal (..) + , RoundingMode (..) + , MathContext + , getScale + , getValue + , precision + , trim + , nf + , divide + , roundBD + , fromRatio + , halfUp + , fromString + , matchScales + , toString + ) +where + +import Data.List (find, elemIndex) +import Data.Maybe (fromMaybe) +import GHC.Real ((%), Ratio ((:%))) + +-- | RoundingMode defines how to handle loss of precision in divisions or explicit rounding. +data RoundingMode + = UP -- ^ Rounding mode to round away from zero. + | DOWN -- ^ Rounding mode to round towards zero. + | CEILING -- ^ Rounding mode to round towards positive infinity. + | FLOOR -- ^ Rounding mode to round towards negative infinity. + | HALF_UP -- ^ Rounding mode to round towards "nearest neighbor" unless both neighbors are equidistant, in which case round up. + | HALF_DOWN -- ^ Rounding mode to round towards "nearest neighbor" unless both neighbors are equidistant, in which case round down. + | HALF_EVEN -- ^ Rounding mode to round towards "nearest neighbor" unless both neighbors are equidistant, in which case, round towards the even neighbor. + | PRECISE -- ^ Rounding mode to assert that the requested operation has an exact result, hence no rounding is applied. + +{-| BigDecimal is represented by an unscaled Integer value plus a second Integer value that defines the scale + E.g.: (BigDecimal 1234 2) represents the decimal value 12.34. + +-} +data BigDecimal = + -- | creates a BigDecimal value from an unscaled 'Integer' value and a scale, given as a positive 'Integer'. + -- Example: (BigDecimal 1234 2) creates the value 12.34 + BigDecimal Integer Integer + deriving (Show, Read) + +-- | gets the scale part of a BigDecimal +getScale :: BigDecimal -> Integer +getScale (BigDecimal _ s) = s + +-- | get the unscaled value of a BigDecimal +getValue :: BigDecimal -> Integer +getValue (BigDecimal v _) = v + +-- | A MathContext is interpreted by divisions and rounding operations to specify the expected loss of precision and the rounding behaviour. +-- MathContext is a pair of a 'RoundingMode' and a target precision of type 'Maybe' 'Integer'. The precision defines the number of digits after the decimal point. +-- If 'Nothing' is given as precision all decimal digits are to be preserved, that is precision is not limited. +type MathContext = (RoundingMode, Maybe Integer) + +instance Num BigDecimal where + a + b = plus (a, b) + a * b = mul (a, b) + abs (BigDecimal v s) = BigDecimal (abs v) s + signum (BigDecimal v _) = BigDecimal (signum v) 0 + fromInteger i = BigDecimal i 0 + negate (BigDecimal v s) = BigDecimal (-v) s + +instance Eq BigDecimal where + a == b = + let (BigDecimal valA _, BigDecimal valB _) = matchScales (a, b) + in valA == valB + +instance Fractional BigDecimal where + -- default division rounds up and does not limit precision + a / b = nf $ divide (matchScales (a, b)) (HALF_UP, Nothing) + fromRational ratio@(x :% y) = fromRatio ratio (HALF_UP, Nothing) + +-- | creates a BigDecimal from a 'Rational' value. 'MathContext' defines precision and rounding mode. +fromRatio :: Rational -> MathContext -> BigDecimal +fromRatio (x :% y) = divide (fromInteger x, fromInteger y) + +instance Real BigDecimal where + toRational (BigDecimal val scale) = toRational val * 10^^(-scale) + +instance Ord BigDecimal where + compare a b = + let (BigDecimal valA _, BigDecimal valB _) = matchScales (a, b) + in compare valA valB + +-- | add two BigDecimals +plus :: (BigDecimal, BigDecimal) -> BigDecimal +plus (a@(BigDecimal valA scaleA), b@(BigDecimal valB scaleB)) + | scaleA == scaleB = BigDecimal (valA + valB) scaleA + | otherwise = plus $ matchScales (a,b) + +-- | multiply two BigDecimals +mul :: (BigDecimal, BigDecimal) -> BigDecimal +mul (BigDecimal valA scaleA, BigDecimal valB scaleB) = BigDecimal (valA * valB) (scaleA + scaleB) + +-- | divide two BigDecimals and applies the 'MathContext' (i.e. a tuple of 'RoundingMode' and the specified precision) for rounding. +divide :: (BigDecimal, BigDecimal) -- ^ the tuple of dividend and divisor. I.e. (dividend, divisor) + -> MathContext -- ^ 'MathContext' (i.e. a tuple of 'RoundingMode' and the specified precision) defines the rounding behaviour. + -- if 'Nothing' if given as precision the maximum possible precision is used. + -> BigDecimal -- ^ the resulting BigDecimal +divide (a, b) (rMode, prefScale) = + let (BigDecimal numA _, BigDecimal numB _) = matchScales (a, b) + maxPrecision = fromMaybe (precision a + round (fromInteger (precision b) * 10 / 3)) prefScale + in trim maxPrecision (BigDecimal (divUsing rMode (numA * (10 :: Integer) ^ maxPrecision) numB) maxPrecision) + +-- | divide two correctly scaled Integers and apply the RoundingMode +divUsing :: RoundingMode -> Integer -> Integer -> Integer +divUsing rounding a b = + let (quot, rem) = quotRem a b + delta = (10 * abs rem `div` abs b) - 5 + in case rounding of + PRECISE -> if rem == 0 then quot else error "non-terminating decimal expansion" + UP -> if abs rem > 0 then quot + signum quot else quot + CEILING -> if abs rem > 0 && quot >= 0 then quot + 1 else quot + HALF_UP -> if delta >= 0 then quot + signum quot else quot + HALF_DOWN -> if delta <= 0 then quot else quot + signum quot + DOWN -> quot + FLOOR -> if quot >= 0 then quot else quot - 1 + HALF_EVEN + | delta > 0 -> quot + signum quot + | delta == 0 && odd quot -> quot + signum quot + | otherwise -> quot + +-- | round a BigDecimal to 'n' digits applying the 'MathContext' 'mc' +roundBD :: BigDecimal -> MathContext -> BigDecimal +roundBD bd@(BigDecimal val scale) mc@(rMode, Just n) + | n < 0 || n >= scale = bd + | otherwise = BigDecimal (divUsing rMode val (10 ^ (scale-n))) n + +-- | match the scales of a tuple of BigDecimals +matchScales :: (BigDecimal, BigDecimal) -> (BigDecimal, BigDecimal) +matchScales (a@(BigDecimal integerA scaleA), b@(BigDecimal integerB scaleB)) + | scaleA < scaleB = (BigDecimal (integerA * 10 ^ (scaleB - scaleA)) scaleB, b) + | scaleA > scaleB = (a, BigDecimal (integerB * 10 ^ (scaleA - scaleB)) scaleA) + | otherwise = (a, b) + +-- | returns the number of digits of an Integer +precision :: BigDecimal -> Integer +precision 0 = 1 +precision (BigDecimal val _) = 1 + floor (logBase 10 $ abs $ fromInteger val) + +-- | removes trailing zeros from a BigDecimals intValue by decreasing the scale +trim :: Integer -> BigDecimal -> BigDecimal +trim prefScale bd@(BigDecimal val scale) = + let (v, r) = quotRem val 10 + in if r == 0 && 0 <= prefScale && prefScale < scale + then trim prefScale $ BigDecimal v (scale - 1) + else bd + +-- | computes the normal form of a BigDecimal +nf :: BigDecimal -> BigDecimal +nf = trim 0 + +-- | read a BigDecimal from a human readable decimal notation. +-- e.g. @ fromString "3.14" @ yields 'BigDecimal 314 2' +fromString :: String -> BigDecimal +fromString s = + let maybeIndex = elemIndex '.' s + intValue = read (filter (/= '.') s) :: Integer + in case maybeIndex of + Nothing -> BigDecimal intValue 0 + Just i -> BigDecimal intValue $ toInteger (length s - i - 1) + +-- | returns a readable String representation of a BigDecimal +-- e.g. @ toString (BigDecimal 314 2) @ yields "3.14" +toString :: BigDecimal -> String +toString bd@(BigDecimal intValue scale) = + let s = show $ abs intValue + filled = + if fromInteger scale >= length s + then replicate (1 + fromInteger scale - length s) '0' ++ s + else s + splitPos = length filled - fromInteger scale + (ints, decimals) = splitAt splitPos filled + sign = if intValue < 0 then "-" else "" + in sign ++ if not (null decimals) then ints ++ "." ++ decimals else ints + +-- | construct a 'MathContext' for rounding 'HALF_UP' with 'scale' decimal digits +halfUp :: Integer -> MathContext +halfUp scale = (HALF_UP, Just scale) diff --git a/src/Data/BigFloating.hs b/src/Data/BigFloating.hs new file mode 100644 --- /dev/null +++ b/src/Data/BigFloating.hs @@ -0,0 +1,100 @@ +module Data.BigFloating + ( piChudnovsky + , sqr + , nthRoot + ) +where + +import Data.BigDecimal +import Data.List (find) +import Data.Maybe (fromMaybe) +import GHC.Real ((%), Ratio ((:%))) + +-- I'm giving some implementation ideas for approximisations for functions on transcendental numbers. +-- The rest is left as an exercise to the interested reader ;-) +instance Floating BigDecimal where + pi = piChudnovsky defaultMC + exp = undefined -- e^x + log = undefined + sin = undefined + cos = undefined + asin = undefined + acos = undefined + atan = undefined + sinh = undefined + cosh = undefined + asinh = undefined + acosh = undefined + atanh = undefined + +-- not required for minimal implementation + sqrt x = sqr x defaultMC + x ** y = nthRoot (x^b) n defaultMC + where + (b :% n) = toRational y + +defaultMC = (DOWN, Just 100) + +-- | computes the square root of any non-negative BigDecimal, rounding and precision defined by MathContext. +-- We are using Newton's algorithm. +sqr :: BigDecimal -> MathContext -> BigDecimal +sqr x mc + | x < 0 = error "can't determine the square root of negative numbers" + | x == 0 = 0 + | otherwise = fst $ fromMaybe (error "did not find a sqrt") $ refine x 1 mc + where + refine x initial mc@(_, Just scale) = find withinPrecision $ iterate nextGuess (initial, 0) + where + withinPrecision (guess, count) = abs (guess^2 - x) < BigDecimal 10 scale || count > 10 * scale * precision x + nextGuess (guess, count) = (nf $ divide (guess + divide (x, guess) mc, 2) mc, count+1) + +nthRoot :: BigDecimal -> Integer -> MathContext -> BigDecimal +nthRoot x n mc@(r,Just s) + | x < 0 && even n = error "can't determine even roots of negative numbers" + | x < 0 && odd n = - nthRoot x (-n) mc + | x == 0 = 0 + | otherwise = roundBD (fst (fromMaybe (error "did not find a sqrt") $ refine x 1 (r, Just (s+4)))) mc + where + refine x initial mc@(_, Just scale) = find withinPrecision $ iterate nextGuess (initial, 0) + where + withinPrecision (guess, count) = abs (guess^n - x) < BigDecimal (n*10) scale || count > 10 * scale * precision x + nextGuess (guess, count) = + (nf $ divide ((guess * BigDecimal (n-1) 0) + divide (x, guess^(n-1)) mc, BigDecimal n 0) mc, count+1) + + +-- | Compute pi using rounding mode and scale of the specified MathContext +-- Sources: https://wiki.haskell.org/Integers_too_big_for_floats & https://github.com/eobermuhlner/big-math +piChudnovsky :: MathContext -> BigDecimal +piChudnovsky mc@(rMode, Just scale) = divide (1, 12 * divide (fromRatio s mc,f) mc') mc + where + mc' = (rMode, Just $ scale + 3) -- increase precision to avoid propagation of rounding errors + steps = 1 + div scale 14 -- taken from github.com/eobermuhlner/big-math + s = sum [chudnovsky n | n <- [0..steps]] :: Rational + f = sqr (fromInteger c^3) mc -- Common factor in the sum + + -- k-th term of the Chudnovsky series + chudnovsky :: Integer -> Rational + chudnovsky k + | even k = quot + | otherwise = -quot + where + quot = num % den + num = facDiv (6 * k) (3 * k) * (a + b * k) + den = fac k ^ 3 * (c ^ (3 * k)) + + -- Compute n! + fac :: (Enum a, Num a) => a -> a + fac n = product [1..n] + + -- Compute n! / m! efficiently + facDiv :: Integer -> Integer -> Integer + facDiv n m + | n > m = product [n, n - 1 .. m + 1] + | n == m = 1 + | otherwise = facDiv m n + + a = 13591409 + b = 545140134 + c = 640320 + + diff --git a/test/Data/BigDecimalSpec.hs b/test/Data/BigDecimalSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/BigDecimalSpec.hs @@ -0,0 +1,315 @@ +module Data.BigDecimalSpec + (main, spec) +where + +import Control.Exception (evaluate) +import Data.BigDecimal +import GHC.Real (Ratio ((:%))) +import Test.Hspec hiding (it) +import Data.TestUtils (it) -- I'm redefining it to use 1000 examples +import Test.Hspec.QuickCheck (modifyMaxSize, modifyMaxSuccess) +import Test.QuickCheck + +-- `main` is here so that this module can be run from GHCi on its own. It is +-- not needed for automatic spec discovery. +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + describe "toBD" $ do + it "reads BigDecimals from strings" $ + fromString "-145.123" `shouldBe` BigDecimal (-145123) 3 + it "is inverse of toString" $ + property $ \bd -> (fromString . toString) bd === (bd :: BigDecimal) + + describe "toString" $ do + it "converts BigDecimals to string" $ + toString (BigDecimal (-145123) 3) `shouldBe` "-145.123" + it "adds leading 0s if required" $ + toString (BigDecimal (-14) 10) `shouldBe` "-0.0000000014" + it "can handle integer values" $ + toString 10 `shouldBe` "10" + it "is inverse of toBD" $ + property $ \bd -> (toString . fromString . toString) bd === toString (bd :: BigDecimal) + + describe "read" $ do + it "reads BigDecimals from strings in constructor notation" $ + read "BigDecimal 76878 5" `shouldBe` BigDecimal 76878 5 + it "is inverse of show" $ + property $ \bd -> (read . show) bd === (bd :: BigDecimal) + + describe "show" $ do + it "converts BigDecimals to strings in constructor notation" $ + show (BigDecimal 76878 5) `shouldBe` "BigDecimal 76878 5" + it "is inverse of read" $ + property $ \bd -> (read . show) bd === (bd :: BigDecimal) + + describe "(+)" $ do + it "adds two BigDecimals" $ + BigDecimal 73 1 + BigDecimal 270 2 `shouldBe` BigDecimal 1000 2 + modifyMaxSuccess (const 1000) $ it "has 0 as neutral element" $ + property $ \bd -> bd + 0 === (bd :: BigDecimal) + it "adds x to (-x) yielding 0" $ + property $ \bd -> bd + (-bd) === (0 :: BigDecimal) + it "uses the max scale of the summands" $ + property $ \ai as bi bs -> max as bs === getScale (BigDecimal ai as + BigDecimal bi bs) + it "uses Integer addition when summands have same scale" $ + property $ \ai bi scale -> ai + bi === getValue (BigDecimal ai scale + BigDecimal bi scale) + it "matches values when scaling" $ + property $ \ai bi scale -> getValue (BigDecimal ai scale + BigDecimal bi (scale+1)) === 10*ai + bi + + describe "(*)" $ do + it "multiplies BigDecimals" $ + BigDecimal 12 1 * BigDecimal 12 2 `shouldBe` BigDecimal 144 3 + it "has 1 as neutral element" $ + property $ \bd -> bd * 1 === (bd :: BigDecimal) + it "has 0 as zero element" $ + property $ \bd -> bd * 0 === (0 :: BigDecimal) + it "Uses Integer multiplication" $ + property $ \ai as bi -> BigDecimal ai as * BigDecimal bi 0 === BigDecimal (ai*bi) as + it "adds the scales of the multiplicands" $ + property $ \ai as bi bs -> BigDecimal ai as * BigDecimal bi bs === BigDecimal (ai*bi) (as+bs) + + describe "abs" $ do + it "determines the absolute value of a BigDecimal" $ + abs (BigDecimal (-12) 4) `shouldBe` BigDecimal 12 4 + it "is idempotent" $ + property $ \bd -> (abs . abs) bd === (abs bd :: BigDecimal) + it "is based on abs for Integers" $ + property $ \ai as -> abs (BigDecimal ai as) === BigDecimal (abs ai) as + it "negates for input < 0" $ + property $ \bd -> abs bd === if getValue bd < 0 then negate bd else bd + + describe "signum" $ do + it "determines the signature a BigDecimal" $ + signum (BigDecimal (-12) 4) `shouldBe` -1 + it "returns 1 if input > 0, zero if input == 0 and -1 if input < 0" $ + property $ \ai as -> signum (BigDecimal ai as) === if ai > 0 then 1 else if ai == 0 then 0 else -1 + it "is based on signum for Integers" $ + property $ \ai as -> signum (BigDecimal ai as) === BigDecimal (signum ai) 0 + + describe "fromInteger" $ do + it "constructs a BigDecimal from an Integer" $ + 1234 `shouldBe` BigDecimal 1234 0 + it "works for any Integer" $ + property $ \i -> fromInteger i === BigDecimal i 0 + + describe "negate" $ do + it "negates a BigDecimal" $ + negate (BigDecimal 1234 1) `shouldBe` -BigDecimal 1234 1 + it "works for any BigDecimal" $ + property $ \bd -> negate bd === (-bd :: BigDecimal) + it "is the same as *(-1)" $ + property $ \bd -> negate bd === (-1 * bd :: BigDecimal) + it "is its own inverse" $ + property $ \bd -> negate (negate bd) === (bd :: BigDecimal) + + describe "(/)" $ do + it "divides two BigDecimals" $ + BigDecimal 16 1 / BigDecimal 4 1 `shouldBe` BigDecimal 4 0 + it "yields x for x/1 for any x" $ + property $ \x -> x/1 === (x :: BigDecimal) + it "yields 1 for x/x any non-zero x" $ + property $ \x -> if x /= (0 :: BigDecimal) then x / x === 1 else 1===1 + it "throws an Arithmetic exception when dividing by 0" $ + property $ \bd -> evaluate (bd / 0 :: BigDecimal) `shouldThrow` anyArithException + it "yields y for (x*y)/x for any nonzero x" $ + property $ \x y -> y === if x == (0 :: BigDecimal) then y else (x*y)/x + it "rounds up if next decimal would be > 5" $ + 6 / 9 `shouldBe` fromString "0.6667" + it "rounds up if next decimal would be = 5" $ + 5 / 9 `shouldBe` fromString "0.5556" + it "rounds down if next decimal would be < 5" $ + 4 / 9 `shouldBe` fromString "0.4444" + + describe "fromRational" $ do + it "constructs a BigDecimal from a Ratio" $ + fromRational (1 :% 32) `shouldBe` 1 / BigDecimal 32 0 + it "works for any non-zero divisors" $ + property $ \x y -> if y == 0 then 1 ===1 else fromRational (x :% y) === BigDecimal x 0 / BigDecimal y 0 + + describe "toRational" $ do + it "converts a BigDecimal to a Ratio" $ + toRational (1 / BigDecimal 32 0) `shouldBe` (1 :% 32) + it "is inverse to fromRational" $ + property $ \x -> (x::BigDecimal) === fromRational (toRational x) + + describe "divide +/+" $ do + -- checking expresions >= 0 + it "divides BigDecimals applying RoundingMode and precision" $ + divide (2, 3) (HALF_UP, Just 9) `shouldBe` fromString "0.666666667" + it "always rounds down when using DOWN" $ + divide (2, 3) (DOWN, Just 9) `shouldBe` fromString "0.666666666" + it "always rounds down when using FLOOR" $ + divide (2, 3) (FLOOR, Just 9) `shouldBe` fromString "0.666666666" + it "rounds up when using UP when there is a remainder" $ + divide (1, 9) (UP, Just 3) `shouldBe` fromString "0.112" + it "does not round when there is no remainder when using UP" $ + divide (14, 100) (UP, Just 2) `shouldBe` fromString "0.14" + it "rounds up when using UP when there is a remainder" $ + divide (1, 9) (CEILING, Just 3) `shouldBe` fromString "0.112" + it "does not round when there is no remainder when using UP" $ + divide (14, 100) (CEILING, Just 2) `shouldBe` fromString "0.14" + it "rounds down if next decimal would be <= 5 when using HALF_DOWN" $ + divide (5, 9) (HALF_DOWN, Just 4) `shouldBe` fromString "0.5555" + it "rounds up if next decimal would be > 5 when using HALF_DOWN" $ + divide (2, 3) (HALF_DOWN, Just 4) `shouldBe` fromString "0.6667" + it "rounds up if next decimal would be >= 5 when using HALF_UP" $ + divide (5, 9) (HALF_UP, Just 4) `shouldBe` fromString "0.5556" + it "rounds to next even number if next decimal would be == 5 when using HALF_EVEN" $ + divide (5, 9) (HALF_EVEN, Just 4) `shouldBe` fromString "0.5556" + it "rounds to next even number if next decimal would be == 5 when using HALF_EVEN" $ + divide (1, 8) (HALF_EVEN, Just 2) `shouldBe` fromString "0.12" + it "rounds to next even number if next decimal would be == 5 when using HALF_EVEN" $ + divide (15, 100) (HALF_EVEN, Just 1) `shouldBe` fromString "0.2" + it "rounds up if next decimal would be > 5 when using HALF_EVEN" $ + divide (2, 3) (HALF_EVEN, Just 4) `shouldBe` fromString "0.6667" + it "throws an exception when PRECISE is used and a non-terminating decimal expansion is detected" $ + evaluate (divide (5, 9) (PRECISE, Nothing)) `shouldThrow` anyException + it "gives a precise value when using PRECISE and no max precision" $ + divide (1, 32) (PRECISE, Nothing) `shouldBe` fromString "0.03125" + it "gives a precise value when using PRECISE and a sufficient precision" $ + divide (1, 32) (PRECISE, Just 5) `shouldBe` fromString "0.03125" + it "gives a precise value when using PRECISE and a to small precision" $ + evaluate (divide (1, 32) (PRECISE, Just 4)) `shouldThrow` anyException + + describe "divide -/+" $ do + -- checking dividend < 0 + it "divides BigDecimals applying RoundingMode and precision" $ + divide (-2, 3) (HALF_UP, Just 9) `shouldBe` fromString "-0.666666667" + it "always rounds down when using DOWN" $ + divide (-2, 3) (DOWN, Just 9) `shouldBe` fromString "-0.666666666" + it "always rounds towards -INF when using FLOOR" $ + divide (-2, 3) (FLOOR, Just 9) `shouldBe` fromString "-0.666666667" + it "rounds up when using UP when there is a remainder" $ + divide (-1, 9) (UP, Just 3) `shouldBe` fromString "-0.112" + it "does not round when there is no remainder when using UP" $ + divide (-14, 100) (UP, Just 2) `shouldBe` fromString "-0.14" + it "rounds towards +INF when using CEILING when there is a remainder" $ + divide (-1, 9) (CEILING, Just 3) `shouldBe` fromString "-0.111" + it "does not round when there is no remainder when using UP" $ + divide (-14, 100) (CEILING, Just 2) `shouldBe` fromString "-0.14" + it "rounds down if next decimal would be <= 5 when using HALF_DOWN" $ + divide (-5, 9) (HALF_DOWN, Just 4) `shouldBe` fromString "-0.5555" + it "rounds up if next decimal would be > 5 when using HALF_DOWN" $ + divide (-2, 3) (HALF_DOWN, Just 4) `shouldBe` fromString "-0.6667" + it "rounds up if next decimal would be >= 5 when using HALF_UP" $ + divide (-5, 9) (HALF_UP, Just 4) `shouldBe` fromString "-0.5556" + it "rounds to next even number if next decimal would be == 5 when using HALF_EVEN" $ + divide (-5, 9) (HALF_EVEN, Just 4) `shouldBe` fromString "-0.5556" + it "rounds to next even number if next decimal would be == 5 when using HALF_EVEN" $ + divide (-1, 8) (HALF_EVEN, Just 2) `shouldBe` fromString "-0.12" + it "rounds to next even number if next decimal would be == 5 when using HALF_EVEN" $ + divide (-15, 100) (HALF_EVEN, Just 1) `shouldBe` fromString "-0.2" + it "rounds up if next decimal would be > 5 when using HALF_EVEN" $ + divide (-2, 3) (HALF_EVEN, Just 4) `shouldBe` fromString "-0.6667" + it "throws an exception when PRECISE is used and a non-terminating decimal expansion is detected" $ + evaluate (divide (-5, 9) (PRECISE, Nothing)) `shouldThrow` anyException + it "gives a precise value when using PRECISE and no max precision" $ + divide (-1, 32) (PRECISE, Nothing) `shouldBe` fromString "-0.03125" + it "gives a precise value when using PRECISE and a sufficient precision" $ + divide (-1, 32) (PRECISE, Just 5) `shouldBe` fromString "-0.03125" + it "gives a precise value when using PRECISE and a to small precision" $ + evaluate (divide (-1, 32) (PRECISE, Just 4)) `shouldThrow` anyException + + describe "divide +/-" $ do + -- checking divisor < 0 + it "divides BigDecimals applying RoundingMode and precision" $ + divide (2, -3) (HALF_UP, Just 9) `shouldBe` fromString "-0.666666667" + it "always rounds down when using DOWN" $ + divide (2, -3) (DOWN, Just 9) `shouldBe` fromString "-0.666666666" + it "always rounds towards -INF when using FLOOR" $ + divide (2, -3) (FLOOR, Just 9) `shouldBe` fromString "-0.666666667" + it "rounds up when using UP when there is a remainder" $ + divide (1, -9) (UP, Just 3) `shouldBe` fromString "-0.112" + it "does not round when there is no remainder when using UP" $ + divide (14, -100) (UP, Just 2) `shouldBe` fromString "-0.14" + it "rounds towards +INF when using CEILING when there is a remainder" $ + divide (1, -9) (CEILING, Just 3) `shouldBe` fromString "-0.111" + it "does not round when there is no remainder when using UP" $ + divide (14, -100) (CEILING, Just 2) `shouldBe` fromString "-0.14" + it "rounds down if next decimal would be <= 5 when using HALF_DOWN" $ + divide (5, -9) (HALF_DOWN, Just 4) `shouldBe` fromString "-0.5555" + it "rounds up if next decimal would be > 5 when using HALF_DOWN" $ + divide (2, -3) (HALF_DOWN, Just 4) `shouldBe` fromString "-0.6667" + it "rounds up if next decimal would be >= 5 when using HALF_UP" $ + divide (5, -9) (HALF_UP, Just 4) `shouldBe` fromString "-0.5556" + it "rounds to next even number if next decimal would be == 5 when using HALF_EVEN" $ + divide (5, -9) (HALF_EVEN, Just 4) `shouldBe` fromString "-0.5556" + it "rounds to next even number if next decimal would be == 5 when using HALF_EVEN" $ + divide (1, -8) (HALF_EVEN, Just 2) `shouldBe` fromString "-0.12" + it "rounds to next even number if next decimal would be == 5 when using HALF_EVEN" $ + divide (15, -100) (HALF_EVEN, Just 1) `shouldBe` fromString "-0.2" + it "rounds up if next decimal would be > 5 when using HALF_EVEN" $ + divide (2, -3) (HALF_EVEN, Just 4) `shouldBe` fromString "-0.6667" + it "throws an exception when PRECISE is used and a non-terminating decimal expansion is detected" $ + evaluate (divide (5, -9) (PRECISE, Nothing)) `shouldThrow` anyException + it "gives a precise value when using PRECISE and no max precision" $ + divide (1, -32) (PRECISE, Nothing) `shouldBe` fromString "-0.03125" + it "gives a precise value when using PRECISE and a sufficient precision" $ + divide (1, -32) (PRECISE, Just 5) `shouldBe` fromString "-0.03125" + it "gives a precise value when using PRECISE and a to small precision" $ + evaluate (divide (1, -32) (PRECISE, Just 4)) `shouldThrow` anyException + + describe "divide -/-" $ do + -- checking dividend and divisor < 0 + it "divides BigDecimals applying RoundingMode and precision" $ + divide (-2, -3) (HALF_UP, Just 9) `shouldBe` fromString "0.666666667" + it "always rounds down when using DOWN" $ + divide (-2, -3) (DOWN, Just 9) `shouldBe` fromString "0.666666666" + it "always rounds towards -INF when using FLOOR" $ + divide (-2, -3) (FLOOR, Just 9) `shouldBe` fromString "0.666666666" + it "rounds up when using UP when there is a remainder" $ + divide (-1, -9) (UP, Just 3) `shouldBe` fromString "0.112" + it "does not round when there is no remainder when using UP" $ + divide (-14, -100) (UP, Just 2) `shouldBe` fromString "0.14" + it "rounds towards +INF when using CEILING when there is a remainder" $ + divide (-1, -9) (CEILING, Just 3) `shouldBe` fromString "0.112" + it "does not round when there is no remainder when using UP" $ + divide (-14, -100) (CEILING, Just 2) `shouldBe` fromString "0.14" + it "rounds down if next decimal would be <= 5 when using HALF_DOWN" $ + divide (-5, -9) (HALF_DOWN, Just 4) `shouldBe` fromString "0.5555" + it "rounds up if next decimal would be > 5 when using HALF_DOWN" $ + divide (-2, -3) (HALF_DOWN, Just 4) `shouldBe` fromString "0.6667" + it "rounds up if next decimal would be >= 5 when using HALF_UP" $ + divide (-5, -9) (HALF_UP, Just 4) `shouldBe` fromString "0.5556" + it "rounds to next even number if next decimal would be == 5 when using HALF_EVEN" $ + divide (-5, -9) (HALF_EVEN, Just 4) `shouldBe` fromString "0.5556" + it "rounds to next even number if next decimal would be == 5 when using HALF_EVEN" $ + divide (-1, -8) (HALF_EVEN, Just 2) `shouldBe` fromString "0.12" + it "rounds to next even number if next decimal would be == 5 when using HALF_EVEN" $ + divide (-15, -100) (HALF_EVEN, Just 1) `shouldBe` fromString "0.2" + it "rounds up if next decimal would be > 5 when using HALF_EVEN" $ + divide (-2, -3) (HALF_EVEN, Just 4) `shouldBe` fromString "0.6667" + it "throws an exception when PRECISE is used and a non-terminating decimal expansion is detected" $ + evaluate (divide (-5, -9) (PRECISE, Nothing)) `shouldThrow` anyException + it "gives a precise value when using PRECISE and no max precision" $ + divide (-1, -32) (PRECISE, Nothing) `shouldBe` fromString "0.03125" + it "gives a precise value when using PRECISE and a sufficient precision" $ + divide (-1, -32) (PRECISE, Just 5) `shouldBe` fromString "0.03125" + it "gives a precise value when using PRECISE and a to small precision" $ + evaluate (divide (-1, -32) (PRECISE, Just 4)) `shouldThrow` anyException + + + describe "shrink" $ do + it "removes trailing zeros while taking care of the scale" $ + nf (BigDecimal 1000 3) `shouldBe` BigDecimal 1 0 + it "does not eliminate more 0s than requested" $ + trim 2 (BigDecimal 1000 3) `shouldBe` BigDecimal 100 2 + it "does not eliminate more 0s than possible" $ + nf (BigDecimal 1230 3) `shouldBe` BigDecimal 123 2 + it "does not change the value of a BigDecimal" $ + property $ \bd n -> trim n bd === bd + + describe "matchScales" $ + it "adjusts a pair of BigDecimals to use the same scale" $ + property $ \x y -> let (x', y') = matchScales (x,y) in getScale x' === getScale y' + + describe "roundBD" $ do + it "rounds a BigDecimal " $ + roundBD (BigDecimal 123456 3) (halfUp 2) `shouldBe` BigDecimal 12346 2 + it "ignores negative scales in MathContext" $ + roundBD (BigDecimal 123456 3) (halfUp (-2)) `shouldBe` BigDecimal 123456 3 + it "ignores MathContext with scale higher than in input value" $ + roundBD (BigDecimal 123456 3) (halfUp 10) `shouldBe` BigDecimal 123456 3 diff --git a/test/Data/BigFloatingSpec.hs b/test/Data/BigFloatingSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/BigFloatingSpec.hs @@ -0,0 +1,45 @@ +module Data.BigFloatingSpec + (main, spec) +where + +import Control.Exception (evaluate) +import Data.BigDecimal +import Data.BigFloating +import GHC.Real (Ratio ((:%))) +import Test.Hspec hiding (it) +import Data.TestUtils (it) -- I'm redefining it to use 1000 examples +import Test.Hspec.QuickCheck (modifyMaxSize, modifyMaxSuccess) +import Test.QuickCheck + + +-- `main` is here so that this module can be run from GHCi on its own. It is +-- not needed for automatic spec discovery. +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + -- mathematical functions on BigDecimals + describe "sqr" $ do + it "computes the square root of any non-negative BigDecimal" $ + property $ \x scale -> let (x', r) = (abs x, sqr x' $ halfUp scale) in abs (r*r - x') < BigDecimal 1000 scale + it "throws an exception if applied to a negative number" $ + evaluate (sqr (-16) $ halfUp 2) `shouldThrow` anyException + + -- mathematical functions on BigDecimals + describe "nthRoot" $ do + it "computes the nth root of any non-negative BigDecimal" $ + property $ \x n -> let (x', n', r) = (1+ abs x, 1+abs n, nthRoot x' n' (halfUp 10)) in abs (r^n' - x') < BigDecimal (n'*10000) 10 + it "throws an exception if trying to get even root of a negative number" $ + evaluate (nthRoot (-16) 4 $ halfUp 2) `shouldThrow` anyException + --it "computes odd roots of any negative BigDecimal" $ + -- property $ \x n -> let (x', n', r) = ((-1)- abs x, if even n then 1 + abs n else abs n, nthRoot x' n' (halfUp 10)) in abs (r^n' - x') < BigDecimal (n'*10000) 10 + + + describe "pi" $ + it "computes pi with a default precision of 100 decimal digits" $ + pi `shouldBe` fromString "3.1415926535897932384626433832795028841971693993751058209749445923078164062862089986280348253421170679" + + describe "piChudnovsky" $ + it "computes pi with arbitrary precision (demonstrating it with 1000 digits)" $ + piChudnovsky (FLOOR, Just 1000) `shouldBe` fromString "3.1415926535897932384626433832795028841971693993751058209749445923078164062862089986280348253421170679821480865132823066470938446095505822317253594081284811174502841027019385211055596446229489549303819644288109756659334461284756482337867831652712019091456485669234603486104543266482133936072602491412737245870066063155881748815209209628292540917153643678925903600113305305488204665213841469519415116094330572703657595919530921861173819326117931051185480744623799627495673518857527248912279381830119491298336733624406566430860213949463952247371907021798609437027705392171762931767523846748184676694051320005681271452635608277857713427577896091736371787214684409012249534301465495853710507922796892589235420199561121290219608640344181598136297747713099605187072113499999983729780499510597317328160963185950244594553469083026425223082533446850352619311881710100031378387528865875332083814206171776691473035982534904287554687311595628638823537875937519577818577805321712268066130019278766111959092164201989" diff --git a/test/Data/TestUtils.hs b/test/Data/TestUtils.hs new file mode 100644 --- /dev/null +++ b/test/Data/TestUtils.hs @@ -0,0 +1,19 @@ +module Data.TestUtils where + +import Test.Hspec hiding (it) +import qualified Test.Hspec as HS (it) +import Test.Hspec.QuickCheck (modifyMaxSize, modifyMaxSuccess) +import Test.QuickCheck hiding (shrink) +import Data.BigDecimal + +-- redefine it to use a sample with 1000 elements +it :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a) +it label action = modifyMaxSuccess (const 1000) $ HS.it label action + +-- arbitrary BigDecimals can be constructed using any Integer as unscaled value +-- and any non-negative Integer as scale +instance Arbitrary BigDecimal where + arbitrary = do + unscaledValue <- arbitrary + NonNegative scale <- arbitrary + return $ BigDecimal unscaledValue scale diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} -- this compiler pragma allows GHC to automatically discover all Hspec Test Specs.