on master help sign in
Merge with Eduard
commit1c03ee4940fffc33b3259024a696caa73224b4fd authorBryan O'Sullivan <bos@serpentine.com> dateMon 7 Nov 2011, 21:38 (15 years ago) parentfa9c2ab2aa2513
2 files changed+31−5
Data/Aeson/Generic.hs+8−5 tests/Properties.hs+23
Data/Aeson/Generic.hs+8−5
@@ -112,6 +112,13 @@ toJSON = toJSON_generic
112112 remap f = Object . hashMap (f . fromJust . cast) toJSON $ m
113113
114114
115+-- Skip leading '_' in field name so we can use keywords
116+-- etc. as field names.
117+mungeField :: String -> Text
118+mungeField ('_':cs) = pack cs
119+mungeField cs = pack cs
120+
121+
115122toJSON_generic :: (Data a) => a -> Value
116123toJSON_generic = generic
117124 where
@@ -146,10 +153,6 @@ toJSON_generic = generic
146153 encodeArgs' [] js = Array . V.fromList $ js
147154 encodeArgs' ns js = object $ zip (map mungeField ns) js
148155
149− -- Skip leading '_' in field name so we can use keywords
150− -- etc. as field names.
151− mungeField ('_':cs) = pack cs
152− mungeField cs = pack cs
153156
154157fromJSON :: (Data a) => Value -> Result a
155158fromJSON = parse parseJSON
@@ -284,7 +287,7 @@ parseJSON_generic j = generic
284287 -- Select the named fields from a JSON object.
285288 selectFields fjs = mapM sel
286289 where sel f = maybe (modFail "parseJSON" $ "field does not exist " ++
287− f) return $ Map.lookup (pack f) fjs
290+ f) return $ Map.lookup (mungeField f) fjs
288291
289292 -- Count how many arguments a constructor has. The value x is
290293 -- used to determine what type the constructor returns.
tests/Properties.hs+23
@@ -56,6 +56,12 @@ toFromJSON x = case fromJSON . toJSON $ x of
5656 Error _ -> False
5757 Success x' -> x == x'
5858
59+genericToFromJSON :: (Arbitrary a, Eq a, Data a) => a -> Bool
60+genericToFromJSON x = case G.fromJSON . G.toJSON $ x of
61+ Error _ -> False
62+ Success x' -> x == x'
63+
64+
5965data Foo = Foo {
6066 fooInt :: Int
6167 , fooDouble :: Double
@@ -94,6 +100,20 @@ instance (Ord k, Arbitrary k, Arbitrary v) => Arbitrary (Map.Map k v) where
94100instance Arbitrary Foo where
95101 arbitrary = liftM4 Foo arbitrary arbitrary arbitrary arbitrary
96102
103+
104+{-
105+ Test for Data.Aeson.Generic handling '_' names
106+-}
107+data UFoo = UFoo {
108+ _UFooInt :: Int
109+ , uFooInt :: Int
110+ } deriving (Show, Eq, Data, Typeable)
111+
112+instance Arbitrary UFoo where
113+ arbitrary = UFoo <$> arbitrary <*> arbitrary
114+
115+
116+
97117main :: IO ()
98118main = defaultMain tests
99119
@@ -130,5 +150,8 @@ tests = [
130150 , testProperty "Maybe Integer" (toFromJSON :: Maybe Integer -> Bool)
131151 , testProperty "Either Integer Double" (toFromJSON :: Either Integer Double -> Bool)
132152 , testProperty "Either Integer Integer" (toFromJSON :: Either Integer Integer -> Bool)
153+ ],
154+ testGroup "genericToFromJSON" [
155+ testProperty "_UFoo" (genericToFromJSON :: UFoo -> Bool)
133156 ]
134157 ]