master..4d3767c · typeable/aeson

git.iko.soy/typeable/aeson

13 files changed+33−321

unifiedsplit

CONTRIBUTING.md−38 Data/Aeson/TH.hs+4−24 Data/Aeson/Types.hs−1 Data/Aeson/Types/FromJSON.hs+22−67 Data/Aeson/Types/Internal.hs+1−9 Data/Aeson/Types/ToJSON.hs+1 changelog.md−5 tests/Encoders.hs−25 tests/ErrorMessages.hs−26 tests/Instances.hs+1−1 tests/Options.hs−11 tests/UnitTests.hs+4−106 tests/golden/generic.expected−8

CONTRIBUTING.md−38

@@ -58,41 +58,3 @@ import Foo as F

5858import Qux (Q(..), q)

5959import qualified A

6060```

61−

62−## Development Workflow (If you plan on using Stack)

63−

64−Here we outline a general workflow new contributors could adopt for a nice incremental development experience.

65−

66−The root folder consists of two stack-*.yaml config files.

67−

68−1. stack-nightly.yaml - Config file defines all the settings to build and test any changes.

69−2. stack-bench.yaml - Used to run benchmark tests.

70−3. stack-ffi-unescape.yaml - This is for replacing certain parts with a C-implementation.

71−

72−Therefore, a ghci development experience would be:

73−

74−1. `stack ghci --stack-yaml stack-nightly.yaml --test`

75−2. :r to recompile

76−3. `main` to run all tests, or `:main --pattern Foo` to run specific tests matched by pattern.

77−

78−Some discussion on this topic can also be found here [here](https://github.com/bos/aeson/issues/733)

79−

80−Of course before submitting a PR, the following steps are recommended:

81−

82−1. 'stack test --stack-yaml stack-nightly.yaml` - Run the entire suite of tests

83−2. `make hlint` - Run hlint on the source folders.

84−3. 'stack test --stack-yaml stack-bench.yaml` - Run the benchmark tests if you believe your changes could affect the benchmarks.

85−

86−## Development Workflow (If you plan on using Cabal)

87−

88−A ghci development experience would be:

89−

90−1. `cabal new-repl test:tests`

91−2. `:r` to recompile

92−3. `Main.main` to run all tests, or `:m Main; :main --pattern Foo` to run specific tests matched by pattern.

93−

94−Of course before submitting a PR, the following steps are recommended:

95−

96−1. `cabal new-test` - Run the entire suite of tests

97−2. `make hlint` - Run hlint on the source folders.

98−3. Uncomment the `benchmarks` line in `cabal.project` - Run the benchmark tests if you believe your changes could affect the benchmarks.

Data/Aeson/TH.hs+4−24

@@ -143,7 +143,7 @@ import Language.Haskell.TH.Syntax (mkNameG_tc)

143143import Text.Printf (printf)

144144import qualified Data.Aeson.Encoding.Internal as E

145145import qualified Data.Foldable as F (all)

146−import qualified Data.HashMap.Strict as H (difference, fromList, keys, lookup, toList)

146+import qualified Data.HashMap.Strict as H (lookup, toList)

147147import qualified Data.List.NonEmpty as NE (length, reverse)

148148import qualified Data.Map as M (fromList, keys, lookup , singleton, size)

149149import qualified Data.Semigroup as Semigroup (Option(..))

@@ -922,32 +922,12 @@ parseRecord :: JSONClass

922922 -> Name

923923 -> [Name]

924924 -> Name

925− -> Bool

926925 -> ExpQ

927−parseRecord jc tvMap argTys opts tName conName fields obj inTaggedObject =

928− (if rejectUnknownFields opts

929− then infixApp checkUnknownRecords [|(>>)|]

930− else id) $

926+parseRecord jc tvMap argTys opts tName conName fields obj =

931927 foldl' (\a b -> infixApp a [|(<*>)|] b)

932928 (infixApp (conE conName) [|(<$>)|] x)

933929 xs

934930 where

935− tagFieldNameAppender =

936− if inTaggedObject then (tagFieldName (sumEncoding opts) :) else id

937− knownFields = appE [|H.fromList|] $ listE $

