diff --git a/json-builder.cabal b/json-builder.cabal --- a/json-builder.cabal +++ b/json-builder.cabal @@ -1,5 +1,5 @@ Name: json-builder -Version: 0.0 +Version: 0.0.1 Synopsis: Data structure agnostic JSON serialization License: BSD3 License-file: LICENSE @@ -13,9 +13,9 @@ 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. + Most json packages dictate a data structure that corresponds to json values. + To serialize other values to json, then that value must be marshalled into + the specified structure. . This library avoids this marshalling step, and is thus potentially more efficient when serializing arbitrary data structures. Unfortunately @@ -33,6 +33,7 @@ bytestring, containers, text, + unordered-containers, utf8-string source-repository head @@ -42,4 +43,4 @@ source-repository this type: git location: http://github.com/lpsmith/json-builder - tag: v0.0 + tag: v0.0.1 diff --git a/src/Data/Json/Builder.hs b/src/Data/Json/Builder.hs --- a/src/Data/Json/Builder.hs +++ b/src/Data/Json/Builder.hs @@ -10,11 +10,11 @@ -- ----------------------------------------------------------------------------- -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverlappingInstances #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE IncoherentInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Data.Json.Builder @@ -58,8 +58,10 @@ 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 +import qualified Data.HashMap.Lazy as HashMap + +-- | 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 @@ -71,11 +73,11 @@ class Value a where toBuilder :: a -> Blaze.Builder --- | The 'Escaped' type is a special Builder value that represents a UTF-8 +-- | 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 +-- from multiple Haskell strings without actually concatinating the Haskell -- strings (which might require some kind of conversion in addition to -- concatination.) @@ -96,9 +98,9 @@ -- | 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 +-- 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. +-- user of this interface to avoid duplicate field names. newtype Object = Object CommaTracker @@ -110,7 +112,7 @@ 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'. +-- These objects can be concatinated using 'mappend'. row :: (Key k, Value a) => k -> a -> Object row k a = Object syntax where @@ -183,61 +185,49 @@ toBuilder False = copyByteString "false" instance Key BS.ByteString where - escape x = Escaped (loop (splitQ x)) + escape x = Escaped (loop x) where - splitQ = BU.break quoteNeeded - - loop (a,b) + loop (BU.break quoteNeeded -> (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)) + Just (c,n) -> quoteChar c `mappend` loop (BS.drop n b) instance Value BS.ByteString where toBuilder = toBuilder . escape instance Key BL.ByteString where - escape x = Escaped (loop (splitQ x)) + escape x = Escaped (loop x) where - splitQ = BLU.break quoteNeeded - - loop (a,b) + loop (BLU.break quoteNeeded -> (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)) + Just (c,n) -> quoteChar c `mappend` loop (BL.drop n b) instance Value BL.ByteString where toBuilder = toBuilder . escape instance Key T.Text where - escape x = Escaped (loop (splitQ x)) + escape x = Escaped (loop x) where - splitQ = T.break quoteNeeded - - loop (a,b) + loop (T.break quoteNeeded -> (a,b)) = fromText a `mappend` case T.uncons b of Nothing -> mempty - Just (c,b') -> fromWrite (quoteChar c) `mappend` - loop (splitQ b') + Just (c,b') -> quoteChar c `mappend` loop b' instance Value T.Text where toBuilder = toBuilder . escape instance Key TL.Text where - escape x = Escaped (loop (splitQ x)) + escape x = Escaped (loop x) where - splitQ = TL.break quoteNeeded - - loop (a,b) + loop (TL.break quoteNeeded -> (a,b)) = fromLazyText a `mappend` case TL.uncons b of Nothing -> mempty - Just (c,b') -> fromWrite (quoteChar c) `mappend` - loop (splitQ b') + Just (c,b') -> quoteChar c `mappend` loop b' instance Value TL.Text where toBuilder = toBuilder . escape @@ -245,8 +235,8 @@ instance Key [Char] where escape str = Escaped (fromWriteList writeEscapedChar str) where - writeEscapedChar c | quoteNeeded c = quoteChar c - | otherwise = writeChar c + writeEscapedChar c | quoteNeeded c = quoteCharW c + | otherwise = writeChar c instance Value [Char] where toBuilder = toBuilder . escape @@ -258,22 +248,37 @@ toBuilder = toBuilder . Map.foldrWithKey (\k a b -> row k a `mappend` b) mempty +instance (Key k, Value a) => Value (HashMap.HashMap k a) where + toBuilder = toBuilder + . HashMap.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 :: Char -> Builder quoteChar c = case c of - '\\' -> writeByteString "\\\\" - '"' -> writeByteString "\\\"" - '\b' -> writeByteString "\\b" - '\f' -> writeByteString "\\f" - '\n' -> writeByteString "\\n" - '\r' -> writeByteString "\\r" - '\t' -> writeByteString "\\t" - _ -> hexEscape c + '\\' -> copyByteString "\\\\" + '"' -> copyByteString "\\\"" + '\b' -> copyByteString "\\b" + '\f' -> copyByteString "\\f" + '\n' -> copyByteString "\\n" + '\r' -> copyByteString "\\r" + '\t' -> copyByteString "\\t" + _ -> fromWrite (hexEscape c) + +quoteCharW :: Char -> Write +quoteCharW 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)