git.iko.soy/typeable/aeson
on 1.1.0.0 help sign in
typeable/aeson/tests/Types.hs
135 lines 4.1 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE DeriveDataTypeable #-}
3{-# LANGUAGE DeriveGeneric #-}
4{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE GADTs #-}
6{-# LANGUAGE GeneralizedNewtypeDeriving #-}
7{-# LANGUAGE StandaloneDeriving #-}
9module Types where
11import Prelude ()
12import Prelude.Compat
14import Data.Data
15import Data.Functor.Compose (Compose (..))
16import Data.Functor.Identity (Identity (..))
17import Data.Text
18import Data.Time (Day (..), fromGregorian)
19import GHC.Generics
20import Test.QuickCheck (Arbitrary (..), Property, counterexample)
21import qualified Data.Map as Map
22import Data.Aeson
24type I = Identity
25type Compose3 f g h = Compose (Compose f g) h
26type Compose3' f g h = Compose f (Compose g h)
28data Foo = Foo {
29 fooInt :: Int
30 , fooDouble :: Double
31 , fooTuple :: (String, Text, Int)
32 -- This definition causes an infinite loop in genericTo and genericFrom!
33 -- , fooMap :: Map.Map String Foo
34 , fooMap :: Map.Map String (Text,Int)
35 } deriving (Show, Typeable, Data)
37data UFoo = UFoo {
38 _UFooInt :: Int
39 , uFooInt :: Int
40 } deriving (Show, Eq, Data, Typeable)
42data OneConstructor = OneConstructor
43 deriving (Show, Eq, Typeable, Data)
45data Product2 a b = Product2 a b
46 deriving (Show, Eq, Typeable, Data)
48data Product6 a b c d e f = Product6 a b c d e f
49 deriving (Show, Eq, Typeable, Data)
51data Sum4 a b c d = Alt1 a | Alt2 b | Alt3 c | Alt4 d
52 deriving (Show, Eq, Typeable, Data)
54class ApproxEq a where
55 (=~) :: a -> a -> Bool
57newtype Approx a = Approx { fromApprox :: a }
58 deriving (Show, Data, Typeable, ApproxEq, Num)
60instance (ApproxEq a) => Eq (Approx a) where
61 Approx a == Approx b = a =~ b
63data Nullary = C1 | C2 | C3 deriving (Eq, Show)
65data SomeType a = Nullary
66 | Unary Int
67 | Product String (Maybe Char) a
68 | Record { testOne :: Double
69 , testTwo :: Maybe Bool
70 , testThree :: Maybe a
71 }
72 | List [a]
73 deriving (Eq, Show)
75-- | This type requires IncoherentInstances for the instances of the type
76-- classes Data.Aeson.TH.LookupField and Data.Aeson.Types.FromJSON.FromRecord.
77--
78-- The minimum known requirements for this type are:
79-- * Record type with at least two fields
80-- * One field type is either a type parameter or a type/data family
81-- * Another field type is a @Maybe@ of the above field type
82data IncoherentInstancesNeeded a = IncoherentInstancesNeeded
83 { incoherentInstancesNeededMaybeNot :: a
84 , incoherentInstancesNeededMaybeYes :: Maybe a
85 } deriving Generic
87-- Used for testing UntaggedValue SumEncoding
88data EitherTextInt
89 = LeftBool Bool
90 | RightInt Int
91 | BothTextInt Text Int
92 | NoneNullary
93 deriving (Eq, Show)
95data GADT a where
96 GADT :: { gadt :: String } -> GADT String
97 deriving Typeable
99deriving instance Data (GADT String)
100deriving instance Eq (GADT a)
101deriving instance Show (GADT a)
103deriving instance Generic Foo
104deriving instance Generic UFoo
105deriving instance Generic OneConstructor
106deriving instance Generic (Product2 a b)
107deriving instance Generic (Product6 a b c d e f)
108deriving instance Generic (Sum4 a b c d)
109deriving instance Generic (Approx a)
110deriving instance Generic Nullary
111deriving instance Generic (SomeType a)
112#if __GLASGOW_HASKELL__ >= 706
113deriving instance Generic1 SomeType
114#endif
115deriving instance Generic EitherTextInt
117failure :: Show a => String -> String -> a -> Property
118failure func msg v = counterexample
119 (func ++ " failed: " ++ msg ++ ", " ++ show v) False
121newtype BCEDay = BCEDay Day
122 deriving (Eq, Show)
124zeroDay :: Day
125zeroDay = fromGregorian 0 0 0
127instance Arbitrary BCEDay where
128 arbitrary = fmap (BCEDay . ModifiedJulianDay . (+ toModifiedJulianDay zeroDay)) arbitrary
130instance ToJSON BCEDay where
131 toJSON (BCEDay d) = toJSON d
132 toEncoding (BCEDay d) = toEncoding d
134instance FromJSON BCEDay where
135 parseJSON = fmap BCEDay . parseJSON