on master help sign in
Remove isUnary

Instead decide at compile time whether a record is unary

commit8b007a82e5606dc87771f8f567aa6f90e692f2db authorLysxia <lysxia@gmail.com> dateTue 27 Mar 2018, 11:43 (9 years ago) parentb8283bc
3 files changed+16−17
Data/Aeson/Types/FromJSON.hs+2−2 Data/Aeson/Types/Generic.hs−5 Data/Aeson/Types/ToJSON.hs+14−10
Data/Aeson/Types/FromJSON.hs+2−2
@@ -1004,7 +1004,7 @@ instance ( IsRecord f isRecord
10041004
10051005instance OVERLAPPING_
10061006 ( GFromJSON arity a, FromRecord arity (S1 s a)
1007− ) => ConsFromJSON' arity (S1 s a) 'True where
1007+ ) => ConsFromJSON' arity (S1 s a) True where
10081008 consParseJSON' opts fargs
10091009 | unwrapUnaryRecords opts = Tagged . gParseJSON opts fargs
10101010 | otherwise = Tagged . withObject "unary record" (parseRecord opts fargs)
@@ -1013,7 +1013,7 @@ instance FromRecord arity f => ConsFromJSON' arity f True where
10131013 consParseJSON' opts fargs =
10141014 Tagged . withObject "record (:*:)" (parseRecord opts fargs)
10151015
1016−instance (GFromJSON arity f) => ConsFromJSON' arity f False where
1016+instance GFromJSON arity f => ConsFromJSON' arity f False where
10171017 consParseJSON' opts fargs = Tagged . gParseJSON opts fargs
10181018
10191019--------------------------------------------------------------------------------
Data/Aeson/Types/Generic.hs−5
@@ -44,12 +44,8 @@ import GHC.Generics
4444--------------------------------------------------------------------------------
4545
4646class IsRecord (f :: * -> *) isRecord | f -> isRecord
47− where
48− isUnary :: f a -> Bool
49− isUnary = const True
5047
5148instance (IsRecord f isRecord) => IsRecord (f :*: g) isRecord
52− where isUnary = const False
5349#if MIN_VERSION_base(4,9,0)
5450instance OVERLAPPING_ IsRecord (M1 S ('MetaSel 'Nothing u ss ds) f) False
5551#else
@@ -61,7 +57,6 @@ instance IsRecord Par1 True
6157instance IsRecord (Rec1 f) True
6258instance IsRecord (f :.: g) True
6359instance IsRecord U1 False
64− where isUnary = const False
6560
6661--------------------------------------------------------------------------------
6762
Data/Aeson/Types/ToJSON.hs+14−10
@@ -956,7 +956,6 @@ class ConsToJSON enc arity f where
956956
957957class ConsToJSON' enc arity f isRecord where
958958 consToJSON' :: Options -> ToArgs enc arity a
959− -> Bool -- ^ Are we a record with one field?
960959 -> f a -> Tagged isRecord enc
961960
962961instance ( IsRecord f isRecord
@@ -965,23 +964,28 @@ instance ( IsRecord f isRecord
965964 where
966965 consToJSON opts targs =
967966 (unTagged :: Tagged isRecord enc -> enc)
968− . consToJSON' opts targs (isUnary (undefined :: f a))
967+ . consToJSON' opts targs
969968 {-# INLINE consToJSON #-}
970969
971−instance ( RecordToPairs enc pairs arity f
970+instance OVERLAPPING_
971+ ( RecordToPairs enc pairs arity (S1 s f)
972972 , FromPairs enc pairs
973973 , GToJSON enc arity f
974− ) => ConsToJSON' enc arity f True
974+ ) => ConsToJSON' enc arity (S1 s f) True
975975 where
976− consToJSON' opts targs isUn =
977− Tagged .
978− case (isUn, unwrapUnaryRecords opts) of
979− (True, True) -> gToJSON opts targs
980− _ -> fromPairs . recordToPairs opts targs
976+ consToJSON' opts targs
977+ | unwrapUnaryRecords opts = Tagged . gToJSON opts targs
978+ | otherwise = Tagged . fromPairs . recordToPairs opts targs
981979 {-# INLINE consToJSON' #-}
982980
981+instance ( RecordToPairs enc pairs arity f
982+ , FromPairs enc pairs
983+ ) => ConsToJSON' enc arity f True
984+ where
985+ consToJSON' opts targs = Tagged . fromPairs . recordToPairs opts targs
986+
983987instance GToJSON enc arity f => ConsToJSON' enc arity f False where
984− consToJSON' opts targs _ = Tagged . gToJSON opts targs
988+ consToJSON' opts targs = Tagged . gToJSON opts targs
985989 {-# INLINE consToJSON' #-}
986990
987991--------------------------------------------------------------------------------