blaze-textual-0.2.0.8/0000755000000000000000000000000012016050232012615 5ustar0000000000000000blaze-textual-0.2.0.8/blaze-textual.cabal0000644000000000000000000000443312016050232016366 0ustar0000000000000000name: blaze-textual version: 0.2.0.8 license: BSD3 license-file: LICENSE category: Text copyright: Copyright 2011 MailRank, Inc. author: Bryan O'Sullivan maintainer: Bryan O'Sullivan stability: experimental synopsis: Fast rendering of common datatypes cabal-version: >= 1.8 homepage: http://github.com/bos/blaze-textual bug-reports: http://github.com/bos/blaze-textual/issues build-type: Simple description: A library for efficiently rendering Haskell datatypes to bytestrings. . /Note/: if you use GHCi or Template Haskell, please see the @README@ file for important details about building this package, and other packages that depend on it: extra-source-files: README.markdown tests/*.hs flag developer description: operate in developer mode default: False flag native description: use slow native code for double conversion default: True library exposed-modules: Blaze.Text Blaze.Text.Double Blaze.Text.Int if flag(native) other-modules: Blaze.Text.Double.Native build-depends: base == 4.*, blaze-builder >= 0.2.1.4, bytestring, ghc-prim, old-locale, text >= 0.11.0.2, time, vector if !flag(native) build-depends: double-conversion >= 0.2.0.1 if flag(developer) ghc-options: -Werror ghc-prof-options: -auto-all if flag(native) cpp-options: -DNATIVE ghc-options: -Wall if impl(ghc >= 6.11) cpp-options: -DINTEGER_GMP build-depends: integer-gmp >= 0.2 if impl(ghc >= 6.9) && impl(ghc < 6.11) cpp-options: -DINTEGER_GMP build-depends: integer >= 0.1 && < 0.2 test-suite tests type: exitcode-stdio-1.0 hs-source-dirs: tests main-is: QC.hs ghc-options: -Wall -threaded -rtsopts build-depends: QuickCheck >= 2.4.0.1, base, blaze-builder, blaze-textual, bytestring, double-conversion, test-framework >= 0.3.3, test-framework-quickcheck2 >= 0.2.9 source-repository head type: git location: http://github.com/bos/blaze-textual source-repository head type: mercurial location: http://bitbucket.org/bos/blaze-textual blaze-textual-0.2.0.8/LICENSE0000644000000000000000000000266712016050232013635 0ustar0000000000000000Copyright (c) 2011, MailRank, Inc. 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. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE 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. blaze-textual-0.2.0.8/README.markdown0000644000000000000000000000475112016050232015325 0ustar0000000000000000# Welcome to blaze-textual blaze-textual is a fast Haskell library for rendering common Haskell datatypes in text form using the [blaze-builder](http://hackage.haskell.org/package/blaze-builder) library. # Important note for users of GHCi and Template Haskell To achieve excellent performance for rendering floating point numbers, this package can optionally use the [double-conversion](http://hackage.haskell.org/package/double-conversion) package. Unfortunately, due to bugs in GHC, some uses of GHCi and Template Haskell can crash if the double-conversion package is used. As a result, this package's use of double-conversion is disabled by default. * [5289: Can't use ghci with a library linked against libstdc++](http://hackage.haskell.org/trac/ghc/ticket/5289) (fixed in GHC 7.2.1). * [5386: GHCi crashes with SIGFPE when using double-conversion package](http://hackage.haskell.org/trac/ghc/ticket/5386) (not yet fixed at the time of writing) If you enable use of double-conversion and are affected by these problems, you should expect the 5289 crash to look like this: Loading package double-conversion-0.2.0.0 ... can't load .so/.DLL for: stdc++ The 5386 crash causes GHCi to die with a floating point exception (SIGFPE). To work around these bugs, this package includes an alternative, slower, floating point conversion that is written in pure Haskell. Although it is 10 times slower than the double-conversion package, it is the default because it does not crash. If you don't use GHCi or Template Haskell, and you want to force the use of double-conversion, you can reinstall this package by disabling the `native` flag with `cabal`: cabal install -f-native --reinstall Afterwards, you will also need to reinstall any downstream packages that depend on this one, e.g. the [aeson JSON library](http://hackage.haskell.org/package/aeson): cabal install aeson --reinstall # Join in! We are happy to receive bug reports, fixes, documentation enhancements, and other improvements. Please report bugs via the [github issue tracker](http://github.com/bos/blaze-textual/issues). Master [git repository](http://github.com/bos/blaze-textual): * `git clone git://github.com/bos/blaze-textual.git` There's also a [Mercurial mirror](http://bitbucket.org/bos/blaze-textual): * `hg clone http://bitbucket.org/bos/blaze-textual` (You can create and contribute changes using either git or Mercurial.) Authors ------- This library is written and maintained by Bryan O'Sullivan, . blaze-textual-0.2.0.8/Setup.lhs0000644000000000000000000000011412016050232014421 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain blaze-textual-0.2.0.8/Blaze/0000755000000000000000000000000012016050232013652 5ustar0000000000000000blaze-textual-0.2.0.8/Blaze/Text.hs0000644000000000000000000000017412016050232015134 0ustar0000000000000000module Blaze.Text ( float , double , integral ) where import Blaze.Text.Double import Blaze.Text.Int blaze-textual-0.2.0.8/Blaze/Text/0000755000000000000000000000000012016050232014576 5ustar0000000000000000blaze-textual-0.2.0.8/Blaze/Text/Double.hs0000644000000000000000000000121612016050232016344 0ustar0000000000000000{-# LANGUAGE CPP #-} -- Module: Blaze.Text.Double -- Copyright: (c) 2011 MailRank, Inc. -- License: BSD3 -- Maintainer: Bryan O'Sullivan -- Stability: experimental -- Portability: portable -- -- Efficiently serialize a Double as a lazy 'L.ByteString'. module Blaze.Text.Double ( float , double ) where #ifdef NATIVE import Blaze.Text.Double.Native #else import Blaze.ByteString.Builder (Builder, fromByteString) import Data.Double.Conversion.ByteString (toShortest) float :: Float -> Builder float = double . realToFrac double :: Double -> Builder double f = fromByteString (toShortest f) #endif blaze-textual-0.2.0.8/Blaze/Text/Int.hs0000644000000000000000000001263712016050232015675 0ustar0000000000000000{-# LANGUAGE BangPatterns, CPP, MagicHash, OverloadedStrings, UnboxedTuples #-} -- Module: Blaze.Text.Int -- Copyright: (c) 2011 MailRank, Inc. -- License: BSD3 -- Maintainer: Bryan O'Sullivan -- Stability: experimental -- Portability: portable -- -- Efficiently serialize an integral value as a lazy 'L.ByteString'. module Blaze.Text.Int ( digit , integral , minus ) where import Blaze.ByteString.Builder import Blaze.ByteString.Builder.Char8 import Data.ByteString.Char8 () import Data.Int (Int8, Int16, Int32, Int64) import Data.Monoid (mappend, mempty) import Data.Word (Word, Word8, Word16, Word32, Word64) import GHC.Base (quotInt, remInt) import GHC.Num (quotRemInteger) import GHC.Types (Int(..)) #ifdef __GLASGOW_HASKELL__ # if __GLASGOW_HASKELL__ < 611 import GHC.Integer.Internals # else import GHC.Integer.GMP.Internals # endif #endif #ifdef INTEGER_GMP # define PAIR(a,b) (# a,b #) #else # define PAIR(a,b) (a,b) #endif integral :: (Integral a, Show a) => a -> Builder {-# RULES "integral/Int" integral = bounded :: Int -> Builder #-} {-# RULES "integral/Int8" integral = bounded :: Int8 -> Builder #-} {-# RULES "integral/Int16" integral = bounded :: Int16 -> Builder #-} {-# RULES "integral/Int32" integral = bounded :: Int32 -> Builder #-} {-# RULES "integral/Int64" integral = bounded :: Int64 -> Builder #-} {-# RULES "integral/Word" integral = nonNegative :: Word -> Builder #-} {-# RULES "integral/Word8" integral = nonNegative :: Word8 -> Builder #-} {-# RULES "integral/Word16" integral = nonNegative :: Word16 -> Builder #-} {-# RULES "integral/Word32" integral = nonNegative :: Word32 -> Builder #-} {-# RULES "integral/Word64" integral = nonNegative :: Word64 -> Builder #-} {-# RULES "integral/Integer" integral = integer :: Integer -> Builder #-} -- This definition of the function is here PURELY to be used by ghci -- and those rare cases where GHC is being invoked without -- optimization, as otherwise the rewrite rules above should fire. The -- test for "-0" catches an overflow if we render minBound. integral i | i >= 0 = nonNegative i | toByteString b == "-0" = fromString (show i) | otherwise = b where b = minus `mappend` nonNegative (-i) bounded :: (Bounded a, Integral a) => a -> Builder {-# SPECIALIZE bounded :: Int -> Builder #-} {-# SPECIALIZE bounded :: Int8 -> Builder #-} {-# SPECIALIZE bounded :: Int16 -> Builder #-} {-# SPECIALIZE bounded :: Int32 -> Builder #-} {-# SPECIALIZE bounded :: Int64 -> Builder #-} bounded i | i >= 0 = nonNegative i | i > minBound = minus `mappend` nonNegative (-i) | otherwise = minus `mappend` nonNegative (negate (k `quot` 10)) `mappend` digit (negate (k `rem` 10)) where k = minBound `asTypeOf` i nonNegative :: Integral a => a -> Builder {-# SPECIALIZE nonNegative :: Int -> Builder #-} {-# SPECIALIZE nonNegative :: Int8 -> Builder #-} {-# SPECIALIZE nonNegative :: Int16 -> Builder #-} {-# SPECIALIZE nonNegative :: Int32 -> Builder #-} {-# SPECIALIZE nonNegative :: Int64 -> Builder #-} {-# SPECIALIZE nonNegative :: Word -> Builder #-} {-# SPECIALIZE nonNegative :: Word8 -> Builder #-} {-# SPECIALIZE nonNegative :: Word16 -> Builder #-} {-# SPECIALIZE nonNegative :: Word32 -> Builder #-} {-# SPECIALIZE nonNegative :: Word64 -> Builder #-} nonNegative = go where go n | n < 10 = digit n | otherwise = go (n `quot` 10) `mappend` digit (n `rem` 10) digit :: Integral a => a -> Builder digit n = fromWord8 $! fromIntegral n + 48 {-# INLINE digit #-} minus :: Builder minus = fromWord8 45 int :: Int -> Builder int = integral {-# INLINE int #-} integer :: Integer -> Builder integer (S# i#) = int (I# i#) integer i | i < 0 = minus `mappend` go (-i) | otherwise = go i where go n | n < maxInt = int (fromInteger n) | otherwise = putH (splitf (maxInt * maxInt) n) splitf p n | p > n = [n] | otherwise = splith p (splitf (p*p) n) splith p (n:ns) = case n `quotRemInteger` p of PAIR(q,r) | q > 0 -> q : r : splitb p ns | otherwise -> r : splitb p ns splith _ _ = error "splith: the impossible happened." splitb p (n:ns) = case n `quotRemInteger` p of PAIR(q,r) -> q : r : splitb p ns splitb _ _ = [] data T = T !Integer !Int fstT :: T -> Integer fstT (T a _) = a maxInt :: Integer maxDigits :: Int T maxInt maxDigits = until ((>mi) . (*10) . fstT) (\(T n d) -> T (n*10) (d+1)) (T 10 1) where mi = fromIntegral (maxBound :: Int) putH :: [Integer] -> Builder putH (n:ns) = case n `quotRemInteger` maxInt of PAIR(x,y) | q > 0 -> int q `mappend` pblock r `mappend` putB ns | otherwise -> int r `mappend` putB ns where q = fromInteger x r = fromInteger y putH _ = error "putH: the impossible happened" putB :: [Integer] -> Builder putB (n:ns) = case n `quotRemInteger` maxInt of PAIR(x,y) -> pblock q `mappend` pblock r `mappend` putB ns where q = fromInteger x r = fromInteger y putB _ = mempty pblock :: Int -> Builder pblock = go maxDigits where go !d !n | d == 1 = digit n | otherwise = go (d-1) q `mappend` digit r where q = n `quotInt` 10 r = n `remInt` 10 blaze-textual-0.2.0.8/Blaze/Text/Double/0000755000000000000000000000000012016050232016010 5ustar0000000000000000blaze-textual-0.2.0.8/Blaze/Text/Double/Native.hs0000644000000000000000000001064512016050232017600 0ustar0000000000000000{-# LANGUAGE BangPatterns, CPP, MagicHash, OverloadedStrings, UnboxedTuples #-} -- Module: Blaze.Text.Double.Native -- Copyright: (c) 2011 MailRank, Inc. -- License: BSD3 -- Maintainer: Bryan O'Sullivan -- Stability: experimental -- Portability: portable -- -- Efficiently serialize a Double as a lazy 'L.ByteString'. module Blaze.Text.Double.Native ( float , double ) where import Blaze.ByteString.Builder (Builder, fromByteString) import Blaze.ByteString.Builder.Char8 (fromChar) import Blaze.Text.Int (digit, integral, minus) import Data.ByteString.Char8 () import Data.Monoid (mappend, mconcat, mempty) import qualified Data.Vector as V -- The code below is originally from GHC.Float, but has been optimised -- in quite a few ways. data T = T [Int] {-# UNPACK #-} !Int float :: Float -> Builder float = double . realToFrac double :: Double -> Builder double f | isInfinite f = fromByteString $ if f > 0 then "Infinity" else "-Infinity" | f < 0 || isNegativeZero f = minus `mappend` goGeneric (floatToDigits (-f)) | f >= 0 = goGeneric (floatToDigits f) | otherwise = fromByteString "NaN" where goGeneric p@(T _ e) | e < 0 || e > 7 = goExponent p | otherwise = goFixed p goExponent (T is e) = case is of [] -> error "putFormattedFloat" [0] -> fromByteString "0.0e0" [d] -> digit d `mappend` fromByteString ".0e" `mappend` integral (e-1) (d:ds) -> digit d `mappend` fromChar '.' `mappend` digits ds `mappend` fromChar 'e' `mappend` integral (e-1) goFixed (T is e) | e <= 0 = fromChar '0' `mappend` fromChar '.' `mappend` mconcat (replicate (-e) (fromChar '0')) `mappend` digits is | otherwise = let g 0 rs = fromChar '.' `mappend` mk0 rs g n [] = fromChar '0' `mappend` g (n-1) [] g n (r:rs) = digit r `mappend` g (n-1) rs in g e is mk0 [] = fromChar '0' mk0 rs = digits rs digits :: [Int] -> Builder digits (d:ds) = digit d `mappend` digits ds digits _ = mempty {-# INLINE digits #-} floatToDigits :: Double -> T floatToDigits 0 = T [0] 0 floatToDigits x = T (reverse rds) k where (f0, e0) = decodeFloat x (minExp0, _) = floatRange (undefined::Double) p = floatDigits x b = floatRadix x minExp = minExp0 - p -- the real minimum exponent -- Haskell requires that f be adjusted so denormalized numbers -- will have an impossibly low exponent. Adjust for this. (# f, e #) = let n = minExp - e0 in if n > 0 then (# f0 `div` (b^n), e0+n #) else (# f0, e0 #) (# r, s, mUp, mDn #) = if e >= 0 then let be = b^ e in if f == b^(p-1) then (# f*be*b*2, 2*b, be*b, b #) else (# f*be*2, 2, be, be #) else if e > minExp && f == b^(p-1) then (# f*b*2, b^(-e+1)*2, b, 1 #) else (# f*2, b^(-e)*2, 1, 1 #) k = fixup k0 where k0 | b == 2 = (p - 1 + e0) * 3 `div` 10 -- logBase 10 2 is slightly bigger than 3/10 so the following -- will err on the low side. Ignoring the fraction will make -- it err even more. Haskell promises that p-1 <= logBase b f -- < p. | otherwise = ceiling ((log (fromInteger (f+1) :: Double) + fromIntegral e * log (fromInteger b)) / log 10) fixup n | n >= 0 = if r + mUp <= exp10 n * s then n else fixup (n+1) | otherwise = if exp10 (-n) * (r + mUp) <= s then n else fixup (n+1) gen ds !rn !sN !mUpN !mDnN = let (dn0, rn') = (rn * 10) `divMod` sN mUpN' = mUpN * 10 mDnN' = mDnN * 10 !dn = fromInteger dn0 !dn' = dn + 1 in case (# rn' < mDnN', rn' + mUpN' > sN #) of (# True, False #) -> dn : ds (# False, True #) -> dn' : ds (# True, True #) -> if rn' * 2 < sN then dn : ds else dn' : ds (# False, False #) -> gen (dn:ds) rn' sN mUpN' mDnN' rds | k >= 0 = gen [] r (s * exp10 k) mUp mDn | otherwise = gen [] (r * bk) s (mUp * bk) (mDn * bk) where bk = exp10 (-k) exp10 :: Int -> Integer exp10 n | n >= 0 && n < maxExpt = V.unsafeIndex expts n | otherwise = 10 ^ n where expts = V.generate maxExpt (10^) {-# NOINLINE expts #-} maxExpt = 17 {-# INLINE exp10 #-} blaze-textual-0.2.0.8/tests/0000755000000000000000000000000012016050232013757 5ustar0000000000000000blaze-textual-0.2.0.8/tests/QC.hs0000644000000000000000000000401212016050232014613 0ustar0000000000000000module Main (main) where import Blaze.ByteString.Builder (Builder, toByteString) import Blaze.Text (double, float, integral) import Data.Int (Int8, Int16, Int32, Int64) import Data.Word (Word, Word8, Word16, Word32, Word64) import Test.Framework (Test, defaultMain, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) import qualified Data.ByteString.Char8 as B -- Integral values should be rendered exactly as Haskell does. t_integral :: (Integral a, Show a) => a -> a -> Bool t_integral _ i = toByteString (integral i) == B.pack (show i) -- This package doesn't render floating point numbers exactly as -- Haskell does, but the numbers it renders should read back exactly. -- So that's the property we check. t_real :: (RealFloat a, Show a, Read a) => (a -> Builder) -> a -> a -> Bool t_real f i j = case read (B.unpack . toByteString . f $ ij) of r | isNaN r -> isNaN ij | isInfinite r -> isInfinite ij && signum r == signum ij | otherwise -> r == ij where ij = i / j main :: IO () main = defaultMain tests tests :: [Test] tests = [ testGroup "int" [ testProperty "Integer" $ t_integral (undefined::Integer) , testProperty "Int" $ t_integral (undefined::Int) , testProperty "Int8" $ t_integral (undefined::Int8) , testProperty "Int16" $ t_integral (undefined::Int16) , testProperty "Int32" $ t_integral (undefined::Int32) , testProperty "Int64" $ t_integral (undefined::Int64) ] , testGroup "word" [ testProperty "Word" $ t_integral (undefined::Word) , testProperty "Word8" $ t_integral (undefined::Word8) , testProperty "Word16" $ t_integral (undefined::Word16) , testProperty "Word32" $ t_integral (undefined::Word32) , testProperty "Word64" $ t_integral (undefined::Word64) ] , testProperty "Double" $ t_real double , testProperty "Float" $ t_real float ]