json-bytes-builder 0.5 → 0.5.1
raw patch · 6 files changed
+316/−11 lines, 6 filesdep +aesondep +criteriondep +rebasePVP ok
version bump matches the API change (PVP)
Dependencies added: aeson, criterion, rebase
API changes (from Hackage documentation)
Files
- benchmark/Main.hs +26/−0
- benchmark/Main/Aeson.hs +129/−0
- benchmark/Main/JSONBytesBuilder.hs +54/−0
- benchmark/Main/Model.hs +66/−0
- json-bytes-builder.cabal +37/−11
- library/JSONBytesBuilder/Private/Builder.hs +4/−0
+ benchmark/Main.hs view
@@ -0,0 +1,26 @@+module Main where++import Rebase.Prelude+import Criterion.Main+import qualified Main.Model+import qualified Main.JSONBytesBuilder+import qualified Main.Aeson+import qualified Data.Aeson+import qualified Rebase.Data.ByteString.Lazy+import qualified JSONBytesBuilder.ByteString.ByteString+import qualified JSONBytesBuilder.ByteString.LazyByteString++main =+ do+ input <- load "samples/twitter100.json"+ defaultMain+ [+ bench "strict" (nf (JSONBytesBuilder.ByteString.ByteString.jsonLiteral . Main.JSONBytesBuilder.result) input)+ ,+ bench "lazy" (nf (JSONBytesBuilder.ByteString.LazyByteString.jsonLiteral . Main.JSONBytesBuilder.result) input)+ ]++load :: FilePath -> IO Main.Model.Result+load fileName =+ (=<<) (either fail return . Data.Aeson.eitherDecode') $+ Rebase.Data.ByteString.Lazy.readFile fileName
+ benchmark/Main/Aeson.hs view
@@ -0,0 +1,129 @@+module Main.Aeson where++import Rebase.Prelude+import Main.Model+import Data.Aeson hiding (Result)+++instance ToJSON Metadata where+ toJSON Metadata{..} = object [+ "result_type" .= result_type+ ]++ toEncoding Metadata{..} = pairs $+ "result_type" .= result_type++instance FromJSON Metadata where+ parseJSON (Object v) = Metadata <$> v .: "result_type"+ parseJSON _ = empty++instance ToJSON Geo where+ toJSON Geo{..} = object [+ "type_" .= type_+ , "coordinates" .= coordinates+ ]++ toEncoding Geo{..} = pairs $+ "type_" .= type_+ <> "coordinates" .= coordinates++instance FromJSON Geo where+ parseJSON (Object v) = Geo <$>+ v .: "type_"+ <*> v .: "coordinates"+ parseJSON _ = empty++instance ToJSON Story where+ toJSON Story{..} = object [+ "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+ ]++ toEncoding Story{..} = pairs $+ "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++instance FromJSON Story where+ parseJSON (Object v) = Story <$>+ v .: "from_user_id_str"+ <*> v .: "profile_image_url"+ <*> v .: "created_at"+ <*> v .: "from_user"+ <*> v .: "id_str"+ <*> v .: "metadata"+ <*> v .: "to_user_id"+ <*> v .: "text"+ <*> v .: "id"+ <*> v .: "from_user_id"+ <*> v .: "geo"+ <*> v .: "iso_language_code"+ <*> v .: "to_user_id_str"+ <*> v .: "source"+ parseJSON _ = empty++instance ToJSON Result where+ toJSON Result{..} = object [+ "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+ ]++ toEncoding Result{..} = pairs $+ "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++instance FromJSON Result where+ parseJSON (Object v) = Result <$>+ v .: "results"+ <*> v .: "max_id"+ <*> v .: "since_id"+ <*> v .: "refresh_url"+ <*> v .: "next_page"+ <*> v .: "results_per_page"+ <*> v .: "page"+ <*> v .: "completed_in"+ <*> v .: "since_id_str"+ <*> v .: "max_id_str"+ <*> v .: "query"+ parseJSON _ = empty
+ benchmark/Main/JSONBytesBuilder.hs view
@@ -0,0 +1,54 @@+module Main.JSONBytesBuilder where++import Rebase.Prelude hiding (null)+import JSONBytesBuilder.Builder+import qualified Main.Model as A+++result :: A.Result -> Literal+result x =+ object $+ row "results" (array (foldMap (element . story) (A.results x))) <>+ row "max_id" ((numberFromInt . fromIntegral) (A.max_id x)) <>+ row "since_id" ((numberFromInt . fromIntegral) (A.since_id x)) <>+ row "refresh_url" (stringFromText (A.refresh_url x)) <>+ row "next_page" (stringFromText (A.next_page x)) <>+ row "results_per_page" ((numberFromInt . fromIntegral) (A.results_per_page x)) <>+ row "page" ((numberFromInt . fromIntegral) (A.page x)) <>+ row "completed_in" (numberFromDouble (A.completed_in x)) <>+ row "since_id_str" (stringFromText (A.since_id_str x)) <>+ row "max_id_str" (stringFromText (A.max_id_str x)) <>+ row "query" (stringFromText (A.query x))++story :: A.Story -> Literal+story x =+ object $+ row "from_user_id_str" (stringFromText (A.from_user_id_str x)) <>+ row "profile_image_url" (stringFromText (A.profile_image_url x)) <>+ row "created_at" (stringFromText (A.created_at x)) <>+ row "from_user" (stringFromText (A.from_user x)) <>+ row "id_str" (stringFromText (A.id_str x)) <>+ row "metadata" (metadata (A.metadata x)) <>+ row "to_user_id" (maybe null (numberFromInt . fromIntegral) (A.to_user_id x)) <>+ row "text" (stringFromText (A.text x)) <>+ row "id" ((numberFromInt . fromIntegral) (A.id x)) <>+ row "from_user_id" ((numberFromInt . fromIntegral) (A.from_user_id x)) <>+ row "geo" (maybe null geo (A.geo x)) <>+ row "iso_language_code" (stringFromText (A.iso_language_code x)) <>+ row "to_user_id_str" (maybe null stringFromText (A.to_user_id_str x)) <>+ row "source" (stringFromText (A.source x))++geo :: A.Geo -> Literal+geo x =+ object $+ row "type_" (stringFromText (A.type_ x)) <>+ row "coordinates" (coordinates (A.coordinates x))++coordinates :: (Double, Double) -> Literal+coordinates (x, y) =+ array (element (numberFromDouble x) <> element (numberFromDouble y))++metadata :: A.Metadata -> Literal+metadata x =+ object $+ row "result_type" (stringFromText (A.result_type x))
+ benchmark/Main/Model.hs view
@@ -0,0 +1,66 @@+module Main.Model+(+ Metadata(..),+ Geo(..),+ Story(..),+ Result(..)+)+where++import Rebase.Prelude hiding (id)++data Metadata =+ Metadata {+ result_type :: Text+ }+ deriving (Eq, Show, Typeable, Data, Generic)++instance NFData Metadata++data Geo =+ Geo {+ type_ :: Text,+ coordinates :: (Double, Double)+ }+ deriving (Eq, Show, Typeable, Data, Generic)++instance NFData Geo++data Story =+ Story {+ from_user_id_str :: Text,+ profile_image_url :: Text,+ created_at :: Text,+ from_user :: Text,+ id_str :: Text,+ metadata :: Metadata,+ to_user_id :: Maybe Int64,+ text :: Text,+ id :: Int64,+ from_user_id :: Int64,+ geo :: Maybe Geo,+ iso_language_code :: Text,+ to_user_id_str :: Maybe Text,+ source :: Text+ }+ deriving (Show, Typeable, Data, Generic)++instance NFData Story++data Result =+ Result {+ results :: [Story],+ max_id :: Int64,+ since_id :: Int64,+ refresh_url :: Text,+ next_page :: Text,+ results_per_page :: Int,+ page :: Int,+ completed_in :: Double,+ since_id_str :: Text,+ max_id_str :: Text,+ query :: Text+ }+ deriving (Show, Typeable, Data, Generic)++instance NFData Result
json-bytes-builder.cabal view
@@ -1,7 +1,7 @@ name: json-bytes-builder version:- 0.5+ 0.5.1 synopsis: Direct-to-bytes JSON Builder description:@@ -9,7 +9,7 @@ which is faster and simpler than \"aeson\". . Check out- <http://hackage.haskell.org/package/json-bytes-builder-0.3/src/demo/Main.hs the demo>.+ <http://hackage.haskell.org/package/json-bytes-builder-0.5/src/demo/Main.hs the demo>. category: JSON, Codecs homepage:@@ -31,19 +31,17 @@ cabal-version: >=1.10 - source-repository head type: git location: git://github.com/nikita-volkov/json-bytes-builder.git - library hs-source-dirs: library default-extensions:- Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+ Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, PatternSynonyms, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples default-language: Haskell2010 other-modules:@@ -64,11 +62,7 @@ base-prelude < 2, base >= 4.7 && < 5 ---- Well, it's not a benchmark actually, --- but Cabal provides no better way to specify an executable, --- which is not intended for distribution.-benchmark demo+test-suite demo type: exitcode-stdio-1.0 hs-source-dirs:@@ -76,7 +70,7 @@ main-is: Main.hs default-extensions:- Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+ Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, PatternSynonyms, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples default-language: Haskell2010 build-depends:@@ -84,3 +78,35 @@ text, bytestring, base-prelude++benchmark benchmark+ type: + exitcode-stdio-1.0+ hs-source-dirs:+ benchmark+ main-is:+ Main.hs+ other-modules:+ Main.Model+ Main.JSONBytesBuilder+ Main.Aeson+ ghc-options:+ -O2+ -threaded+ "-with-rtsopts=-N"+ ghc-prof-options:+ -O2+ -threaded+ -fprof-auto+ "-with-rtsopts=-N -p -s -h -i0.1"+ default-extensions:+ Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, PatternSynonyms, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+ default-language:+ Haskell2010+ build-depends:+ json-bytes-builder,+ -- benchmarking:+ criterion == 1.1.*,+ -- + aeson >= 0.10 && < 2,+ rebase == 1.*
library/JSONBytesBuilder/Private/Builder.hs view
@@ -34,6 +34,8 @@ Rows Nothing -> id +instance Semigroup Rows+ -- | -- Builder of JSON Array elements. newtype Elements =@@ -54,6 +56,8 @@ Elements (Just left) Elements Nothing -> id++instance Semigroup Elements -- | -- JSON Null literal.