git.iko.soy/typeable/aeson
on 0.9.0.1 help sign in
typeable/aeson/tests/Instances.hs
147 lines 4.9 kB history raw
1{-# Language CPP, OverloadedStrings, RecordWildCards, StandaloneDeriving #-}
2{-# OPTIONS_GHC -fno-warn-orphans #-}
3#if __GLASGOW_HASKELL__ < 702
4{-# OPTIONS_GHC -fno-warn-missing-methods #-}
5#endif
7module Instances where
9import Types
10import Data.Function (on)
11import Control.Monad
12import Test.QuickCheck (Arbitrary(..), Gen, choose, oneof, elements)
13import Data.Time.Clock (DiffTime, UTCTime(..), picosecondsToDiffTime)
14import Data.Time (ZonedTime(..), LocalTime(..), TimeZone(..),
15 hoursToTimeZone, Day(..), TimeOfDay(..))
16import qualified Data.Text as T
17import qualified Data.Map as Map
18import Data.Text (Text)
19import Data.Aeson.Types
20import Control.Applicative
21import Functions
23-- "System" types.
25instance Arbitrary Text where
26 arbitrary = T.pack <$> arbitrary
28instance (Ord k, Arbitrary k, Arbitrary v) => Arbitrary (Map.Map k v) where
29 arbitrary = Map.fromList <$> arbitrary
31instance Arbitrary LocalTime where
32 arbitrary = return $ LocalTime (ModifiedJulianDay 1) (TimeOfDay 1 2 3)
34instance Arbitrary TimeZone where
35 arbitrary = do
36 offset <- choose (0,2) :: Gen Int
37 return $ hoursToTimeZone offset
39instance Arbitrary Day where
40 arbitrary = ModifiedJulianDay `liftM` arbitrary
42instance Arbitrary DiffTime where
43 arbitrary = (picosecondsToDiffTime . (* 1000000000)) <$>
44 choose (0, 86400000)
46instance Arbitrary UTCTime where
47 arbitrary = liftM2 UTCTime arbitrary arbitrary
49instance Arbitrary DotNetTime where
50 arbitrary = DotNetTime `liftM` arbitrary
52instance Arbitrary ZonedTime where
53 arbitrary = liftM2 ZonedTime arbitrary arbitrary
55deriving instance Eq ZonedTime
57-- Compare equality to within a millisecond, allowing for rounding
58-- error (ECMA 262 requires milliseconds to rounded to zero, not
59-- rounded to nearest).
60instance ApproxEq UTCTime where
61 a =~ b = ((==) `on` utctDay) a b &&
62 (approxEqWith 1 1 `on` ((* 1e3) . utctDayTime)) a b
64instance ApproxEq DotNetTime where
65 (=~) = (=~) `on` fromDotNetTime
67instance ApproxEq Double where
68 (=~) = approxEq
70-- Test-related types.
72instance Arbitrary Foo where
73 arbitrary = liftM4 Foo arbitrary arbitrary arbitrary arbitrary
75instance Eq Foo where
76 a == b = fooInt a == fooInt b &&
77 fooDouble a `approxEq` fooDouble b &&
78 fooTuple a == fooTuple b
80instance ToJSON Foo where
81 toJSON Foo{..} = object [ "fooInt" .= fooInt
82 , "fooDouble" .= fooDouble
83 , "fooTuple" .= fooTuple
84 , "fooMap" .= fooMap
85 ]
87instance FromJSON Foo where
88 parseJSON (Object v) = Foo <$>
89 v .: "fooInt" <*>
90 v .: "fooDouble" <*>
91 v .: "fooTuple" <*>
92 v .: "fooMap"
93 parseJSON _ = empty
95instance Arbitrary UFoo where
96 arbitrary = UFoo <$> arbitrary <*> arbitrary
97 where _ = uFooInt
99instance Arbitrary OneConstructor where
100 arbitrary = return OneConstructor
102instance FromJSON OneConstructor
103instance ToJSON OneConstructor
105instance (Arbitrary a, Arbitrary b) => Arbitrary (Product2 a b) where
106 arbitrary = liftM2 Product2 arbitrary arbitrary
108instance (FromJSON a, FromJSON b) => FromJSON (Product2 a b)
109instance (ToJSON a, ToJSON b) => ToJSON (Product2 a b)
111instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d, Arbitrary e,
112 Arbitrary f) => Arbitrary (Product6 a b c d e f) where
113 arbitrary = Product6 <$> arbitrary <*> arbitrary <*> arbitrary <*>
114 arbitrary <*> arbitrary <*> arbitrary
116instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
117 FromJSON f) => FromJSON (Product6 a b c d e f)
118instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e,
119 ToJSON f) => ToJSON (Product6 a b c d e f)
121instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d)
122 => Arbitrary (Sum4 a b c d) where
123 arbitrary = oneof [Alt1 <$> arbitrary, Alt2 <$> arbitrary,
124 Alt3 <$> arbitrary, Alt4 <$> arbitrary]
126instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d)
127 => FromJSON (Sum4 a b c d)
128instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON (Sum4 a b c d)
130instance (Arbitrary a) => Arbitrary (Approx a) where
131 arbitrary = Approx <$> arbitrary
133instance (FromJSON a) => FromJSON (Approx a) where
134 parseJSON a = Approx <$> parseJSON a
136instance (ToJSON a) => ToJSON (Approx a) where
137 toJSON = toJSON . fromApprox
139instance Arbitrary Nullary where
140 arbitrary = elements [C1, C2, C3]
142instance Arbitrary a => Arbitrary (SomeType a) where
143 arbitrary = oneof [ pure Nullary
144 , Unary <$> arbitrary
145 , Product <$> arbitrary <*> arbitrary <*> arbitrary
146 , Record <$> arbitrary <*> arbitrary <*> arbitrary
147 ]