Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Test round-tripping of compound types.

  • Loading branch information...
commit 6da6d9fe719513ee2cbe3034ba6ec58c63b8bea6 1 parent e92c3e5
Bryan O'Sullivan authored
Showing with 43 additions and 3 deletions.
  1. +3 −1 aeson.cabal
  2. +40 −2 tests/Properties.hs
4 aeson.cabal
View
@@ -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
42 tests/Properties.hs
View
@@ -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
]
]
Please sign in to comment.
Something went wrong with that request. Please try again.