json-builder (empty) → 0.0
raw patch · 4 files changed
+364/−0 lines, 4 filesdep +basedep +blaze-builderdep +blaze-textualsetup-changed
Dependencies added: base, blaze-builder, blaze-textual, bytestring, containers, text, utf8-string
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- json-builder.cabal +45/−0
- src/Data/Json/Builder.hs +287/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2011, Leon P Smith++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * 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.++ * Neither the name of Leon P Smith nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS 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 COPYRIGHT+OWNER 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ json-builder.cabal view
@@ -0,0 +1,45 @@+Name: json-builder+Version: 0.0+Synopsis: Data structure agnostic JSON serialization+License: BSD3+License-file: LICENSE+Author: Leon P Smith+Maintainer: leon@melding-monads.com+Stability: experimental+Copyright: (c) 2011 Leon P Smith+Category: JSON+Build-type: Simple+Cabal-version: >= 1.6+homepage: http://github.com/lpsmith/json-builder+bug-reports: http://github.com/lpsmith/json-builder/issues+description:+ Most json packages define a data structure that corresponds to json values.+ To serialize other values to a json string, then that value must be+ marshalled into the json data structure.+ .+ This library avoids this marshalling step, and is thus potentially more+ efficient when serializing arbitrary data structures. Unfortunately+ json-builder cannot yet read or process json data, and it's not clear+ to me yet how pull a similar kind of trick to avoid unnecessary data+ structures when parsing json data into arbitrary data types.++Library+ hs-source-dirs: src+ Exposed-modules: Data.Json.Builder++ Build-depends: base >= 4 && < 5,+ blaze-builder,+ blaze-textual,+ bytestring,+ containers,+ text,+ utf8-string++source-repository head+ type: git+ location: http://github.com/lpsmith/json-builder++source-repository this+ type: git+ location: http://github.com/lpsmith/json-builder+ tag: v0.0
+ src/Data/Json/Builder.hs view
@@ -0,0 +1,287 @@+-----------------------------------------------------------------------------+-- |+-- Module : Data.Json.Builder+-- Copyright : (c) 2011 Leon P Smith+-- License : BSD3+--+-- Maintainer : Leon P Smith <leon@melding-monads.com>+--+-- Data structure agnostic JSON serialization+--+-----------------------------------------------------------------------------++{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverlappingInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Data.Json.Builder+ ( Key (..)+ , Value(..)+ , Object+ , row+ , Array+ , element+ , Escaped(..)+ ) where++import Blaze.ByteString.Builder as Blaze+ ( Write+ , Builder+ , copyByteString+ , fromByteString+ , fromLazyByteString+ , writeByteString+ , fromWrite+ , fromWriteList+ , writeWord8 )+import Blaze.ByteString.Builder.Char.Utf8+ ( fromChar, writeChar, fromText, fromLazyText )+import Blaze.Text (float, double, integral)++import Data.Bits ( Bits((.&.), shiftR) )+import qualified Data.Map as Map+import Data.Monoid ( Monoid (mempty, mappend, mconcat) )+import Data.Int ( Int8, Int16, Int32, Int64)+import Data.Word ( Word, Word8, Word16, Word32, Word64 )++import qualified Data.Char as Char++import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.UTF8 as BU+import qualified Data.ByteString.Lazy.UTF8 as BLU+import Data.ByteString.Internal ( c2w )++import qualified Data.Text as T+import qualified Data.Text.Lazy as TL++-- | The 'Key' typeclass represents types that are rendered +-- into json strings. They are special because only strings +-- can appear as field names of a json objects.++class Value a => Key a where+ escape :: a -> Escaped++-- | The 'Value' typeclass represents types that can be rendered+-- into valid json syntax.++class Value a where+ toBuilder :: a -> Blaze.Builder++-- | The 'Escaped' type is a special Builder value that represents a UTF-8 +-- encoded string with all necessary characters json-escaped. These builders+-- must not render the opening or closing quotes, which are instead rendered+-- by 'toBuilder'. This is so that Json strings can be efficiently constructed+-- from multiple Haskell strings without actually concatinating the Haskell +-- strings (which might require some kind of conversion in addition to+-- concatination.)++newtype Escaped = Escaped Blaze.Builder deriving (Monoid)++instance Key Escaped where+ escape = id++instance Value Escaped where+ toBuilder (Escaped str) = fromChar '"' `mappend` str `mappend` fromChar '"'++type CommaTracker = (Bool -> Blaze.Builder) -> Bool -> Blaze.Builder++comma :: Blaze.Builder -> CommaTracker+comma b f True = b `mappend` f False+comma b f False = fromChar ',' `mappend` b `mappend` f False+{-# INLINE comma #-}++-- | The 'Object' type represents a builder that constructs syntax for a+-- json object. It has a singleton constructor 'row', and an instance of+-- monoid, so that arbitrary objects can be constructed. 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+ toBuilder (Object f) = fromChar '{' `mappend` f (\_ -> fromChar '}') True++instance Monoid Object where+ mempty = Object id+ mappend (Object f) (Object g) = Object (f . g)++-- | The 'row' constructs a json object consisting of exactly one field.+-- These objects can be concatinated using 'mappend'. +row :: (Key k, Value a) => k -> a -> Object+row k a = Object syntax+ where+ syntax = comma (mconcat [ toBuilder k, fromChar ':', toBuilder a ])++-- | The 'Array' type represents a builder that constructs syntax for a+-- json array. It has a singleton constructor 'element' and an instance of+-- monoid, so that arbitrary arrays can be constructed.++newtype Array = Array CommaTracker++instance Value Array where+ toBuilder (Array f) = fromChar '[' `mappend` f (\_ -> fromChar ']') True++instance Monoid Array where+ mempty = Array id+ mappend (Array f) (Array g) = Array (f . g)++-- | 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)++-- Primitive instances for json-builder++instance Value () where+ toBuilder _ = copyByteString "null"++instance Value Int where+ toBuilder = integral++instance Value Int8 where+ toBuilder = integral++instance Value Int16 where+ toBuilder = integral++instance Value Int32 where+ toBuilder = integral++instance Value Int64 where+ toBuilder = integral++instance Value Integer where+ toBuilder = integral++instance Value Word where+ toBuilder = integral++instance Value Word8 where+ toBuilder = integral++instance Value Word16 where+ toBuilder = integral++instance Value Word32 where+ toBuilder = integral++instance Value Word64 where+ toBuilder = integral++instance Value Double where+ toBuilder = double++instance Value Float where+ toBuilder = float++instance Value Bool where+ toBuilder True = copyByteString "true"+ toBuilder False = copyByteString "false"++instance Key BS.ByteString where+ escape x = Escaped (loop (splitQ x))+ where+ splitQ = BU.break quoteNeeded++ loop (a,b)+ = fromByteString a `mappend`+ case BU.decode b of+ Nothing -> mempty+ Just (c,n) -> fromWrite (quoteChar c) `mappend`+ loop (splitQ (BS.drop n b))++instance Value BS.ByteString where+ toBuilder = toBuilder . escape++instance Key BL.ByteString where+ escape x = Escaped (loop (splitQ x))+ where+ splitQ = BLU.break quoteNeeded++ loop (a,b)+ = fromLazyByteString a `mappend`+ case BLU.decode b of+ Nothing -> mempty+ Just (c,n) -> fromWrite (quoteChar c) `mappend`+ loop (splitQ (BL.drop n b))++instance Value BL.ByteString where+ toBuilder = toBuilder . escape++instance Key T.Text where+ escape x = Escaped (loop (splitQ x))+ where+ splitQ = T.break quoteNeeded++ loop (a,b)+ = fromText a `mappend`+ case T.uncons b of+ Nothing -> mempty+ Just (c,b') -> fromWrite (quoteChar c) `mappend`+ loop (splitQ b')++instance Value T.Text where+ toBuilder = toBuilder . escape++instance Key TL.Text where+ escape x = Escaped (loop (splitQ x))+ where+ splitQ = TL.break quoteNeeded++ loop (a,b)+ = fromLazyText a `mappend`+ case TL.uncons b of+ Nothing -> mempty+ Just (c,b') -> fromWrite (quoteChar c) `mappend`+ loop (splitQ b')++instance Value TL.Text where+ toBuilder = toBuilder . escape++instance Key [Char] where+ escape str = Escaped (fromWriteList writeEscapedChar str)+ where+ writeEscapedChar c | quoteNeeded c = quoteChar c+ | otherwise = writeChar c++instance Value [Char] where+ toBuilder = toBuilder . escape++instance Value a => Value [a] where+ toBuilder = toBuilder . mconcat . map element++instance (Key k, Value a) => Value (Map.Map k a) where+ toBuilder = toBuilder+ . Map.foldrWithKey (\k a b -> row k a `mappend` b) mempty++------------------------------------------------------------------------------++quoteNeeded :: Char -> Bool+quoteNeeded c = c == '\\' || c == '"' || Char.ord c < 0x20+{-# INLINE quoteNeeded #-}++quoteChar :: Char -> Write+quoteChar c = case c of+ '\\' -> writeByteString "\\\\"+ '"' -> writeByteString "\\\""+ '\b' -> writeByteString "\\b"+ '\f' -> writeByteString "\\f"+ '\n' -> writeByteString "\\n"+ '\r' -> writeByteString "\\r"+ '\t' -> writeByteString "\\t"+ _ -> hexEscape c++hexEscape :: Char -> Write+hexEscape (c2w -> c)+ = writeByteString "\\u00"+ `mappend` writeWord8 (char ((c `shiftR` 4) .&. 0xF))+ `mappend` writeWord8 (char ( c .&. 0xF))++char :: Word8 -> Word8+char i | i < 10 = i + 48+ | otherwise = i + 87+{-# INLINE char #-}