jsonifier 0.1.2 → 0.1.2.1
raw patch · 16 files changed
+566/−585 lines, 16 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- bench/Main.hs +55/−67
- bench/Main/Aeson.hs +114/−104
- bench/Main/BufferBuilder.hs +32/−33
- bench/Main/Jsonifier.hs +40/−41
- bench/Main/Model.hs +33/−38
- demo/Main.hs +18/−21
- jsonifier.cabal +2/−1
- library/Jsonifier.hs +121/−131
- library/Jsonifier/Ffi.hs +3/−4
- library/Jsonifier/Poke.hs +17/−16
- library/Jsonifier/Prelude.hs +19/−32
- library/Jsonifier/Size.hs +14/−14
- library/Jsonifier/Text.hs +15/−0
- library/Jsonifier/Write.hs +2/−4
- test/Main.hs +77/−73
- test/Main/Util/HedgehogGens.hs +4/−6
bench/Main.hs view
@@ -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
bench/Main/Aeson.hs view
@@ -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
bench/Main/BufferBuilder.hs view
@@ -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
bench/Main/Jsonifier.hs view
@@ -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) ]
bench/Main/Model.hs view
@@ -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)
demo/Main.hs view
@@ -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) ]
jsonifier.cabal view
@@ -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
library/Jsonifier.hs view
@@ -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
library/Jsonifier/Ffi.hs view
@@ -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
library/Jsonifier/Poke.hs view
@@ -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
library/Jsonifier/Prelude.hs view
@@ -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
library/Jsonifier/Size.hs view
@@ -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
+ library/Jsonifier/Text.hs view
@@ -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
library/Jsonifier/Write.hs view
@@ -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
test/Main.hs view
@@ -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)
test/Main/Util/HedgehogGens.hs view
@@ -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 =