git.iko.soy/typeable/aeson
on master help sign in
Add roundtrip tests for DotNetTime and UTCTime
b2be712Bryan O'Sullivan
tests/Properties.hs+37−8
compare with master
unifiedsplit
@@ -9,6 +9,7 @@ import Data.Aeson.Parser (value)
9import Data.Aeson.Types
9import Data.Aeson.Types
10import Data.Attoparsec.Number
10import Data.Attoparsec.Number
11import Data.Data (Typeable, Data)
11import Data.Data (Typeable, Data)
12+import Data.Function (on)
12import Data.Text (Text)
13import Data.Text (Text)
13import Test.Framework (Test, defaultMain, testGroup)
14import Test.Framework (Test, defaultMain, testGroup)
14import Test.Framework.Providers.QuickCheck2 (testProperty)
15import Test.Framework.Providers.QuickCheck2 (testProperty)
@@ -18,7 +19,10 @@ import qualified Data.Attoparsec.Lazy as L
18import qualified Data.ByteString.Lazy.Char8 as L
19import qualified Data.ByteString.Lazy.Char8 as L
19import qualified Data.Text as T
20import qualified Data.Text as T
20import qualified Data.Map as Map
21import qualified Data.Map as Map
22+import Data.Time.Calendar (Day)
23+import Data.Time.Clock (DiffTime, UTCTime(..), picosecondsToDiffTime)
24+import Data.Time (ZonedTime(..), LocalTime(..), TimeZone(..),
21−import Data.Time (ZonedTime(..), LocalTime(..), TimeZone(..), hoursToTimeZone, Day(..), TimeOfDay(..))
25+ hoursToTimeZone, Day(..), TimeOfDay(..))
22
26
23encodeDouble :: Double -> Double -> Bool
27encodeDouble :: Double -> Double -> Bool
24encodeDouble num denom
28encodeDouble num denom
@@ -44,13 +48,24 @@ genericTo _ v = G.toJSON v == toJSON v
44genericFrom :: (Eq a, Data a, ToJSON a) => a -> a -> Bool
48genericFrom :: (Eq a, Data a, ToJSON a) => a -> a -> Bool
45genericFrom _ v = G.fromJSON (toJSON v) == Success v
49genericFrom _ v = G.fromJSON (toJSON v) == Success v
46
50
47−approxEq :: Double -> Double -> Bool
51+approxEq :: (Fractional a, Ord a) => a -> a -> Bool
48−approxEq a b = a == b ||
52+approxEq = approxEqWith 1e-15 1e-15
53+
54+approxEqWith :: (Fractional a, Ord a) => a -> a -> a -> a -> Bool
55+approxEqWith maxAbsoluteError maxRelativeError a b =
49− d < maxAbsoluteError ||
56+ a == b || d < maxAbsoluteError ||
50− d / max (abs b) (abs a) <= maxRelativeError
57+ d / max (abs b) (abs a) <= maxRelativeError
51− where d = abs (a - b)
58+ where d = abs (a - b)
52− maxAbsoluteError = 1e-15
59+
53− maxRelativeError = 1e-15
60+-- Compare equality to within a millisecond, allowing for rounding
61+-- error (ECMA 262 requires milliseconds to rounded to zero, not
62+-- rounded to nearest).
63+approxEqUTC :: UTCTime -> UTCTime -> Bool
64+approxEqUTC a b = ((==) `on` utctDay) a b &&
65+ (approxEqWith 1 1 `on` ((* 1e3) . utctDayTime)) a b
66+
67+approxEqNet :: DotNetTime -> DotNetTime -> Bool
68+approxEqNet (DotNetTime a) (DotNetTime b) = approxEqUTC a b
54
69
55toFromJSON :: (Arbitrary a, Eq a, FromJSON a, ToJSON a) => a -> Bool
70toFromJSON :: (Arbitrary a, Eq a, FromJSON a, ToJSON a) => a -> Bool
56toFromJSON x = case fromJSON . toJSON $ x of
71toFromJSON x = case fromJSON . toJSON $ x of
@@ -120,6 +135,18 @@ instance Arbitrary TimeZone where
120 offset <- choose (0,2) :: Gen Int
135 offset <- choose (0,2) :: Gen Int
121 return $ hoursToTimeZone offset
136 return $ hoursToTimeZone offset
122
137
138+instance Arbitrary Day where
139+ arbitrary = ModifiedJulianDay `liftM` arbitrary
140+
141+instance Arbitrary DiffTime where
142+ arbitrary = picosecondsToDiffTime `liftM` choose (0, 86400000000000000)
143+
144+instance Arbitrary UTCTime where
145+ arbitrary = liftM2 UTCTime arbitrary arbitrary
146+
147+instance Arbitrary DotNetTime where
148+ arbitrary = DotNetTime `liftM` arbitrary
149+
123instance Arbitrary ZonedTime where
150instance Arbitrary ZonedTime where
124 arbitrary = liftM2 ZonedTime arbitrary arbitrary
151 arbitrary = liftM2 ZonedTime arbitrary arbitrary
125
152
@@ -168,6 +195,8 @@ tests = [
168 , testProperty "String" $ roundTripEq (""::String)
195 , testProperty "String" $ roundTripEq (""::String)
169 , testProperty "Text" $ roundTripEq T.empty
196 , testProperty "Text" $ roundTripEq T.empty
170 , testProperty "Foo" $ roundTripEq (undefined::Foo)
197 , testProperty "Foo" $ roundTripEq (undefined::Foo)
198+ , testProperty "DotNetTime" $ roundTrip approxEqNet undefined
199+ , testProperty "UTCTime" $ roundTrip approxEqUTC undefined
171 , testProperty "ZonedTime" $ roundTripEq (undefined::ZonedTime)
200 , testProperty "ZonedTime" $ roundTripEq (undefined::ZonedTime)
172 ],
201 ],
173 testGroup "toFromJSON" [
202 testGroup "toFromJSON" [