diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -64,27 +64,24 @@ ``` $ cabal bench -Preprocessing library highjson-0.1.0.0... -[1 of 1] Compiling Data.Json.Parser ( src/Data/Json/Parser.hs, dist/build/Data/Json/Parser.o ) -In-place registering highjson-0.1.0.0... -Preprocessing benchmark 'highjson-benchmarks' for highjson-0.1.0.0... -[1 of 1] Compiling Main ( bench/Twitter.hs, dist/build/highjson-benchmarks/highjson-benchmarks-tmp/Main.o ) [Data.Json.Parser changed] -Linking dist/build/highjson-benchmarks/highjson-benchmarks ... +Preprocessing library highjson-0.2.0.0... +In-place registering highjson-0.2.0.0... +Preprocessing benchmark 'highjson-benchmarks' for highjson-0.2.0.0... Running 1 benchmarks... Benchmark highjson-benchmarks: RUNNING... benchmarking twitter/aeson -time 2.200 ms (2.044 ms .. 2.349 ms) - 0.983 R² (0.975 R² .. 0.996 R²) -mean 2.065 ms (2.031 ms .. 2.120 ms) -std dev 138.3 μs (93.40 μs .. 204.8 μs) -variance introduced by outliers: 48% (moderately inflated) +time 2.148 ms (2.102 ms .. 2.187 ms) + 0.997 R² (0.995 R² .. 0.999 R²) +mean 2.137 ms (2.112 ms .. 2.169 ms) +std dev 99.12 μs (81.84 μs .. 120.1 μs) +variance introduced by outliers: 31% (moderately inflated) benchmarking twitter/highjson -time 2.058 ms (2.032 ms .. 2.087 ms) - 0.997 R² (0.994 R² .. 0.999 R²) -mean 2.077 ms (2.050 ms .. 2.115 ms) -std dev 103.6 μs (80.86 μs .. 138.0 μs) -variance introduced by outliers: 35% (moderately inflated) +time 2.196 ms (2.162 ms .. 2.235 ms) + 0.998 R² (0.996 R² .. 0.999 R²) +mean 2.222 ms (2.195 ms .. 2.252 ms) +std dev 94.52 μs (75.45 μs .. 125.1 μs) +variance introduced by outliers: 28% (moderately inflated) ``` The benchmarks are derived from [aeson](https://github.com/bos/aeson)'s diff --git a/bench/Twitter.hs b/bench/Twitter.hs --- a/bench/Twitter.hs +++ b/bench/Twitter.hs @@ -15,17 +15,24 @@ import GHC.Generics (Generic) import Prelude hiding (id) import Control.DeepSeq -import Data.Json.Parser +import Data.Json import qualified Data.ByteString as BS data Metadata = Metadata { result_type :: Text } deriving (Eq, Show, Typeable, Data, Generic) +metadataSpec = + JsonSpec Metadata $ + "result_type" .= result_type + :+: EmptySpec + instance JsonReadable Metadata where - readJson = - runParseSpec $ OnlyConstr Metadata $ "result_type" :&&: ObjSpecNil + readJson = makeParser metadataSpec +instance ToJson Metadata where + toJson = makeSerialiser metadataSpec + instance NFData Metadata data Geo = Geo { @@ -33,10 +40,18 @@ , coordinates :: (Double, Double) } deriving (Eq, Show, Typeable, Data, Generic) +geoSpec = + JsonSpec Geo $ + "type_" .= type_ + :+: "coordinates" .= coordinates + :+: EmptySpec + instance JsonReadable Geo where - readJson = - runParseSpec $ OnlyConstr Geo $ "type_" :&&: "coordinates" :&&: ObjSpecNil + readJson = makeParser geoSpec +instance ToJson Geo where + toJson = makeSerialiser geoSpec + instance NFData Geo data Story = Story { @@ -56,15 +71,30 @@ , source :: Text } deriving (Show, Typeable, Data, Generic) +storySpec = + JsonSpec Story $ + "from_user_id_str" .= from_user_id_str + :+: "profile_image_url" .= profile_image_url + :+: "created_at" .= created_at + :+: "from_user" .= from_user + :+: "id_str" .= id_str + :+: "metadata" .= metadata + :+: "to_user_id" .= to_user_id + :+: "text" .= text + :+: "id" .= id + :+: "from_user_id" .= from_user_id + :+: "geo" .= geo + :+: "iso_language_code" .= iso_language_code + :+: "to_user_id_str" .= to_user_id_str + :+: "source" .= source + :+: EmptySpec + instance JsonReadable Story where - readJson = - runParseSpec $ OnlyConstr Story $ - "from_user_id_str" :&&: "profile_image_url" :&&: "created_at" - :&&: "from_user" :&&: "id_str" :&&: "metadata" :&&: "to_user_id" - :&&: "text" :&&: "id" :&&: "from_user_id" :&&: "geo" :&&: "iso_language_code" - :&&: "to_user_id_str" :&&: "source" - :&&: ObjSpecNil + readJson = makeParser storySpec +instance ToJson Story where + toJson = makeSerialiser storySpec + instance NFData Story data Result = Result { @@ -81,13 +111,26 @@ , query :: Text } deriving (Show, Typeable, Data, Generic) +resultSpec = + JsonSpec Result $ + "results" .= results + :+: "max_id" .= max_id + :+: "since_id" .= since_id + :+: "refresh_url" .= refresh_url + :+: "next_page" .= next_page + :+: "results_per_page" .= results_per_page + :+: "page" .= page + :+: "completed_in" .= completed_in + :+: "since_id_str" .= since_id_str + :+: "max_id_str" .= max_id_str + :+: "query" .= query + :+: EmptySpec + instance JsonReadable Result where - readJson = - runParseSpec $ OnlyConstr Result $ - "results" :&&: "max_id" :&&: "since_id" :&&: "refresh_url" :&&: "next_page" - :&&: "results_per_page" :&&: "page" :&&: "completed_in" :&&: "since_id_str" - :&&: "max_id_str" :&&: "query" - :&&: ObjSpecNil + readJson = makeParser resultSpec + +instance ToJson Result where + toJson = makeSerialiser resultSpec instance NFData Result diff --git a/highjson.cabal b/highjson.cabal --- a/highjson.cabal +++ b/highjson.cabal @@ -1,5 +1,5 @@ name: highjson -version: 0.2.0.0 +version: 0.2.0.1 synopsis: Very fast JSON serialisation and parsing library description: Low boilerplate, easy to use and very fast JSON serialisation and parsing homepage: https://github.com/agrafix/highjson @@ -50,7 +50,7 @@ text, QuickCheck >=2.8 default-language: Haskell2010 - ghc-options: -Wall + ghc-options: -Wall -fno-warn-orphans source-repository head type: git diff --git a/src/Data/Json.hs b/src/Data/Json.hs --- a/src/Data/Json.hs +++ b/src/Data/Json.hs @@ -78,7 +78,7 @@ -- non-sum types using 'JsonSpec'. data JsonSumSpec k = JsonSumSpec - { js_parser :: !P.ParseSpec k + { js_parser :: !(P.ParseSpec k) , js_serialiser :: !(k -> S.KeyedSerialiser k) } diff --git a/src/Data/Json/Serialiser.hs b/src/Data/Json/Serialiser.hs --- a/src/Data/Json/Serialiser.hs +++ b/src/Data/Json/Serialiser.hs @@ -16,6 +16,7 @@ where import Data.BufferBuilder.Json +import Data.Int import Data.Monoid import Data.Typeable import qualified Data.ByteString as BS @@ -28,6 +29,15 @@ case x of Left y -> toJson y Right z -> toJson z + +instance (ToJson a, ToJson b) => ToJson (a, b) where + toJson (x, y) = toJson [ toJson x, toJson y ] + +instance ToJson Int64 where + toJson i = + let j :: Int + j = fromIntegral i + in toJson j -- | A json key and a getter data SpecKey k t