From c7a344be08a2d308f066a1a57c740788b3792276 Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Mon, 19 Sep 2011 14:36:09 -0500 Subject: [PATCH 1/6] Add test support. --- aeson.cabal | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/aeson.cabal b/aeson.cabal index 0d9def2bf..0ddf1af09 100644 --- a/aeson.cabal +++ b/aeson.cabal @@ -135,6 +135,22 @@ library ghc-options: -Wall +test-suite tests + type: exitcode-stdio-1.0 + hs-source-dirs: tests + main-is: Properties.hs + + ghc-options: + -Wall -threaded -rtsopts + + build-depends: + aeson, + attoparsec, + base, + bytestring, + test-framework, + test-framework-quickcheck2 + source-repository head type: git location: http://github.com/mailrank/aeson From adf9cce3123af1bc326a73f8f0907c6ef2d91b71 Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Mon, 19 Sep 2011 14:53:55 -0500 Subject: [PATCH 2/6] Use a better comparison for encoded Double values. --- tests/Properties.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/Properties.hs b/tests/Properties.hs index ed6a02843..95669752f 100644 --- a/tests/Properties.hs +++ b/tests/Properties.hs @@ -12,7 +12,7 @@ import qualified Data.Attoparsec.Lazy as L encodeDouble :: Double -> Double -> Bool encodeDouble num denom | isInfinite d || isNaN d = encode (Number (D d)) == "null" - | otherwise = encode (Number (D d)) == L.pack (show d) + | otherwise = (read . L.unpack . encode . Number . D) d == d where d = num / denom encodeInteger :: Integer -> Bool From fe906878802a983459cc7e7d3a2d4d1524c90111 Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Mon, 19 Sep 2011 16:11:47 -0500 Subject: [PATCH 3/6] Test round-tripping of compound types. --- aeson.cabal | 4 +++- tests/Properties.hs | 42 ++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 43 insertions(+), 3 deletions(-) diff --git a/aeson.cabal b/aeson.cabal index 0ddf1af09..08d707568 100644 --- a/aeson.cabal +++ b/aeson.cabal @@ -144,12 +144,14 @@ test-suite tests -Wall -threaded -rtsopts build-depends: + QuickCheck, aeson, attoparsec, base, bytestring, test-framework, - test-framework-quickcheck2 + test-framework-quickcheck2, + text source-repository head type: git diff --git a/tests/Properties.hs b/tests/Properties.hs index 95669752f..9522323b2 100644 --- a/tests/Properties.hs +++ b/tests/Properties.hs @@ -1,13 +1,18 @@ -{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings, RecordWildCards, ScopedTypeVariables #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +import Control.Applicative import Data.Aeson.Encode import Data.Aeson.Parser (value) import Data.Aeson.Types import Data.Attoparsec.Number +import Data.Text (Text) import Test.Framework (Test, defaultMain, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) -import qualified Data.ByteString.Lazy.Char8 as L +import Test.QuickCheck (Arbitrary(..)) import qualified Data.Attoparsec.Lazy as L +import qualified Data.ByteString.Lazy.Char8 as L +import qualified Data.Text as T encodeDouble :: Double -> Double -> Bool encodeDouble num denom @@ -30,6 +35,8 @@ roundTripDouble :: Double -> Bool roundTripDouble = roundTrip approxEq roundTripInteger :: Integer -> Bool roundTripInteger = roundTrip (==) +roundTripFoo :: Foo -> Bool +roundTripFoo = roundTrip (==) approxEq :: Double -> Double -> Bool approxEq a b = a == b || @@ -39,6 +46,36 @@ approxEq a b = a == b || maxAbsoluteError = 1e-15 maxRelativeError = 1e-15 +data Foo = Foo { + fooInt :: Int + , fooDouble :: Double + , fooTuple :: (String, Text) + } deriving (Show) + +instance Eq Foo where + a == b = fooInt a == fooInt b && + fooDouble a `approxEq` fooDouble b && + fooTuple a == fooTuple b + +instance ToJSON Foo where + toJSON Foo{..} = object [ "int" .= fooInt + , "double" .= fooDouble + , "tuple" .= fooTuple + ] + +instance FromJSON Foo where + parseJSON (Object v) = Foo <$> + v .: "int" <*> + v .: "double" <*> + v .: "tuple" + parseJSON _ = empty + +instance Arbitrary Text where + arbitrary = T.pack <$> arbitrary + +instance Arbitrary Foo where + arbitrary = liftA3 Foo arbitrary arbitrary arbitrary + main :: IO () main = defaultMain tests @@ -52,5 +89,6 @@ tests = [ testProperty "roundTripBool" roundTripBool , testProperty "roundTripDouble" roundTripDouble , testProperty "roundTripInteger" roundTripInteger + , testProperty "roundTripFoo" roundTripFoo ] ] From 9ec56941020cd7308fcac7af5d954c6fc27edd81 Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Mon, 19 Sep 2011 16:31:02 -0500 Subject: [PATCH 4/6] See if generic JSON conversion is behaving. --- tests/Properties.hs | 53 ++++++++++++++++++++++++++------------------- 1 file changed, 31 insertions(+), 22 deletions(-) diff --git a/tests/Properties.hs b/tests/Properties.hs index 9522323b2..610ad9996 100644 --- a/tests/Properties.hs +++ b/tests/Properties.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE OverloadedStrings, RecordWildCards, ScopedTypeVariables #-} +{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, RecordWildCards, + ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-orphans #-} import Control.Applicative @@ -6,10 +7,12 @@ import Data.Aeson.Encode import Data.Aeson.Parser (value) import Data.Aeson.Types import Data.Attoparsec.Number +import Data.Data (Typeable, Data) import Data.Text (Text) import Test.Framework (Test, defaultMain, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.QuickCheck (Arbitrary(..)) +import qualified Data.Aeson.Generic as G import qualified Data.Attoparsec.Lazy as L import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.Text as T @@ -23,20 +26,17 @@ encodeDouble num denom encodeInteger :: Integer -> Bool encodeInteger i = encode (Number (I i)) == L.pack (show i) -roundTrip :: (FromJSON a, ToJSON a) => (a -> a -> Bool) -> a -> Bool -roundTrip eq i = +roundTrip :: (FromJSON a, ToJSON a) => (a -> a -> Bool) -> a -> a -> Bool +roundTrip eq _ i = case fmap fromJSON . L.parse value . encode . toJSON $ i of L.Done _ (Success v) -> v `eq` i _ -> False -roundTripBool :: Bool -> Bool -roundTripBool = roundTrip (==) -roundTripDouble :: Double -> Bool -roundTripDouble = roundTrip approxEq -roundTripInteger :: Integer -> Bool -roundTripInteger = roundTrip (==) -roundTripFoo :: Foo -> Bool -roundTripFoo = roundTrip (==) +roundTripEq :: (Eq a, FromJSON a, ToJSON a) => a -> a -> Bool +roundTripEq x y = roundTrip (==) x y + +genericTo :: (Data a, ToJSON a) => a -> a -> Bool +genericTo _ v = G.toJSON v == toJSON v approxEq :: Double -> Double -> Bool approxEq a b = a == b || @@ -50,7 +50,7 @@ data Foo = Foo { fooInt :: Int , fooDouble :: Double , fooTuple :: (String, Text) - } deriving (Show) + } deriving (Show, Typeable, Data) instance Eq Foo where a == b = fooInt a == fooInt b && @@ -58,16 +58,16 @@ instance Eq Foo where fooTuple a == fooTuple b instance ToJSON Foo where - toJSON Foo{..} = object [ "int" .= fooInt - , "double" .= fooDouble - , "tuple" .= fooTuple + toJSON Foo{..} = object [ "fooInt" .= fooInt + , "fooDouble" .= fooDouble + , "fooTuple" .= fooTuple ] instance FromJSON Foo where parseJSON (Object v) = Foo <$> - v .: "int" <*> - v .: "double" <*> - v .: "tuple" + v .: "fooInt" <*> + v .: "fooDouble" <*> + v .: "fooTuple" parseJSON _ = empty instance Arbitrary Text where @@ -85,10 +85,19 @@ tests = [ testProperty "encodeDouble" encodeDouble , testProperty "encodeInteger" encodeInteger ], + testGroup "generic" [ + testProperty "Bool" $ genericTo True + , testProperty "Double" $ genericTo (1::Double) + , testProperty "Int" $ genericTo (1::Int) + , testProperty "Foo" $ genericTo (undefined::Foo) + ], testGroup "roundTrip" [ - testProperty "roundTripBool" roundTripBool - , testProperty "roundTripDouble" roundTripDouble - , testProperty "roundTripInteger" roundTripInteger - , testProperty "roundTripFoo" roundTripFoo + testProperty "Bool" $ roundTripEq True + , testProperty "Double" $ roundTrip approxEq (1::Double) + , testProperty "Int" $ roundTripEq (1::Int) + , testProperty "Integer" $ roundTripEq (1::Integer) + , testProperty "String" $ roundTripEq (""::String) + , testProperty "Text" $ roundTripEq T.empty + , testProperty "Foo" $ roundTripEq (undefined::Foo) ] ] From 3b13b80d3e67e652fb63bd442b00ec61d0cc61eb Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Mon, 19 Sep 2011 17:00:40 -0500 Subject: [PATCH 5/6] And the reverse conversion direction. --- tests/Properties.hs | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/tests/Properties.hs b/tests/Properties.hs index 610ad9996..194b555df 100644 --- a/tests/Properties.hs +++ b/tests/Properties.hs @@ -38,6 +38,9 @@ roundTripEq x y = roundTrip (==) x y genericTo :: (Data a, ToJSON a) => a -> a -> Bool genericTo _ v = G.toJSON v == toJSON v +genericFrom :: (Eq a, Data a, ToJSON a) => a -> a -> Bool +genericFrom _ v = G.fromJSON (toJSON v) == Success v + approxEq :: Double -> Double -> Bool approxEq a b = a == b || d < maxAbsoluteError || @@ -85,7 +88,13 @@ tests = [ testProperty "encodeDouble" encodeDouble , testProperty "encodeInteger" encodeInteger ], - testGroup "generic" [ + testGroup "genericFrom" [ + testProperty "Bool" $ genericFrom True + , testProperty "Double" $ genericFrom (1::Double) + , testProperty "Int" $ genericFrom (1::Int) + , testProperty "Foo" $ genericFrom (undefined::Foo) + ], + testGroup "genericTo" [ testProperty "Bool" $ genericTo True , testProperty "Double" $ genericTo (1::Double) , testProperty "Int" $ genericTo (1::Int) From a1888a75b5f92b45ea4a0ef8ffa7c599117f46bd Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Mon, 19 Sep 2011 17:13:47 -0500 Subject: [PATCH 6/6] Try encoding/decoding maps. --- aeson.cabal | 1 + tests/Properties.hs | 14 +++++++++++--- 2 files changed, 12 insertions(+), 3 deletions(-) diff --git a/aeson.cabal b/aeson.cabal index 08d707568..ad73b7921 100644 --- a/aeson.cabal +++ b/aeson.cabal @@ -148,6 +148,7 @@ test-suite tests aeson, attoparsec, base, + containers, bytestring, test-framework, test-framework-quickcheck2, diff --git a/tests/Properties.hs b/tests/Properties.hs index 194b555df..10bf8f38a 100644 --- a/tests/Properties.hs +++ b/tests/Properties.hs @@ -2,6 +2,7 @@ ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-orphans #-} +import Control.Monad import Control.Applicative import Data.Aeson.Encode import Data.Aeson.Parser (value) @@ -16,6 +17,7 @@ import qualified Data.Aeson.Generic as G import qualified Data.Attoparsec.Lazy as L import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.Text as T +import qualified Data.Map as Map encodeDouble :: Double -> Double -> Bool encodeDouble num denom @@ -52,7 +54,8 @@ approxEq a b = a == b || data Foo = Foo { fooInt :: Int , fooDouble :: Double - , fooTuple :: (String, Text) + , fooTuple :: (String, Text, Int) + , fooMap :: Map.Map String Foo } deriving (Show, Typeable, Data) instance Eq Foo where @@ -64,20 +67,25 @@ instance ToJSON Foo where toJSON Foo{..} = object [ "fooInt" .= fooInt , "fooDouble" .= fooDouble , "fooTuple" .= fooTuple + , "fooMap" .= fooMap ] instance FromJSON Foo where parseJSON (Object v) = Foo <$> v .: "fooInt" <*> v .: "fooDouble" <*> - v .: "fooTuple" + v .: "fooTuple" <*> + v .: "fooMap" parseJSON _ = empty instance Arbitrary Text where arbitrary = T.pack <$> arbitrary +instance (Ord k, Arbitrary k, Arbitrary v) => Arbitrary (Map.Map k v) where + arbitrary = Map.fromList <$> arbitrary + instance Arbitrary Foo where - arbitrary = liftA3 Foo arbitrary arbitrary arbitrary + arbitrary = liftM4 Foo arbitrary arbitrary arbitrary arbitrary main :: IO () main = defaultMain tests