git.iko.soy/typeable/aeson
on 0.10.0.0 help sign in
typeable/aeson/tests/Types.hs
69 lines 2.2 kB history raw
1{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
2{-# LANGUAGE DeriveGeneric, StandaloneDeriving #-}
4module Types where
6import qualified Data.Map as Map
7import Data.Data
8import Data.Text
9import GHC.Generics
10import Test.QuickCheck (Property, counterexample)
12data Foo = Foo {
13 fooInt :: Int
14 , fooDouble :: Double
15 , fooTuple :: (String, Text, Int)
16 -- This definition causes an infinite loop in genericTo and genericFrom!
17 -- , fooMap :: Map.Map String Foo
18 , fooMap :: Map.Map String (Text,Int)
19 } deriving (Show, Typeable, Data)
21data UFoo = UFoo {
22 _UFooInt :: Int
23 , uFooInt :: Int
24 } deriving (Show, Eq, Data, Typeable)
26data OneConstructor = OneConstructor
27 deriving (Show, Eq, Typeable, Data)
29data Product2 a b = Product2 a b
30 deriving (Show, Eq, Typeable, Data)
32data Product6 a b c d e f = Product6 a b c d e f
33 deriving (Show, Eq, Typeable, Data)
35data Sum4 a b c d = Alt1 a | Alt2 b | Alt3 c | Alt4 d
36 deriving (Show, Eq, Typeable, Data)
38class ApproxEq a where
39 (=~) :: a -> a -> Bool
41newtype Approx a = Approx { fromApprox :: a }
42 deriving (Show, Data, Typeable, ApproxEq, Num)
44instance (ApproxEq a) => Eq (Approx a) where
45 Approx a == Approx b = a =~ b
47data Nullary = C1 | C2 | C3 deriving (Eq, Show)
49data SomeType a = Nullary
50 | Unary Int
51 | Product String (Maybe Char) a
52 | Record { testOne :: Double
53 , testTwo :: Maybe Bool
54 , testThree :: Maybe a
55 } deriving (Eq, Show)
57deriving instance Generic Foo
58deriving instance Generic UFoo
59deriving instance Generic OneConstructor
60deriving instance Generic (Product2 a b)
61deriving instance Generic (Product6 a b c d e f)
62deriving instance Generic (Sum4 a b c d)
63deriving instance Generic (Approx a)
64deriving instance Generic Nullary
65deriving instance Generic (SomeType a)
67failure :: Show a => String -> String -> a -> Property
68failure func msg v = counterexample
69 (func ++ " failed: " ++ msg ++ ", " ++ show v) False