git.iko.soy/typeable/aeson
on 1.4.6.0 help sign in
typeable/aeson/tests/Instances.hs
170 lines 5.4 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE NoImplicitPrelude #-}
5{-# LANGUAGE OverloadedStrings #-}
6{-# LANGUAGE RecordWildCards #-}
8{-# OPTIONS_GHC -fno-warn-orphans #-}
10module Instances () where
12import Prelude.Compat
14import Control.Applicative (empty)
15import Control.Monad
16import Data.Aeson.Types
17import Data.Function (on)
18import Data.Time (ZonedTime(..), TimeZone(..))
19import Data.Time.Clock (UTCTime(..))
20import Functions
21import Test.QuickCheck (Arbitrary(..), elements, oneof)
22import Types
23import qualified Data.DList as DList
24import qualified Data.HashMap.Strict as HM
26import Data.Orphans ()
27import Test.QuickCheck.Instances ()
28#if MIN_VERSION_base(4,7,0)
29import Data.Hashable.Time ()
30#endif
32-- "System" types.
34instance Arbitrary DotNetTime where
35 arbitrary = DotNetTime `liftM` arbitrary
36 shrink = map DotNetTime . shrink . fromDotNetTime
38-- | Compare timezone part only on 'timeZoneMinutes'
39instance Eq ZonedTime where
40 ZonedTime a (TimeZone a' _ _) == ZonedTime b (TimeZone b' _ _) =
41 a == b && a' == b'
43-- Compare equality to within a millisecond, allowing for rounding
44-- error (ECMA 262 requires milliseconds to rounded to zero, not
45-- rounded to nearest).
46instance ApproxEq UTCTime where
47 a =~ b = ((==) `on` utctDay) a b &&
48 (approxEqWith 1 1 `on` ((* 1e3) . utctDayTime)) a b
50instance ApproxEq DotNetTime where
51 (=~) = (=~) `on` fromDotNetTime
53instance ApproxEq Float where
54 a =~ b
55 | isNaN a && isNaN b = True
56 | otherwise = approxEq a b
58instance ApproxEq Double where
59 a =~ b
60 | isNaN a && isNaN b = True
61 | otherwise = approxEq a b
63instance (ApproxEq k, Eq v) => ApproxEq (HM.HashMap k v) where
64 a =~ b = and $ zipWith eq (HM.toList a) (HM.toList b)
65 where
66 eq (x,y) (u,v) = x =~ u && y == v
68-- Test-related types.
70instance Arbitrary Foo where
71 arbitrary = liftM4 Foo arbitrary arbitrary arbitrary arbitrary
73instance Eq Foo where
74 a == b = fooInt a == fooInt b &&
75 fooDouble a `approxEq` fooDouble b &&
76 fooTuple a == fooTuple b
78instance ToJSON Foo where
79 toJSON Foo{..} = object [ "fooInt" .= fooInt
80 , "fooDouble" .= fooDouble
81 , "fooTuple" .= fooTuple
82 , "fooMap" .= fooMap
83 ]
85instance FromJSON Foo where
86 parseJSON (Object v) = Foo <$>
87 v .: "fooInt" <*>
88 v .: "fooDouble" <*>
89 v .: "fooTuple" <*>
90 v .: "fooMap"
91 parseJSON _ = empty
93instance Arbitrary UFoo where
94 arbitrary = UFoo <$> arbitrary <*> arbitrary
95 where _ = uFooInt
97instance Arbitrary OneConstructor where
98 arbitrary = return OneConstructor
100instance FromJSON OneConstructor
101instance ToJSON OneConstructor
103instance (Arbitrary a, Arbitrary b) => Arbitrary (Product2 a b) where
104 arbitrary = liftM2 Product2 arbitrary arbitrary
106instance (FromJSON a, FromJSON b) => FromJSON (Product2 a b)
107instance (ToJSON a, ToJSON b) => ToJSON (Product2 a b)
109instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d, Arbitrary e,
110 Arbitrary f) => Arbitrary (Product6 a b c d e f) where
111 arbitrary = Product6 <$> arbitrary <*> arbitrary <*> arbitrary <*>
112 arbitrary <*> arbitrary <*> arbitrary
114instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
115 FromJSON f) => FromJSON (Product6 a b c d e f)
116instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e,
117 ToJSON f) => ToJSON (Product6 a b c d e f)
119instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d)
120 => Arbitrary (Sum4 a b c d) where
121 arbitrary = oneof [Alt1 <$> arbitrary, Alt2 <$> arbitrary,
122 Alt3 <$> arbitrary, Alt4 <$> arbitrary]
124instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d)
125 => FromJSON (Sum4 a b c d)
126instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON (Sum4 a b c d)
128instance (Arbitrary a) => Arbitrary (Approx a) where
129 arbitrary = Approx <$> arbitrary
131instance (FromJSON a) => FromJSON (Approx a) where
132 parseJSON a = Approx <$> parseJSON a
134instance (ToJSON a) => ToJSON (Approx a) where
135 toJSON = toJSON . fromApprox
137instance Arbitrary Nullary where
138 arbitrary = elements [C1, C2, C3]
140instance Arbitrary a => Arbitrary (SomeType a) where
141 arbitrary = oneof [ pure Nullary
142 , Unary <$> arbitrary
143 , Product <$> arbitrary <*> arbitrary <*> arbitrary
144 , Record <$> arbitrary <*> arbitrary <*> arbitrary
145 , List <$> arbitrary
146 ]
148instance Arbitrary EitherTextInt where
149 arbitrary = oneof
150 [ LeftBool <$> arbitrary
151 , RightInt <$> arbitrary
152 , BothTextInt <$> arbitrary <*> arbitrary
153 , pure NoneNullary
154 ]
156instance Arbitrary (GADT String) where
157 arbitrary = GADT <$> arbitrary
159instance Arbitrary OptionField where
160 arbitrary = OptionField <$> arbitrary
163instance ApproxEq Char where
164 (=~) = (==)
166instance (ApproxEq a) => ApproxEq [a] where
167 a =~ b = length a == length b && all (uncurry (=~)) (zip a b)
169instance Arbitrary a => Arbitrary (DList.DList a) where
170 arbitrary = DList.fromList <$> arbitrary