on master help sign in
Add roundtrip key tests
commit1cde7f1cdd20bff5e9f0f1bd4d309a42c675fe99 authorOleg Grenrus <oleg.grenrus@iki.fi> dateWed 8 Jun 2016, 01:16 (10 years ago) parent8a1eb2a
2 files changed+24−1
Data/Aeson/Types/FromJSON.hs+7−1 tests/Properties.hs+17
Data/Aeson/Types/FromJSON.hs+7−1
@@ -1388,10 +1388,16 @@ instance FromJSONKey b => FromJSONKey (Tagged a b) where
13881388instance FromJSONKey Text where
13891389 fromJSONKey = fromJSONKeyCoerce
13901390
1391+instance FromJSONKey Bool where
1392+ fromJSONKey = FromJSONKeyTextParser $ \t -> case t of
1393+ "true" -> pure True
1394+ "false" -> pure False
1395+ _ -> fail $ "Cannot parse key into Bool: " ++ T.unpack t
1396+
13911397instance FromJSONKey Int where
13921398 -- not sure if there if there is already a helper in
13931399 -- aeson for doing this.
1394− fromJSONKey = FromJSONKeyTextParser $ \t -> case TR.decimal t of
1400+ fromJSONKey = FromJSONKeyTextParser $ \t -> case TR.signed TR.decimal t of
13951401 Left err -> fail err
13961402 Right (v,t2) -> if T.null t2
13971403 then return v
tests/Properties.hs+17
@@ -12,6 +12,9 @@ import Data.ByteString.Builder (toLazyByteString)
1212import Data.Int (Int8)
1313import Data.Sequence (Seq)
1414import Data.DList (DList)
15+import Data.Hashable (Hashable)
16+import Data.HashMap.Strict (HashMap)
17+import Data.Map (Map)
1518import Data.List.NonEmpty (NonEmpty)
1619import Data.Time (Day, LocalTime, NominalDiffTime, TimeOfDay, UTCTime,
1720 ZonedTime)
@@ -66,6 +69,12 @@ roundTripNoEnc eq _ i =
6669roundTripEq :: (Eq a, FromJSON a, ToJSON a, Show a) => a -> a -> Property
6770roundTripEq x y = roundTripEnc (===) x y .&&. roundTripNoEnc (===) x y
6871
72+-- We test keys by encoding HashMap and Map with it
73+roundTripKey
74+ :: (Ord a, Hashable a, FromJSONKey a, ToJSONKey a, Show a)
75+ => a -> HashMap a Int -> Map a Int -> Property
76+roundTripKey _ h m = roundTripEq h h .&&. roundTripEq m m
77+
6978infix 4 ==~
7079(==~) :: (ApproxEq a, Show a) => a -> a -> Property
7180x ==~ y =
@@ -163,6 +172,14 @@ tests = testGroup "properties" [
163172 , testProperty "Sum4" $ roundTripEq (undefined :: S4)
164173 ]
165174 ]
175+ , testGroup "roundTrip Key"
176+ [ testProperty "Bool" $ roundTripKey True
177+ , testProperty "Text" $ roundTripKey (undefined :: T.Text)
178+ , testProperty "String" $ roundTripKey (undefined :: String)
179+ , testProperty "Int" $ roundTripKey (undefined :: Int)
180+ , testProperty "[Text]" $ roundTripKey (undefined :: [T.Text])
181+ , testProperty "(Int,Char)" $ roundTripKey (undefined :: (Int,Char))
182+ ]
166183 , testGroup "toFromJSON" [
167184 testProperty "Integer" (toFromJSON :: Integer -> Property)
168185 , testProperty "Double" (toFromJSON :: Double -> Property)