[Git][haskell-team/DHG_packages][master] aeson: Backport patch to fix failing tests

[Ilias Tsitsimpis]

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>