git.iko.soy/typeable/aeson
on 1.3.1.1 help sign in
typeable/aeson/tests/Instances.hs
169 lines 5.4 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE OverloadedStrings #-}
5{-# LANGUAGE RecordWildCards #-}
6{-# OPTIONS_GHC -fno-warn-orphans #-}
8module Instances () where
10import Prelude ()
11import Prelude.Compat
13import Control.Applicative (empty)
14import Control.Monad
15import Data.Aeson.Types
16import Data.Function (on)
17import Data.Time (ZonedTime(..), TimeZone(..))
18import Data.Time.Clock (UTCTime(..))
19import Functions
20import Test.QuickCheck (Arbitrary(..), elements, oneof)
21import Types
22import qualified Data.DList as DList
23import qualified Data.HashMap.Strict as HM
25import Data.Orphans ()
26import Test.QuickCheck.Instances ()
27#if MIN_VERSION_base(4,7,0)
28import Data.Hashable.Time ()
29#endif
31-- "System" types.
33instance Arbitrary DotNetTime where
34 arbitrary = DotNetTime `liftM` arbitrary
35 shrink = map DotNetTime . shrink . fromDotNetTime
37-- | Compare timezone part only on 'timeZoneMinutes'
38instance Eq ZonedTime where
39 ZonedTime a (TimeZone a' _ _) == ZonedTime b (TimeZone b' _ _) =
40 a == b && a' == b'
42-- Compare equality to within a millisecond, allowing for rounding
43-- error (ECMA 262 requires milliseconds to rounded to zero, not
44-- rounded to nearest).
45instance ApproxEq UTCTime where
46 a =~ b = ((==) `on` utctDay) a b &&
47 (approxEqWith 1 1 `on` ((* 1e3) . utctDayTime)) a b
49instance ApproxEq DotNetTime where
50 (=~) = (=~) `on` fromDotNetTime
52instance ApproxEq Float where
53 a =~ b
54 | isNaN a && isNaN b = True
55 | otherwise = approxEq a b
57instance ApproxEq Double where
58 a =~ b
59 | isNaN a && isNaN b = True
60 | otherwise = approxEq a b
62instance (ApproxEq k, Eq v) => ApproxEq (HM.HashMap k v) where
63 a =~ b = and $ zipWith eq (HM.toList a) (HM.toList b)
64 where
65 eq (x,y) (u,v) = x =~ u && y == v
67-- Test-related types.
69instance Arbitrary Foo where
70 arbitrary = liftM4 Foo arbitrary arbitrary arbitrary arbitrary
72instance Eq Foo where
73 a == b = fooInt a == fooInt b &&
74 fooDouble a `approxEq` fooDouble b &&
75 fooTuple a == fooTuple b
77instance ToJSON Foo where
78 toJSON Foo{..} = object [ "fooInt" .= fooInt
79 , "fooDouble" .= fooDouble
80 , "fooTuple" .= fooTuple
81 , "fooMap" .= fooMap
82 ]
84instance FromJSON Foo where
85 parseJSON (Object v) = Foo <$>
86 v .: "fooInt" <*>
87 v .: "fooDouble" <*>
88 v .: "fooTuple" <*>
89 v .: "fooMap"
90 parseJSON _ = empty
92instance Arbitrary UFoo where
93 arbitrary = UFoo <$> arbitrary <*> arbitrary
94 where _ = uFooInt
96instance Arbitrary OneConstructor where
97 arbitrary = return OneConstructor
99instance FromJSON OneConstructor
100instance ToJSON OneConstructor
102instance (Arbitrary a, Arbitrary b) => Arbitrary (Product2 a b) where
103 arbitrary = liftM2 Product2 arbitrary arbitrary
105instance (FromJSON a, FromJSON b) => FromJSON (Product2 a b)
106instance (ToJSON a, ToJSON b) => ToJSON (Product2 a b)
108instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d, Arbitrary e,
109 Arbitrary f) => Arbitrary (Product6 a b c d e f) where
110 arbitrary = Product6 <$> arbitrary <*> arbitrary <*> arbitrary <*>
111 arbitrary <*> arbitrary <*> arbitrary
113instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
114 FromJSON f) => FromJSON (Product6 a b c d e f)
115instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e,
116 ToJSON f) => ToJSON (Product6 a b c d e f)
118instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d)
119 => Arbitrary (Sum4 a b c d) where
120 arbitrary = oneof [Alt1 <$> arbitrary, Alt2 <$> arbitrary,
121 Alt3 <$> arbitrary, Alt4 <$> arbitrary]
123instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d)
124 => FromJSON (Sum4 a b c d)
125instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON (Sum4 a b c d)
127instance (Arbitrary a) => Arbitrary (Approx a) where
128 arbitrary = Approx <$> arbitrary
130instance (FromJSON a) => FromJSON (Approx a) where
131 parseJSON a = Approx <$> parseJSON a
133instance (ToJSON a) => ToJSON (Approx a) where
134 toJSON = toJSON . fromApprox
136instance Arbitrary Nullary where
137 arbitrary = elements [C1, C2, C3]
139instance Arbitrary a => Arbitrary (SomeType a) where
140 arbitrary = oneof [ pure Nullary
141 , Unary <$> arbitrary
142 , Product <$> arbitrary <*> arbitrary <*> arbitrary
143 , Record <$> arbitrary <*> arbitrary <*> arbitrary
144 , List <$> arbitrary
145 ]
147instance Arbitrary EitherTextInt where
148 arbitrary = oneof
149 [ LeftBool <$> arbitrary
150 , RightInt <$> arbitrary
151 , BothTextInt <$> arbitrary <*> arbitrary
152 , pure NoneNullary
153 ]
155instance Arbitrary (GADT String) where
156 arbitrary = GADT <$> arbitrary
158instance Arbitrary OptionField where
159 arbitrary = OptionField <$> arbitrary
162instance ApproxEq Char where
163 (=~) = (==)
165instance (ApproxEq a) => ApproxEq [a] where
166 a =~ b = length a == length b && all (uncurry (=~)) (zip a b)
168instance Arbitrary a => Arbitrary (DList.DList a) where
169 arbitrary = DList.fromList <$> arbitrary