bytestring-lexing-0.5.0.14/0000755000000000000000000000000007346545000013606 5ustar0000000000000000bytestring-lexing-0.5.0.14/AUTHORS0000644000000000000000000000151307346545000014656 0ustar0000000000000000=== Haskell bytestring-lexing package AUTHORS/THANKS file === The bytestring-lexing package was originally written by Don Stewart and released under the terms in the LICENSE file. In January 2012 maintainership was taken over by wren gayle romano. I would also like to give thanks to the following contributers: Bryan O'Sullivan --- For adding support for parsing Doubles from lazy bytestrings back during Don's maintainership. Also for inspiring the improved (v0.4.2) packDecimal implementation. Erik de Castro Lopo, Vincent Hanquez, and Christoph Breitkopf --- for excessive tweaking and benchmarking of the readDecimal function. Hirotomo Moriwaki --- for highlighting the inefficiency of the old Alex-based parser by publishing bytestring-read. And for the idea behind the new (v0.5.0) limited-precision parsers.bytestring-lexing-0.5.0.14/CHANGELOG0000644000000000000000000000366407346545000015031 0ustar00000000000000000.5.0.14 (2024-08-29): - Updating version bounds for the test suite, and factoring out the `Common library-build-depends` stanza. 0.5.0.13 (2024-08-29): - Updated version bounds for GHC 9.10 0.5.0.11 (2023-11-15): - Updated version bounds for base-4.19, bytestring-0.12, tasty-1.5 0.5.0.10 (2023-03-19): - Updated version bounds for GHC 9.6 0.5.0.9 (2021-08-28): - Updated version bounds for GHC 9.4 0.5.0.8 (2021-11-02): - Updated version bounds for GHC 9.2.1 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): - Cleaned up the README file 0.5.0 (2015-05-06): - Corrected the License field in the .cabal file to say BSD2 (instead of BSD3) - Data.ByteString.Lex.{Double,.Lazy.Double}: removed - Data.ByteString.Lex.Fractional: added based on the inefficiency of the old Alex-based parsers, as demonstrated by Hirotomo Moriwaki's bytestring-read (v0.3.0). 0.4.3.3 (2015-05-30): - Moved VERSION to CHANGELOG 0.4.3.1 (2014-03-07): - Updated the .cabal file to require newer alex for newer ghc. 0.4.3 (2013-03-21): - Data.ByteString.Lex.Integral: Corrected a segmentation fault in packDecimal. 0.4.2 (2013-03-20): - Data.ByteString.Lex.Integral: Improved packDecimal. 0.4.1 (2012-00-00): - Data.ByteString.Lex.Integral: Added buffer overflow check for asHexadecimal 0.4.0 (2012-02-03): - Data.ByteString.Lex.Integral: added readDecimal_ 0.3.0 (2012-01-28): - Added Data.ByteString.Lex.Integral - Converted repo to Darcs-2 hashed format. - wren ng thornton took over maintainership. 0.2.1 (2010-02-14): 0.2 (2008-10-15): - Add support for lexing lazy bytestrings. 0.1.2 (2008-07-23): 0.1.0.2 (2008-07-23): 0.1.0.1 (2008-07-19): 0.1.0 (2008-07-19): bytestring-lexing-0.5.0.14/LICENSE0000644000000000000000000000244507346545000014620 0ustar0000000000000000Copyright (c) wren gayle romano 2012--2015; Don Stewart 2008, 2010 All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. bytestring-lexing-0.5.0.14/README.md0000644000000000000000000001721507346545000015073 0ustar0000000000000000bytestring-lexing ================= [![Hackage version](https://img.shields.io/hackage/v/bytestring-lexing.svg?style=flat)](https://hackage.haskell.org/package/bytestring-lexing) [![Build Status](https://github.com/wrengr/bytestring-lexing/workflows/ci/badge.svg)](https://github.com/wrengr/bytestring-lexing/actions?query=workflow%3Aci) [![Dependencies](https://img.shields.io/hackage-deps/v/bytestring-lexing.svg?style=flat)](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](https://github.com/wrengr/bytestring-lexing/tree/master/bench/html) ## Install This is a simple package and should be easy to install. You should be able to use the standard: $> cabal install bytestring-lexing ### Testing To run the test suite (without coverage information), you can use the standard method (with `runhaskell Setup.hs` in lieu of `cabal`, if necessary): $> cd bytestring-lexing $> cabal configure --enable-tests $> cabal build $> cabal test If you want coverage information as well, there are a few options depending on your version of Cabal. For modern cabal with v2/nix-style builds, add `--enable-coverage` to the configure step, and the results will be located at `./dist-newstyle/build/$ARCH/$GHC/bytestring-lexing-$VERSION/opt/hpc/vanilla/html/bytestring-lexing-$VERSION/hpc_index.html`. For v1/classic builds, add `--enable-coverage` to the configure step and also add `--keep-tix-files` to the test step, and the results are instead located at `./dist/hpc/vanilla/html/bytestring-lexing-$VERSION/hpc_index.html`. For very old versions of Cabal, you must use `--enable-library-coverage` in lieu of `--enable-coverage`. ### 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](https://github.com/wrengr/bytestring-lexing/blob/master/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-0.5.0.14/Setup.hs0000644000000000000000000000016207346545000015241 0ustar0000000000000000#!/usr/bin/env runhaskell module Main (main) where import Distribution.Simple main :: IO () main = defaultMain bytestring-lexing-0.5.0.14/bytestring-lexing.cabal0000644000000000000000000001470107346545000020253 0ustar0000000000000000Cabal-Version: 2.2 -- Cabal >=2.2 is required for: -- -- Since 2.1, the Cabal-Version must be the absolutely first thing -- in the file, even before comments. Also, no longer uses ">=". -- ---------------------------------------------------------------- -- wren gayle romano ~ 2024-08-29 ---------------------------------------------------------------- Name: bytestring-lexing Version: 0.5.0.14 Build-Type: Simple Stability: provisional Homepage: https://wrengr.org/software/hackage.html Bug-Reports: https://github.com/wrengr/bytestring-lexing/issues Author: wren gayle romano, Don Stewart Maintainer: wren@cpan.org Copyright: 2012–2024 wren romano, 2008–2011 Don Stewart -- Cabal-2.2 requires us to say "BSD-3-Clause" not "BSD3" License: BSD-3-Clause License-File: LICENSE Category: Data Synopsis: Efficiently parse and produce common integral and fractional numbers. Description: 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: ---------------------------------------------------------------- Extra-source-files: AUTHORS, CHANGELOG, README.md -- We only list here what is still being verified by CI: -- -- For older versions of GHC and older versions of this library, see: -- -- And if needed, you can try relaxing the lower bounds according to: -- Tested-With: 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, GHC ==9.2.4, GHC ==9.4.8, GHC ==9.6.5, GHC ==9.8.2, GHC ==9.10.1 Source-Repository head Type: git Location: https://github.com/wrengr/bytestring-lexing.git ---------------------------------------------------------------- -- This stanza requires Cabal>=2.2: -- -- While Cabal-2.2 only ships with GHC 8.4.1, the dependencies to -- build it have essentially the same lower bounds as we do. (They -- require bytestring>=0.9.2.1 and deepseq>=1.3) So users of older -- GHC should still be able to compile it; and if they can't, then -- they already can't compile this package. -- -- N.B., the "import:" field must be the first thing in a stanza. Common library-build-depends Default-Language: Haskell2010 -- TODO(2021-10-23): bytestring 0.11.0.0 changed the internal -- representation of ByteStrings to remove the offset. While -- they do offer pattern synonyms for backwards combatibility, -- we should re-verify that our code doesn't depend on the details. -- Build-Depends: base >= 4.9 && < 4.21 , bytestring >= 0.10.8 && < 0.13 Library Import: library-build-depends Ghc-Options: -O2 Hs-Source-Dirs: src Exposed-Modules: Data.ByteString.Lex.Integral Data.ByteString.Lex.Fractional Other-Modules: Data.ByteString.Lex.Internal ---------------------------------------------------------------- -- -- 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., -- 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 Import: library-build-depends 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 our own library for the tests to use it; but -- we must not give a version restriction lest Cabal give warnings. -- There's also bug : -- if we don't pass -any, then Cabal will fill in ">= 0 && <= $ThisVersion" -- which will also give a warning. Build-Depends: bytestring-lexing -any , tasty >= 0.10.1.2 && < 1.6 , tasty-smallcheck >= 0.8.0.1 && < 0.9 , tasty-quickcheck >= 0.8.3.2 && < 0.12 -- QuickCheck >= 2.10 && < 2.16 -- 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. bytestring-lexing-0.5.0.14/src/Data/ByteString/Lex/0000755000000000000000000000000007346545000020070 5ustar0000000000000000bytestring-lexing-0.5.0.14/src/Data/ByteString/Lex/Fractional.hs0000644000000000000000000004372307346545000022517 0ustar0000000000000000{-# OPTIONS_GHC -Wall -fwarn-tabs #-} {-# LANGUAGE BangPatterns, ScopedTypeVariables #-} ---------------------------------------------------------------- -- 2021.10.17 -- | -- Module : Data.ByteString.Lex.Fractional -- Copyright : Copyright (c) 2015--2021 wren gayle romano -- License : BSD2 -- Maintainer : wren@cpan.org -- Stability : provisional -- Portability : BangPatterns + ScopedTypeVariables -- -- Functions for parsing and producing 'Fractional' values from\/to -- 'ByteString's based on the \"Char8\" encoding. That is, we assume -- an ASCII-compatible encoding of alphanumeric characters. -- -- /Since: 0.5.0/ ---------------------------------------------------------------- module Data.ByteString.Lex.Fractional ( -- * General combinators readSigned -- packSigned -- * Decimal conversions , readDecimal -- TODO: packDecimal -- TODO: asDecimal -- this will be really hard to make efficient... -- * Hexadecimal conversions , readHexadecimal -- TODO: packHexadecimal -- TODO: asHexadecimal -- * Octal conversions , readOctal -- TODO: packOctal -- TODO: asOctal -- this will be really hard to make efficient... -- * Exponential conversions , readExponential -- TODO: packExponential -- TODO: asExponential -- * Precision-limited conversions , decimalPrecision , readDecimalLimited , readExponentialLimited ) where import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Unsafe as BSU import Data.Word (Word8) import qualified Data.ByteString.Lex.Integral as I import Data.ByteString.Lex.Integral (readSigned) import Data.ByteString.Lex.Internal ---------------------------------------------------------------- ---------------------------------------------------------------- -- | A helper function to ensure consistent strictness. -- TODO: should we really be this strict? justPair :: a -> b -> Maybe (a,b) {-# INLINE justPair #-} justPair !x !y = Just (x,y) pair :: a -> b -> (a,b) {-# INLINE pair #-} pair !x !y = (x,y) -- NOTE: We use 'fromInteger' everywhere instead of 'fromIntegral' -- in order to fix the types of the calls to 'I.readDecimal', etc. -- This is always correct, but for some result types there are other -- intermediate types which may be faster. ---------------------------------------------------------------- ----- Decimal -- | Read an unsigned\/non-negative fractional value in ASCII decimal -- format; that is, anything matching the regex @\\d+(\\.\\d+)?@. -- Returns @Nothing@ if there is no such number at the beginning -- of the string, otherwise returns @Just@ the number read and the -- remainder of the string. -- -- N.B., see 'readDecimalLimited' if your fractional type has limited -- precision and you expect your inputs to have greater precision -- than can be represented. Even for types with unlimited precision -- (e.g., 'Rational'), you may want to check out 'readDecimalLimited'. readDecimal :: (Fractional a) => ByteString -> Maybe (a, ByteString) {-# SPECIALIZE readDecimal :: ByteString -> Maybe (Float, ByteString), ByteString -> Maybe (Double, ByteString), ByteString -> Maybe (Rational, ByteString) #-} readDecimal xs = case I.readDecimal xs of Nothing -> Nothing Just (whole, ys) -> case BS.uncons ys of Nothing -> justPair (fromInteger whole) BS.empty Just (y0,ys0) | isNotPeriod y0 -> justPair (fromInteger whole) ys | otherwise -> case I.readDecimal ys0 of Nothing -> justPair (fromInteger whole) ys Just (part, zs) -> let base = 10 ^ (BS.length ys - 1 - BS.length zs) frac = fromInteger whole + (fromInteger part / base) in justPair frac zs ---------------------------------------------------------------- -- If and only if(!) we have Real, then we can use 'toRational'... -- Similarly, only if we have RealFloat can we use 'decodeFloat'... -- TODO: -- Convert a non-negative fractional number into an (unsigned) -- ASCII decimal string. Returns @Nothing@ on negative inputs. -- packDecimal :: (Fractional a) => a -> Maybe ByteString ---------------------------------------------------------------- ---------------------------------------------------------------- ----- Hexadecimal -- | Read a non-negative integral value in ASCII hexadecimal format. -- Returns @Nothing@ if there is no integer at the beginning of the -- string, otherwise returns @Just@ the integer read and the remainder -- of the string. -- -- This function does not recognize the various hexadecimal sigils -- like \"0x\", but because there are so many different variants, -- 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 = case I.readHexadecimal xs of Nothing -> Nothing Just (n, xs') -> justPair (fromInteger n) xs' -- TODO: -- Convert a non-negative integer into a lower-case ASCII hexadecimal -- string. Returns @Nothing@ on negative inputs. -- packHexadecimal :: (Fractional a) => a -> Maybe ByteString ---------------------------------------------------------------- ---------------------------------------------------------------- ----- Octal -- | Read a non-negative integral value in ASCII octal format. -- Returns @Nothing@ if there is no integer at the beginning of the -- string, otherwise returns @Just@ the integer read and the remainder -- of the string. -- -- This function does not recognize the various octal sigils like -- \"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 = case I.readOctal xs of Nothing -> Nothing Just (n, xs') -> justPair (fromInteger n) xs' -- TODO: -- Convert a non-negative integer into an ASCII octal string. -- Returns @Nothing@ on negative inputs. -- packOctal :: (Fractional a) => a -> Maybe ByteString ---------------------------------------------------------------- ---------------------------------------------------------------- ----- Exponential -- | Read an unsigned\/non-negative fractional value in ASCII -- exponential format; that is, anything matching the regex -- @\\d+(\\.\\d+)?([eE][\\+\\-]?\\d+)?@. Returns @Nothing@ if there -- is no such number at the beginning of the string, otherwise -- returns @Just@ the number read and the remainder of the string. -- -- N.B., the current implementation assumes the exponent is small -- enough to fit into an 'Int'. This gives a significant performance -- increase for @a ~ Float@ and @a ~ Double@ and agrees with the -- 'RealFloat' class which has 'exponent' returning an 'Int'. If -- you need a larger exponent, contact the maintainer. -- -- N.B., see 'readExponentialLimited' if your fractional type has -- limited precision and you expect your inputs to have greater -- precision than can be represented. Even for types with unlimited -- precision, you may want to check out 'readExponentialLimited'. readExponential :: (Fractional a) => ByteString -> Maybe (a, ByteString) {-# SPECIALIZE readExponential :: ByteString -> Maybe (Float, ByteString), ByteString -> Maybe (Double, ByteString), ByteString -> Maybe (Rational, ByteString) #-} readExponential xs = case readDecimal xs of Nothing -> Nothing Just (frac, ys) -> case BS.uncons ys of Nothing -> justPair frac BS.empty Just (y0,ys0) | isNotE y0 -> justPair frac ys | otherwise -> -- HACK: monomorphizing @e::Int@ for performance! case readSigned I.readDecimal ys0 of Nothing -> justPair frac ys Just (ex,zs) -> justPair (frac * (10 ^^ (ex::Int))) zs ---------------------------------------------------------------- ---------------------------------------------------------------- ----- Limited -- | A representation of unsigned fractional numbers decomposed -- into a significand\/mantissa and a decimal exponent. This allows -- efficient scaling by decimal exponents (cf., 'scaleDF'). -- -- TODO: the first component should be some @a@-specific intermediate -- 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 -- @'Data.Ratio.Ratio' a@. data DecimalFraction a = DF !Integer {-# UNPACK #-}!Int -- BUG: Can't unpack integers... -- | A helpful smart constructor. fractionDF :: Integer -> Int -> Integer -> DecimalFraction a {-# INLINE fractionDF #-} fractionDF whole scale part = DF (whole * (10 ^ scale) + part) (negate scale) -- TODO: use an unsafe variant of (^) which has an assertion instead of a runtime check? -- | Extract the fractional number encoded in the record. -- -- > fromDF (DF frac scale) = fromIntegral frac * (10 ^^ scale) fromDF :: Fractional a => DecimalFraction a -> a {-# INLINE fromDF #-} fromDF (DF frac scale) -- Avoid possibility of returning NaN -- TODO: really, ought to check @fromInteger frac == 0@... | frac == 0 = 0 -- Avoid throwing an error due to @negate minBound == minBound@ | scale == minBound = fromInteger frac * (10 ^^ toInteger scale) -- Now we're safe for the default implementation | otherwise = fromInteger frac * (10 ^^ scale) -- TODO: manually implement (^^) so that we get @_ / (10^ _)@ -- instead of @_ * recip (10^ _)@ for negative exponents? -- | Scale a decimal fraction by some power of 10. scaleDF :: DecimalFraction a -> Int -> DecimalFraction a {-# INLINE scaleDF #-} scaleDF (DF frac scale) scale' = DF frac (scale + scale') -- TODO: is there a way to avoid ScopedTypeVariables without losing -- the fact that this is a constant function? -- -- TODO: try looking at core again to see if @n@ gets completely -- optimized away or not. If not, is there a way to help make that -- happen without using TH? -- -- | Return the 'RealFloat' type's inherent decimal precision -- limitation. This is the number of decimal digits in @floatRadix -- proxy ^ floatDigits proxy@. decimalPrecision :: forall proxy a. RealFloat a => proxy a -> Int {-# INLINE decimalPrecision #-} decimalPrecision = let proxy = undefined :: a n = numDecimalDigits (floatRadix proxy ^ floatDigits proxy) in n `seq` \_ -> n -- TODO: for the isDecimalZero instance, use 'BS.breakByte' where -- possible; or design our own similar... -- -- | Drop while the predicate is true, and return the number of -- bytes dropped. lengthDropWhile :: (Word8 -> Bool) -> ByteString -> (Int, ByteString) {-# INLINE lengthDropWhile #-} lengthDropWhile p xs = let ys = BS.dropWhile p xs in (BS.length xs - BS.length ys, ys) {- -- TODO: benchmark let len = BS.length (BS.takeWhile p xs) in (len, BS.drop len xs) case BS.break (not . p) xs of (ys,zs) -> (BS.length ys, zs) -} -- | A variant of 'readDecimal' which only reads up to some limited -- precision. The first argument gives the number of decimal digits -- at which to limit the precision. -- -- For types with inherently limited precision (e.g., 'Float' and -- 'Double'), when you pass in the precision limit (cf., -- 'decimalPrecision') this is far more efficient than 'readDecimal'. -- However, passing in a precision limit which is greater than the -- type's inherent limitation will degrate performance compared to -- 'readDecimal'. -- -- For types with unlimited precision (e.g., 'Rational') this may -- still be far more efficient than 'readDecimal' (it is for -- 'Rational', in fact). The reason being that it delays the scaling -- the significand\/mantissa by the exponent, thus allowing you to -- further adjust the exponent before computing the final value -- (e.g., as in 'readExponentialLimited'). This avoids the need to -- renormalize intermediate results, and allows faster computation -- of the scaling factor by doing it all at once. readDecimalLimited :: (Fractional a) => Int -> ByteString -> Maybe (a, ByteString) {-# INLINE readDecimalLimited #-} readDecimalLimited p xs = case readDecimalLimited_ p xs of Nothing -> Nothing Just (df,ys) -> justPair (fromDF df) ys readDecimalLimited_ :: (Fractional a) => Int -> ByteString -> Maybe (DecimalFraction a, ByteString) {-# SPECIALIZE readDecimalLimited_ :: Int -> ByteString -> Maybe (DecimalFraction Float, ByteString), Int -> ByteString -> Maybe (DecimalFraction Double, ByteString), Int -> ByteString -> Maybe (DecimalFraction Rational, ByteString) #-} readDecimalLimited_ = start where -- All calls to 'I.readDecimal' are monomorphized at 'Integer', -- as specified by what 'DF' needs. 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 = let ys = BS.take p xs in case I.readDecimal ys of Nothing -> justPair (DF 0 0) xs Just (part, ys') -> let scale' = scale + BS.length xs - BS.length ys' in justPair (DF part (negate scale')) (BS.dropWhile isDecimal ys') readWholePart !p !xs = let ys = BS.take p xs in case I.readDecimal ys of Nothing -> Nothing Just (whole, ys') | BS.null ys' -> case lengthDropWhile isDecimal (BS.drop p xs) of (scale, zs) -> justPair (DF whole scale) (dropFractionPart zs) | otherwise -> let len = BS.length ys - BS.length ys' -- N.B., @xs' == ys' `BS.append` BS.drop p xs@ xs' = BS.drop len xs in -- N.B., @BS.null xs'@ is impossible. Were it to -- happen then returning @pair (DF whole 0) BS.empty@ -- is consistent with the branch where we drop the -- fraction part (the original input is less than -- the original @p@ long); however, reaching this -- branch ia that input would be a control-flow -- error. if isNotPeriod (BSU.unsafeHead xs') then justPair (DF whole 0) xs' else readFractionPart (p-len) whole xs' dropFractionPart !xs = case BS.uncons xs of Nothing -> BS.empty -- == xs Just (x0,xs0) | isNotPeriod x0 -> xs | otherwise -> case BS.uncons xs0 of Nothing -> BS.singleton 0x2E -- == xs Just (x1,xs1) | isDecimal x1 -> BS.dropWhile isDecimal xs1 | otherwise -> xs -- NOTES: @BS.null xs@ is impossible as it begins with a period; -- see the call sites. If @not (BS.null ys')@ then the @BS.dropWhile -- 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 = let ys = BS.take p (BSU.unsafeTail xs) in case I.readDecimal ys of Nothing -> justPair (DF whole 0) xs Just (part, ys') -> let scale = BS.length ys - BS.length ys' in justPair (fractionDF whole scale part) (BS.dropWhile isDecimal (BS.drop (1+scale) xs)) -- | A variant of 'readExponential' which only reads up to some limited -- precision. The first argument gives the number of decimal digits -- at which to limit the precision. See 'readDecimalLimited' for -- more discussion of the performance benefits of using this function. readExponentialLimited :: (Fractional a) => Int -> ByteString -> Maybe (a, ByteString) {-# SPECIALIZE readExponentialLimited :: Int -> ByteString -> Maybe (Float, ByteString), Int -> ByteString -> Maybe (Double, ByteString), Int -> ByteString -> Maybe (Rational, ByteString) #-} readExponentialLimited = start where start !p !xs = case readDecimalLimited_ p xs of Nothing -> Nothing Just (df,xs') -> Just $! readExponentPart df xs' readExponentPart !df !xs | BS.null xs = pair (fromDF df) BS.empty | isNotE (BSU.unsafeHead xs) = pair (fromDF df) xs | otherwise = -- HACK: monomorphizing at 'Int' -- TODO: how to handle too-large exponents? case readSigned I.readDecimal (BSU.unsafeTail xs) of Nothing -> pair (fromDF df) xs Just (scale, xs') -> pair (fromDF $ scaleDF df scale) xs' ---------------------------------------------------------------- ----------------------------------------------------------- fin. bytestring-lexing-0.5.0.14/src/Data/ByteString/Lex/Integral.hs0000644000000000000000000006411207346545000022175 0ustar0000000000000000{-# OPTIONS_GHC -Wall -fwarn-tabs #-} {-# LANGUAGE BangPatterns #-} ---------------------------------------------------------------- -- 2021.10.17 -- | -- Module : Data.ByteString.Lex.Integral -- Copyright : Copyright (c) 2010--2021 wren gayle romano -- License : BSD2 -- Maintainer : wren@cpan.org -- Stability : provisional -- Portability : BangPatterns -- -- Functions for parsing and producing 'Integral' values from\/to -- 'ByteString's based on the \"Char8\" encoding. That is, we assume -- an ASCII-compatible encoding of alphanumeric characters. -- -- /Since: 0.3.0/ ---------------------------------------------------------------- module Data.ByteString.Lex.Integral ( -- * General combinators readSigned -- , packSigned -- * Decimal conversions , readDecimal , readDecimal_ , packDecimal -- TODO: asDecimal -- this will be really hard to make efficient... -- * Hexadecimal conversions , readHexadecimal , packHexadecimal , asHexadecimal -- * Octal conversions , readOctal , packOctal -- TODO: asOctal -- this will be really hard to make efficient... ) where import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BS8 (pack) import qualified Data.ByteString.Internal as BSI import qualified Data.ByteString.Unsafe as BSU import Data.Int import Data.Word import Data.Bits import Foreign.Ptr (Ptr, plusPtr) import qualified Foreign.ForeignPtr as FFI (withForeignPtr) import Foreign.Storable (peek, poke) import Data.ByteString.Lex.Internal ---------------------------------------------------------------- ----- General -- TODO: On the one hand, making this a combinator is "the right -- thing to do" for generality. However, for performance critical -- code, we could optimize away some extraneous guards if we just -- provide both signed and unsigned versions of the -- {read,pack}{Decimal,Octal,Hex} functions... -- TODO: move to somewhere more general, shared by both Integral and Fractional -- | Adjust a reading function to recognize an optional leading -- sign. As with the other functions, we assume an ASCII-compatible -- encoding of the sign characters. readSigned :: (Num a) => (ByteString -> Maybe (a, ByteString)) -> ByteString -> Maybe (a, ByteString) readSigned f xs | BS.null xs = Nothing | otherwise = case BSU.unsafeHead xs of 0x2D -> f (BSU.unsafeTail xs) >>= \(n, ys) -> return (negate n, ys) 0x2B -> f (BSU.unsafeTail xs) _ -> f xs ---------------------------------------------------------------- ----- Decimal {- -- We unroll this definition in order to reduce the number of -- conversions from native Int to the Integral type. readDecimalSimple :: (Integral a) => ByteString -> Maybe (a, ByteString) readDecimalSimple = start where -- This implementation is near verbatim from -- bytestring-0.9.1.7:Data.ByteString.Char8.readInt. We do -- remove the superstrictness by lifting the 'Just' so it can -- be returned after seeing the first byte. Do beware of the -- scope of 'fromIntegral', we want to avoid unnecessary -- 'Integral' operations and do as much as possible in 'Word8'. start xs | BS.null xs = Nothing | otherwise = case BSU.unsafeHead xs of w | 0x39 >= w && w >= 0x30 -> Just $ loop (fromIntegral (w - 0x30)) (BSU.unsafeTail xs) | otherwise -> Nothing 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 -> loop (n * 10 + fromIntegral (w - 0x30)) (BSU.unsafeTail xs) | otherwise -> (n,xs) -} -- | Read an unsigned\/non-negative integral value in ASCII decimal -- format. Returns @Nothing@ if there is no integer at the beginning -- of the string, otherwise returns @Just@ the integer read and the -- remainder of the string. -- -- If you are extremely concerned with performance, then it is more -- performant to use this function at @Int@ or @Word@ and then to -- call 'fromIntegral' to perform the conversion at the end. However, -- doing this will make your code succeptible to overflow bugs if -- the target type is larger than @Int@. readDecimal :: (Integral a) => ByteString -> Maybe (a, ByteString) {-# SPECIALIZE readDecimal :: ByteString -> Maybe (Int, ByteString), ByteString -> Maybe (Int8, ByteString), ByteString -> Maybe (Int16, ByteString), ByteString -> Maybe (Int32, ByteString), ByteString -> Maybe (Int64, ByteString), ByteString -> Maybe (Integer, ByteString), ByteString -> Maybe (Word, ByteString), ByteString -> Maybe (Word8, ByteString), ByteString -> Maybe (Word16, ByteString), ByteString -> Maybe (Word32, ByteString), ByteString -> Maybe (Word64, ByteString) #-} readDecimal = start where -- TODO: should we explicitly drop all leading zeros before we jump into the unrolled loop? start :: (Integral a) => ByteString -> Maybe (a, ByteString) start xs | BS.null xs = Nothing | otherwise = case BSU.unsafeHead xs of w | isDecimal w -> Just $ loop0 (toDigit w) (BSU.unsafeTail xs) | otherwise -> Nothing loop0 :: (Integral a) => a -> ByteString -> (a, ByteString) loop0 !m !xs | BS.null xs = (m, BS.empty) | otherwise = case BSU.unsafeHead xs of w | isDecimal w -> loop1 m (toDigit w) (BSU.unsafeTail xs) | otherwise -> (m, xs) loop1, loop2, loop3, loop4, loop5, loop6, loop7, loop8 :: (Integral a) => a -> Int -> ByteString -> (a, ByteString) 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 | 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 | 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 | 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 | 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 | 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 | 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 | BS.null xs = (m*100000000 + fromIntegral n, BS.empty) | otherwise = case BSU.unsafeHead xs of w | isDecimal w -> loop0 (m*1000000000 + fromIntegral (addDigit n w)) (BSU.unsafeTail xs) | otherwise -> (m*100000000 + fromIntegral n, xs) ---------------------------------------------------------------- -- | A variant of 'readDecimal' which does not return the tail of -- the string, and returns @0@ instead of @Nothing@. This is twice -- as fast for 'Int64' on 32-bit systems, but has identical performance -- to 'readDecimal' for all other types and architectures. -- -- /Since: 0.4.0/ readDecimal_ :: (Integral a) => ByteString -> a {-# SPECIALIZE readDecimal_ :: ByteString -> Int, ByteString -> Int8, ByteString -> Int16, ByteString -> Int32, ByteString -> Int64, ByteString -> Integer, ByteString -> Word, ByteString -> Word8, ByteString -> Word16, ByteString -> Word32, ByteString -> Word64 #-} readDecimal_ = start where start xs | BS.null xs = 0 | otherwise = case BSU.unsafeHead xs of w | isDecimal w -> loop0 (toDigit w) (BSU.unsafeTail xs) | otherwise -> 0 loop0 :: (Integral a) => a -> ByteString -> a loop0 !m !xs | BS.null xs = m | otherwise = case BSU.unsafeHead xs of w | isDecimal w -> loop1 m (toDigit w) (BSU.unsafeTail xs) | otherwise -> m loop1, loop2, loop3, loop4, loop5, loop6, loop7, loop8 :: (Integral a) => a -> Int -> ByteString -> a 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 | 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 | 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 | 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 | 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 | 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 | 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 | BS.null xs = m*100000000 + fromIntegral n | otherwise = case BSU.unsafeHead xs of w | isDecimal w -> loop0 (m*1000000000 + fromIntegral (addDigit n w)) (BSU.unsafeTail xs) | otherwise -> m*100000000 + fromIntegral n ---------------------------------------------------------------- -- | Convert a non-negative integer into an (unsigned) ASCII decimal -- string. Returns @Nothing@ on negative inputs. packDecimal :: (Integral a) => a -> Maybe ByteString {-# INLINE packDecimal #-} packDecimal n | n < 0 = Nothing | otherwise = Just (unsafePackDecimal n) -- This implementation is modified from: -- -- 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. unsafePackDecimal :: (Integral a) => a -> ByteString {-# SPECIALIZE unsafePackDecimal :: Int -> ByteString, Int8 -> ByteString, Int16 -> ByteString, Int32 -> ByteString, Int64 -> ByteString, Integer -> ByteString, Word -> ByteString, Word8 -> ByteString, Word16 -> ByteString, Word32 -> ByteString, Word64 -> ByteString #-} unsafePackDecimal n0 = let size = numDecimalDigits n0 in BSI.unsafeCreate size $ \p0 -> loop n0 (p0 `plusPtr` (size - 1)) where getDigit = BSU.unsafeIndex packDecimal_digits loop !n !p | n >= 100 = do let (q,r) = n `quotRem` 100 write2 r p loop q (p `plusPtr` negate 2) | n >= 10 = write2 n p | otherwise = poke p (0x30 + fromIntegral n) write2 !i0 !p = do let i = fromIntegral i0; j = i + i poke p (getDigit $! j + 1) poke (p `plusPtr` negate 1) (getDigit j) -- TODO(2021-10-23): We might should replace this with the 'Addr#' -- hack that newer Bytestring uses for hexadecimal stuff: -- packDecimal_digits :: ByteString {-# NOINLINE packDecimal_digits #-} packDecimal_digits = BS8.pack "0001020304050607080910111213141516171819\ \2021222324252627282930313233343536373839\ \4041424344454647484950515253545556575859\ \6061626364656667686970717273747576777879\ \8081828384858687888990919293949596979899" ---------------------------------------------------------------- ---------------------------------------------------------------- ----- Hexadecimal -- | Read a non-negative integral value in ASCII hexadecimal format. -- Returns @Nothing@ if there is no integer at the beginning of the -- string, otherwise returns @Just@ the integer read and the remainder -- of the string. -- -- This function does not recognize the various hexadecimal sigils -- like \"0x\", but because there are so many different variants, -- 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. readHexadecimal :: (Integral a) => ByteString -> Maybe (a, ByteString) {-# SPECIALIZE readHexadecimal :: ByteString -> Maybe (Int, ByteString), ByteString -> Maybe (Int8, ByteString), ByteString -> Maybe (Int16, ByteString), ByteString -> Maybe (Int32, ByteString), ByteString -> Maybe (Int64, ByteString), ByteString -> Maybe (Integer, ByteString), ByteString -> Maybe (Word, ByteString), ByteString -> Maybe (Word8, ByteString), ByteString -> Maybe (Word16, ByteString), ByteString -> Maybe (Word32, ByteString), ByteString -> Maybe (Word64, ByteString) #-} readHexadecimal = start where -- TODO: Would it be worth trying to do the magichash trick -- used by Warp here? It'd really help remove branch prediction -- issues etc. -- -- Beware the urge to make this code prettier, cf 'readDecimal'. start xs | BS.null xs = Nothing | otherwise = case BSU.unsafeHead xs of w | 0x39 >= w && w >= 0x30 -> Just $ loop (fromIntegral (w - 0x30)) (BSU.unsafeTail xs) | 0x46 >= w && w >= 0x41 -> Just $ loop (fromIntegral (w-0x41+10)) (BSU.unsafeTail xs) | 0x66 >= w && w >= 0x61 -> Just $ loop (fromIntegral (w-0x61+10)) (BSU.unsafeTail xs) | otherwise -> Nothing 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 -> loop (n*16 + fromIntegral (w - 0x30)) (BSU.unsafeTail xs) | 0x46 >= w && w >= 0x41 -> loop (n*16 + fromIntegral (w-0x41+10)) (BSU.unsafeTail xs) | 0x66 >= w && w >= 0x61 -> loop (n*16 + fromIntegral (w-0x61+10)) (BSU.unsafeTail xs) | otherwise -> (n,xs) -- | Convert a non-negative integer into a lower-case ASCII hexadecimal -- string. Returns @Nothing@ on negative inputs. packHexadecimal :: (Integral a) => a -> Maybe ByteString {-# INLINE packHexadecimal #-} packHexadecimal n | n < 0 = Nothing | otherwise = Just (unsafePackHexadecimal n) -- | Convert a non-negative integer into a lower-case ASCII hexadecimal -- string. This function is unsafe to use on negative inputs. unsafePackHexadecimal :: (Integral a) => a -> ByteString {-# SPECIALIZE unsafePackHexadecimal :: Int -> ByteString, Int8 -> ByteString, Int16 -> ByteString, Int32 -> ByteString, Int64 -> ByteString, Integer -> ByteString, Word -> ByteString, Word8 -> ByteString, Word16 -> ByteString, Word32 -> ByteString, Word64 -> ByteString #-} unsafePackHexadecimal n0 = let size = numTwoPowerDigits 4 (toInteger n0) -- for Bits in BSI.unsafeCreate size $ \p0 -> loop n0 (p0 `plusPtr` (size - 1)) where -- TODO: benchmark using @hexDigits@ vs using direct manipulations. loop :: (Integral a) => a -> Ptr Word8 -> IO () loop n p | n <= 15 = do poke p (BSU.unsafeIndex hexDigits (fromIntegral n .&. 0x0F)) | otherwise = do let (q,r) = n `quotRem` 16 poke p (BSU.unsafeIndex hexDigits (fromIntegral r .&. 0x0F)) loop q (p `plusPtr` negate 1) -- Inspired by, -- | Convert a bitvector into a lower-case ASCII hexadecimal string. -- This is helpful for visualizing raw binary data, rather than for -- parsing as such. asHexadecimal :: ByteString -> ByteString asHexadecimal = start where start buf | BS.length buf > maxBound `quot` 2 = error _asHexadecimal_overflow | otherwise = BSI.unsafeCreate (2 * BS.length buf) $ \p0 -> do _ <- foldIO step p0 buf return () -- needed for type checking step :: Ptr Word8 -> Word8 -> IO (Ptr Word8) 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 #-} _asHexadecimal_overflow = "asHexadecimal: cannot create buffer larger than (maxBound::Int)" -- TODO: benchmark against the magichash hack used in Warp. -- TODO(2021-10-23): Benchmark against the 'Addr#' hack that newer -- Bytestring uses for hexadecimal stuff: -- -- -- | The lower-case ASCII hexadecimal digits, in numerical order -- for use as a lookup table. hexDigits :: ByteString {-# NOINLINE hexDigits #-} hexDigits = BS8.pack "0123456789abcdef" -- | We can only do this for MonadIO not just any Monad, but that's -- good enough for what we need... foldIO :: (a -> Word8 -> IO a) -> a -> ByteString -> IO a {-# INLINE foldIO #-} foldIO f z0 (BSI.PS fp off len) = FFI.withForeignPtr fp $ \p0 -> do let q = p0 `plusPtr` (off+len) let go !z !p | p == q = return z | otherwise = do w <- peek p z' <- f z w go z' (p `plusPtr` 1) go z0 (p0 `plusPtr` off) ---------------------------------------------------------------- ---------------------------------------------------------------- ----- Octal -- | Read a non-negative integral value in ASCII octal format. -- Returns @Nothing@ if there is no integer at the beginning of the -- string, otherwise returns @Just@ the integer read and the remainder -- of the string. -- -- This function does not recognize the various octal sigils like -- \"0o\", but because there are different variants, those are best -- handled by helper functions which then use this function for the -- actual numerical parsing. readOctal :: (Integral a) => ByteString -> Maybe (a, ByteString) {-# SPECIALIZE readOctal :: ByteString -> Maybe (Int, ByteString), ByteString -> Maybe (Int8, ByteString), ByteString -> Maybe (Int16, ByteString), ByteString -> Maybe (Int32, ByteString), ByteString -> Maybe (Int64, ByteString), ByteString -> Maybe (Integer, ByteString), ByteString -> Maybe (Word, ByteString), ByteString -> Maybe (Word8, ByteString), ByteString -> Maybe (Word16, ByteString), ByteString -> Maybe (Word32, ByteString), ByteString -> Maybe (Word64, ByteString) #-} readOctal = start where start xs | BS.null xs = Nothing | otherwise = case BSU.unsafeHead xs of w | 0x37 >= w && w >= 0x30 -> Just $ loop (fromIntegral (w - 0x30)) (BSU.unsafeTail xs) | otherwise -> Nothing 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 -> loop (n * 8 + fromIntegral (w - 0x30)) (BSU.unsafeTail xs) | otherwise -> (n,xs) -- | Convert a non-negative integer into an ASCII octal string. -- Returns @Nothing@ on negative inputs. packOctal :: (Integral a) => a -> Maybe ByteString {-# INLINE packOctal #-} packOctal n | n < 0 = Nothing | otherwise = Just (unsafePackOctal n) -- | Convert a non-negative integer into an ASCII octal string. -- This function is unsafe to use on negative inputs. unsafePackOctal :: (Integral a) => a -> ByteString {-# SPECIALIZE unsafePackOctal :: Int -> ByteString, Int8 -> ByteString, Int16 -> ByteString, Int32 -> ByteString, Int64 -> ByteString, Integer -> ByteString, Word -> ByteString, Word8 -> ByteString, Word16 -> ByteString, Word32 -> ByteString, Word64 -> ByteString #-} unsafePackOctal n0 = let size = numTwoPowerDigits 3 (toInteger n0) -- for Bits in BSI.unsafeCreate size $ \p0 -> loop n0 (p0 `plusPtr` (size - 1)) where loop :: (Integral a) => a -> Ptr Word8 -> IO () loop n p | n <= 7 = do poke p (0x30 + fromIntegral n) | otherwise = do let (q,r) = n `quotRem` 8 poke p (0x30 + fromIntegral r) loop q (p `plusPtr` negate 1) {- -- BUG: This doesn't quite work right... asOctal :: ByteString -> ByteString asOctal buf = BSI.unsafeCreate (ceilEightThirds $ BS.length buf) $ \p0 -> do let (BSI.PS fq off len) = buf FFI.withForeignPtr fq $ \q0 -> do let qF = q0 `plusPtr` (off + len - rem len 3) let loop :: Ptr Word8 -> Ptr Word8 -> IO () loop p q | q /= qF = do {- Take three Word8s and write 8 chars at a time -} i <- peek q j <- peek (q `plusPtr` 1) :: IO Word8 k <- peek (q `plusPtr` 2) :: IO Word8 let w = fromIntegral i .|. (fromIntegral j `shiftL` 8) .|. (fromIntegral k `shiftL` 16) poke p (toC8( w .&. 0x07)) poke (p `plusPtr` 1) (toC8((w `shiftR` 3) .&. 0x07)) poke (p `plusPtr` 2) (toC8((w `shiftR` 6) .&. 0x07)) poke (p `plusPtr` 3) (toC8((w `shiftR` 9) .&. 0x07)) poke (p `plusPtr` 4) (toC8((w `shiftR` 12) .&. 0x07)) poke (p `plusPtr` 5) (toC8((w `shiftR` 15) .&. 0x07)) poke (p `plusPtr` 6) (toC8((w `shiftR` 18) .&. 0x07)) poke (p `plusPtr` 7) (toC8((w `shiftR` 21) .&. 0x07)) loop (p `plusPtr` 8) (q `plusPtr` 3) | 2 == rem len 3 = do {- Handle the last two Word8s -} i <- peek q j <- peek (q `plusPtr` 1) :: IO Word8 let w = fromIntegral i .|. (fromIntegral j `shiftL` 8) poke p (toC8( w .&. 0x07)) poke (p `plusPtr` 1) (toC8((w `shiftR` 3) .&. 0x07)) poke (p `plusPtr` 2) (toC8((w `shiftR` 6) .&. 0x07)) poke (p `plusPtr` 3) (toC8((w `shiftR` 9) .&. 0x07)) poke (p `plusPtr` 4) (toC8((w `shiftR` 12) .&. 0x07)) poke (p `plusPtr` 5) (toC8((w `shiftR` 15) .&. 0x01)) | otherwise = do {- Handle the last Word8 -} i <- peek q let w = fromIntegral i poke p (toC8( w .&. 0x07)) poke (p `plusPtr` 1) (toC8((w `shiftR` 3) .&. 0x07)) poke (p `plusPtr` 2) (toC8((w `shiftR` 6) .&. 0x03)) -- loop p0 (q0 `plusPtr` off) where toC8 :: Int -> Word8 toC8 i = fromIntegral (0x30+i) {-# INLINE toC8 #-} -- We can probably speed that up by using (.|.) in lieu of (+) -- See the benchmark file for credits and implementation details. ceilEightThirds x | x >= 3*(b-1) = error _asOctal_overflow | x >= b = ceiling (fromIntegral x / 3 * 8 :: Double) | otherwise = (x*8 + 2) `quot` 3 where {-# INLINE b #-} b = 2^(28::Int)::Int -- b*8-1 is the last positive number for Int=Int32 -- TODO: need to generalize for Int=Int64 _asOctal_overflow :: String {-# NOINLINE _asOctal_overflow #-} _asOctal_overflow = "asOctal: cannot create buffer larger than (maxBound::Int)" -- -} ---------------------------------------------------------------- ----------------------------------------------------------- fin. bytestring-lexing-0.5.0.14/src/Data/ByteString/Lex/Internal.hs0000644000000000000000000001552707346545000022212 0ustar0000000000000000{-# OPTIONS_GHC -Wall -fwarn-tabs #-} {-# LANGUAGE BangPatterns #-} ---------------------------------------------------------------- -- 2024-04-11 -- | -- Module : Data.ByteString.Lex.Internal -- Copyright : Copyright (c) 2010--2024 wren gayle romano -- License : BSD2 -- Maintainer : wren@cpan.org -- Stability : provisional -- Portability : BangPatterns -- -- 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 , numTwoPowerDigits , numDecimalDigits ) where 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). -- -- This implementation is derived from -- -- modified to use 'quot' instead of 'div', to ensure strictness, -- and using more guard notation (but this last one's compiled -- away). See @./bench/BenchNumDigits.hs@ for other implementation -- choices. -- -- | @numDigits b n@ computes the number of base-@b@ digits required -- to represent the number @n@. N.B., this implementation is unsafe -- and will throw errors if the base is @(<= 1)@, or if the number -- is negative. If the base happens to be a power of 2, then see -- 'numTwoPowerDigits' for a more efficient implementation. -- -- We must be careful about the input types here. When using small -- unsigned types or very large values, the repeated squaring can -- overflow causing the function to loop. (E.g., the fourth squaring -- of 10 overflows 32-bits (==1874919424) which is greater than the -- third squaring. For 64-bit, the 5th squaring overflows, but it's -- negative so will be caught.) Forcing the type to Integer ensures -- correct behavior, but makes it substantially slower. numDigits :: Integer -> Integer -> Int {-# INLINE numDigits #-} 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 = finish (ilog b0 n0) where finish (ND e _) = 1 + e ilog !b !n | n < b = ND 0 n -- TODO(2024-04-11): Check core to see whether these @(2*)@ -- ops are properly weakened to shifts. | r < b = ND (2*e) r | otherwise = ND (2*e+1) (r `quot` b) where -- TODO(2024-04-11): Benchmark this lazy-pattern matching, -- vs using a strict pattern (and alas less guard-notation, -- to ensure we only evaluate it when needed). ND e r = ilog (b*b) n -- TODO(2024-04-11): Benchmark this change in the implementation -- (relative to using @(,)@ and @($!)@). Also, need to re-run all -- the benchmarks anyways, to see how things've changed on newer GHC. data ND = ND {-#UNPACK#-}!Int !Integer -- | Compute the number of base-@2^p@ digits required to represent a -- number @n@. N.B., this implementation is unsafe and will throw -- errors if the base power is non-positive, or if the number is -- negative. For bases which are not a power of 2, see 'numDigits' -- for a more general implementation. numTwoPowerDigits :: (Integral a, Bits a) => Int -> a -> Int {-# INLINE numTwoPowerDigits #-} 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 | n > 0 = go (d+1) (n `shiftR` p) | otherwise = d -- This implementation is from: -- -- -- | Compute the number of base-@10@ digits required to represent -- a number @n@. N.B., this implementation is unsafe and will throw -- errors if the number is negative. numDecimalDigits :: (Integral a) => a -> Int {-# INLINE numDecimalDigits #-} numDecimalDigits n0 | n0 < 0 = error (_numDecimalDigits ++ _negativeNumber) -- Unfortunately this causes significant (1.2x) slowdown since -- GHC can't see it will always fail for types other than Integer... -- TODO(2024-04-11): See if we can't do more static-analysis -- code to optimize this path (a~la my C++ safe comparisons) | n0 > limit = numDigits 10 (toInteger n0) | otherwise = go 1 (fromIntegral n0 :: Word64) where limit = fromIntegral (maxBound :: Word64) fin n bound = if n >= bound then 1 else 0 go !k !n | n < 10 = k | n < 100 = k + 1 | n < 1000 = k + 2 | n < 1000000000000 = k + if n < 100000000 then if n < 1000000 then if n < 10000 then 3 else 4 + fin n 100000 else 6 + fin n 10000000 else if n < 10000000000 then 8 + fin n 1000000000 else 10 + fin n 100000000000 | otherwise = go (k + 12) (n `quot` 1000000000000) _numDigits :: String _numDigits = "numDigits" {-# NOINLINE _numDigits #-} _numTwoPowerDigits :: String _numTwoPowerDigits = "numTwoPowerDigits" {-# NOINLINE _numTwoPowerDigits #-} _numDecimalDigits :: String _numDecimalDigits = "numDecimalDigits" {-# NOINLINE _numDecimalDigits #-} _nonpositiveBase :: String _nonpositiveBase = ": base must be greater than one" {-# NOINLINE _nonpositiveBase #-} _negativeNumber :: String _negativeNumber = ": number must be non-negative" {-# NOINLINE _negativeNumber #-} ---------------------------------------------------------------- ----------------------------------------------------------- fin. bytestring-lexing-0.5.0.14/test/0000755000000000000000000000000007346545000014565 5ustar0000000000000000bytestring-lexing-0.5.0.14/test/Fractional.hs0000644000000000000000000002136507346545000017212 0ustar0000000000000000{-# OPTIONS_GHC -Wall -fwarn-tabs #-} {-# LANGUAGE RankNTypes, ScopedTypeVariables #-} ---------------------------------------------------------------- -- 2021.10.17 -- | -- Module : test/Fractional -- Copyright : Copyright (c) 2015--2021 wren gayle romano -- License : BSD2 -- Maintainer : wren@cpan.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. bytestring-lexing-0.5.0.14/test/Integral.hs0000644000000000000000000001672407346545000016700 0ustar0000000000000000{-# OPTIONS_GHC -Wall -fwarn-tabs #-} {-# LANGUAGE RankNTypes, FlexibleContexts #-} ---------------------------------------------------------------- -- 2021.10.17 -- | -- Module : test/Integral -- Copyright : Copyright (c) 2010--2021 wren gayle romano -- License : BSD2 -- Maintainer : wren@cpan.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. bytestring-lexing-0.5.0.14/test/Main.hs0000644000000000000000000000172007346545000016005 0ustar0000000000000000{-# OPTIONS_GHC -Wall -fwarn-tabs #-} ---------------------------------------------------------------- -- 2021.10.17 -- | -- Module : test/Main -- Copyright : Copyright (c) 2015--2021 wren gayle romano -- License : BSD2 -- Maintainer : wren@cpan.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.