bytestring-lexing 0.5.0.2 → 0.5.0.7
raw patch · 10 files changed
+910/−217 lines, 10 filesdep +bytestring-lexingdep +tastydep +tasty-quickcheckdep ~basedep ~bytestringnew-uploaderPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: bytestring-lexing, tasty, tasty-quickcheck, tasty-smallcheck
Dependency ranges changed: base, bytestring
API changes (from Hackage documentation)
- Data.ByteString.Lex.Fractional: decimalPrecision :: RealFloat a => proxy a -> Int
+ Data.ByteString.Lex.Fractional: decimalPrecision :: forall proxy a. RealFloat a => proxy a -> Int
Files
- CHANGELOG +6/−0
- README +0/−36
- README.md +185/−0
- bytestring-lexing.cabal +89/−21
- src/Data/ByteString/Lex/Fractional.hs +34/−54
- src/Data/ByteString/Lex/Integral.hs +43/−91
- src/Data/ByteString/Lex/Internal.hs +49/−15
- test/Fractional.hs +248/−0
- test/Integral.hs +227/−0
- test/Main.hs +29/−0
CHANGELOG view
@@ -1,3 +1,9 @@+0.5.0.7 (2021-10-16):+ - Switching from TravisCI to GithubActions+ - Linting Haddock warnings+ - Remove some trailing whitespaces+0.5.0.6 (2019-04-13):+ - Nudging everything to the correct urls, emails, etc 0.5.0.2 (2015-05-06): - Fixed the benchmarking url 0.5.0.1 (2015-05-06):
− README
@@ -1,36 +0,0 @@-bytestring-lexing-=================--This is a simple package and should be easy to install. You should-be able to use one of the following standard methods to install it.-- -- With cabal-install and without the source:- $> cabal install bytestring-lexing- - -- With cabal-install and with the source already:- $> cd bytestring-lexing- $> cabal install- - -- Without cabal-install, but with the source already:- $> cd bytestring-lexing- $> runhaskell Setup.hs configure --user- $> runhaskell Setup.hs build- $> runhaskell Setup.hs test- $> runhaskell Setup.hs haddock --hyperlink-source- $> runhaskell Setup.hs copy- $> runhaskell Setup.hs register--The test step is optional and currently does nothing. The Haddock-step is also optional.---Portability-===========--An attempt has been made to keep this library portable. However,-the decimalPrecision function in Data.ByteString.Lex.Fractional-requires ScopedTypeVariables for efficiency. If your compiler does-not support ScopedTypeVariables, this should be easy enough to fix.-Contact the maintainer if this is an issue for you.------------------------------------------------------------- fin.
+ README.md view
@@ -0,0 +1,185 @@+bytestring-lexing+=================+[](https://hackage.haskell.org/package/bytestring-lexing) +[](https://github.com/wrengr/bytestring-lexing/actions?query=workflow%3Aci)+[](http://packdeps.haskellers.com/specific?package=bytestring-lexing)++The bytestring-lexing package offers extremely efficient `ByteString`+parsers for some common lexemes: namely integral and fractional+numbers. In addition, it provides efficient serializers for (some+of) the formats it parses.++As of version 0.3.0, bytestring-lexing offers the best-in-show+parsers for integral values. And as of version 0.5.0 it offers (to+my knowledge) the best-in-show parser for fractional/floating+numbers. A record of these benchmarks can be found+[here](http://code.haskell.org/~wren/bytestring-lexing/bench/html)+++## Install++This is a simple package and should be easy to install. You should+be able to use any of the standard methods to install it.++ -- With cabal-install and without the source:+ $> cabal install bytestring-lexing+ + -- With cabal-install and with the source already:+ $> cd bytestring-lexing+ $> cabal install+ + -- Without cabal-install, but with the source already:+ $> cd bytestring-lexing+ $> runhaskell Setup.hs configure --user+ $> runhaskell Setup.hs build+ $> runhaskell Setup.hs haddock --hyperlink-source+ $> runhaskell Setup.hs copy+ $> runhaskell Setup.hs register++The Haddock step is optional.+++### Testing++If you want to run the test suite, use the following standard method+(with `runhaskell Setup.hs` in lieu of `cabal`, if necessary):++ $> cd bytestring-lexing+ $> cabal configure --enable-tests --enable-coverage+ $> cabal build+ $> cabal test --keep-tix-files++The results of the code coverage are in+`./dist/hpc/vanilla/html/bytestring-lexing-$VERSION/hpc_index.html`.+If you're not interested in the coverage of the test suite, then+you needn't pass the `--enable-coverage` nor `--keep-tix-files`+flags. Note that older versions of cabal used the flag name+`--enable-library-coverage` instead of `--enable-coverage`. And+IIRC hpc integration in cabal was broken for ghc-7.6.+++### Benchmarks++If you want to run the benchmarking code, then do:++ $> cd bytestring-lexing/bench+ $> cabal configure+ $> cabal build+ $> for b in isSpace numDigits packDecimal readDecimal readExponential ceilEightThirds; do+ ./dist/build/bench-${b}/bench-${b} -o ${b}.html;+ done && open *.html++Of course, you needn't run all the benchmarking programs if you+don't want. Notably, these benchmarks are artefacts of the development+of the library. They are not necessarily the most up-to-date+reflection of the library itself, nor of other Haskell libraries+we've compared against in the past.+++## Portability++An attempt has been made to keep this library portable. However,+we do make use of two simple language extensions. Both of these+would be easy enough to remove, but they should not pose a significant+portability burden. If they do in fact pose a burden for your+compiler, contact the maintainer.++* ScopedTypeVariables - the `decimalPrecision` function in+ `Data.ByteString.Lex.Fractional` uses ScopedTypeVariables for+ efficiency; namely to ensure that the constant function+ `decimalPrecision` need only compute its result once (per type),+ and that its result has no data dependency on the proxy argument.+* BangPatterns - are used to make the code prettier and to "improve"+ code coverage over the equivalent semantics via the following+ idiom:+ + foo x ... z+ | x `seq` ... `seq` z `seq` False = error "impossible"+ | otherwise = ...+ + BangPatterns are supported in GHC as far back as [version+ 6.6.1][ghc-bangpatterns], and are also supported by+ [JHC][jhc-bangpatterns] and [UHC][uhc-bangpatterns]. As of 2010,+ they were [not supported by Hugs][hugs-bangpatterns]; but alas+ Hugs is pretty much dead now.++[ghc-bangpatterns]: + https://downloads.haskell.org/~ghc/6.6.1/docs/html/users_guide/sec-bang-patterns.html+[jhc-bangpatterns]:+ http://repetae.net/computer/jhc/manual.html#code-options+[uhc-bangpatterns]:+ https://github.com/UU-ComputerScience/uhc-js/issues/1+[hugs-bangpatterns]: + https://mail.haskell.org/pipermail/haskell-cafe/2010-July/079946.html+++## Changes: Version 0.5.0 (2015-05-06) vs 0.4.3 (2013-03-21)++I've completely overhauled the parsers for fractional numbers.++The old `Data.ByteString.Lex.Double` and `Data.ByteString.Lex.Lazy.Double`+modules have been removed, as has their reliance on Alex as a build+tool. I know some users were reluctant to use bytestring-lexing+because of that dependency, and forked their own version of+bytestring-lexing-0.3.0's integral parsers. This is no longer an+issue, and those users are requested to switch over to using+bytestring-lexing.++The old modules are replaced by the new `Data.ByteString.Lex.Fractional`+module. This module provides two variants of the primary parsers.+The `readDecimal` and `readExponential` functions are very simple+and should suffice for most users' needs. The `readDecimalLimited`+and `readExponentialLimited` are variants which take an argument+specifying the desired precision limit (in decimal digits). With+care, the limited-precision parsers can perform far more efficiently+than the unlimited-precision parsers. Performance aside, they can+also be used to intentionally restrict the precision of your program's+inputs.+++## Benchmarks: Version 0.5.0 (2015-05-06)++The Criterion output of the benchmark discussed below, [is available+here](http://code.haskell.org/~wren/bytestring-lexing/bench/html/readExponential-0.5.0_ereshkigal.html).+The main competitors we compare against are the previous version+of bytestring-lexing (which already surpassed text and+attoparsec/scientific) and bytestring-read which was the previous+best-in-show.++The unlimited-precision parsers provide 3.3x to 3.9x speedup over+the `readDouble` function from bytestring-lexing-0.4.3.3, as well+as being polymorphic over all `Fractional` values. For `Float`/`Double`:+these functions have essentially the same performance as bytestring-read+on reasonable inputs (1.07x to 0.89x), but for inputs which have+far more precision than `Float`/`Double` can handle these functions+are much slower than bytestring-read (0.30x 'speedup'). However,+for `Rational`: these functions provide 1.26x to 1.96x speedup+compared to bytestring-read.++The limited-precision parsers do even better, but require some care+to use properly. For types with infinite precision (e.g., `Rational`)+we can pass in an 'infinite' limit by passing the length of the+input string plus one. For `Rational`: doing so provides 1.5x speedup+over the unlimited-precision parsers (and 1.9x to 3x speedup over+bytestring-read), because we can avoid intermediate renormalizations.+Whether other unlimited precision types would see the same benefit+remains an open question.++For types with inherently limited precision (e.g., `Float`/`Double`),+we could either pass in an 'infinite' limit or we could pass in the+actual inherent limit. For types with inherently limited precision,+passing in an 'infinite' limit degrades performance compared to the+unlimited-precision parsers (0.51x to 0.8x 'speedup'). Whereas,+passing in the actual inherent limit gives 1.3x to 4.5x speedup+over the unlimited-precision parsers. They also provide 1.2x to+1.4x speedup over bytestring-read; for a total of 5.1x to 14.4x+speedup over bytestring-lexing-0.4.3.3!+++## Links++* [Website](https://wrengr.org/)+* [Blog](http://winterkoninkje.dreamwidth.org/)+* [Twitter](https://twitter.com/wrengr)+* [Hackage](http://hackage.haskell.org/package/bytestring-lexing)+* [GitHub](https://github.com/wrengr/bytestring-lexing)
bytestring-lexing.cabal view
@@ -1,51 +1,119 @@ ------------------------------------------------------------------- wren gayle romano <wren@community.haskell.org> ~ 2015.06.05+-- wren gayle romano <wren@cpan.org> ~ 2021.10.16 ---------------------------------------------------------------- --- By and large Cabal >=1.2 is fine; but >= 1.6 gives tested-with:--- and source-repository:.-Cabal-Version: >= 1.6+-- Cabal >=1.10 is required by Hackage.+Cabal-Version: >= 1.10 Build-Type: Simple Name: bytestring-lexing-Version: 0.5.0.2+Version: 0.5.0.7 Stability: provisional-Homepage: http://code.haskell.org/~wren/+Homepage: https://wrengr.org/ Author: wren gayle romano, Don Stewart-Maintainer: wren@community.haskell.org-Copyright: Copyright (c) 2012--2015 wren gayle romano, 2008--2011 Don Stewart-License: BSD2+Maintainer: wren@cpan.org+Copyright: Copyright (c) 2012--2021 wren gayle romano, 2008--2011 Don Stewart+License: BSD3 License-File: LICENSE Category: Data Synopsis:- Parse and produce literals efficiently from strict or lazy bytestrings.+ Efficiently parse and produce common integral and fractional numbers. Description:- Parse and produce literals efficiently from strict or lazy bytestrings.+ The bytestring-lexing package offers extremely efficient `ByteString`+ parsers for some common lexemes: namely integral and fractional+ numbers. In addition, it provides efficient serializers for (some+ of) the formats it parses. .+ As of version 0.3.0, bytestring-lexing offers the best-in-show+ parsers for integral values. (According to the Warp web server's+ benchmark of parsing the Content-Length field of HTTP headers.) And+ as of version 0.5.0 it offers (to my knowledge) the best-in-show+ parser for fractional/floating numbers.+ . Some benchmarks for this package can be found at:- <http://community.haskell.org/~wren/bytestring-lexing/bench/html>+ <http://code.haskell.org/~wren/bytestring-lexing/bench/html> +----------------------------------------------------------------+Extra-source-files:+ AUTHORS, CHANGELOG, README.md --- Formerly tested with GHCs 6.8.2, 6.10.1, 6.12.1, 7.0.3, 7.6.1, 7.8.0; but those are no longer verified.+-- This should work as far back as GHC 7.4.1, but we don't verify that by CI.+-- <https://github.com/wrengr/bytestring-lexing/actions?query=workflow%3Aci> Tested-With:- GHC ==7.8.3, GHC == 7.10.1-Extra-source-files:- AUTHORS, README, CHANGELOG+ GHC ==8.0.2,+ GHC ==8.2.2,+ GHC ==8.4.4,+ GHC ==8.6.5,+ GHC ==8.8.4,+ GHC ==8.10.3,+ GHC ==9.0.1+ Source-Repository head- Type: darcs- Location: http://community.haskell.org/~wren/bytestring-lexing+ Type: git+ Location: https://github.com/wrengr/bytestring-lexing.git ---------------------------------------------------------------- Library+ Default-Language: Haskell2010 Ghc-Options: -O2 Hs-Source-Dirs: src Exposed-Modules: Data.ByteString.Lex.Integral Data.ByteString.Lex.Fractional Other-Modules: Data.ByteString.Lex.Internal- - -- Should actually be able to work as far back as base-2.0...- Build-Depends: base >= 4 && < 5, bytestring++ -- These lower bounds are probably more restrictive than+ -- necessary. But then, we don't maintain any CI tests for+ -- older versions, so these are the lowest bounds we've verified.+ Build-Depends: base >= 4.5 && < 4.16+ , bytestring >= 0.9.2.1 && < 0.12++----------------------------------------------------------------+-- <https://www.haskell.org/cabal/users-guide/developing-packages.html#test-suites>+-- You can either:+-- (1) have type:exitcode-stdio-1.0 & main-is:+-- where main-is exports `main::IO()` as usual. Or,+-- (2) have type:detailed-0.9 & test-module:+-- where test-module exports tests::IO[Distribution.TestSuite.Test]+-- and you have Build-Depends: Cabal >= 1.9.2+--+-- Rather than using Cabal's built-in detailed-0.9 framework, we+-- could use the test-framework* family of packages with+-- exitcode-stdio-1.0. cf.,+-- <http://hackage.haskell.org/package/Decimal-0.4.2/src/Decimal.cabal> Or+-- the tasty* family of packages with exitcode-stdio-1.0. Notice+-- that test-framework-smallcheck is deprecated in favor of+-- tasty-smallcheck. Both have more dependencies than Cabal, so+-- will be harder to install on legacy systems; but then we wouldn't+-- have to maintain our own code to glue into Cabal's detailed-0.9.+-- Note that the oldest Tasty requires base>=4.5 whereas the oldest+-- test-framework seems to have no lower bound on base.++Test-Suite test-all+ Default-Language: Haskell2010+ Hs-Source-Dirs: test+ Type: exitcode-stdio-1.0+ -- HACK: main-is must *not* have ./test/ like it does for executables!+ Main-Is: Main.hs+ Other-Modules: Integral+ , Fractional+ -- We must include this library in order for the tests to use+ -- it; but we must not give a version restriction lest Cabal+ -- give warnings.+ Build-Depends: base >= 4.5 && < 5+ , bytestring >= 0.9.2.1 && < 0.12+ , bytestring-lexing+ , tasty >= 0.10.1.2 && < 1.5+ , tasty-smallcheck >= 0.8.0.1 && < 0.9+ , tasty-quickcheck >= 0.8.3.2 && < 0.11+ -- QuickCheck >= 2.10 && < 2.15+ -- smallcheck >= 1.1.1 && < 1.3+ -- lazysmallcheck >= 0.6 && < 0.7++-- cabal configure flags:+-- * --enable-tests+-- * --enable-coverage (replaces the deprecated --enable-library-coverage)+-- * --enable-benchmarks (doesn't seem to actually work... At least, I was getting errors whenever I tried passing this; maybe upping the cabal-version to 1.8 fixed that?) ---------------------------------------------------------------- ----------------------------------------------------------- fin.
src/Data/ByteString/Lex/Fractional.hs view
@@ -1,14 +1,14 @@ {-# OPTIONS_GHC -Wall -fwarn-tabs #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE BangPatterns, ScopedTypeVariables #-} ------------------------------------------------------------------- 2015.06.05+-- 2015.06.11 -- | -- Module : Data.ByteString.Lex.Fractional--- Copyright : Copyright (c) 2015 wren gayle romano+-- Copyright : Copyright (c) 2015--2019 wren gayle romano -- License : BSD2--- Maintainer : wren@community.haskell.org+-- Maintainer : wren@cpan.org -- Stability : provisional--- Portability : Haskell98 + ScopedTypeVariables+-- Portability : BangPatterns + ScopedTypeVariables -- -- Functions for parsing and producing 'Fractional' values from\/to -- 'ByteString's based on the \"Char8\" encoding. That is, we assume@@ -49,7 +49,7 @@ import Data.Word (Word8) import qualified Data.ByteString.Lex.Integral as I import Data.ByteString.Lex.Integral (readSigned)-import Data.ByteString.Lex.Internal (numDecimalDigits)+import Data.ByteString.Lex.Internal ---------------------------------------------------------------- ----------------------------------------------------------------@@ -58,15 +58,11 @@ -- TODO: should we really be this strict? justPair :: a -> b -> Maybe (a,b) {-# INLINE justPair #-}-justPair x y- | x `seq` y `seq` False = undefined- | otherwise = Just (x,y)+justPair !x !y = Just (x,y) pair :: a -> b -> (a,b) {-# INLINE pair #-}-pair x y- | x `seq` y `seq` False = undefined- | otherwise = (x,y)+pair !x !y = (x,y) -- NOTE: We use 'fromInteger' everywhere instead of 'fromIntegral'@@ -74,22 +70,7 @@ -- This is always correct, but for some result types there are other -- intermediate types which may be faster. -{-# INLINE isNotPeriod #-}-isNotPeriod :: Word8 -> Bool-isNotPeriod w = w /= 0x2E -{-# INLINE isNotE #-}-isNotE :: Word8 -> Bool-isNotE w = w /= 0x65 && w /= 0x45--{-# INLINE isDecimal #-}-isDecimal :: Word8 -> Bool-isDecimal w = 0x39 >= w && w >= 0x30--{-# INLINE isDecimalZero #-}-isDecimalZero :: Word8 -> Bool-isDecimalZero w = w == 0x30- ---------------------------------------------------------------- ----- Decimal @@ -149,12 +130,14 @@ -- those are best handled by helper functions which then use this -- function for the actual numerical parsing. This function recognizes -- both upper-case, lower-case, and mixed-case hexadecimal.+--+-- This is just a thin wrapper around 'I.readHexadecimal'. readHexadecimal :: (Fractional a) => ByteString -> Maybe (a, ByteString) {-# SPECIALIZE readHexadecimal :: ByteString -> Maybe (Float, ByteString), ByteString -> Maybe (Double, ByteString), ByteString -> Maybe (Rational, ByteString) #-}-readHexadecimal xs = +readHexadecimal xs = case I.readHexadecimal xs of Nothing -> Nothing Just (n, xs') -> justPair (fromInteger n) xs'@@ -179,12 +162,14 @@ -- \"0o\", but because there are different variants, those are best -- handled by helper functions which then use this function for the -- actual numerical parsing.+--+-- This is just a thin wrapper around 'I.readOctal'. readOctal :: (Fractional a) => ByteString -> Maybe (a, ByteString) {-# SPECIALIZE readOctal :: ByteString -> Maybe (Float, ByteString), ByteString -> Maybe (Double, ByteString), ByteString -> Maybe (Rational, ByteString) #-}-readOctal xs = +readOctal xs = case I.readOctal xs of Nothing -> Nothing Just (n, xs') -> justPair (fromInteger n) xs'@@ -248,7 +233,7 @@ -- representation, as defined by a fundep or typefamily! We use -- 'Integer' which is sufficient for all cases, but it'd be better -- to use @Word24@ for 'Float', @Word53@ for 'Double', and @a@ for--- @'Ratio' a@.+-- @'Data.Ratio.Ratio' a@. data DecimalFraction a = DF !Integer {-# UNPACK #-}!Int -- BUG: Can't unpack integers... @@ -358,26 +343,21 @@ where -- All calls to 'I.readDecimal' are monomorphized at 'Integer', -- as specified by what 'DF' needs.-- -- TODO: verify this is ~inferred~ strict in both @p@ and @xs@- -- without the guard trick or BangPatterns- start p xs- | p `seq` xs `seq` False = undefined- | otherwise =- case lengthDropWhile isDecimalZero xs of- (0, _) -> readWholePart p xs- (_, ys) ->- case BS.uncons ys of- Nothing -> justPair (DF 0 0) BS.empty- Just (y0,ys0)- | isDecimal y0 -> readWholePart p ys- | isNotPeriod y0 -> justPair (DF 0 0) ys- | otherwise ->- case lengthDropWhile isDecimalZero ys0 of- (0, _) -> readFractionPart p 0 ys- (scale, zs) -> afterDroppingZeroes p scale zs+ start !p !xs =+ case lengthDropWhile isDecimalZero xs of+ (0, _) -> readWholePart p xs+ (_, ys) ->+ case BS.uncons ys of+ Nothing -> justPair (DF 0 0) BS.empty+ Just (y0,ys0)+ | isDecimal y0 -> readWholePart p ys+ | isNotPeriod y0 -> justPair (DF 0 0) ys+ | otherwise ->+ case lengthDropWhile isDecimalZero ys0 of+ (0, _) -> readFractionPart p 0 ys+ (scale, zs) -> afterDroppingZeroes p scale zs - afterDroppingZeroes p scale xs =+ afterDroppingZeroes !p !scale !xs = let ys = BS.take p xs in case I.readDecimal ys of Nothing -> justPair (DF 0 0) xs@@ -386,7 +366,7 @@ in justPair (DF part (negate scale')) (BS.dropWhile isDecimal ys') - readWholePart p xs =+ readWholePart !p !xs = let ys = BS.take p xs in case I.readDecimal ys of Nothing -> Nothing@@ -411,7 +391,7 @@ then justPair (DF whole 0) xs' else readFractionPart (p-len) whole xs' - dropFractionPart xs =+ dropFractionPart !xs = case BS.uncons xs of Nothing -> BS.empty -- == xs Just (x0,xs0)@@ -428,7 +408,7 @@ -- isDecimal@ is a noop; but there's no reason to branch on -- testing for that. The @+1@ in @BS.drop (1+scale)@ is for the -- 'BSU.unsafeTail' in @ys@.- readFractionPart p whole xs =+ readFractionPart !p !whole !xs = let ys = BS.take p (BSU.unsafeTail xs) in case I.readDecimal ys of Nothing -> justPair (DF whole 0) xs@@ -449,12 +429,12 @@ Int -> ByteString -> Maybe (Rational, ByteString) #-} readExponentialLimited = start where- start p xs =+ start !p !xs = case readDecimalLimited_ p xs of Nothing -> Nothing Just (df,xs') -> Just $! readExponentPart df xs' - readExponentPart df xs+ readExponentPart !df !xs | BS.null xs = pair (fromDF df) BS.empty | isNotE (BSU.unsafeHead xs) = pair (fromDF df) xs | otherwise =
src/Data/ByteString/Lex/Integral.hs view
@@ -1,13 +1,14 @@ {-# OPTIONS_GHC -Wall -fwarn-tabs #-}+{-# LANGUAGE BangPatterns #-} ------------------------------------------------------------------- 2013.03.21+-- 2015.06.11 -- | -- Module : Data.ByteString.Lex.Integral--- Copyright : Copyright (c) 2010--2015 wren gayle romano+-- Copyright : Copyright (c) 2010--2019 wren gayle romano -- License : BSD2--- Maintainer : wren@community.haskell.org+-- Maintainer : wren@cpan.org -- Stability : provisional--- Portability : Haskell98+-- Portability : BangPatterns -- -- Functions for parsing and producing 'Integral' values from\/to -- 'ByteString's based on the \"Char8\" encoding. That is, we assume@@ -96,9 +97,8 @@ Just $ loop (fromIntegral (w - 0x30)) (BSU.unsafeTail xs) | otherwise -> Nothing - loop n xs- | n `seq` xs `seq` False = undefined -- for strictness analysis- | BS.null xs = (n, BS.empty) -- not @xs@, to help GC+ loop !n !xs+ | BS.null xs = (n, BS.empty) -- not @xs@, to help GC | otherwise = case BSU.unsafeHead xs of w | 0x39 >= w && w >= 0x30 ->@@ -131,18 +131,6 @@ ByteString -> Maybe (Word64, ByteString) #-} readDecimal = start where- isDecimal :: Word8 -> Bool- {-# INLINE isDecimal #-}- isDecimal w = 0x39 >= w && w >= 0x30-- toDigit :: (Integral a) => Word8 -> a- {-# INLINE toDigit #-}- toDigit w = fromIntegral (w - 0x30)-- addDigit :: Int -> Word8 -> Int- {-# INLINE addDigit #-}- addDigit n w = n * 10 + toDigit w- -- TODO: should we explicitly drop all leading zeros before we jump into the unrolled loop? start :: (Integral a) => ByteString -> Maybe (a, ByteString) start xs@@ -153,8 +141,7 @@ | otherwise -> Nothing loop0 :: (Integral a) => a -> ByteString -> (a, ByteString)- loop0 m xs- | m `seq` xs `seq` False = undefined+ loop0 !m !xs | BS.null xs = (m, BS.empty) | otherwise = case BSU.unsafeHead xs of@@ -163,57 +150,49 @@ loop1, loop2, loop3, loop4, loop5, loop6, loop7, loop8 :: (Integral a) => a -> Int -> ByteString -> (a, ByteString)- loop1 m n xs- | m `seq` n `seq` xs `seq` False = undefined+ loop1 !m !n !xs | BS.null xs = (m*10 + fromIntegral n, BS.empty) | otherwise = case BSU.unsafeHead xs of w | isDecimal w -> loop2 m (addDigit n w) (BSU.unsafeTail xs) | otherwise -> (m*10 + fromIntegral n, xs)- loop2 m n xs- | m `seq` n `seq` xs `seq` False = undefined+ loop2 !m !n !xs | BS.null xs = (m*100 + fromIntegral n, BS.empty) | otherwise = case BSU.unsafeHead xs of w | isDecimal w -> loop3 m (addDigit n w) (BSU.unsafeTail xs) | otherwise -> (m*100 + fromIntegral n, xs)- loop3 m n xs- | m `seq` n `seq` xs `seq` False = undefined+ loop3 !m !n !xs | BS.null xs = (m*1000 + fromIntegral n, BS.empty) | otherwise = case BSU.unsafeHead xs of w | isDecimal w -> loop4 m (addDigit n w) (BSU.unsafeTail xs) | otherwise -> (m*1000 + fromIntegral n, xs)- loop4 m n xs- | m `seq` n `seq` xs `seq` False = undefined+ loop4 !m !n !xs | BS.null xs = (m*10000 + fromIntegral n, BS.empty) | otherwise = case BSU.unsafeHead xs of w | isDecimal w -> loop5 m (addDigit n w) (BSU.unsafeTail xs) | otherwise -> (m*10000 + fromIntegral n, xs)- loop5 m n xs- | m `seq` n `seq` xs `seq` False = undefined+ loop5 !m !n !xs | BS.null xs = (m*100000 + fromIntegral n, BS.empty) | otherwise = case BSU.unsafeHead xs of w | isDecimal w -> loop6 m (addDigit n w) (BSU.unsafeTail xs) | otherwise -> (m*100000 + fromIntegral n, xs)- loop6 m n xs- | m `seq` n `seq` xs `seq` False = undefined+ loop6 !m !n !xs | BS.null xs = (m*1000000 + fromIntegral n, BS.empty) | otherwise = case BSU.unsafeHead xs of w | isDecimal w -> loop7 m (addDigit n w) (BSU.unsafeTail xs) | otherwise -> (m*1000000 + fromIntegral n, xs)- loop7 m n xs- | m `seq` n `seq` xs `seq` False = undefined+ loop7 !m !n !xs | BS.null xs = (m*10000000 + fromIntegral n, BS.empty) | otherwise = case BSU.unsafeHead xs of w | isDecimal w -> loop8 m (addDigit n w) (BSU.unsafeTail xs) | otherwise -> (m*10000000 + fromIntegral n, xs)- loop8 m n xs- | m `seq` n `seq` xs `seq` False = undefined+ loop8 !m !n !xs | BS.null xs = (m*100000000 + fromIntegral n, BS.empty) | otherwise = case BSU.unsafeHead xs of@@ -245,18 +224,6 @@ ByteString -> Word64 #-} readDecimal_ = start where- isDecimal :: Word8 -> Bool- {-# INLINE isDecimal #-}- isDecimal w = 0x39 >= w && w >= 0x30-- toDigit :: (Integral a) => Word8 -> a- {-# INLINE toDigit #-}- toDigit w = fromIntegral (w - 0x30)-- addDigit :: Int -> Word8 -> Int- {-# INLINE addDigit #-}- addDigit n w = n * 10 + toDigit w- start xs | BS.null xs = 0 | otherwise =@@ -265,8 +232,7 @@ | otherwise -> 0 loop0 :: (Integral a) => a -> ByteString -> a- loop0 m xs- | m `seq` xs `seq` False = undefined+ loop0 !m !xs | BS.null xs = m | otherwise = case BSU.unsafeHead xs of@@ -275,57 +241,49 @@ loop1, loop2, loop3, loop4, loop5, loop6, loop7, loop8 :: (Integral a) => a -> Int -> ByteString -> a- loop1 m n xs- | m `seq` n `seq` xs `seq` False = undefined+ loop1 !m !n !xs | BS.null xs = m*10 + fromIntegral n | otherwise = case BSU.unsafeHead xs of w | isDecimal w -> loop2 m (addDigit n w) (BSU.unsafeTail xs) | otherwise -> m*10 + fromIntegral n- loop2 m n xs- | m `seq` n `seq` xs `seq` False = undefined+ loop2 !m !n !xs | BS.null xs = m*100 + fromIntegral n | otherwise = case BSU.unsafeHead xs of w | isDecimal w -> loop3 m (addDigit n w) (BSU.unsafeTail xs) | otherwise -> m*100 + fromIntegral n- loop3 m n xs- | m `seq` n `seq` xs `seq` False = undefined+ loop3 !m !n !xs | BS.null xs = m*1000 + fromIntegral n | otherwise = case BSU.unsafeHead xs of w | isDecimal w -> loop4 m (addDigit n w) (BSU.unsafeTail xs) | otherwise -> m*1000 + fromIntegral n- loop4 m n xs- | m `seq` n `seq` xs `seq` False = undefined+ loop4 !m !n !xs | BS.null xs = m*10000 + fromIntegral n | otherwise = case BSU.unsafeHead xs of w | isDecimal w -> loop5 m (addDigit n w) (BSU.unsafeTail xs) | otherwise -> m*10000 + fromIntegral n- loop5 m n xs- | m `seq` n `seq` xs `seq` False = undefined+ loop5 !m !n !xs | BS.null xs = m*100000 + fromIntegral n | otherwise = case BSU.unsafeHead xs of w | isDecimal w -> loop6 m (addDigit n w) (BSU.unsafeTail xs) | otherwise -> m*100000 + fromIntegral n- loop6 m n xs- | m `seq` n `seq` xs `seq` False = undefined+ loop6 !m !n !xs | BS.null xs = m*1000000 + fromIntegral n | otherwise = case BSU.unsafeHead xs of w | isDecimal w -> loop7 m (addDigit n w) (BSU.unsafeTail xs) | otherwise -> m*1000000 + fromIntegral n- loop7 m n xs- | m `seq` n `seq` xs `seq` False = undefined+ loop7 !m !n !xs | BS.null xs = m*10000000 + fromIntegral n | otherwise = case BSU.unsafeHead xs of w | isDecimal w -> loop8 m (addDigit n w) (BSU.unsafeTail xs) | otherwise -> m*10000000 + fromIntegral n- loop8 m n xs- | m `seq` n `seq` xs `seq` False = undefined+ loop8 !m !n !xs | BS.null xs = m*100000000 + fromIntegral n | otherwise = case BSU.unsafeHead xs of@@ -346,6 +304,8 @@ -- This implementation is modified from: -- <http://www.serpentine.com/blog/2013/03/20/whats-good-for-c-is-good-for-haskell/>+-- See the banchmarks for implementation details.+-- BUG: the additional guard in 'numDecimalDigits' results in a 3x slowdown!! -- -- | Convert a non-negative integer into an (unsigned) ASCII decimal -- string. This function is unsafe to use on negative inputs.@@ -368,8 +328,7 @@ where getDigit = BSU.unsafeIndex packDecimal_digits - loop n p- | n `seq` p `seq` False = undefined -- for strictness analysis+ loop !n !p | n >= 100 = do let (q,r) = n `quotRem` 100 write2 r p@@ -377,12 +336,10 @@ | n >= 10 = write2 n p | otherwise = poke p (0x30 + fromIntegral n) - write2 i0 p- | i0 `seq` p `seq` False = undefined -- for strictness analysis- | otherwise = do- let i = fromIntegral i0; j = i + i- poke p (getDigit $! j + 1)- poke (p `plusPtr` negate 1) (getDigit j)+ write2 !i0 !p = do+ let i = fromIntegral i0; j = i + i+ poke p (getDigit $! j + 1)+ poke (p `plusPtr` negate 1) (getDigit j) packDecimal_digits :: ByteString {-# NOINLINE packDecimal_digits #-}@@ -392,7 +349,7 @@ \4041424344454647484950515253545556575859\ \6061626364656667686970717273747576777879\ \8081828384858687888990919293949596979899"- -- BUG: syntax highlighting fail: ->+ -- BUG: jEdit syntax highlighting fail: -> ---------------------------------------------------------------- ----------------------------------------------------------------@@ -440,9 +397,8 @@ Just $ loop (fromIntegral (w-0x61+10)) (BSU.unsafeTail xs) | otherwise -> Nothing - loop n xs- | n `seq` xs `seq` False = undefined -- for strictness analysis- | BS.null xs = (n, BS.empty) -- not @xs@, to help GC+ loop !n !xs+ | BS.null xs = (n, BS.empty) -- not @xs@, to help GC | otherwise = case BSU.unsafeHead xs of w | 0x39 >= w && w >= 0x30 ->@@ -510,13 +466,11 @@ return () -- needed for type checking step :: Ptr Word8 -> Word8 -> IO (Ptr Word8)- step p w- | p `seq` w `seq` False = undefined -- for strictness analysis- | otherwise = do- let ix = fromIntegral w- poke p (BSU.unsafeIndex hexDigits ((ix .&. 0xF0) `shiftR` 4))- poke (p `plusPtr` 1) (BSU.unsafeIndex hexDigits (ix .&. 0x0F))- return (p `plusPtr` 2)+ step !p !w = do+ let ix = fromIntegral w+ poke p (BSU.unsafeIndex hexDigits ((ix .&. 0xF0) `shiftR` 4))+ poke (p `plusPtr` 1) (BSU.unsafeIndex hexDigits (ix .&. 0x0F))+ return (p `plusPtr` 2) _asHexadecimal_overflow :: String {-# NOINLINE _asHexadecimal_overflow #-}@@ -539,8 +493,7 @@ foldIO f z0 (BSI.PS fp off len) = FFI.withForeignPtr fp $ \p0 -> do let q = p0 `plusPtr` (off+len)- let go z p- | z `seq` p `seq` False = undefined -- for strictness analysis+ let go !z !p | p == q = return z | otherwise = do w <- peek p@@ -585,9 +538,8 @@ Just $ loop (fromIntegral (w - 0x30)) (BSU.unsafeTail xs) | otherwise -> Nothing - loop n xs- | n `seq` xs `seq` False = undefined -- for strictness analysis- | BS.null xs = (n, BS.empty) -- not @xs@, to help GC+ loop !n !xs+ | BS.null xs = (n, BS.empty) -- not @xs@, to help GC | otherwise = case BSU.unsafeHead xs of w | 0x37 >= w && w >= 0x30 ->
src/Data/ByteString/Lex/Internal.hs view
@@ -1,29 +1,65 @@ {-# OPTIONS_GHC -Wall -fwarn-tabs #-}+{-# LANGUAGE BangPatterns #-} ------------------------------------------------------------------- 2015.06.05+-- 2015.06.11 -- | -- Module : Data.ByteString.Lex.Internal--- Copyright : Copyright (c) 2010--2015 wren gayle romano+-- Copyright : Copyright (c) 2010--2019 wren gayle romano -- License : BSD2--- Maintainer : wren@community.haskell.org+-- Maintainer : wren@cpan.org -- Stability : provisional--- Portability : Haskell98+-- Portability : BangPatterns ----- Some functions we want to share across the other modules without actually exposing them to the user.+-- Some functions we want to share across the other modules without+-- actually exposing them to the user. ---------------------------------------------------------------- module Data.ByteString.Lex.Internal (+ -- * Character-based bit-bashing+ isNotPeriod+ , isNotE+ , isDecimal+ , isDecimalZero+ , toDigit+ , addDigit -- * Integral logarithms- numDigits+ , numDigits , numTwoPowerDigits , numDecimalDigits ) where -import Data.Word (Word64)+import Data.Word (Word8, Word64) import Data.Bits (Bits(shiftR)) ---------------------------------------------------------------- ----------------------------------------------------------------+----- Character-based bit-bashing++{-# INLINE isNotPeriod #-}+isNotPeriod :: Word8 -> Bool+isNotPeriod w = w /= 0x2E++{-# INLINE isNotE #-}+isNotE :: Word8 -> Bool+isNotE w = w /= 0x65 && w /= 0x45++{-# INLINE isDecimal #-}+isDecimal :: Word8 -> Bool+isDecimal w = 0x39 >= w && w >= 0x30++{-# INLINE isDecimalZero #-}+isDecimalZero :: Word8 -> Bool+isDecimalZero w = w == 0x30++{-# INLINE toDigit #-}+toDigit :: (Integral a) => Word8 -> a+toDigit w = fromIntegral (w - 0x30)++{-# INLINE addDigit #-}+addDigit :: Int -> Word8 -> Int+addDigit n w = n * 10 + toDigit w++---------------------------------------------------------------- ----- Integral logarithms -- TODO: cf. integer-gmp:GHC.Integer.Logarithms made available in version 0.3.0.0 (ships with GHC 7.2.1).@@ -53,13 +89,13 @@ numDigits :: Integer -> Integer -> Int {-# INLINE numDigits #-}-numDigits b0 n0+numDigits !b0 !n0 | b0 <= 1 = error (_numDigits ++ _nonpositiveBase) | n0 < 0 = error (_numDigits ++ _negativeNumber) -- BUG: need to check n0 to be sure we won't overflow Int | otherwise = 1 + fst (ilog b0 n0) where- ilog b n+ ilog !b !n | n < b = (0, n) | r < b = ((,) $! 2*e) r | otherwise = ((,) $! 2*e+1) $! (r `quot` b)@@ -74,15 +110,14 @@ -- for a more general implementation. numTwoPowerDigits :: (Integral a, Bits a) => Int -> a -> Int {-# INLINE numTwoPowerDigits #-}-numTwoPowerDigits p n0+numTwoPowerDigits !p !n0 | p <= 0 = error (_numTwoPowerDigits ++ _nonpositiveBase) | n0 < 0 = error (_numTwoPowerDigits ++ _negativeNumber) | n0 == 0 = 1 -- BUG: need to check n0 to be sure we won't overflow Int | otherwise = go 0 n0 where- go d n- | d `seq` n `seq` False = undefined+ go !d !n | n > 0 = go (d+1) (n `shiftR` p) | otherwise = d @@ -103,10 +138,9 @@ | otherwise = go 1 (fromIntegral n0 :: Word64) where limit = fromIntegral (maxBound :: Word64)- + fin n bound = if n >= bound then 1 else 0- go k n- | k `seq` False = undefined -- For strictness analysis+ go !k !n | n < 10 = k | n < 100 = k + 1 | n < 1000 = k + 2
+ test/Fractional.hs view
@@ -0,0 +1,248 @@+{-# OPTIONS_GHC -Wall -fwarn-tabs #-}+{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}+----------------------------------------------------------------+-- 2015.06.11+-- |+-- Module : test/Fractional+-- Copyright : Copyright (c) 2015 wren gayle romano+-- License : BSD2+-- Maintainer : wren@community.haskell.org+-- Stability : test framework+-- Portability : ScopedTypeVariables + RankNTypes+--+-- Correctness testing for "Data.ByteString.Lex.Fractional".+----------------------------------------------------------------+module Fractional (main, tests) where++import qualified Test.Tasty as Tasty+--import qualified Test.Tasty.SmallCheck as SC+import qualified Test.Tasty.QuickCheck as QC+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS8+import Data.ByteString.Lex.Fractional+--import Control.Monad ((<=<))++----------------------------------------------------------------+----------------------------------------------------------------+-- We reimplement Data.Proxy to avoid build errors on older systems++data Proxy a = Proxy ++asProxyTypeOf :: a -> Proxy a -> a+asProxyTypeOf a _ = a++----------------------------------------------------------------+-- | Fuzzy equality checking for floating-point numbers.+(=~=) :: (Fractional a, Ord a) => a -> a -> Bool+(=~=) a b = a == b || abs (a - b) <= max (abs a) (abs b) * 1e20+++----------------------------------------------------------------+----- QuickCheck\/SmallCheck properties+-- N.B., these properties do not hold of 'Rational', since those+-- are shown as @numerator % denominator@.+++-- | Converting a non-negative number to a string using 'show' and+-- then reading it back using 'readDecimal' returns the original+-- number.+prop_readDecimal_show+ :: (Show a, Ord a, Fractional a) => Proxy a -> Integer -> Bool+prop_readDecimal_show proxy x =+ let px = abs x in+ case (readDecimal . BS8.pack . show) px of+ Nothing -> False+ Just (py, rest) ->+ BS.null rest && py =~= (fromInteger px `asProxyTypeOf` proxy)+++-- | Converting a number to a string using 'show' and then reading+-- it back using @'readSigned' 'readDecimal'@ returns the original+-- number.+prop_readSignedDecimal_show+ :: (Show a, Ord a, Fractional a) => Proxy a -> Integer -> Bool+prop_readSignedDecimal_show proxy x =+ case (readSigned readDecimal . BS8.pack . show) x of+ Nothing -> False+ Just (y, rest) ->+ BS.null rest && y =~= (fromInteger x `asProxyTypeOf` proxy)++----------------------------------------------------------------+-- | Converting a non-negative number to a string using 'show' and+-- then reading it back using 'readExponential' returns the original+-- number.+prop_readExponential_show :: (Show a, Ord a, Fractional a) => a -> Bool+prop_readExponential_show x =+ let px = abs x in+ case (readExponential . BS8.pack . show) px of+ Nothing -> False+ Just (py, rest) -> BS.null rest && px =~= py+++-- | Converting a number to a string using 'show' and then reading+-- it back using @'readSigned' 'readExponential'@ returns the+-- original number.+prop_readSignedExponential_show+ :: (Show a, Ord a, Fractional a) => a -> Bool+prop_readSignedExponential_show x =+ case (readSigned readExponential . BS8.pack . show) x of+ Nothing -> False+ Just (y, rest) -> BS.null rest && x =~= y++----------------------------------------------------------------++-- | Use \"infinity\" as the precision-limit for a reader.+atInfinity+ :: (Int -> ByteString -> Maybe (a,ByteString))+ -> ByteString -> Maybe (a,ByteString)+atInfinity f = (\xs -> f (1 + BS.length xs) xs)++-- | Use a 'RealFloat' type's inherent limit as the precision-limit+-- for a reader.+atInherent+ :: forall a. RealFloat a+ => (Int -> ByteString -> Maybe (a,ByteString))+ -> ByteString -> Maybe (a,ByteString)+atInherent f = f (decimalPrecision (Proxy::Proxy a))+++-- BUG: at Double, fails on 5.0e-324+--+-- | Converting a non-negative number to a string using 'show' and+-- then reading it back using 'readDecimalLimited' with an \"infinite\"+-- precision limit returns the original number.+prop_readDecimalLimitedInfinity_show+ :: (Show a, Ord a, Fractional a) => Proxy a -> Integer -> Bool+prop_readDecimalLimitedInfinity_show proxy x =+ let px = abs x in+ case (atInfinity readDecimalLimited . BS8.pack . show) px of+ Nothing -> False+ Just (py, rest) ->+ BS.null rest && py =~= (fromInteger px `asProxyTypeOf` proxy)++-- | Converting a non-negative number to a string using 'show' and+-- then reading it back using 'readExponentialLimited' with an+-- \"infinite\" precision limit returns the original number.+prop_readExponentialLimitedInfinity_show+ :: (Show a, Ord a, Fractional a) => a -> Bool+prop_readExponentialLimitedInfinity_show x =+ let px = abs x in+ case (atInfinity readExponentialLimited . BS8.pack . show) px of+ Nothing -> False+ Just (py, rest) -> BS.null rest && px =~= py+++-- | Converting a non-negative number to a string using 'show' and+-- then reading it back using 'readDecimalLimited' with the type's+-- inherent precision limit returns the original number.+prop_readDecimalLimitedInherent_show+ :: (Show a, Ord a, RealFloat a) => Proxy a -> Integer -> Bool+prop_readDecimalLimitedInherent_show proxy x =+ let px = abs x in+ case (atInherent readDecimalLimited . BS8.pack . show) px of+ Nothing -> False+ Just (py, rest) ->+ BS.null rest && py =~= (fromInteger px `asProxyTypeOf` proxy)++-- | Converting a non-negative number to a string using 'show' and+-- then reading it back using 'readExponentialLimited' with the+-- type's inherent precision limit returns the original number.+prop_readExponentialLimitedInherent_show+ :: (Show a, Ord a, RealFloat a) => a -> Bool+prop_readExponentialLimitedInherent_show x =+ let px = abs x in+ case (atInherent readExponentialLimited . BS8.pack . show) px of+ Nothing -> False+ Just (py, rest) -> BS.null rest && px =~= py++----------------------------------------------------------------+----------------------------------------------------------------+floatProxy :: Proxy Float+floatProxy = Proxy++doubleProxy :: Proxy Double+doubleProxy = Proxy++atFloat :: (Float -> a) -> Float -> a+atFloat = id++atDouble :: (Double -> a) -> Double -> a+atDouble = id++qc_testGroup_Proxy+ :: QC.Testable b+ => String+ -> (forall a. (RealFloat a, Ord a, Show a) => Proxy a -> b)+ -> Tasty.TestTree+qc_testGroup_Proxy n f =+ Tasty.testGroup n+ [ QC.testProperty "Float" $ f floatProxy+ , QC.testProperty "Double" $ f doubleProxy+ ]++qc_testGroup_At+ :: QC.Testable b+ => String+ -> (forall a. (RealFloat a, Ord a, Show a) => a -> b)+ -> Tasty.TestTree+qc_testGroup_At n f =+ Tasty.testGroup n+ [ QC.testProperty "Float" $ atFloat f+ , QC.testProperty "Double" $ atDouble f+ ]++----------------------------------------------------------------+main :: IO ()+main = Tasty.defaultMain tests++tests :: Tasty.TestTree+tests = Tasty.testGroup "Fractional Tests"+ [Tasty.testGroup "Properties"+ [ quickcheckTests+ , smallcheckTests+ ]+ -- TODO: add some HUnit tests+ ]+++quickcheckTests :: Tasty.TestTree+quickcheckTests = Tasty.testGroup "(checked by QuickCheck)"+ [ qc_testGroup_Proxy+ "prop_readDecimal_show"+ prop_readDecimal_show+ , qc_testGroup_Proxy+ "prop_readSignedDecimal_show"+ prop_readSignedDecimal_show+ , qc_testGroup_At+ "prop_readExponential_show"+ prop_readExponential_show+ , qc_testGroup_At+ "prop_readSignedExponential_show"+ prop_readSignedExponential_show+ , qc_testGroup_Proxy+ "prop_readDecimalLimitedInfinity_show"+ prop_readDecimalLimitedInfinity_show+ , qc_testGroup_At+ "prop_readExponentialLimitedInfinity_show"+ prop_readExponentialLimitedInfinity_show+ , qc_testGroup_Proxy+ "prop_readDecimalLimitedInherent_show"+ prop_readDecimalLimitedInherent_show+ , qc_testGroup_At+ "prop_readExponentialLimitedInherent_show"+ prop_readExponentialLimitedInherent_show+ ]+++-- TODO: how to properly utilize SmallCheck for this module?+-- TODO: how can we set a default 'SmallCheckDepth' while still allowing @--smallcheck-depth@ to override that default?+smallcheckTests :: Tasty.TestTree+smallcheckTests = + -- Tasty.localOption (SC.SmallCheckDepth (2 ^ (8 :: Int))) $+ Tasty.testGroup "(checked by SmallCheck)"+ [+ ]++----------------------------------------------------------------+----------------------------------------------------------- fin.
+ test/Integral.hs view
@@ -0,0 +1,227 @@+{-# OPTIONS_GHC -Wall -fwarn-tabs #-}+{-# LANGUAGE RankNTypes, FlexibleContexts #-}+----------------------------------------------------------------+-- 2015.06.11+-- |+-- Module : test/Integral+-- Copyright : Copyright (c) 2010--2015 wren gayle romano+-- License : BSD2+-- Maintainer : wren@community.haskell.org+-- Stability : test framework+-- Portability : FlexibleContexts + RankNTypes+--+-- Correctness testing for "Data.ByteString.Lex.Integral".+----------------------------------------------------------------+module Integral (main, tests) where++import qualified Test.Tasty as Tasty+import qualified Test.Tasty.SmallCheck as SC+import qualified Test.Tasty.QuickCheck as QC+import Data.Int (Int32, Int64)+import Control.Monad ((<=<))+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS8+import Data.ByteString.Lex.Integral++----------------------------------------------------------------+----------------------------------------------------------------+----- QuickCheck\/SmallCheck properties++-- | Converting a non-negative number to a string using 'show' and+-- then reading it back using 'readDecimal' returns the original+-- number.+prop_readDecimal_show :: (Show a, Integral a) => a -> Bool+prop_readDecimal_show x =+ let px = abs x+ in Just (px, BS.empty) == (readDecimal . BS8.pack . show) px+++-- | Converting a number to a string using 'show' and then reading+-- it back using @'readSigned' 'readDecimal'@ returns the original+-- number.+prop_readSignedDecimal_show :: (Show a, Integral a) => a -> Bool+prop_readSignedDecimal_show x =+ Just (x, BS.empty) == (readSigned readDecimal . BS8.pack . show) x+++-- | Converting a non-negative number to a string using 'show' and+-- then reading it back using 'readDecimal_' returns the original+-- number.+prop_readDecimalzu_show :: (Show a, Integral a) => a -> Bool+prop_readDecimalzu_show x =+ let px = abs x+ in px == (readDecimal_ . BS8.pack . show) px+++-- | Converting a non-negative number to a bytestring using+-- 'packDecimal' and then reading it back using 'read' returns the+-- original number.+prop_read_packDecimal :: (Read a, Integral a) => a -> Bool+prop_read_packDecimal x =+ let px = abs x+ in px == (read . maybe "" BS8.unpack . packDecimal) px+++-- | Converting a non-negative number to a string using 'packDecimal'+-- and then reading it back using 'readDecimal' returns the original+-- number.+prop_readDecimal_packDecimal :: (Show a, Integral a) => a -> Bool+prop_readDecimal_packDecimal x =+ let px = abs x+ in Just (px, BS.empty) == (readDecimal <=< packDecimal) px+-- TODO: how can we check the other composition with QC/SC?++----------------------------------------------------------------+-- | Converting a non-negative number to a string using 'packHexadecimal'+-- and then reading it back using 'readHexadecimal' returns the+-- original number.+prop_readHexadecimal_packHexadecimal :: (Show a, Integral a) => a -> Bool+prop_readHexadecimal_packHexadecimal x =+ let px = abs x+ in Just (px, BS.empty) == (readHexadecimal <=< packHexadecimal) px++-- TODO: how can we check the other composition with QC/SC?++----------------------------------------------------------------+-- | Converting a non-negative number to a string using 'packOctal'+-- and then reading it back using 'readOctal' returns the original+-- number.+prop_readOctal_packOctal :: (Show a, Integral a) => a -> Bool+prop_readOctal_packOctal x =+ let px = abs x+ in Just (px, BS.empty) == (readOctal <=< packOctal) px++-- TODO: how can we check the other composition with QC/SC?++----------------------------------------------------------------+{-+-- | A more obviously correct but much slower implementation than+-- the public one.+packDecimal :: (Integral a) => a -> Maybe ByteString+packDecimal = start+ where+ start n0+ | n0 < 0 = Nothing+ | otherwise = Just $ loop n0 BS.empty++ loop !n !xs+ | n <= 9 = BS.cons (0x30 + fromIntegral n) xs+ | otherwise =+ let (q,r) = n `quotRem` 10+ in loop q (BS.cons (0x30 + fromIntegral r) xs)+-}++----------------------------------------------------------------+----------------------------------------------------------------++atInt :: (Int -> a) -> Int -> a+atInt = id++atInt32 :: (Int32 -> a) -> Int32 -> a+atInt32 = id++atInt64 :: (Int64 -> a) -> Int64 -> a+atInt64 = id++atInteger :: (Integer -> a) -> Integer -> a+atInteger = id++-- | Test 'Integers' around the 'Int' boundary. This combinator is+-- for smallcheck.+intBoundary :: (Integer -> a) -> Integer -> a+intBoundary f x = f (x + fromIntegral (maxBound - 8 :: Int))+++qc_testGroup+ :: QC.Testable b+ => String+ -> (forall a. (Integral a, Read a, Show a) => a -> b)+ -> Tasty.TestTree+qc_testGroup n f =+ Tasty.testGroup n+ [ QC.testProperty "Int" $ atInt f+ , QC.testProperty "Int32" $ atInt32 f+ , QC.testProperty "Int64" $ atInt64 f+ , QC.testProperty "Integer" $ atInteger f+ ]++sc_testGroup+ :: SC.Testable IO b+ => String+ -> (forall a. (Integral a, Read a, Show a) => a -> b)+ -> Tasty.TestTree+sc_testGroup n f =+ Tasty.testGroup n+ [ SC.testProperty "Int" $ atInt f+ , SC.testProperty "IntBoundary" $ intBoundary f+ ]++----------------------------------------------------------------+main :: IO ()+main = Tasty.defaultMain tests++tests :: Tasty.TestTree+tests = Tasty.testGroup "Integral Tests"+ [Tasty.testGroup "Properties"+ [ quickcheckTests+ , smallcheckTests+ ]+ -- TODO: add some HUnit tests+ ]++quickcheckTests :: Tasty.TestTree+quickcheckTests = Tasty.testGroup "(checked by QuickCheck)"+ [ qc_testGroup+ "prop_readDecimal_show"+ prop_readDecimal_show+ , qc_testGroup+ "prop_readDecimalzu_show"+ prop_readDecimalzu_show+ , qc_testGroup+ "prop_readSignedDecimal_show"+ prop_readSignedDecimal_show+ , qc_testGroup+ "prop_read_packDecimal"+ prop_read_packDecimal+ , qc_testGroup+ "prop_readDecimal_packDecimal"+ prop_readDecimal_packDecimal+ , qc_testGroup+ "prop_readHexadecimal_packHexadecimal"+ prop_readHexadecimal_packHexadecimal+ , qc_testGroup+ "prop_readOctal_packOctal"+ prop_readOctal_packOctal+ ]+++-- TODO: how can we set our default 'SmallCheckDepth' to 2^8 while still allowing @--smallcheck-depth@ to override that default?+smallcheckTests :: Tasty.TestTree+smallcheckTests = + Tasty.localOption (SC.SmallCheckDepth (2 ^ (8 :: Int))) $+ Tasty.testGroup "(checked by SmallCheck)"+ [ sc_testGroup+ "prop_readDecimal_show"+ prop_readDecimal_show+ , sc_testGroup+ "prop_readDecimalzu_show"+ prop_readDecimalzu_show+ , sc_testGroup+ "prop_readSignedDecimal_show"+ prop_readSignedDecimal_show+ , sc_testGroup+ "prop_read_packDecimal"+ prop_read_packDecimal+ , sc_testGroup+ "prop_readDecimal_packDecimal"+ prop_readDecimal_packDecimal+ , sc_testGroup+ "prop_readHexadecimal_packHexadecimal"+ prop_readHexadecimal_packHexadecimal+ , sc_testGroup+ "prop_readOctal_packOctal"+ prop_readOctal_packOctal+ ]++----------------------------------------------------------------+----------------------------------------------------------- fin.
+ test/Main.hs view
@@ -0,0 +1,29 @@+{-# OPTIONS_GHC -Wall -fwarn-tabs #-}+----------------------------------------------------------------+-- 2015.06.11+-- |+-- Module : test/Main+-- Copyright : Copyright (c) 2015 wren gayle romano+-- License : BSD2+-- Maintainer : wren@community.haskell.org+-- Stability : benchmark+-- Portability : Haskell98+--+-- Run all the basic correctness tests.+----------------------------------------------------------------+module Main (main) where+import qualified Test.Tasty as Tasty+import qualified Integral+import qualified Fractional++----------------------------------------------------------------+----------------------------------------------------------------++main :: IO ()+main = Tasty.defaultMain . Tasty.testGroup "Main" $+ [ Integral.tests+ , Fractional.tests+ ]++----------------------------------------------------------------+----------------------------------------------------------- fin.