on 0.10.0.0 help sign in
typeable/aeson/tests/Instances.hs
155 lines 5.1 kB history raw
1{-# Language OverloadedStrings, RecordWildCards, StandaloneDeriving #-}
2{-# OPTIONS_GHC -fno-warn-orphans #-}
4module Instances where
6import Types
7import Data.Function (on)
8import Control.Monad
9import Test.QuickCheck (Arbitrary(..), Gen, choose, oneof, elements)
10import Data.Time.Clock (DiffTime, UTCTime(..), picosecondsToDiffTime)
11import Data.Fixed (Pico)
12import Data.Time (ZonedTime(..), LocalTime(..), TimeZone(..),
13 hoursToTimeZone, Day(..), TimeOfDay(..),
14 NominalDiffTime)
15import qualified Data.Text as T
16import qualified Data.Map as Map
17import Data.Text (Text)
18import Data.Aeson.Types
19import Control.Applicative
20import Functions
22-- "System" types.
24instance Arbitrary Text where
25 arbitrary = T.pack <$> arbitrary
27instance (Ord k, Arbitrary k, Arbitrary v) => Arbitrary (Map.Map k v) where
28 arbitrary = Map.fromList <$> arbitrary
30instance Arbitrary LocalTime where
31 arbitrary = return $ LocalTime (ModifiedJulianDay 1) (TimeOfDay 1 2 3)
33instance Arbitrary TimeZone where
34 arbitrary = do
35 offset <- choose (0,2) :: Gen Int
36 return $ hoursToTimeZone offset
38instance Arbitrary Day where
39 arbitrary = ModifiedJulianDay `liftM` arbitrary
41instance Arbitrary DiffTime where
42 arbitrary = (picosecondsToDiffTime . (* 1000000000)) <$>
43 choose (0, 86400000)
45instance Arbitrary UTCTime where
46 arbitrary = liftM2 UTCTime arbitrary arbitrary
48instance Arbitrary DotNetTime where
49 arbitrary = DotNetTime `liftM` arbitrary
51instance Arbitrary ZonedTime where
52 arbitrary = liftM2 ZonedTime arbitrary arbitrary
54instance Arbitrary NominalDiffTime where
55 arbitrary = realToFrac <$> (arbitrary :: Gen Pico)
57deriving instance Eq ZonedTime
59-- Compare equality to within a millisecond, allowing for rounding
60-- error (ECMA 262 requires milliseconds to rounded to zero, not
61-- rounded to nearest).
62instance ApproxEq UTCTime where
63 a =~ b = ((==) `on` utctDay) a b &&
64 (approxEqWith 1 1 `on` ((* 1e3) . utctDayTime)) a b
66instance ApproxEq DotNetTime where
67 (=~) = (=~) `on` fromDotNetTime
69instance ApproxEq Double where
70 (=~) = approxEq
72-- Test-related types.
74instance Arbitrary Foo where
75 arbitrary = liftM4 Foo arbitrary arbitrary arbitrary arbitrary
77instance Eq Foo where
78 a == b = fooInt a == fooInt b &&
79 fooDouble a `approxEq` fooDouble b &&
80 fooTuple a == fooTuple b
82instance ToJSON Foo where
83 toJSON Foo{..} = object [ "fooInt" .= fooInt
84 , "fooDouble" .= fooDouble
85 , "fooTuple" .= fooTuple
86 , "fooMap" .= fooMap
87 ]
89instance FromJSON Foo where
90 parseJSON (Object v) = Foo <$>
91 v .: "fooInt" <*>
92 v .: "fooDouble" <*>
93 v .: "fooTuple" <*>
94 v .: "fooMap"
95 parseJSON _ = empty
97instance Arbitrary UFoo where
98 arbitrary = UFoo <$> arbitrary <*> arbitrary
99 where _ = uFooInt
101instance Arbitrary OneConstructor where
102 arbitrary = return OneConstructor
104instance FromJSON OneConstructor
105instance ToJSON OneConstructor
107instance (Arbitrary a, Arbitrary b) => Arbitrary (Product2 a b) where
108 arbitrary = liftM2 Product2 arbitrary arbitrary
110instance (FromJSON a, FromJSON b) => FromJSON (Product2 a b)
111instance (ToJSON a, ToJSON b) => ToJSON (Product2 a b)
113instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d, Arbitrary e,
114 Arbitrary f) => Arbitrary (Product6 a b c d e f) where
115 arbitrary = Product6 <$> arbitrary <*> arbitrary <*> arbitrary <*>
116 arbitrary <*> arbitrary <*> arbitrary
118instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
119 FromJSON f) => FromJSON (Product6 a b c d e f)
120instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e,
121 ToJSON f) => ToJSON (Product6 a b c d e f)
123instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d)
124 => Arbitrary (Sum4 a b c d) where
125 arbitrary = oneof [Alt1 <$> arbitrary, Alt2 <$> arbitrary,
126 Alt3 <$> arbitrary, Alt4 <$> arbitrary]
128instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d)
129 => FromJSON (Sum4 a b c d)
130instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON (Sum4 a b c d)
132instance (Arbitrary a) => Arbitrary (Approx a) where
133 arbitrary = Approx <$> arbitrary
135instance (FromJSON a) => FromJSON (Approx a) where
136 parseJSON a = Approx <$> parseJSON a
138instance (ToJSON a) => ToJSON (Approx a) where
139 toJSON = toJSON . fromApprox
141instance Arbitrary Nullary where
142 arbitrary = elements [C1, C2, C3]
144instance Arbitrary a => Arbitrary (SomeType a) where
145 arbitrary = oneof [ pure Nullary
146 , Unary <$> arbitrary
147 , Product <$> arbitrary <*> arbitrary <*> arbitrary
148 , Record <$> arbitrary <*> arbitrary <*> arbitrary
149 ]
151instance ApproxEq Char where
152 (=~) = (==)
154instance (ApproxEq a) => ApproxEq [a] where
155 a =~ b = length a == length b && all (uncurry (=~)) (zip a b)