json-builder 0.0.1 → 0.1.0

raw patch · 3 files changed

+173/−98 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• json-builder.cabal +3/−2
• src/Data/Json/Builder.hs +99/−96
• src/Data/Json/Builder/Internal.hs +71/−0

@@ -1,5 +1,5 @@ Name:                json-builder-Version:             0.0.1+Version:             0.1.0 Synopsis:            Data structure agnostic JSON serialization License:             BSD3 License-file:        LICENSE@@ -26,6 +26,7 @@ Library   hs-source-dirs: src   Exposed-modules:     Data.Json.Builder+                       Data.Json.Builder.Internal    Build-depends:       base >= 4 && < 5,                        blaze-builder,@@ -43,4 +44,4 @@ source-repository this   type:     git   location: http://github.com/lpsmith/json-builder-  tag:      v0.0.1+  tag:      v0.1.0

@@ -10,23 +10,28 @@ -- ----------------------------------------------------------------------------- -{-# LANGUAGE BangPatterns               #-}-{-# LANGUAGE ViewPatterns               #-}-{-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE FlexibleInstances          #-}-{-# LANGUAGE IncoherentInstances        #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE BangPatterns        #-}+{-# LANGUAGE ViewPatterns        #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE IncoherentInstances #-}  module Data.Json.Builder-     ( Key  (..)-     , Value(..)-     , Object-     , row+     ( Value(toJson)+     , Json+     , toBuilder+     , toJsonByteString+     , toJsonLazyByteString      , Array      , element-     , Escaped(..)+     , Object+     , row+     , JsString(escape)+     , Escaped      ) where +import           Prelude hiding ((++))+ import           Blaze.ByteString.Builder as Blaze                    ( Write                    , Builder@@ -36,7 +41,9 @@                    , writeByteString                    , fromWrite                    , fromWriteList-                   , writeWord8         )+                   , writeWord8+                   , toByteString+                   , toLazyByteString    ) import           Blaze.ByteString.Builder.Char.Utf8                    ( fromChar, writeChar, fromText, fromLazyText ) import           Blaze.Text (float, double, integral)@@ -60,72 +67,64 @@  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-  escape           :: a -> Escaped---- | The 'Value' typeclass represents types that can be rendered--- into valid json syntax.--class Value a where-  toBuilder        :: a -> Blaze.Builder+import           Data.Json.Builder.Internal --- | 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.)+(++) :: Monoid a => a -> a -> a+(++) = mappend+infixr 5 ++ -newtype Escaped = Escaped Blaze.Builder deriving (Monoid)+toBuilder :: Value a => a -> Builder+toBuilder x = case toJson x of+                Json y -> y+{-# SPECIALIZE toBuilder :: Json -> Builder #-}+{-# INLINE toBuilder #-} -instance Key Escaped where-  escape = id+toJsonByteString     :: Value a => a -> BS.ByteString+toJsonByteString     = toByteString     . toBuilder -instance Value Escaped where-  toBuilder (Escaped str) = fromChar '"' `mappend` str `mappend` fromChar '"'+toJsonLazyByteString :: Value a => a -> BL.ByteString+toJsonLazyByteString = toLazyByteString . toBuilder -type CommaTracker = (Bool -> Blaze.Builder) -> Bool -> Blaze.Builder+type CommaTracker = (Bool -> Builder) -> Bool -> Builder -comma :: Blaze.Builder -> CommaTracker-comma b f True  =                        b `mappend` f False-comma b f False = fromChar ',' `mappend` b `mappend` f False+comma :: Builder -> CommaTracker+comma b f True  =                 b ++ f False+comma b f False = fromChar ',' ++ b ++ 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.+-- |  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-  toBuilder (Object f) = fromChar '{' `mappend` f (\_ -> fromChar '}') True+  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' constructs a json object consisting of exactly one field.--- These objects can be concatinated using 'mappend'.-row :: (Key k, Value a) => k -> a -> Object+-- |  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 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.+-- |  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-  toBuilder (Array f) = fromChar '[' `mappend` f (\_ -> fromChar ']') True+  toJson (Array f) = Json (fromChar '[' ++ f (\_ -> fromChar ']') True)  instance Monoid Array where   mempty = Array id@@ -138,119 +137,123 @@  -- Primitive instances for json-builder +-- | renders as @null@ instance Value () where-  toBuilder _ = copyByteString "null"+  toJson _ = Json (copyByteString "null")  instance Value Int     where-  toBuilder = integral+  toJson = Json . integral  instance Value Int8    where-  toBuilder = integral+  toJson = Json . integral  instance Value Int16   where-  toBuilder = integral+  toJson = Json . integral  instance Value Int32   where-  toBuilder = integral+  toJson = Json . integral  instance Value Int64   where-  toBuilder = integral+  toJson = Json . integral  instance Value Integer where-  toBuilder = integral+  toJson = Json . integral  instance Value Word    where-  toBuilder = integral+  toJson = Json . integral  instance Value Word8   where-  toBuilder = integral+  toJson = Json . integral  instance Value Word16  where-  toBuilder = integral+  toJson = Json . integral  instance Value Word32  where-  toBuilder = integral+  toJson = Json . integral  instance Value Word64  where-  toBuilder = integral+  toJson = Json . integral  instance Value Double where-  toBuilder = double+  toJson = Json . double  instance Value Float where-  toBuilder = float+  toJson = Json . float +-- | renders as @true@ or @false@+ instance Value Bool where-  toBuilder True  = copyByteString "true"-  toBuilder False = copyByteString "false"+  toJson True  = Json (copyByteString "true")+  toJson False = Json (copyByteString "false") -instance Key BS.ByteString where+instance JsString BS.ByteString where   escape x = Escaped (loop x)     where       loop (BU.break quoteNeeded -> (a,b))-        = fromByteString a `mappend`+        = fromByteString a ++             case BU.decode b of               Nothing     ->  mempty-              Just (c,n)  ->  quoteChar c `mappend` loop (BS.drop n b)+              Just (c,n)  ->  quoteChar c ++ loop (BS.drop n b)  instance Value BS.ByteString where-  toBuilder = toBuilder . escape+  toJson = toJson . escape -instance Key BL.ByteString where+instance JsString BL.ByteString where   escape x = Escaped (loop x)     where       loop (BLU.break quoteNeeded -> (a,b))-        = fromLazyByteString a `mappend`+        = fromLazyByteString a ++             case BLU.decode b of               Nothing     ->  mempty-              Just (c,n)  ->  quoteChar c `mappend` loop (BL.drop n b)+              Just (c,n)  ->  quoteChar c ++ loop (BL.drop n b)  instance Value BL.ByteString where-  toBuilder = toBuilder . escape+  toJson = toJson . escape -instance Key T.Text where+instance JsString T.Text where   escape x = Escaped (loop x)     where       loop (T.break quoteNeeded -> (a,b))-        = fromText a `mappend`+        = fromText a ++             case T.uncons b of               Nothing      ->  mempty-              Just (c,b')  ->  quoteChar c `mappend` loop b'+              Just (c,b')  ->  quoteChar c ++ loop b'  instance Value T.Text where-  toBuilder = toBuilder . escape+  toJson = toJson . escape -instance Key TL.Text where+instance JsString TL.Text where   escape x = Escaped (loop x)     where       loop (TL.break quoteNeeded -> (a,b))-        = fromLazyText a `mappend`+        = fromLazyText a ++             case TL.uncons b of               Nothing      ->  mempty-              Just (c,b')  ->  quoteChar c `mappend` loop b'+              Just (c,b')  ->  quoteChar c ++ loop b'  instance Value TL.Text where-  toBuilder = toBuilder . escape+  toJson = toJson . escape -instance Key [Char] where+instance JsString [Char] where   escape str = Escaped (fromWriteList writeEscapedChar str)     where       writeEscapedChar c | quoteNeeded c = quoteCharW c                          | otherwise     = writeChar  c  instance Value [Char] where-  toBuilder = toBuilder . escape+  toJson = toJson . escape +-- | renders as an 'Array' instance Value a => Value [a] where-  toBuilder = toBuilder . mconcat . map element+  toJson = toJson . 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+-- | renders as an 'Object'+instance (JsString k, Value a) => Value (Map.Map k a) where+  toJson = toJson . Map.foldrWithKey     (\k a b -> row k a ++ 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+-- | renders as an 'Object'+instance (JsString k, Value a) => Value (HashMap.HashMap k a) where+  toJson = toJson . HashMap.foldrWithKey (\k a b -> row k a ++ b) mempty  ------------------------------------------------------------------------------ @@ -283,8 +286,8 @@ hexEscape  :: Char -> Write hexEscape  (c2w -> c)   = writeByteString "\\u00"-    `mappend` writeWord8 (char ((c `shiftR` 4) .&. 0xF))-    `mappend` writeWord8 (char ( c             .&. 0xF))+    ++ writeWord8 (char ((c `shiftR` 4) .&. 0xF))+    ++ writeWord8 (char ( c             .&. 0xF))  char :: Word8 -> Word8 char i | i < 10    = i + 48

@@ -0,0 +1,71 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Json.Builder.Internal+-- Copyright   :  (c) 2011 Leon P Smith+-- License     :  BSD3+--+-- Maintainer  :  Leon P Smith <leon@melding-monads.com>+--+-- Internal bits.   You can break this library's abstraction and emit+-- invalid Json syntax the constructors provided in this module.+-----------------------------------------------------------------------------++{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Data.Json.Builder.Internal+     ( Value   (..)+     , Json    (..)+     , JsString(..)+     , Escaped (..)+     ) where++import Prelude hiding ((++))++import Blaze.ByteString.Builder+import Blaze.ByteString.Builder.Char.Utf8 ( fromChar )+import Data.ByteString(ByteString)+import Data.Monoid++(++) :: Monoid a => a -> a -> a+(++) = mappend+infixr 5 ++++-- | The 'Value' typeclass represents types that can be rendered+-- into valid json syntax.++class Value a where+  toJson :: a -> Json++-- | The 'Json' type represents valid json syntax.  It cannot be directly+-- analyzed, however it can be rendered into a 'ByteString' and used to+-- as a component of an array or an object to build a bigger json value.++newtype Json = Json Builder++instance Value Json where+  toJson = id++-- | The 'String' typeclass represents types that render into json string+-- syntax.  They are special because only strings can appear as field names+-- of json objects.++class Value a => JsString a where+  escape :: a -> Escaped++-- | The 'Escaped' type represents json string syntax.  The purpose of this+-- type is so that json strings can be efficiently constructed from multiple+-- Haskell strings without superfluous conversions or concatinations.+--+-- Internally, it is just a 'Builder' value which must produce a UTF-8 encoded+-- bytestring with backslashes,  quotes,  and control characters appropriately+-- escaped.   It also must not render the opening or closing quote,  which+-- are instead rendered by 'toJson'.++newtype Escaped = Escaped Builder deriving (Monoid)++instance Value    Escaped where+  toJson (Escaped str) = Json (fromChar '"' ++ str ++ fromChar '"')++instance JsString Escaped where+  escape = id+