938− map (\knownName -> tupE [appE [|T.pack|] $ litE $ stringL knownName, [|()|]]) $

939− tagFieldNameAppender $ map nameBase fields

940− checkUnknownRecords =

941− caseE (appE [|H.keys|] $ infixApp (varE obj) [|H.difference|] knownFields)

942− [ match (listP []) (normalB [|return ()|]) []

943− , newName "unknownFields" >>=

944− \unknownFields -> match (varP unknownFields)

945− (normalB $ appE [|fail|] $ infixApp

946− (litE (stringL "Unknown fields: "))

947− [|(++)|]

948− (appE [|show|] (varE unknownFields)))

949− []

950− ]

951931 x:xs = [ [|lookupField|]

952932 `appE` dispatchParseJSON jc conName tvMap argTy

953933 `appE` litE (stringL $ show tName)

@@ -1022,7 +1002,7 @@ parseArgs jc tvMap tName opts

10221002 , constructorFields = argTys }

10231003 (Left (_, obj)) = do

10241004 argTys' <- mapM resolveTypeSynonyms argTys

1025− parseRecord jc tvMap argTys' opts tName conName fields obj True

1005+ parseRecord jc tvMap argTys' opts tName conName fields obj

10261006parseArgs jc tvMap tName opts

10271007 info@ConstructorInfo { constructorName = conName

10281008 , constructorVariant = RecordConstructor fields

@@ -1037,7 +1017,7 @@ parseArgs jc tvMap tName opts

10371017 argTys' <- mapM resolveTypeSynonyms argTys

10381018 caseE (varE valName)

10391019 [ match (conP 'Object [varP obj]) (normalB $

1040− parseRecord jc tvMap argTys' opts tName conName fields obj False) []

1020+ parseRecord jc tvMap argTys' opts tName conName fields obj) []

10411021 , matchFailed tName conName "Object"

10421022 ]

10431023

Data/Aeson/Types.hs−1

@@ -124,7 +124,6 @@ module Data.Aeson.Types

124124 , sumEncoding

125125 , unwrapUnaryRecords

126126 , tagSingleConstructors

127− , rejectUnknownFields

128127

129128 -- ** Options utilities

130129 , SumEncoding(..)

Data/Aeson/Types/FromJSON.hs+22−67

@@ -11,7 +11,6 @@

1111{-# LANGUAGE RecordWildCards #-}

1212{-# LANGUAGE ScopedTypeVariables #-}

1313{-# LANGUAGE TypeOperators #-}

14−{-# LANGUAGE TupleSections #-}

1514{-# LANGUAGE UndecidableInstances #-}

1615{-# LANGUAGE ViewPatterns #-}

1716

@@ -1201,9 +1200,9 @@ class FromTaggedObject' arity f isRecord where

12011200 :: String :* ConName :* TypeName :* Options :* FromArgs arity a

12021201 -> Object -> Tagged isRecord (Parser (f a))

12031202

1204−instance (RecordFromJSON arity f, FieldNames f) => FromTaggedObject' arity f True where

1203+instance (RecordFromJSON arity f) => FromTaggedObject' arity f True where

12051204 -- Records are unpacked in the tagged object

1206− parseFromTaggedObject' (_ :* p) = Tagged . recordParseJSON (True :* p)

1205+ parseFromTaggedObject' (_ :* p) = Tagged . recordParseJSON p

12071206

12081207instance (ConsFromJSON arity f) => FromTaggedObject' arity f False where

12091208 -- Nonnullary nonrecords are encoded in the contents field

@@ -1244,11 +1243,11 @@ instance OVERLAPPING_

12441243 ) => ConsFromJSON' arity (S1 s a) True where

12451244 consParseJSON' p@(cname :* tname :* opts :* fargs)

12461245 | unwrapUnaryRecords opts = Tagged . fmap M1 . gParseJSON opts fargs

1247− | otherwise = Tagged . withObject (showCons cname tname) (recordParseJSON (False :* p))

1246+ | otherwise = Tagged . withObject (showCons cname tname) (recordParseJSON p)

12481247

12491248instance RecordFromJSON arity f => ConsFromJSON' arity f True where

12501249 consParseJSON' p@(cname :* tname :* _) =

1251− Tagged . withObject (showCons cname tname) (recordParseJSON (False :* p))

1250+ Tagged . withObject (showCons cname tname) (recordParseJSON p)

12521251

12531252instance OVERLAPPING_

12541253 ConsFromJSON' arity U1 False where

@@ -1274,55 +1273,21 @@ instance (ProductFromJSON arity f, ProductSize f

12741273

12751274--------------------------------------------------------------------------------

12761275

1277−class FieldNames f where

1278− fieldNames :: f a -> [Text] -> [Text]

1279−

1280−instance (FieldNames a, FieldNames b) => FieldNames (a :*: b) where

1281− fieldNames _ =

1282− fieldNames (undefined :: a x) .

1283− fieldNames (undefined :: b y)

1284−

1285−instance (Selector s) => FieldNames (S1 s f) where

1286− fieldNames _ = (pack (selName (undefined :: M1 _i s _f _p)) :)

1287−

12881276class RecordFromJSON arity f where

12891277 recordParseJSON

1290− :: Bool :* ConName :* TypeName :* Options :* FromArgs arity a

1291− -> Object -> Parser (f a)

1292−

1293−instance ( FieldNames f

1294− , RecordFromJSON' arity f

1295− ) => RecordFromJSON arity f where

1296− recordParseJSON (fromTaggedSum :* p@(cname :* tname :* opts :* _)) =

1297− \obj -> checkUnknown obj >> recordParseJSON' p obj

1298− where

1299− knownFields :: H.HashMap Text ()

1300− knownFields = H.fromList $ map (,()) $

1301− fieldNames (undefined :: f a)

1302− [pack (tagFieldName (sumEncoding opts)) | fromTaggedSum]

1303− checkUnknown =

1304− if not (rejectUnknownFields opts)

1305− then \_ -> return ()

1306− else \obj -> case H.keys (H.difference obj knownFields) of

1307− [] -> return ()

1308− unknownFields -> contextCons cname tname $

1309− fail ("unknown fields: " ++ show unknownFields)

1310−

1311−class RecordFromJSON' arity f where

1312− recordParseJSON'

13131278 :: ConName :* TypeName :* Options :* FromArgs arity a

13141279 -> Object -> Parser (f a)

13151280

1316−instance ( RecordFromJSON' arity a

1317− , RecordFromJSON' arity b

1318− ) => RecordFromJSON' arity (a :*: b) where

1319− recordParseJSON' p obj =

1320− (:*:) <$> recordParseJSON' p obj

1321− <*> recordParseJSON' p obj

1281+instance ( RecordFromJSON arity a

1282+ , RecordFromJSON arity b

1283+ ) => RecordFromJSON arity (a :*: b) where

1284+ recordParseJSON p obj =

1285+ (:*:) <$> recordParseJSON p obj

1286+ <*> recordParseJSON p obj

13221287

13231288instance OVERLAPPABLE_ (Selector s, GFromJSON arity a) =>

1324− RecordFromJSON' arity (S1 s a) where

1325− recordParseJSON' (cname :* tname :* opts :* fargs) obj = do

1289+ RecordFromJSON arity (S1 s a) where

1290+ recordParseJSON (cname :* tname :* opts :* fargs) obj = do

13261291 fv <- contextCons cname tname (obj .: label)

13271292 M1 <$> gParseJSON opts fargs fv <?> Key label

13281293 where

@@ -1330,16 +1295,16 @@ instance OVERLAPPABLE_ (Selector s, GFromJSON arity a) =>

13301295 sname = selName (undefined :: M1 _i s _f _p)

13311296

13321297instance INCOHERENT_ (Selector s, FromJSON a) =>

1333− RecordFromJSON' arity (S1 s (K1 i (Maybe a))) where

1334− recordParseJSON' (_ :* _ :* opts :* _) obj = M1 . K1 <$> obj .:? pack label

1298+ RecordFromJSON arity (S1 s (K1 i (Maybe a))) where

1299+ recordParseJSON (_ :* _ :* opts :* _) obj = M1 . K1 <$> obj .:? pack label

13351300 where

13361301 label = fieldLabelModifier opts sname

13371302 sname = selName (undefined :: M1 _i s _f _p)

13381303

13391304-- Parse an Option like a Maybe.

13401305instance INCOHERENT_ (Selector s, FromJSON a) =>

1341− RecordFromJSON' arity (S1 s (K1 i (Semigroup.Option a))) where

1342− recordParseJSON' p obj = wrap <$> recordParseJSON' p obj

1306+ RecordFromJSON arity (S1 s (K1 i (Semigroup.Option a))) where

1307+ recordParseJSON p obj = wrap <$> recordParseJSON p obj

13431308 where

13441309 wrap :: S1 s (K1 i (Maybe a)) p -> S1 s (K1 i (Semigroup.Option a)) p

13451310 wrap (M1 (K1 a)) = M1 (K1 (Semigroup.Option a))

@@ -1576,22 +1541,12 @@ instance FromJSONKey Float where

15761541 _ -> Scientific.toRealFloat <$> parseScientificText t

15771542

15781543instance (FromJSON a, Integral a) => FromJSON (Ratio a) where

1579− parseJSON (Number x)

1580− | exp10 <= 1024

1581− , exp10 >= -1024 = return $! realToFrac x

1582− | otherwise = prependContext "Ratio" $ fail msg

1583− where

1584− exp10 = base10Exponent x

1585− msg = "found a number with exponent " ++ show exp10

1586− ++ ", but it must not be greater than 1024 or less than -1024"

1587− parseJSON o = objParser o

1588− where

1589− objParser = withObject "Rational" $ \obj -> do

1590− numerator <- obj .: "numerator"

1591− denominator <- obj .: "denominator"

1592− if denominator == 0

1593− then fail "Ratio denominator was 0"

1594− else pure $ numerator % denominator

1544+ parseJSON = withObject "Rational" $ \obj -> do

1545+ numerator <- obj .: "numerator"

1546+ denominator <- obj .: "denominator"

1547+ if denominator == 0

1548+ then fail "Ratio denominator was 0"

1549+ else pure $ numerator % denominator

15951550 {-# INLINE parseJSON #-}

15961551

15971552-- | This instance includes a bounds check to prevent maliciously

Data/Aeson/Types/Internal.hs+1−9

@@ -64,7 +64,6 @@ module Data.Aeson.Types.Internal

6464 , sumEncoding

6565 , unwrapUnaryRecords

6666 , tagSingleConstructors

67− , rejectUnknownFields

6867 )

6968

7069 , SumEncoding(..)

@@ -625,14 +624,10 @@ data Options = Options

625624 , tagSingleConstructors :: Bool

626625 -- ^ Encode types with a single constructor as sums,

627626 -- so that `allNullaryToStringTag` and `sumEncoding` apply.

628− , rejectUnknownFields :: Bool

629− -- ^ Applies only to 'Data.Aeson.FromJSON' instances. If a field appears in

630− -- the parsed object map, but does not appear in the target object, parsing

631− -- will fail, with an error message indicating which fields were unknown.

632627 }

633628

634629instance Show Options where

635− show (Options f c a o s u t r) =

630+ show (Options f c a o s u t) =

636631 "Options {"

637632 ++ intercalate ", "

638633 [ "fieldLabelModifier =~ " ++ show (f "exampleField")

@@ -642,7 +637,6 @@ instance Show Options where

642637 , "sumEncoding = " ++ show s

643638 , "unwrapUnaryRecords = " ++ show u

644639 , "tagSingleConstructors = " ++ show t

645− , "rejectUnknownFields = " ++ show r

646640 ]

647641 ++ "}"

648642

@@ -724,7 +718,6 @@ data JSONKeyOptions = JSONKeyOptions

724718-- , 'sumEncoding' = 'defaultTaggedObject'

725719-- , 'unwrapUnaryRecords' = False

726720-- , 'tagSingleConstructors' = False

727−-- , 'rejectUnknownFields' = False

728721-- }

729722-- @

730723defaultOptions :: Options

@@ -736,7 +729,6 @@ defaultOptions = Options

736729 , sumEncoding = defaultTaggedObject

737730 , unwrapUnaryRecords = False

738731 , tagSingleConstructors = False

739− , rejectUnknownFields = False

740732 }

741733

742734-- | Default 'TaggedObject' 'SumEncoding' options:

Data/Aeson/Types/ToJSON.hs+1

@@ -100,6 +100,7 @@ import GHC.Generics

100100import Numeric.Natural (Natural)

101101import qualified Data.Aeson.Encoding as E

102102import qualified Data.Aeson.Encoding.Internal as E (InArray, comma, econcat, retagEncoding)

103+import qualified Data.ByteString as S

103104import qualified Data.ByteString.Lazy as L

104105import qualified Data.DList as DList

105106import qualified Data.HashMap.Strict as H

changelog.md−5

@@ -1,10 +1,5 @@

11For the latest version of this document, please see [https://github.com/bos/aeson/blob/master/changelog.md](https://github.com/bos/aeson/blob/master/changelog.md).

3−### upcoming

4−

5−* `FromJSON` instance of `Ratio a` now parses numbers in addtion to

6− standard `{numerator=..., denumerator=...}` encoding.

7−

83### 1.4.6.0

105* Provide a clearer error message when a required tagKey for a constructor is missing, thanks to Guru Devanla.

tests/Encoders.hs−25

@@ -243,31 +243,6 @@ gSomeTypeToEncodingOmitNothingFields :: SomeType Int -> Encoding

243243gSomeTypeToEncodingOmitNothingFields = genericToEncoding optsOmitNothingFields

244244

245245

246−thSomeTypeParseJSONRejectUnknownFields :: Value -> Parser (SomeType Int)

247−thSomeTypeParseJSONRejectUnknownFields = $(mkParseJSON optsRejectUnknownFields ''SomeType)

248−

249−gSomeTypeParseJSONRejectUnknownFields :: Value -> Parser (SomeType Int)

250−gSomeTypeParseJSONRejectUnknownFields = genericParseJSON optsRejectUnknownFields

251−

252−

253−--------------------------------------------------------------------------------

254−-- Foo decoders

255−--------------------------------------------------------------------------------

256−

257−thFooParseJSONRejectUnknownFields :: Value -> Parser Foo

258−thFooParseJSONRejectUnknownFields = $(mkParseJSON optsRejectUnknownFields ''Foo)

259−

260−gFooParseJSONRejectUnknownFields :: Value -> Parser Foo

261−gFooParseJSONRejectUnknownFields = genericParseJSON optsRejectUnknownFields

262−

263−

264−thFooParseJSONRejectUnknownFieldsTagged :: Value -> Parser Foo

265−thFooParseJSONRejectUnknownFieldsTagged = $(mkParseJSON optsRejectUnknownFieldsTagged ''Foo)

266−

267−gFooParseJSONRejectUnknownFieldsTagged :: Value -> Parser Foo

268−gFooParseJSONRejectUnknownFieldsTagged = genericParseJSON optsRejectUnknownFieldsTagged

269−

270−

271246--------------------------------------------------------------------------------

272247-- Option fields

273248--------------------------------------------------------------------------------

tests/ErrorMessages.hs−26

@@ -136,29 +136,6 @@ outputGeneric choice = concat

136136 , "[1,"

137137 ]

138138

139− , testWithSomeType "SomeType (reject unknown fields)"

140− (select

141− thSomeTypeParseJSONRejectUnknownFields

142− gSomeTypeParseJSONRejectUnknownFields)

143− [ "{\"tag\": \"record\", \"testOne\": 1.0, \"testZero\": 1}"

144− , "{\"testZero\": 1}"

145− , "{\"tag\": \"record\", \"testone\": true, \"testtwo\": null, \"testthree\": null}"

146− ]

147−

148− , testWithFoo "Foo (reject unknown fields)"

149− (select

150− thFooParseJSONRejectUnknownFields

151− gFooParseJSONRejectUnknownFields)

152− [ "{\"tag\": \"foo\"}"

153− ]

154−

155− , testWithFoo "Foo (reject unknown fields, tagged single)"

156− (select

157− thFooParseJSONRejectUnknownFieldsTagged

158− gFooParseJSONRejectUnknownFieldsTagged)

159− [ "{\"tag\": \"foo\", \"unknownField\": 0}"

160− ]

161−

162139 , testWith "EitherTextInt"

163140 (select

164141 thEitherTextIntParseJSONUntaggedValue

@@ -219,6 +196,3 @@ testFor name _ = testWith name (parseJSON :: Value -> Parser a)

219196

220197testWithSomeType :: String -> (Value -> Parser (SomeType Int)) -> [L.ByteString] -> Output

221198testWithSomeType = testWith

222−

223−testWithFoo :: String -> (Value -> Parser Foo) -> [L.ByteString] -> Output

224−testWithFoo = testWith

tests/Instances.hs+1−1

@@ -29,7 +29,7 @@ import Data.Hashable.Time ()

2929-- "System" types.

3030

3131instance Arbitrary DotNetTime where

32− arbitrary = DotNetTime `fmap` arbitrary

32+ arbitrary = DotNetTime `liftM` arbitrary

3333 shrink = map DotNetTime . shrink . fromDotNetTime

3434

3535-- | Compare timezone part only on 'timeZoneMinutes'

tests/Options.hs−11

@@ -55,14 +55,3 @@ optsOptionField = optsDefault

5555 { fieldLabelModifier = const "field"

5656 , omitNothingFields = True

5757 }

58−

59−optsRejectUnknownFields :: Options

60−optsRejectUnknownFields = optsDefault

61− { rejectUnknownFields = True

62− }

63−

64−optsRejectUnknownFieldsTagged :: Options

65−optsRejectUnknownFieldsTagged = optsDefault

66− { rejectUnknownFields = True

67− , tagSingleConstructors = True

68− }

tests/UnitTests.hs+4−106

@@ -33,15 +33,15 @@ import Data.Aeson.Parser

3333 ( json, jsonLast, jsonAccum, jsonNoDup

3434 , json', jsonLast', jsonAccum', jsonNoDup')

3535import Data.Aeson.Types

36− ( Options(..), Result(Success, Error), ToJSON(..)

37− , Value(Array, Bool, Null, Number, Object, String), camelTo, camelTo2

38− , defaultOptions, formatPath, formatRelativePath, omitNothingFields, parse)

36+ ( Options(..), Result(Success), ToJSON(..), Value(Array, Bool, Null, Object)

37+ , camelTo, camelTo2, defaultOptions, formatPath, formatRelativePath

38+ , omitNothingFields, parse)

3939import Data.Attoparsec.ByteString (Parser, parseOnly)

4040import Data.Char (toUpper)

4141import Data.Either.Compat (isLeft, isRight)

4242import Data.Hashable (hash)

4343import Data.HashMap.Strict (HashMap)

44−import Data.List (sort, isSuffixOf)

44+import Data.List (sort)

4545import Data.Maybe (fromMaybe)

4646import Data.Scientific (Scientific, scientific)

4747import Data.Tagged (Tagged(..))

@@ -112,12 +112,8 @@ tests = testGroup "unit" [

112112 , testGroup "SingleMaybeField" singleMaybeField

113113 , testCase "withEmbeddedJSON" withEmbeddedJSONTest

114114 , testCase "SingleFieldCon" singleFieldCon

115− , testGroup "UnknownFields" unknownFields

116115 , testGroup "Ordering of object keys" keyOrdering

117116 , testCase "Ratio with denominator 0" ratioDenominator0

118− , testCase "Rational parses number" rationalNumber

119− , testCase "Big rational" bigRationalDecoding

120− , testCase "Small rational" smallRationalDecoding

121117 , testCase "Big scientific exponent" bigScientificExponent

122118 , testCase "Big integer decoding" bigIntegerDecoding

123119 , testCase "Big natural decading" bigNaturalDecoding

@@ -540,7 +536,6 @@ showOptions =

540536 ++ ", sumEncoding = TaggedObject {tagFieldName = \"tag\", contentsFieldName = \"contents\"}"

541537 ++ ", unwrapUnaryRecords = False"

542538 ++ ", tagSingleConstructors = False"

543− ++ ", rejectUnknownFields = False"

544539 ++ "}")

545540 (show defaultOptions)

546541

@@ -585,79 +580,6 @@ singleFieldCon :: Assertion

585580singleFieldCon =

586581 assertEqual "fromJSON" (Right (SingleFieldCon 0)) (eitherDecode "0")

587582

588−newtype UnknownFields = UnknownFields { knownField :: Int }

589− deriving (Eq, Show, Generic)

590−newtype UnknownFieldsTag = UnknownFieldsTag { tag :: Int }

591− deriving (Eq, Show, Generic)

592−newtype UnknownFieldsUnaryTagged = UnknownFieldsUnaryTagged { knownFieldUnaryTagged :: Int }

593− deriving (Eq, Show, Generic)

594−data UnknownFieldsSum

595− = UnknownFields1 { knownField1 :: Int }

596− | UnknownFields2 { knownField2 :: Int }

597− deriving (Eq, Show, Generic)

598−

599−unknownFields :: [TestTree]

600−unknownFields = concat

601− [ testsUnary

602− "unary-unknown"

603− (object [("knownField", Number 1), ("unknownField", Number 1)])

604− (Error "nknown fields: [\"unknownField\"]" :: Result UnknownFields)

605− , testsUnary

606− "unary-unknown-tag"

607− (object [("knownField", Number 1), ("tag", String "UnknownFields")])

608− (Error "nknown fields: [\"tag\"]" :: Result UnknownFields)

609− , testsUnaryTag

610− "unary-explicit-tag"

611− (object [("tag", Number 1)])

612− (Success $ UnknownFieldsTag 1)

613− , testsSum

614− "sum-tag"

615− (object [("knownField1", Number 1), ("tag", String "UnknownFields1")])

616− (Success $ UnknownFields1 1)

617− , testsSum

618− "sum-unknown-in-branch"

619− (object [("knownField1", Number 1), ("knownField2", Number 1), ("tag", String "UnknownFields1")])

620− (Error "nknown fields: [\"knownField2\"]" :: Result UnknownFieldsSum)

621− , testsSum

622− "sum-unknown"

623− (object [("knownField1", Number 1), ("unknownField", Number 1), ("tag", String "UnknownFields1")])

624− (Error "nknown fields: [\"unknownField\"]" :: Result UnknownFieldsSum)

625− , testsTagged

626− "unary-tagged"

627− (object [("knownFieldUnaryTagged", Number 1), ("tag", String "UnknownFieldsUnaryTagged")])

628− (Success $ UnknownFieldsUnaryTagged 1)

629− , -- Just a case to verify that the tag isn't optional, this is likely already tested by other unit tests

630− testsTagged

631− "unary-tagged-notag"

632− (object [("knownFieldUnaryTagged", Number 1)])

633− (Error "key \"tag\" not found" :: Result UnknownFieldsUnaryTagged)

634− , testsTagged

635− "unary-tagged-unknown"

636− (object [ ("knownFieldUnaryTagged", Number 1), ("unknownField", Number 1)

637− , ("tag", String "UnknownFieldsUnaryTagged")])

638− (Error "nknown fields: [\"unknownField\"]" :: Result UnknownFieldsUnaryTagged)

639− ]

640− where

641− opts = defaultOptions{rejectUnknownFields=True}

642− taggedOpts = opts{tagSingleConstructors=True}

643− assertApprox :: (Show a, Eq a) => Result a -> Result a -> IO ()

644− assertApprox (Error expected) (Error actual) | expected `isSuffixOf` actual = return ()

645− assertApprox expected actual = assertEqual "fromJSON" expected actual

646− testsBase :: (Show a, Eq a) => (Value -> Result a) -> (Value -> Result a)

647− -> String -> Value -> Result a -> [TestTree]

648− testsBase th g name value expected =

649− [ testCase (name ++ "-th") $ assertApprox expected (th value)

650− , testCase (name ++ "-generic") $ assertApprox expected (g value)

651− ]

652− testsUnary :: String -> Value -> Result UnknownFields -> [TestTree]

653− testsUnary = testsBase fromJSON (parse (genericParseJSON opts))

654− testsUnaryTag :: String -> Value -> Result UnknownFieldsTag -> [TestTree]

655− testsUnaryTag = testsBase fromJSON (parse (genericParseJSON opts))

656− testsSum :: String -> Value -> Result UnknownFieldsSum -> [TestTree]

657− testsSum = testsBase fromJSON (parse (genericParseJSON opts))

658− testsTagged :: String -> Value -> Result UnknownFieldsUnaryTagged -> [TestTree]

659− testsTagged = testsBase fromJSON (parse (genericParseJSON taggedOpts))

660−

661583testParser :: (Eq a, Show a)

662584 => String -> Parser a -> S.ByteString -> Either String a -> TestTree

663585testParser name json_ s expected =

@@ -698,25 +620,6 @@ ratioDenominator0 =

698620 (Left "Error in $: Ratio denominator was 0")

699621 (eitherDecode "{ \"numerator\": 1, \"denominator\": 0 }" :: Either String Rational)

700622

701−rationalNumber :: Assertion

702−rationalNumber =

703− assertEqual "Ratio with denominator 0"

704− (Right 1.37)

705− (eitherDecode "1.37" :: Either String Rational)

706−

707−bigRationalDecoding :: Assertion

708−bigRationalDecoding =

709− assertEqual "Decoding an Integer with a large exponent should fail"

710− (Left "Error in $: parsing Ratio failed, found a number with exponent 2000, but it must not be greater than 1024 or less than -1024")

711− ((eitherDecode :: L.ByteString -> Either String Rational) "1e2000")

712−

713−smallRationalDecoding :: Assertion

714−smallRationalDecoding =

715− assertEqual "Decoding an Integer with a large exponent should fail"

716− (Left "Error in $: parsing Ratio failed, found a number with exponent -2000, but it must not be greater than 1024 or less than -1024")

717− ((eitherDecode :: L.ByteString -> Either String Rational) "1e-2000")

718−

719−

720623bigScientificExponent :: Assertion

721624bigScientificExponent =

722625 assertEqual "Encoding an integral scientific with a large exponent should normalize it"

@@ -753,8 +656,3 @@ deriveToJSON defaultOptions ''Foo

753656deriveToJSON1 defaultOptions ''Foo

754657

755658deriveJSON defaultOptions{omitNothingFields=True,unwrapUnaryRecords=True} ''SingleMaybeField

756−

757−deriveJSON defaultOptions{rejectUnknownFields=True} ''UnknownFields

758−deriveJSON defaultOptions{rejectUnknownFields=True} ''UnknownFieldsTag

759−deriveJSON defaultOptions{tagSingleConstructors=True,rejectUnknownFields=True} ''UnknownFieldsUnaryTagged

760−deriveJSON defaultOptions{rejectUnknownFields=True} ''UnknownFieldsSum

tests/golden/generic.expected−8

@@ -31,14 +31,6 @@ Error in $: parsing Types.SomeType failed, expected a 2-element Array, but encou

3131Error in $: parsing Types.SomeType failed, expected Array, but encountered Object

3232Error in $: not enough input. Expecting ',' or ']'

3333Error in $: not enough input. Expecting json list value

34−SomeType (reject unknown fields)

35−Error in $: parsing Types.SomeType(Record) failed, unknown fields: ["testZero"]

36−Error in $: parsing Types.SomeType failed, expected Object with key "tag" containing one of ["nullary","unary","product","record","list"], key "tag" not found

37−Error in $: parsing Types.SomeType(Record) failed, unknown fields: ["testtwo","testone","testthree"]

38−Foo (reject unknown fields)

39−Error in $: parsing Types.Foo(Foo) failed, unknown fields: ["tag"]

40−Foo (reject unknown fields, tagged single)

41−Error in $: parsing Types.Foo(Foo) failed, unknown fields: ["unknownField"]

4234EitherTextInt

4335Error in $: parsing Types.EitherTextInt(NoneNullary) failed, expected tag "nonenullary", but found tag "X"

4436Error in $: parsing Types.EitherTextInt(NoneNullary) failed, expected String, but encountered Array