Permalink
Browse files

Change the implementation of CommaTracker to CommaMonoid

This appears to be faster, on par with Aeson, and avoids the need
for implementations of methods such as

  toJson :: Value a => [a] -> Json

to break the json-builder abstraction for performance reasons.
So far, my attempts to improve this method by breaking abstractions
has resulted in worse performance
  • Loading branch information...
1 parent f363021 commit 3e314ecdbc2e47751c2b8968582f33fb9014970e @lpsmith committed Jun 8, 2011
Showing with 43 additions and 42 deletions.
  1. +2 −42 src/Data/Json/Builder.hs
  2. +41 −0 src/Data/Json/Builder/Internal.hs
View
@@ -85,55 +85,15 @@ toJsonByteString = toByteString . toBuilder
toJsonLazyByteString :: Value a => a -> BL.ByteString
toJsonLazyByteString = toLazyByteString . toBuilder
-type CommaTracker = (Bool -> Builder) -> Bool -> Builder
-
-comma :: Builder -> CommaTracker
-comma b f True = b ++ f False
-comma b f False = fromChar ',' ++ b ++ f False
-{-# INLINE comma #-}
-
--- | The 'Object' type represents syntax for a json object. It has a singleton
--- constructor 'row', and an instance of 'Monoid', so that 'mempty' represents the
--- empty object and 'mappend' concatinates two objects. Arbitrary objects can
--- be constructed using these operators.
---
--- Note that duplicate field names will appear in the output, so it is up
--- to the user of this interface to avoid duplicate field names.
-
-newtype Object = Object CommaTracker
-
-instance Value Object where
- toJson (Object f) = Json (fromChar '{' ++ f (\_ -> fromChar '}') True)
-
-instance Monoid Object where
- mempty = Object id
- mappend (Object f) (Object g) = Object (f . g)
-
-- | The 'row' function constructs a json object consisting of exactly
-- one field. These objects can be concatinated using 'mappend'.
row :: (JsString k, Value a) => k -> a -> Object
-row k a = Object syntax
- where
- syntax = comma (mconcat [ toBuilder k, fromChar ':', toBuilder a ])
-
--- | The 'Array' type represents syntax for a json array. It has been given
--- a singleton constructor 'element' and an instance of 'Monoid', so that
--- 'mempty' represents the empty array and 'mappend' concatinates two arrays.
--- Arbitrary arrays can be constructed using these operators.
-
-newtype Array = Array CommaTracker
-
-instance Value Array where
- toJson (Array f) = Json (fromChar '[' ++ f (\_ -> fromChar ']') True)
-
-instance Monoid Array where
- mempty = Array id
- mappend (Array f) (Array g) = Array (f . g)
+row k a = Object (Comma (toBuilder k ++ fromChar ':' ++ toBuilder a))
-- | The 'element' function constructs a json array consisting of exactly
-- one value. These arrays can be concatinated using 'mappend'.
element :: Value a => a -> Array
-element a = Array $ comma (toBuilder a)
+element a = Array (Comma (toBuilder a))
-- Primitive instances for json-builder
@@ -10,20 +10,25 @@
-- invalid Json syntax the constructors provided in this module.
-----------------------------------------------------------------------------
+{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Data.Json.Builder.Internal
( Value (..)
, Json (..)
, JsString(..)
, Escaped (..)
+ , Object(..)
+ , Array(..)
+ , CommaMonoid(..)
) where
import Prelude hiding ((++))
import Blaze.ByteString.Builder
import Blaze.ByteString.Builder.Char.Utf8 ( fromChar )
import Data.ByteString(ByteString)
+import Data.ByteString.Char8()
import Data.Monoid
(++) :: Monoid a => a -> a -> a
@@ -69,3 +74,39 @@ instance Value Escaped where
instance JsString Escaped where
escape = id
+-- | The 'Object' type represents syntax for a json object. It has a singleton
+-- constructor 'row', and an instance of 'Monoid', so that 'mempty' represents the
+-- empty object and 'mappend' concatinates two objects. Arbitrary objects can
+-- be constructed using these operators.
+--
+-- Note that duplicate field names will appear in the output, so it is up
+-- to the user of this interface to avoid duplicate field names.
+newtype Object = Object CommaMonoid deriving (Monoid)
+
+instance Value Object where
+ toJson (Object xs) = case xs of
+ Empty -> Json (copyByteString "{}")
+ Comma ys -> Json (fromChar '{' ++ ys ++ fromChar '}')
+
+-- | The 'Array' type represents syntax for a json array. It has been given
+-- a singleton constructor 'element' and an instance of 'Monoid', so that
+-- 'mempty' represents the empty array and 'mappend' concatinates two arrays.
+-- Arbitrary arrays can be constructed using these operators.
+
+newtype Array = Array CommaMonoid deriving (Monoid)
+
+instance Value Array where
+ toJson (Array xs) = case xs of
+ Empty -> Json (copyByteString "[]")
+ Comma ys -> Json (fromChar '[' ++ ys ++ fromChar ']')
+
+data CommaMonoid
+ = Empty
+ | Comma Builder
+
+instance Monoid CommaMonoid where
+ mempty = Empty
+ mappend Empty y = y
+ mappend x Empty = x
+ mappend (Comma a) (Comma b)
+ = Comma (a ++ fromChar ',' ++ b)

0 comments on commit 3e314ec

Please sign in to comment.