json-builder 0.0 → 0.0.1

raw patch · 2 files changed

+58/−52 lines, 2 filesdep +unordered-containersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: unordered-containers

API changes (from Hackage documentation)

Files

• json-builder.cabal +6/−5
• src/Data/Json/Builder.hs +52/−47

@@ -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

@@ -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)