diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -1,27 +1,25 @@ module Main where -import Prelude -import Gauge.Main -import qualified Main.Model as Model -import qualified Main.Jsonifier -import qualified Main.Aeson -import qualified Main.BufferBuilder as BufferBuilder import qualified Data.Aeson -import qualified Data.ByteString.Lazy import qualified Data.ByteString.Char8 as Char8ByteString +import qualified Data.ByteString.Lazy +import Gauge.Main import qualified Jsonifier +import qualified Main.Aeson +import qualified Main.BufferBuilder as BufferBuilder +import qualified Main.Jsonifier +import qualified Main.Model as Model import qualified Text.Builder as TextBuilder - +import Prelude main = do twitter1Data <- load "samples/twitter1.json" twitter10Data <- load "samples/twitter10.json" twitter100Data <- load "samples/twitter100.json" - let - twitter1000Data = mapResultsOfResult (concat . replicate 10) twitter100Data - twitter10000Data = mapResultsOfResult (concat . replicate 10) twitter1000Data - twitter100000Data = mapResultsOfResult (concat . replicate 10) twitter10000Data + let twitter1000Data = mapResultsOfResult (concat . replicate 10) twitter100Data + twitter10000Data = mapResultsOfResult (concat . replicate 10) twitter1000Data + twitter100000Data = mapResultsOfResult (concat . replicate 10) twitter10000Data -- Ensure that encoders are correct test "jsonifier" encodeWithJsonifier twitter10Data @@ -29,52 +27,44 @@ test "aeson" encodeWithAeson twitter10Data -- Print out the data sizes of samples - TextBuilder.putLnToStdOut $ let - sampleDataSize = - TextBuilder.dataSizeInBytesInDecimal ',' . - Char8ByteString.length . - encodeWithJsonifier - sample sampleName sampleData = - "- " <> TextBuilder.text sampleName <> ": " <> - sampleDataSize sampleData - in - "Input data sizes report:\n" <> - sample "twitter with 1 objects" twitter1Data <> "\n" <> - sample "twitter with 10 objects" twitter10Data <> "\n" <> - sample "twitter with 100 objects" twitter100Data <> "\n" <> - sample "twitter with 1,000 objects" twitter1000Data <> "\n" <> - sample "twitter with 10,000 objects" twitter10000Data <> "\n" <> - sample "twitter with 100,000 objects" twitter100000Data - - let - - benchInput :: String -> Model.Result -> Benchmark - benchInput name input = - bgroup name [ - bench "jsonifier" (nf encodeWithJsonifier input) - , - bench "aeson" (nf encodeWithAeson input) - , - bench "lazy-aeson" (nf encodeWithLazyAeson input) - , - bench "lazy-aeson-untrimmed-32k" (nf Main.Aeson.resultToLazyByteStringWithUntrimmedStrategy input) - , - bench "buffer-builder" (nf BufferBuilder.encodeResult input) - ] + TextBuilder.putLnToStdOut $ + let sampleDataSize = + TextBuilder.dataSizeInBytesInDecimal ',' + . Char8ByteString.length + . encodeWithJsonifier + sample sampleName sampleData = + "- " <> TextBuilder.text sampleName <> ": " + <> sampleDataSize sampleData + in "Input data sizes report:\n" + <> sample "twitter with 1 objects" twitter1Data + <> "\n" + <> sample "twitter with 10 objects" twitter10Data + <> "\n" + <> sample "twitter with 100 objects" twitter100Data + <> "\n" + <> sample "twitter with 1,000 objects" twitter1000Data + <> "\n" + <> sample "twitter with 10,000 objects" twitter10000Data + <> "\n" + <> sample "twitter with 100,000 objects" twitter100000Data - in - defaultMain [ - benchInput "1kB" twitter1Data - , - benchInput "6kB" twitter10Data - , - benchInput "60kB" twitter100Data - , - benchInput "600kB" twitter1000Data - , - benchInput "6MB" twitter10000Data - , - benchInput "60MB" twitter100000Data + let benchInput :: String -> Model.Result -> Benchmark + benchInput name input = + bgroup + name + [ bench "jsonifier" (nf encodeWithJsonifier input), + bench "aeson" (nf encodeWithAeson input), + bench "lazy-aeson" (nf encodeWithLazyAeson input), + bench "lazy-aeson-untrimmed-32k" (nf Main.Aeson.resultToLazyByteStringWithUntrimmedStrategy input), + bench "buffer-builder" (nf BufferBuilder.encodeResult input) + ] + in defaultMain + [ benchInput "1kB" twitter1Data, + benchInput "6kB" twitter10Data, + benchInput "60kB" twitter100Data, + benchInput "600kB" twitter1000Data, + benchInput "6MB" twitter10000Data, + benchInput "60MB" twitter100000Data ] load :: FilePath -> IO Model.Result @@ -87,16 +77,14 @@ a {Model.results = f (Model.results a)} test name strictEncoder input = - let encoding = strictEncoder input in - case Data.Aeson.eitherDecodeStrict' encoding of - Right decoding -> - if decoding == input - then - return () - else - fail ("Encoder " <> name <> " encodes incorrectly.\nOutput:\n" <> Char8ByteString.unpack encoding) - Left err -> - fail ("Encoder " <> name <> " failed: " <> err <> ".\nOutput:\n" <> Char8ByteString.unpack encoding) + let encoding = strictEncoder input + in case Data.Aeson.eitherDecodeStrict' encoding of + Right decoding -> + if decoding == input + then return () + else fail ("Encoder " <> name <> " encodes incorrectly.\nOutput:\n" <> Char8ByteString.unpack encoding) + Left err -> + fail ("Encoder " <> name <> " failed: " <> err <> ".\nOutput:\n" <> Char8ByteString.unpack encoding) encodeWithJsonifier = Jsonifier.toByteString . Main.Jsonifier.resultJson diff --git a/bench/Main/Aeson.hs b/bench/Main/Aeson.hs --- a/bench/Main/Aeson.hs +++ b/bench/Main/Aeson.hs @@ -1,12 +1,11 @@ module Main.Aeson where -import Prelude -import Main.Model import Data.Aeson hiding (Result) -import qualified Data.ByteString.Lazy as Lbs import qualified Data.ByteString.Builder as ByteStringBuilder import qualified Data.ByteString.Builder.Extra as ByteStringBuilder - +import qualified Data.ByteString.Lazy as Lbs +import Main.Model +import Prelude resultToLazyByteStringWithUntrimmedStrategy :: Result -> Lbs.ByteString resultToLazyByteStringWithUntrimmedStrategy = @@ -20,124 +19,135 @@ fromEncoding . toEncoding instance ToJSON Metadata where - toJSON Metadata{..} = object [ - "result_type" .= result_type - ] + toJSON Metadata {..} = + object + [ "result_type" .= result_type + ] - toEncoding Metadata{..} = pairs $ - "result_type" .= result_type + toEncoding Metadata {..} = + pairs $ + "result_type" .= result_type instance FromJSON Metadata where parseJSON (Object v) = Metadata <$> v .: "result_type" - parseJSON _ = empty + parseJSON _ = empty instance ToJSON Geo where - toJSON Geo{..} = object [ - "type_" .= type_ - , "coordinates" .= coordinates - ] + toJSON Geo {..} = + object + [ "type_" .= type_, + "coordinates" .= coordinates + ] - toEncoding Geo{..} = pairs $ - "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 + 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 - ] + 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 + 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 (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 - ] + 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 + 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 (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 diff --git a/bench/Main/BufferBuilder.hs b/bench/Main/BufferBuilder.hs --- a/bench/Main/BufferBuilder.hs +++ b/bench/Main/BufferBuilder.hs @@ -1,58 +1,57 @@ module Main.BufferBuilder where -import Prelude import Data.BufferBuilder.Json import qualified Main.Model as M - +import Prelude encodeResult :: M.Result -> ByteString encodeResult = encodeJson instance ToJson M.Geo where - toJson M.Geo{..} = + toJson M.Geo {..} = toJson $ - "type_"# .=# toJson type_ <> - "coordinates"# .=# toJson coordinates + "type_"# .=# toJson type_ + <> "coordinates"# .=# toJson coordinates instance ToJson (Double, Double) where toJson (a, b) = toJson [toJson a, toJson b] instance ToJson M.Story where - toJson M.Story{..} = + toJson M.Story {..} = toJson $ - "from_user_id_str"# .=# toJson from_user_id_str <> - "profile_image_url"# .=# toJson profile_image_url <> - "created_at"# .=# toJson created_at <> - "from_user"# .=# toJson from_user <> - "id_str"# .=# toJson id_str <> - "metadata"# .=# toJson metadata <> - "to_user_id"# .=# toJson to_user_id <> - "text"# .=# toJson text <> - "id"# .=# toJson id <> - "from_user_id"# .=# toJson from_user_id <> - "geo"# .=# toJson geo <> - "iso_language_code"# .=# toJson iso_language_code <> - "to_user_id_str"# .=# toJson to_user_id_str <> - "source"# .=# toJson source + "from_user_id_str"# .=# toJson from_user_id_str + <> "profile_image_url"# .=# toJson profile_image_url + <> "created_at"# .=# toJson created_at + <> "from_user"# .=# toJson from_user + <> "id_str"# .=# toJson id_str + <> "metadata"# .=# toJson metadata + <> "to_user_id"# .=# toJson to_user_id + <> "text"# .=# toJson text + <> "id"# .=# toJson id + <> "from_user_id"# .=# toJson from_user_id + <> "geo"# .=# toJson geo + <> "iso_language_code"# .=# toJson iso_language_code + <> "to_user_id_str"# .=# toJson to_user_id_str + <> "source"# .=# toJson source instance ToJson M.Metadata where - toJson M.Metadata{..} = + toJson M.Metadata {..} = toJson $ "result_type"# .=# toJson result_type instance ToJson M.Result where - toJson M.Result{..} = + toJson M.Result {..} = toJson $ - "results"# .=# toJson results <> - "max_id"# .=# toJson max_id <> - "since_id"# .=# toJson since_id <> - "refresh_url"# .=# toJson refresh_url <> - "next_page"# .=# toJson next_page <> - "results_per_page"# .=# toJson results_per_page <> - "page"# .=# toJson page <> - "completed_in"# .=# toJson completed_in <> - "since_id_str"# .=# toJson since_id_str <> - "max_id_str"# .=# toJson max_id_str <> - "query"# .=# toJson query + "results"# .=# toJson results + <> "max_id"# .=# toJson max_id + <> "since_id"# .=# toJson since_id + <> "refresh_url"# .=# toJson refresh_url + <> "next_page"# .=# toJson next_page + <> "results_per_page"# .=# toJson results_per_page + <> "page"# .=# toJson page + <> "completed_in"# .=# toJson completed_in + <> "since_id_str"# .=# toJson since_id_str + <> "max_id_str"# .=# toJson max_id_str + <> "query"# .=# toJson query diff --git a/bench/Main/Jsonifier.hs b/bench/Main/Jsonifier.hs --- a/bench/Main/Jsonifier.hs +++ b/bench/Main/Jsonifier.hs @@ -1,61 +1,60 @@ module Main.Jsonifier where -import Prelude hiding (null, bool) import Jsonifier import qualified Main.Model as A - +import Prelude hiding (bool, null) resultJson :: A.Result -> Json -resultJson A.Result{..} = - object [ - ("results", array (fmap storyJson results)), - ("max_id", intNumber max_id), - ("since_id", intNumber since_id), - ("refresh_url", textString refresh_url), - ("next_page", textString next_page), - ("results_per_page", intNumber results_per_page), - ("page", intNumber page), - ("completed_in", doubleNumber completed_in), - ("since_id_str", textString since_id_str), - ("max_id_str", textString max_id_str), - ("query", textString query) +resultJson A.Result {..} = + object + [ ("results", array (fmap storyJson results)), + ("max_id", intNumber max_id), + ("since_id", intNumber since_id), + ("refresh_url", textString refresh_url), + ("next_page", textString next_page), + ("results_per_page", intNumber results_per_page), + ("page", intNumber page), + ("completed_in", doubleNumber completed_in), + ("since_id_str", textString since_id_str), + ("max_id_str", textString max_id_str), + ("query", textString query) ] storyJson :: A.Story -> Json -storyJson A.Story{..} = - object [ - ("from_user_id_str", textString from_user_id_str), - ("profile_image_url", textString profile_image_url), - ("created_at", textString created_at), - ("from_user", textString from_user), - ("id_str", textString id_str), - ("metadata", metadataJson metadata), - ("to_user_id", maybe null intNumber to_user_id), - ("text", textString text), - ("id", intNumber id), - ("from_user_id", intNumber from_user_id), - ("geo", maybe null geoJson geo), - ("iso_language_code", textString iso_language_code), - ("to_user_id_str", maybe null textString to_user_id_str), - ("source", textString source) +storyJson A.Story {..} = + object + [ ("from_user_id_str", textString from_user_id_str), + ("profile_image_url", textString profile_image_url), + ("created_at", textString created_at), + ("from_user", textString from_user), + ("id_str", textString id_str), + ("metadata", metadataJson metadata), + ("to_user_id", maybe null intNumber to_user_id), + ("text", textString text), + ("id", intNumber id), + ("from_user_id", intNumber from_user_id), + ("geo", maybe null geoJson geo), + ("iso_language_code", textString iso_language_code), + ("to_user_id_str", maybe null textString to_user_id_str), + ("source", textString source) ] geoJson :: A.Geo -> Json -geoJson A.Geo{..} = - object [ - ("type_", textString type_), - ("coordinates", coordinatesJson coordinates) +geoJson A.Geo {..} = + object + [ ("type_", textString type_), + ("coordinates", coordinatesJson coordinates) ] coordinatesJson :: (Double, Double) -> Json coordinatesJson (x, y) = - array [ - doubleNumber x, - doubleNumber y + array + [ doubleNumber x, + doubleNumber y ] metadataJson :: A.Metadata -> Json -metadataJson A.Metadata{..} = - object [ - ("result_type", textString result_type) +metadataJson A.Metadata {..} = + object + [ ("result_type", textString result_type) ] diff --git a/bench/Main/Model.hs b/bench/Main/Model.hs --- a/bench/Main/Model.hs +++ b/bench/Main/Model.hs @@ -1,65 +1,60 @@ module Main.Model -( - Metadata(..), - Geo(..), - Story(..), - Result(..) -) + ( Metadata (..), + Geo (..), + Story (..), + Result (..), + ) where import Prelude hiding (id) -data Metadata = - Metadata { - result_type :: Text +data Metadata = Metadata + { result_type :: Text } deriving (Eq, Show, Typeable, Data, Generic) instance NFData Metadata -data Geo = - Geo { - type_ :: Text, +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, +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 Int, - text :: Text, - id :: Int, - from_user_id :: Int, - geo :: Maybe Geo, + created_at :: Text, + from_user :: Text, + id_str :: Text, + metadata :: Metadata, + to_user_id :: Maybe Int, + text :: Text, + id :: Int, + from_user_id :: Int, + geo :: Maybe Geo, iso_language_code :: Text, - to_user_id_str :: Maybe Text, - source :: Text + to_user_id_str :: Maybe Text, + source :: Text } deriving (Eq, Show, Typeable, Data, Generic) instance NFData Story -data Result = - Result { - results :: [Story], - max_id :: Int, - since_id :: Int, - refresh_url :: Text, - next_page :: Text, +data Result = Result + { results :: [Story], + max_id :: Int, + since_id :: Int, + 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 + page :: Int, + completed_in :: Double, + since_id_str :: Text, + max_id_str :: Text, + query :: Text } deriving (Eq, Show, Typeable, Data, Generic) diff --git a/demo/Main.hs b/demo/Main.hs --- a/demo/Main.hs +++ b/demo/Main.hs @@ -1,14 +1,13 @@ -{-# LANGUAGE OverloadedStrings, RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} -import qualified Jsonifier as J import qualified Data.ByteString.Char8 - - -{-| -Outputs the following: +import qualified Jsonifier as J -> {"name":"Metallica","genres":[{"name":"Metal"},{"name":"Rock"},{"name":"Blues"}]} --} +-- | +-- Outputs the following: +-- +-- > {"name":"Metallica","genres":[{"name":"Metal"},{"name":"Rock"},{"name":"Blues"}]} main = Data.ByteString.Char8.putStrLn (J.toByteString (artistJson metallica)) @@ -16,29 +15,27 @@ metallica = Artist "Metallica" [Genre "Metal", Genre "Rock", Genre "Blues"] - -- * Model -------------------------- -data Artist = - Artist { artistName :: Text, artistGenres :: [Genre] } +------------------------- -data Genre = - Genre { genreName :: Text } +data Artist = Artist {artistName :: Text, artistGenres :: [Genre]} +data Genre = Genre {genreName :: Text} -- * Encoders + ------------------------- artistJson :: Artist -> J.Json -artistJson Artist{..} = - J.object [ - ("name", J.textString artistName), - ("genres", J.array (fmap genreJson artistGenres)) +artistJson Artist {..} = + J.object + [ ("name", J.textString artistName), + ("genres", J.array (fmap genreJson artistGenres)) ] genreJson :: Genre -> J.Json -genreJson Genre{..} = - J.object [ - ("name", J.textString genreName) +genreJson Genre {..} = + J.object + [ ("name", J.textString genreName) ] diff --git a/jsonifier.cabal b/jsonifier.cabal --- a/jsonifier.cabal +++ b/jsonifier.cabal @@ -1,5 +1,5 @@ name: jsonifier -version: 0.1.2 +version: 0.1.2.1 synopsis: Fast and simple JSON encoding toolkit description: Minimalistic library for encoding JSON directly to strict bytestring, @@ -35,6 +35,7 @@ Jsonifier.Ffi Jsonifier.Poke Jsonifier.Prelude + Jsonifier.Text Jsonifier.Write c-sources: cbits/json_allocation.c diff --git a/library/Jsonifier.hs b/library/Jsonifier.hs --- a/library/Jsonifier.hs +++ b/library/Jsonifier.hs @@ -1,168 +1,158 @@ -{-| -Simple DSL for mapping Haskell values into JSON representation and -rendering it into 'ByteString'. --} +-- | +-- Simple DSL for mapping Haskell values into JSON representation and +-- rendering it into 'ByteString'. module Jsonifier -( - -- * ByteString - toByteString, - toWrite, - -- * Json - Json, - -- ** Primitives - null, - bool, - -- ** Numbers - intNumber, - wordNumber, - doubleNumber, - scientificNumber, - -- ** Strings - textString, - scientificString, - -- ** Composites - array, - object, - -- ** Low-level - writeJson, -) + ( -- * Execution + toByteString, + toWrite, + + -- * Json + Json, + + -- ** Primitives + null, + bool, + + -- ** Numbers + intNumber, + wordNumber, + doubleNumber, + scientificNumber, + + -- ** Strings + textString, + scientificString, + + -- ** Composites + array, + object, + + -- ** Low-level + writeJson, + ) where -import Jsonifier.Prelude hiding (null, bool) -import PtrPoker.Poke (Poke) -import PtrPoker.Write (Write) -import qualified Jsonifier.Size as Size +import qualified Data.ByteString as ByteString +import qualified Data.ByteString.Internal as ByteString import qualified Jsonifier.Poke as Poke +import Jsonifier.Prelude hiding (bool, null) +import qualified Jsonifier.Size as Size import qualified Jsonifier.Write as Write +import PtrPoker.Poke (Poke) import qualified PtrPoker.Poke as Poke +import PtrPoker.Write (Write) import qualified PtrPoker.Write as Write -import qualified Data.ByteString as ByteString -import qualified Data.ByteString.Internal as ByteString - -{-| -Render a JSON value into strict bytestring. --} +-- | +-- Render a JSON value into strict bytestring. {-# INLINE toByteString #-} toByteString :: Json -> ByteString toByteString = Write.writeToByteString . coerce -{-| -Render a JSON value into Write. --} +-- | +-- Render a JSON value into Write. {-# INLINE toWrite #-} toWrite :: Json -> Write toWrite = coerce - -- * Json -------------------------- -{-| -Specification of how to render a JSON value to 'ByteString'. -Sort of a JSON-specialized 'ByteString' builder. +------------------------- -You can construct it from Haskell types -using the specialized conversion functions -like 'intNumber', 'textString' or 'object'. -After constructing, you can convert to strict 'ByteString' -using the 'toByteString' function. --} -newtype Json = - Json Write.Write +-- | +-- Specification of how to render a JSON value to 'ByteString'. +-- Sort of a JSON-specialized 'ByteString' builder. +-- +-- You can construct it from Haskell types +-- using the specialized conversion functions +-- like 'intNumber', 'textString' or 'object'. +-- After constructing, you can convert to strict 'ByteString' +-- using the 'toByteString' function. +newtype Json + = Json Write.Write {-# INLINE write #-} write :: Int -> Poke.Poke -> Json write size poke = Json (Write.Write size poke) -{-| -JSON Null literal. --} +-- | +-- JSON Null literal. {-# INLINE null #-} null :: Json null = write 4 Poke.null -{-| -JSON Boolean literal. --} +-- | +-- JSON Boolean literal. {-# INLINE bool #-} bool :: Bool -> Json bool = - \ case + \case True -> write 4 Poke.true False -> write 5 Poke.false -{-| -JSON Number literal from @Int@. --} +-- | +-- JSON Number literal from @Int@. {-# INLINE intNumber #-} intNumber :: Int -> Json intNumber = Json . Write.intAsciiDec -{-| -JSON Number literal from @Word@. --} +-- | +-- JSON Number literal from @Word@. {-# INLINE wordNumber #-} wordNumber :: Word -> Json wordNumber = Json . Write.wordAsciiDec -{-| -JSON Number literal from @Double@. - -Since JSON doesn\'t have support for them, -non-real values like @NaN@, @Infinity@, @-Infinity@ get rendered as @0@. --} +-- | +-- JSON Number literal from @Double@. +-- +-- Since JSON doesn\'t have support for them, +-- non-real values like @NaN@, @Infinity@, @-Infinity@ get rendered as @0@. {-# INLINE doubleNumber #-} doubleNumber :: Double -> Json doubleNumber = Json . Write.zeroNonRealDoubleAsciiDec -{-| -JSON Number literal from @Scientific@. --} +-- | +-- JSON Number literal from @Scientific@. {-# INLINE scientificNumber #-} scientificNumber :: Scientific -> Json scientificNumber = Json . Write.scientificAsciiDec -{-| -JSON String literal from @Text@. --} +-- | +-- JSON String literal from @Text@. {-# INLINE textString #-} textString :: Text -> Json textString text = - let - size = - 2 + Size.stringBody text - poke = - Poke.string text - in write size poke - -{-| -JSON String literal from @Scientific@. + let size = + 2 + Size.stringBody text + poke = + Poke.string text + in write size poke -You may need this when the reader of your JSON -cannot handle large number literals. --} +-- | +-- JSON String literal from @Scientific@. +-- +-- You may need this when the reader of your JSON +-- cannot handle large number literals. {-# INLINE scientificString #-} scientificString :: Scientific -> Json scientificString = Json . Write.scientificString -{-| -JSON Array literal from a foldable over element literals. - -Don\'t be afraid to use 'fmap' to map the elements of the input datastructure, -it will all be optimized away. --} +-- | +-- JSON Array literal from a foldable over element literals. +-- +-- Don\'t worry about using 'fmap' to map the elements of the input datastructure, +-- it will all be optimized away. {-# INLINE array #-} array :: Foldable f => f Json -> Json array foldable = @@ -177,43 +167,44 @@ Size.array count size poke = Poke.Poke $ - Poke.pokePtr Poke.openingSquareBracket >=> - foldr step finalize foldable True + Poke.pokePtr Poke.openingSquareBracket + >=> foldr step finalize foldable True where step (Json (Write.Write _ poke)) next first = if first then - Poke.pokePtr poke >=> - next False + Poke.pokePtr poke + >=> next False else - Poke.pokePtr Poke.comma >=> - Poke.pokePtr poke >=> - next False + Poke.pokePtr Poke.comma + >=> Poke.pokePtr poke + >=> next False finalize _ = Poke.pokePtr Poke.closingSquareBracket -{-| -JSON Object literal from a foldable over pairs of key to value literal. - -Don\'t be afraid to use 'fmap' to map the elements of the input datastructure, -it will all be optimized away. --} +-- | +-- JSON Object literal from a foldable over pairs of key to value literal. +-- +-- Don\'t worry about using 'fmap' to map the elements of the input datastructure, +-- it will all be optimized away. {-# INLINE object #-} object :: Foldable f => f (Text, Json) -> Json object f = foldr step finalize f True 0 0 mempty where - step (key, Json (Write.Write{..})) next first !count !size !poke = + step (key, Json (Write.Write {..})) next first !count !size !poke = if first - then - next False 1 rowSize rowPoke + then next False 1 rowSize rowPoke else - next False (succ count) (size + rowSize) + next + False + (succ count) + (size + rowSize) (poke <> Poke.comma <> rowPoke) where rowSize = - Size.stringBody key + - writeSize + Size.stringBody key + + writeSize rowPoke = Poke.objectRow key writePoke finalize _ count contentsSize bodyPoke = @@ -224,21 +215,20 @@ poke = Poke.openingCurlyBracket <> bodyPoke <> Poke.closingCurlyBracket -{-| -Any JSON literal manually rendered as Write. - -This is a low-level function allowing to avoid unnecessary processing -in cases where you already have a rendered JSON at hand. - -You can think of Write as a specialized version of ByteString builder. -You can efficiently convert a ByteString to Write using 'PtrPoker.Write.byteString', -making it possible to have parts of the JSON value tree rendered using other libraries. -You can as well manually implement encoders for your custom types. - -__Warning:__ - -It is your responsibility to ensure that the content is correct, -otherwise you may produce invalid JSON. --} +-- | +-- Any JSON literal manually rendered as Write. +-- +-- This is a low-level function allowing to avoid unnecessary processing +-- in cases where you already have a rendered JSON at hand. +-- +-- You can think of Write as a specialized version of ByteString builder. +-- You can efficiently convert a ByteString to Write using 'PtrPoker.Write.byteString', +-- making it possible to have parts of the JSON value tree rendered using other libraries. +-- You can as well manually implement encoders for your custom types. +-- +-- __Warning:__ +-- +-- It is your responsibility to ensure that the content is correct, +-- otherwise you may produce invalid JSON. writeJson :: Write.Write -> Json writeJson = coerce diff --git a/library/Jsonifier/Ffi.hs b/library/Jsonifier/Ffi.hs --- a/library/Jsonifier/Ffi.hs +++ b/library/Jsonifier/Ffi.hs @@ -1,11 +1,10 @@ {-# LANGUAGE UnliftedFFITypes #-} -module Jsonifier.Ffi -where -import Jsonifier.Prelude +module Jsonifier.Ffi where + import Foreign.C import GHC.Base (ByteArray#, MutableByteArray#) - +import Jsonifier.Prelude foreign import ccall unsafe "static count_string_allocation_off_len" countStringAllocationSize :: ByteArray# -> CSize -> CSize -> IO CInt diff --git a/library/Jsonifier/Poke.hs b/library/Jsonifier/Poke.hs --- a/library/Jsonifier/Poke.hs +++ b/library/Jsonifier/Poke.hs @@ -1,13 +1,10 @@ -module Jsonifier.Poke -where +module Jsonifier.Poke where +import qualified Jsonifier.Ffi as Ffi import Jsonifier.Prelude +import qualified Jsonifier.Text as Text import PtrPoker.Poke -import qualified Data.Text.Internal as Text -import qualified Data.Text.Array as TextArray -import qualified Jsonifier.Ffi as Ffi - null :: Poke null = byteString "null" @@ -27,13 +24,13 @@ {-# INLINE string #-} string :: Text -> Poke -string (Text.Text arr off len) = - Poke $ \ ptr -> - Ffi.encodeString ptr (TextArray.aBA arr) (fromIntegral off) (fromIntegral len) +string = + Text.destruct $ \arr off len -> + Poke $ \ptr -> + Ffi.encodeString ptr arr (fromIntegral off) (fromIntegral len) -{-| -> "key":value --} +-- | +-- > "key":value {-# INLINE objectRow #-} objectRow :: Text -> Poke -> Poke objectRow keyBody valuePoke = @@ -42,9 +39,13 @@ {-# INLINE array #-} array :: Foldable f => f Poke -> Poke array f = - snd (foldl' (\ (first, acc) p -> (False, acc <> if first then p else comma <> p)) - (True, openingSquareBracket) f) <> - closingSquareBracket + snd + ( foldl' + (\(first, acc) p -> (False, acc <> if first then p else comma <> p)) + (True, openingSquareBracket) + f + ) + <> closingSquareBracket {-# INLINE object #-} object :: Poke -> Poke @@ -55,7 +56,7 @@ objectBody :: Foldable f => f Poke -> Poke objectBody = foldl' - (\ (first, acc) p -> (False, acc <> if first then p else comma <> p)) + (\(first, acc) p -> (False, acc <> if first then p else comma <> p)) (True, mempty) >>> snd diff --git a/library/Jsonifier/Prelude.hs b/library/Jsonifier/Prelude.hs --- a/library/Jsonifier/Prelude.hs +++ b/library/Jsonifier/Prelude.hs @@ -1,25 +1,23 @@ module Jsonifier.Prelude -( - module Exports, - showAsText, -) + ( module Exports, + showAsText, + ) where --- base -------------------------- -import Control.Applicative as Exports hiding (WrappedArrow(..)) +import Control.Applicative as Exports hiding (WrappedArrow (..)) import Control.Arrow as Exports hiding (first, second) import Control.Category as Exports import Control.Concurrent as Exports import Control.Exception as Exports -import Control.Monad as Exports hiding (fail, mapM_, sequence_, forM_, msum, mapM, sequence, forM) -import Control.Monad.IO.Class as Exports +import Control.Monad as Exports hiding (fail, forM, forM_, mapM, mapM_, msum, sequence, sequence_) import Control.Monad.Fail as Exports import Control.Monad.Fix as Exports hiding (fix) +import Control.Monad.IO.Class as Exports import Control.Monad.ST as Exports import Data.Bifunctor as Exports import Data.Bits as Exports import Data.Bool as Exports +import Data.ByteString as Exports (ByteString) import Data.Char as Exports import Data.Coerce as Exports import Data.Complex as Exports @@ -31,19 +29,21 @@ import Data.Function as Exports hiding (id, (.)) import Data.Functor as Exports import Data.Functor.Compose as Exports -import Data.Int as Exports import Data.IORef as Exports +import Data.Int as Exports import Data.Ix as Exports -import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl') -import Data.List.NonEmpty as Exports (NonEmpty(..)) +import Data.List as Exports hiding (all, and, any, concat, concatMap, elem, find, foldl, foldl', foldl1, foldr, foldr1, isSubsequenceOf, mapAccumL, mapAccumR, maximum, maximumBy, minimum, minimumBy, notElem, or, product, sortOn, sum, uncons) +import Data.List.NonEmpty as Exports (NonEmpty (..)) import Data.Maybe as Exports import Data.Monoid as Exports hiding (Alt) import Data.Ord as Exports import Data.Proxy as Exports import Data.Ratio as Exports -import Data.Semigroup as Exports hiding (First(..), Last(..)) import Data.STRef as Exports +import Data.Scientific as Exports (Scientific) +import Data.Semigroup as Exports hiding (First (..), Last (..)) import Data.String as Exports +import Data.Text as Exports (Text) import Data.Traversable as Exports import Data.Tuple as Exports import Data.Unique as Exports @@ -55,13 +55,12 @@ import Foreign.Ptr as Exports import Foreign.StablePtr as Exports import Foreign.Storable as Exports -import GHC.Conc as Exports hiding (orElse, withMVar, threadWaitWriteSTM, threadWaitWrite, threadWaitReadSTM, threadWaitRead) -import GHC.Exts as Exports (IsList(..), lazy, inline, sortWith, groupWith) +import GHC.Conc as Exports hiding (orElse, threadWaitRead, threadWaitReadSTM, threadWaitWrite, threadWaitWriteSTM, withMVar) +import GHC.Exts as Exports (ByteArray#, IsList (..), groupWith, inline, lazy, sortWith) import GHC.Generics as Exports (Generic) import GHC.IO.Exception as Exports import GHC.OverloadedLabels as Exports import Numeric as Exports -import Prelude as Exports hiding (fail, concat, foldr, mapM_, sequence_, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, id, (.)) import System.Environment as Exports import System.Exit as Exports import System.IO as Exports (Handle, hClose) @@ -71,23 +70,11 @@ import System.Mem.StableName as Exports import System.Timeout as Exports import Text.ParserCombinators.ReadP as Exports (ReadP, readP_to_S, readS_to_P) -import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readPrec_to_P, readP_to_Prec, readPrec_to_S, readS_to_Prec) -import Text.Printf as Exports (printf, hPrintf) -import Text.Read as Exports (Read(..), readMaybe, readEither) +import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readP_to_Prec, readPrec_to_P, readPrec_to_S, readS_to_Prec) +import Text.Printf as Exports (hPrintf, printf) +import Text.Read as Exports (Read (..), readEither, readMaybe) import Unsafe.Coerce as Exports - --- text -------------------------- -import Data.Text as Exports (Text) - --- bytestring -------------------------- -import Data.ByteString as Exports (ByteString) - --- scientific -------------------------- -import Data.Scientific as Exports (Scientific) - +import Prelude as Exports hiding (all, and, any, concat, concatMap, elem, fail, foldl, foldl1, foldr, foldr1, id, mapM, mapM_, maximum, minimum, notElem, or, product, sequence, sequence_, sum, (.)) showAsText :: Show a => a -> Text showAsText = show >>> fromString diff --git a/library/Jsonifier/Size.hs b/library/Jsonifier/Size.hs --- a/library/Jsonifier/Size.hs +++ b/library/Jsonifier/Size.hs @@ -1,12 +1,10 @@ {-# LANGUAGE UnliftedFFITypes #-} -module Jsonifier.Size -where -import Jsonifier.Prelude -import qualified Data.Text.Internal as Text -import qualified Data.Text.Array as TextArray -import qualified Jsonifier.Ffi as Ffi +module Jsonifier.Size where +import qualified Jsonifier.Ffi as Ffi +import Jsonifier.Prelude +import qualified Jsonifier.Text as Text {-# INLINE object #-} object :: Int -> Int -> Int @@ -33,12 +31,14 @@ then 0 else pred rowsAmount -{-| -Amount of bytes required for an escaped JSON string value without quotes. --} +-- | +-- Amount of bytes required for an escaped JSON string value without quotes. stringBody :: Text -> Int -stringBody (Text.Text arr off len) = - Ffi.countStringAllocationSize - (TextArray.aBA arr) (fromIntegral off) (fromIntegral len) - & unsafeDupablePerformIO - & fromIntegral +stringBody = + Text.destruct $ \arr off len -> + Ffi.countStringAllocationSize + arr + (fromIntegral off) + (fromIntegral len) + & unsafeDupablePerformIO + & fromIntegral diff --git a/library/Jsonifier/Text.hs b/library/Jsonifier/Text.hs new file mode 100644 --- /dev/null +++ b/library/Jsonifier/Text.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE CPP #-} + +module Jsonifier.Text where + +import qualified Data.Text.Array as TextArray +import qualified Data.Text.Internal as Text +import Jsonifier.Prelude + +{-# INLINE destruct #-} +destruct :: (ByteArray# -> Int -> Int -> x) -> Text -> x +#if MIN_VERSION_text(2,0,0) +destruct k (Text.Text (TextArray.ByteArray arr) off len) = k arr off len +#else +destruct k (Text.Text (TextArray.aBA -> arr) off len) = k arr off len +#endif diff --git a/library/Jsonifier/Write.hs b/library/Jsonifier/Write.hs --- a/library/Jsonifier/Write.hs +++ b/library/Jsonifier/Write.hs @@ -1,10 +1,8 @@ -module Jsonifier.Write -where +module Jsonifier.Write where +import qualified Jsonifier.Poke as Poke import Jsonifier.Prelude import PtrPoker.Write -import qualified Jsonifier.Poke as Poke - {-# INLINE scientificString #-} scientificString :: Scientific -> Write diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -1,27 +1,26 @@ module Main where -import Prelude hiding (null, bool) -import Hedgehog -import Hedgehog.Main import qualified Data.Aeson as A -import qualified Jsonifier as J import qualified Data.Aeson.Key as AesonKey import qualified Data.Aeson.KeyMap as AesonKeyMap -import qualified Hedgehog.Gen as Gen -import qualified Hedgehog.Range as Range import qualified Data.ByteString.Char8 as Char8ByteString import qualified Data.Vector as Vector +import Hedgehog +import qualified Hedgehog.Gen as Gen +import Hedgehog.Main +import qualified Hedgehog.Range as Range +import qualified Jsonifier as J import qualified Main.Util.HedgehogGens as GenExtras - +import Prelude hiding (bool, null) main = defaultMain $ pure $ checkParallel $ $$(discover) prop_sample = withTests 1 $ - property $ do - sample <- liftIO $ load "samples/twitter100.json" - A.eitherDecodeStrict' (J.toByteString (aesonJson sample)) === Right sample + property $ do + sample <- liftIO $ load "samples/twitter100.json" + A.eitherDecodeStrict' (J.toByteString (aesonJson sample)) === Right sample where load :: FilePath -> IO A.Value load fileName = @@ -29,7 +28,7 @@ >>= either fail return aesonJson :: A.Value -> J.Json aesonJson = - \ case + \case A.Null -> J.null A.Bool a -> @@ -41,28 +40,28 @@ A.Array a -> J.array (fmap aesonJson a) A.Object a -> - J.object (AesonKeyMap.foldMapWithKey (\ k -> (: []) . (,) (AesonKey.toText k) . aesonJson) a) + J.object (AesonKeyMap.foldMapWithKey (\k -> (: []) . (,) (AesonKey.toText k) . aesonJson) a) prop_aesonRoundtrip = withTests 9999 $ - property $ do - sample <- forAll sampleGen - let encoding = sampleJsonifier sample - annotate (Char8ByteString.unpack encoding) - aeson <- evalEither (A.eitherDecodeStrict' encoding) - evalEither (maybe (Right ()) Left (detectMismatchInSampleAndAeson sample aeson)) + property $ do + sample <- forAll sampleGen + let encoding = sampleJsonifier sample + annotate (Char8ByteString.unpack encoding) + aeson <- evalEither (A.eitherDecodeStrict' encoding) + evalEither (maybe (Right ()) Left (detectMismatchInSampleAndAeson sample aeson)) -data Sample = - NullSample | - BoolSample Bool | - IntNumberSample Int | - WordNumberSample Word | - DoubleNumberSample Double | - ScientificNumberSample Scientific | - TextStringSample Text | - ScientificStringSample Scientific | - ArraySample [Sample] | - ObjectSample [(Text, Sample)] +data Sample + = NullSample + | BoolSample Bool + | IntNumberSample Int + | WordNumberSample Word + | DoubleNumberSample Double + | ScientificNumberSample Scientific + | TextStringSample Text + | ScientificStringSample Scientific + | ArraySample [Sample] + | ObjectSample [(Text, Sample)] deriving (Eq, Show) sampleGen :: Gen Sample @@ -70,17 +69,20 @@ sample where sample = - Gen.recursive Gen.choice [ - null, bool, - intNumber, - wordNumber, - doubleNumber, - scientificNumber, - textString, - scientificString - ] [ - array, object + Gen.recursive + Gen.choice + [ null, + bool, + intNumber, + wordNumber, + doubleNumber, + scientificNumber, + textString, + scientificString ] + [ array, + object + ] null = pure NullSample bool = @@ -103,8 +105,8 @@ rowList (Range.exponential 0 999) <&> ObjectSample where rowList range = - Gen.list range row <&> - nubBy (on (==) fst) + Gen.list range row + <&> nubBy (on (==) fst) where row = Gen.text (Range.exponential 0 99) Gen.unicode @@ -116,7 +118,7 @@ J.toByteString . sample where sample = - \ case + \case NullSample -> J.null BoolSample a -> J.bool a IntNumberSample a -> J.intNumber a @@ -133,7 +135,7 @@ sample where sample = - \ case + \case NullSample -> A.Null BoolSample a -> A.Bool a IntNumberSample a -> A.Number (fromIntegral a) @@ -147,67 +149,69 @@ where realNumber a = A.Number $ - if isNaN a || isInfinite a then 0 else (read . show) a - -{-| -We have to come down to this trickery due to small differences in -the way scientific renders floating point values and how ptr-poker does. -There is no difference when floating point comparison is used instead of scientific, -so this is what we achieve here. + if isNaN a || isInfinite a then 0 else (read . show) a -It must be mentioned that this only applies to floating point numbers. --} +-- | +-- We have to come down to this trickery due to small differences in +-- the way scientific renders floating point values and how ptr-poker does. +-- There is no difference when floating point comparison is used instead of scientific, +-- so this is what we achieve here. +-- +-- It must be mentioned that this only applies to floating point numbers. detectMismatchInSampleAndAeson :: Sample -> A.Value -> Maybe (Sample, A.Value) detectMismatchInSampleAndAeson = - \ case + \case NullSample -> - \ case + \case A.Null -> Nothing a -> Just (NullSample, a) BoolSample a -> - \ case + \case A.Bool b | b == a -> Nothing b -> Just (BoolSample a, b) IntNumberSample a -> - \ case + \case A.Number b | round b == a -> Nothing b -> Just (IntNumberSample a, b) WordNumberSample a -> - \ case + \case A.Number b | round b == a -> Nothing b -> Just (WordNumberSample a, b) DoubleNumberSample a -> - \ case + \case -- This is what it's all for. A.Number b | realToFrac b == if isNaN a || isInfinite a then 0 else a -> Nothing b -> Just (DoubleNumberSample a, b) ScientificNumberSample a -> - \ case + \case A.Number b | a == b -> Nothing b -> Just (ScientificNumberSample a, b) TextStringSample a -> - \ case + \case A.String b | a == b -> Nothing b -> Just (TextStringSample a, b) ScientificStringSample a -> - \ case + \case A.String b | (fromString . show) a == b -> Nothing b -> Just (ScientificStringSample a, b) ArraySample a -> - \ case - A.Array b | Vector.length b == length a -> - toList b - & zip a - & foldMap (\ (aa, bb) -> fmap First (detectMismatchInSampleAndAeson aa bb)) - & fmap getFirst + \case + A.Array b + | Vector.length b == length a -> + toList b + & zip a + & foldMap (\(aa, bb) -> fmap First (detectMismatchInSampleAndAeson aa bb)) + & fmap getFirst b -> Just (ArraySample a, b) ObjectSample a -> - \ case + \case A.Object b -> - a & foldMap (\ (ak, av) -> - case AesonKeyMap.lookup (AesonKey.fromText ak) b of - Just bv -> fmap First (detectMismatchInSampleAndAeson av bv) - Nothing -> Just (First (ObjectSample a, A.Object b)) - ) + a + & foldMap + ( \(ak, av) -> + case AesonKeyMap.lookup (AesonKey.fromText ak) b of + Just bv -> fmap First (detectMismatchInSampleAndAeson av bv) + Nothing -> Just (First (ObjectSample a, A.Object b)) + ) & fmap getFirst b -> Just (ObjectSample a, b) diff --git a/test/Main/Util/HedgehogGens.hs b/test/Main/Util/HedgehogGens.hs --- a/test/Main/Util/HedgehogGens.hs +++ b/test/Main/Util/HedgehogGens.hs @@ -1,11 +1,10 @@ module Main.Util.HedgehogGens where -import Prelude import Hedgehog import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range import qualified Numeric.Limits as NumericLimits - +import Prelude scientific :: Gen Scientific scientific = @@ -13,10 +12,9 @@ <&> fromRational realFloat = - Gen.frequency [ - (99, realRealFloat) - , - (1, nonRealRealFloat) + Gen.frequency + [ (99, realRealFloat), + (1, nonRealRealFloat) ] realRealFloat =