on 0.3.2.6 help sign in
typeable/aeson/tests/Properties.hs
56 lines 1.8 kB history raw
1{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
3import Data.Aeson.Encode
4import Data.Aeson.Parser (value)
5import Data.Aeson.Types
6import Data.Attoparsec.Number
7import Test.Framework (Test, defaultMain, testGroup)
8import Test.Framework.Providers.QuickCheck2 (testProperty)
9import qualified Data.ByteString.Lazy.Char8 as L
10import qualified Data.Attoparsec.Lazy as L
12encodeDouble :: Double -> Double -> Bool
13encodeDouble num denom
14 | isInfinite d || isNaN d = encode (Number (D d)) == "null"
15 | otherwise = encode (Number (D d)) == L.pack (show d)
16 where d = num / denom
18encodeInteger :: Integer -> Bool
19encodeInteger i = encode (Number (I i)) == L.pack (show i)
21roundTrip :: (FromJSON a, ToJSON a) => (a -> a -> Bool) -> a -> Bool
22roundTrip eq i =
23 case fmap fromJSON . L.parse value . encode . toJSON $ i of
24 L.Done _ (Success v) -> v `eq` i
25 _ -> False
27roundTripBool :: Bool -> Bool
28roundTripBool = roundTrip (==)
29roundTripDouble :: Double -> Bool
30roundTripDouble = roundTrip approxEq
31roundTripInteger :: Integer -> Bool
32roundTripInteger = roundTrip (==)
34approxEq :: Double -> Double -> Bool
35approxEq a b = a == b ||
36 d < maxAbsoluteError ||
37 d / max (abs b) (abs a) <= maxRelativeError
38 where d = abs (a - b)
39 maxAbsoluteError = 1e-15
40 maxRelativeError = 1e-15
42main :: IO ()
43main = defaultMain tests
45tests :: [Test]
46tests = [
47 testGroup "encode" [
48 testProperty "encodeDouble" encodeDouble
49 , testProperty "encodeInteger" encodeInteger
50 ],
51 testGroup "roundTrip" [
52 testProperty "roundTripBool" roundTripBool
53 , testProperty "roundTripDouble" roundTripDouble
54 , testProperty "roundTripInteger" roundTripInteger
55 ]
56 ]