Skip to content

Commit

Permalink
Drop use of blaze-builder during encoding.
Browse files Browse the repository at this point in the history
This improves performance by about 10%.
  • Loading branch information
bos committed Dec 23, 2011
1 parent d0d6a4c commit 672a797
Show file tree
Hide file tree
Showing 2 changed files with 30 additions and 36 deletions.
65 changes: 30 additions & 35 deletions Data/Aeson/Encode.hs
Expand Up @@ -17,75 +17,70 @@ module Data.Aeson.Encode
, encode
) where

import Blaze.ByteString.Builder (Builder, fromByteString, toLazyByteString)
import Blaze.Text (double, integral)
import Data.Aeson.Types (ToJSON(..), Value(..))
import Data.Attoparsec.Number (Number(..))
import Data.Monoid (mappend)
import Data.Text.Encoding (encodeUtf8)
import Data.Text.Lazy.Builder
import Data.Text.Lazy.Builder.Int (decimal)
import Data.Text.Lazy.Builder.RealFloat (realFloat)
import Data.Text.Lazy.Encoding (encodeUtf8)
import Numeric (showHex)
import qualified Blaze.ByteString.Builder.Char.Utf8 as Utf8
import qualified Blaze.ByteString.Builder.Char8 as Char8
import qualified Data.ByteString.Lazy.Char8 as L
import qualified Data.ByteString.Lazy as L
import qualified Data.HashMap.Strict as H
import qualified Data.Text as T
import qualified Data.Vector as V

-- | Encode a JSON value to a 'Builder'.
fromValue :: Value -> Builder
fromValue Null = {-# SCC "fromValue/Null" #-} fromByteString "null"
fromValue Null = {-# SCC "fromValue/Null" #-} "null"
fromValue (Bool b) = {-# SCC "fromValue/Bool" #-}
if b then fromByteString "true"
else fromByteString "false"
if b then "true"
else "false"
fromValue (Number n) = {-# SCC "fromValue/Number" #-} fromNumber n
fromValue (String s) = {-# SCC "fromValue/String" #-} string s
fromValue (Array v)
| V.null v = {-# SCC "fromValue/Array" #-} fromByteString "[]"
| V.null v = {-# SCC "fromValue/Array" #-} "[]"
| otherwise = {-# SCC "fromValue/Array" #-}
Char8.fromChar '[' `mappend`
singleton '[' `mappend`
fromValue (V.unsafeHead v) `mappend`
V.foldr f (Char8.fromChar ']') (V.unsafeTail v)
where f a z = Char8.fromChar ',' `mappend` fromValue a `mappend` z
V.foldr f (singleton ']') (V.unsafeTail v)
where f a z = singleton ',' `mappend` fromValue a `mappend` z
fromValue (Object m) = {-# SCC "fromValue/Object" #-}
case H.toList m of
(x:xs) -> Char8.fromChar '{' `mappend`
one x `mappend` foldr f (Char8.fromChar '}') xs
_ -> fromByteString "{}"
where f a z = Char8.fromChar ',' `mappend` one a `mappend` z
one (k,v) = string k `mappend` Char8.fromChar ':' `mappend` fromValue v
(x:xs) -> singleton '{' `mappend`
one x `mappend` foldr f (singleton '}') xs
_ -> "{}"
where f a z = singleton ',' `mappend` one a `mappend` z
one (k,v) = string k `mappend` singleton ':' `mappend` fromValue v

string :: T.Text -> Builder
string s = {-# SCC "string" #-}
Char8.fromChar '"' `mappend` quote s `mappend` Char8.fromChar '"'
singleton '"' `mappend` quote s `mappend` singleton '"'
where
quote q = case T.uncons t of
Just (c,t') -> fromText h `mappend` escape c `mappend` quote t'
Nothing -> fromText h
where (h,t) = T.break isEscape q
where (h,t) = {-# SCC "break" #-} T.break isEscape q
isEscape c = c == '\"' || c == '\\' || c < '\x20'
escape '\"' = fromByteString "\\\""
escape '\\' = fromByteString "\\\\"
escape '\n' = fromByteString "\\n"
escape '\r' = fromByteString "\\r"
escape '\t' = fromByteString "\\t"
escape '\"' = "\\\""
escape '\\' = "\\\\"
escape '\n' = "\\n"
escape '\r' = "\\r"
escape '\t' = "\\t"
escape c
| c < '\x20' = Char8.fromString $
| c < '\x20' = fromString $
"\\u" ++ replicate (4 - length h) '0' ++ h
| otherwise = Utf8.fromChar c
| otherwise = singleton c
where h = showHex (fromEnum c) ""

-- The version in blaze-builder is way slower.
fromText :: T.Text -> Builder
fromText t = fromByteString (encodeUtf8 t)

fromNumber :: Number -> Builder
fromNumber (I i) = integral i
fromNumber (I i) = decimal i
fromNumber (D d)
| isNaN d || isInfinite d = fromByteString "null"
| otherwise = double d
| isNaN d || isInfinite d = "null"
| otherwise = realFloat d

-- | Efficiently serialize a JSON value as a lazy 'L.ByteString'.
encode :: ToJSON a => a -> L.ByteString
encode = {-# SCC "encode" #-} toLazyByteString . fromValue .
encode = {-# SCC "encode" #-} encodeUtf8 . toLazyText . fromValue .
{-# SCC "toJSON" #-} toJSON
{-# INLINE encode #-}
1 change: 0 additions & 1 deletion aeson.cabal
Expand Up @@ -122,7 +122,6 @@ library
attoparsec >= 0.8.6.1,
base == 4.*,
blaze-builder >= 0.2.1.4,
blaze-textual >= 0.2.0.2,
bytestring,
containers,
deepseq,
Expand Down

0 comments on commit 672a797

Please sign in to comment.