[Git][haskell-team/DHG_packages][master] aeson: Backport patch to fix failing tests
Ilias Tsitsimpis
gitlab at salsa.debian.org
Sun Jun 7 18:29:17 BST 2020
Ilias Tsitsimpis pushed to branch master at Debian Haskell Group / DHG_packages
Commits:
1c432d88 by Ilias Tsitsimpis at 2020-06-07T20:28:46+03:00
aeson: Backport patch to fix failing tests
- - - - -
3 changed files:
- p/haskell-aeson/debian/changelog
- + p/haskell-aeson/debian/patches/fix-rejectUnknownFields
- + p/haskell-aeson/debian/patches/series
Changes:
=====================================
p/haskell-aeson/debian/changelog
=====================================
@@ -1,3 +1,9 @@
+haskell-aeson (1.4.7.1-2) unstable; urgency=medium
+
+ * Backport patch to fix failing tests
+
+ -- Ilias Tsitsimpis <iliastsi at debian.org> Sun, 07 Jun 2020 19:44:54 +0300
+
haskell-aeson (1.4.7.1-1) unstable; urgency=medium
* New upstream release
=====================================
p/haskell-aeson/debian/patches/fix-rejectUnknownFields
=====================================
@@ -0,0 +1,103 @@
+commit 143da4ee9328941863ff2eca2490cfce66e055bd
+Author: Markus Schirp <mbj at schirp-dso.com>
+Date: Sun May 3 02:53:30 2020 +0000
+
+ Fix `rejectUnknownFields` to respect `fieldLabelModifier`
+
+ * Apply `fieldLabelModifier` to known fields reflected from the
+ `FieldName` class. While NOT applying the `fieldLabelModofier` to the
+ encoding tags.
+ * Change the intermediary type returned by the `FieldName` class from
+ `Text` to `String` to reduce `{un,}pack` calls to a minimum.
+ * Update tests which specified the problem before to assert the fixed
+ semantics.
+
+ [fix #773]
+
+Index: b/Data/Aeson/TH.hs
+===================================================================
+--- a/Data/Aeson/TH.hs
++++ b/Data/Aeson/TH.hs
+@@ -939,7 +939,7 @@ parseRecord jc tvMap argTys opts tName c
+ if inTaggedObject then (tagFieldName (sumEncoding opts) :) else id
+ knownFields = appE [|H.fromList|] $ listE $
+ map (\knownName -> tupE [appE [|T.pack|] $ litE $ stringL knownName, [|()|]]) $
+- tagFieldNameAppender $ map nameBase fields
++ tagFieldNameAppender $ map (fieldLabel opts) fields
+ checkUnknownRecords =
+ caseE (appE [|H.keys|] $ infixApp (varE obj) [|H.difference|] knownFields)
+ [ match (listP []) (normalB [|return ()|]) []
+Index: b/Data/Aeson/Types/FromJSON.hs
+===================================================================
+--- a/Data/Aeson/Types/FromJSON.hs
++++ b/Data/Aeson/Types/FromJSON.hs
+@@ -1274,7 +1274,7 @@ instance (ProductFromJSON arity f, Produ
+ --------------------------------------------------------------------------------
+
+ class FieldNames f where
+- fieldNames :: f a -> [Text] -> [Text]
++ fieldNames :: f a -> [String] -> [String]
+
+ instance (FieldNames a, FieldNames b) => FieldNames (a :*: b) where
+ fieldNames _ =
+@@ -1282,7 +1282,7 @@ instance (FieldNames a, FieldNames b) =>
+ fieldNames (undefined :: b y)
+
+ instance (Selector s) => FieldNames (S1 s f) where
+- fieldNames _ = (pack (selName (undefined :: M1 _i s _f _p)) :)
++ fieldNames _ = (selName (undefined :: M1 _i s _f _p) :)
+
+ class RecordFromJSON arity f where
+ recordParseJSON
+@@ -1296,9 +1296,10 @@ instance ( FieldNames f
+ \obj -> checkUnknown obj >> recordParseJSON' p obj
+ where
+ knownFields :: H.HashMap Text ()
+- knownFields = H.fromList $ map (,()) $
+- fieldNames (undefined :: f a)
+- [pack (tagFieldName (sumEncoding opts)) | fromTaggedSum]
++ knownFields = H.fromList $ map ((,()) . pack) $
++ [tagFieldName (sumEncoding opts) | fromTaggedSum] <>
++ (fieldLabelModifier opts <$> fieldNames (undefined :: f a) [])
++
+ checkUnknown =
+ if not (rejectUnknownFields opts)
+ then \_ -> return ()
+Index: b/changelog.md
+===================================================================
+--- a/changelog.md
++++ b/changelog.md
+@@ -3,6 +3,7 @@ For the latest version of this document,
+ #### 1.4.7.1
+
+ * GHC 8.10 compatibility, thanks to Ryan Scott.
++* Fix bug in `rejectUnknownFields` not respecting `fieldLabelModifier`.
+
+ ### 1.4.7.0
+
+Index: b/tests/ErrorMessages.hs
+===================================================================
+--- a/tests/ErrorMessages.hs
++++ b/tests/ErrorMessages.hs
+@@ -140,7 +140,7 @@ outputGeneric choice = concat
+ (select
+ thSomeTypeParseJSONRejectUnknownFields
+ gSomeTypeParseJSONRejectUnknownFields)
+- [ "{\"tag\": \"record\", \"testOne\": 1.0, \"testZero\": 1}"
++ [ "{\"tag\": \"record\", \"testone\": 1.0, \"testZero\": 1}"
+ , "{\"testZero\": 1}"
+ , "{\"tag\": \"record\", \"testone\": true, \"testtwo\": null, \"testthree\": null}"
+ ]
+Index: b/tests/golden/generic.expected
+===================================================================
+--- a/tests/golden/generic.expected
++++ b/tests/golden/generic.expected
+@@ -34,7 +34,7 @@ Error in $: not enough input. Expecting
+ SomeType (reject unknown fields)
+ Error in $: parsing Types.SomeType(Record) failed, unknown fields: ["testZero"]
+ Error in $: parsing Types.SomeType failed, expected Object with key "tag" containing one of ["nullary","unary","product","record","list"], key "tag" not found
+-Error in $: parsing Types.SomeType(Record) failed, unknown fields: ["testtwo","testone","testthree"]
++Error in $.testone: parsing Double failed, unexpected Boolean
+ Foo (reject unknown fields)
+ Error in $: parsing Types.Foo(Foo) failed, unknown fields: ["tag"]
+ Foo (reject unknown fields, tagged single)
=====================================
p/haskell-aeson/debian/patches/series
=====================================
@@ -0,0 +1 @@
+fix-rejectUnknownFields
View it on GitLab: https://salsa.debian.org/haskell-team/DHG_packages/-/commit/1c432d88e9d3ed7c63ace03482758df92bb09d15
--
View it on GitLab: https://salsa.debian.org/haskell-team/DHG_packages/-/commit/1c432d88e9d3ed7c63ace03482758df92bb09d15
You're receiving this email because of your account on salsa.debian.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://alioth-lists.debian.net/pipermail/pkg-haskell-commits/attachments/20200607/436e2b1a/attachment-0001.html>
More information about the Pkg-haskell-commits
mailing list