Bryan O'Sullivan avatar Bryan O'Sullivan committed 4cf4930

Initial commit. Basically a straight drop of aeson code.

Comments (0)

Files changed (8)

+.*\.(?:aux|h[ip]|o|orig|out|pdf|prof|ps|rej)$
+^(?:dist|\.DS_Store)$
+^benchmarks/(?:AesonParse|EncodeFile|JsonParse|.*_p)$
+^tests/(?:qc)
+
+syntax: glob
+cabal-dev
+*~
+.*.swp
+.\#*
+\#*
+module Blaze.Text
+    (
+      float
+    , double
+    , integral
+    ) where
+
+import Blaze.Text.Double
+import Blaze.Text.Int

Blaze/Text/Double.hs

+{-# LANGUAGE BangPatterns, CPP, MagicHash, OverloadedStrings, UnboxedTuples #-}
+
+-- Module:      Blaze.Text.Double
+-- Copyright:   (c) 2011 MailRank, Inc.
+-- License:     BSD3
+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>
+-- Stability:   experimental
+-- Portability: portable
+--
+-- Efficiently serialize a Double as a lazy 'L.ByteString'.
+
+module Blaze.Text.Double
+    (
+      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 . fromRational . toRational
+
+double :: Double -> Builder
+double f
+    | isNaN f || isInfinite f   = fromByteString "null"
+    | f < 0 || isNegativeZero f = minus `mappend` goGeneric (floatToDigits (-f))
+    | otherwise                 = goGeneric (floatToDigits f)
+  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/Text/Int.hs

+{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-}
+
+-- Module:      Blaze.Text.Int
+-- Copyright:   (c) 2011 MailRank, Inc.
+-- License:     BSD3
+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>
+-- 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 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 => a -> Builder
+{-# SPECIALIZE integral :: Int -> Builder #-}
+{-# SPECIALIZE integral :: Int8 -> Builder #-}
+{-# SPECIALIZE integral :: Int16 -> Builder #-}
+{-# SPECIALIZE integral :: Int32 -> Builder #-}
+{-# SPECIALIZE integral :: Int64 -> Builder #-}
+{-# SPECIALIZE integral :: Word -> Builder #-}
+{-# SPECIALIZE integral :: Word8 -> Builder #-}
+{-# SPECIALIZE integral :: Word16 -> Builder #-}
+{-# SPECIALIZE integral :: Word32 -> Builder #-}
+{-# SPECIALIZE integral :: Word64 -> Builder #-}
+{-# RULES "integral/Integer" integral = integer :: Integer -> Builder #-}
+integral i
+    | i < 0     = minus `mappend` go (-i)
+    | otherwise = go i
+  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
+Copyright (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.
+# Welcome to aeson
+
+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.
+
+# 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/mailrank/blaze-textual/issues).
+
+Master [git repository](http://github.com/mailrank/blaze-textual):
+
+* `git clone git://github.com/mailrank/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,
+<bos@mailrank.com>.
+#!/usr/bin/env runhaskell
+> import Distribution.Simple
+> main = defaultMain

blaze-textual.cabal

+name:            blaze-textual
+version:         0.1.0.0
+license:         BSD3
+license-file:    LICENSE
+category:        Text
+copyright:       Copyright 2011 MailRank, Inc.
+author:          Bryan O'Sullivan <bos@mailrank.com>
+maintainer:      Bryan O'Sullivan <bos@mailrank.com>
+stability:       experimental
+synopsis:        Fast rendering of common datatypes
+cabal-version:   >= 1.8
+homepage:        http://github.com/mailrank/blaze-textual
+bug-reports:     http://github.com/mailrank/blaze-textual/issues
+build-type:      Simple
+description:
+    A library for efficiently rendering Haskell datatypes to
+    bytestrings.
+
+extra-source-files:
+    README.markdown
+
+flag developer
+  description: operate in developer mode
+  default: False
+
+library
+  exposed-modules:
+    Blaze.Text
+    Blaze.Text.Double
+    Blaze.Text.Int
+
+  build-depends:
+    base == 4.*,
+    blaze-builder >= 0.2.1.4,
+    bytestring,
+    ghc-prim,
+    integer-gmp,
+    old-locale,
+    text >= 0.11.0.2,
+    time,
+    vector
+
+  if flag(developer)
+    ghc-options: -Werror
+    ghc-prof-options: -auto-all
+
+  ghc-options:      -Wall
+
+  if impl(ghc >= 6.11)
+    cpp-options: -DINTEGER_GMP
+    build-depends: integer-gmp >= 0.2 && < 0.3
+
+  if impl(ghc >= 6.9) && impl(ghc < 6.11)
+    cpp-options: -DINTEGER_GMP
+    build-depends: integer >= 0.1 && < 0.2
+
+source-repository head
+  type:     git
+  location: http://github.com/mailrank/blaze-textual
+
+source-repository head
+  type:     mercurial
+  location: http://bitbucket.org/bos/blaze-textual
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.