on master help sign in
Merge pull request #455 from RyanGlScott/master

Fix TH bug when deriving ToJSON1/2 or FromJSON1/2 for types that don't mention the parameter

commit29eeac44052eaa07c31d011deee82dab6c59ee93 authorAdam Bergmark <adam@bergmark.nl> dateWed 27 Jul 2016, 17:31 (10 years ago) parent8869d71906c3ad
2 files changed+24−7
Data/Aeson/TH.hs+6−4 tests/UnitTests.hs+18−3
Data/Aeson/TH.hs+6−4
@@ -1408,10 +1408,12 @@ dispatchFunByType jc jf conName tvMap list ty = do
14081408 if any (`mentionsName` tyVarNames) lhsArgs
14091409 || itf && any (`mentionsName` tyVarNames) tyArgs
14101410 then outOfPlaceTyVarError jc conName
1411− else appsE $ varE (jsonFunValOrListName list jf $ toEnum numLastArgs)
1412− : zipWith (dispatchFunByType jc jf conName tvMap)
1413− (cycle [False,True])
1414− (interleave rhsArgs rhsArgs)
1411+ else if any (`mentionsName` tyVarNames) rhsArgs
1412+ then appsE $ varE (jsonFunValOrListName list jf $ toEnum numLastArgs)
1413+ : zipWith (dispatchFunByType jc jf conName tvMap)
1414+ (cycle [False,True])
1415+ (interleave rhsArgs rhsArgs)
1416+ else varE $ jsonFunValOrListName list jf Arity0
14151417
14161418dispatchToJSON, dispatchToEncoding, dispatchParseJSON
14171419 :: JSONClass -> Name -> TyVarMap -> Type -> Q Exp
tests/UnitTests.hs+18−3
@@ -15,10 +15,10 @@ import Instances ()
1515
1616import Control.Applicative (Const(..))
1717import Control.Monad (forM)
18−import Data.Aeson (FromJSONKeyFunction(..), FromJSONKey(..), decode, eitherDecode, encode, genericParseJSON, genericToJSON, genericToEncoding, object, FromJSON(..), withObject, (.=), (.:), (.:?), (.:!))
18+import Data.Aeson (FromJSONKeyFunction(..), FromJSONKey(..), decode, eitherDecode, encode, genericParseJSON, genericToJSON, genericToEncoding, object, FromJSON(..), withObject, ToJSON1(..), (.=), (.:), (.:?), (.:!))
1919import Data.Aeson.Text (encodeToTextBuilder)
2020import Data.Aeson.Internal (JSONPathElement(..), formatError)
21−import Data.Aeson.TH (deriveJSON)
21+import Data.Aeson.TH (deriveJSON, deriveToJSON, deriveToJSON1)
2222import Data.Aeson.Types (ToJSON(..), Value, camelTo, camelTo2, defaultOptions, omitNothingFields, Options(..), SumEncoding(..))
2323import Data.Char (toUpper)
2424import Data.Hashable (hash)
@@ -93,6 +93,7 @@ tests = testGroup "unit" [
9393 , testGroup "Issue #351" $ fmap (testCase "-") issue351
9494 , testGroup "Nullary constructors" $ fmap (testCase "-") nullaryConstructors
9595 , testGroup "FromJSONKey" $ fmap (testCase "-") fromJSONKeyAssertions
96+ , testCase "PR #455" pr455
9697 ]
9798
9899roundTripCamel :: String -> Assertion
@@ -544,10 +545,24 @@ encoderComparisonTests = do
544545
545546-- A regression test for: https://github.com/bos/aeson/issues/293
546547data MyRecord = MyRecord {_field1 :: Maybe Int, _field2 :: Maybe Bool}
547−deriveJSON defaultOptions{omitNothingFields=True} ''MyRecord
548548
549549data MyRecord2 = MyRecord2 {_field3 :: Maybe Int, _field4 :: Maybe Bool}
550550 deriving Generic
551551
552552instance ToJSON MyRecord2
553553instance FromJSON MyRecord2
554+
555+-- A regression test for: https://github.com/bos/aeson/pull/455
556+data Foo a = FooNil | FooCons (Foo Int)
557+
558+pr455 :: Assertion
559+pr455 = assertEqual "FooCons FooNil"
560+ (toJSON foo) (liftToJSON undefined undefined foo)
561+ where
562+ foo :: Foo Int
563+ foo = FooCons FooNil
564+
565+deriveJSON defaultOptions{omitNothingFields=True} ''MyRecord
566+
567+deriveToJSON defaultOptions ''Foo
568+deriveToJSON1 defaultOptions ''Foo