1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
{-# LANGUAGE DeriveGeneric #-}
import GHC.Generics
import Generic.Random
import Test.Tasty
import Test.Tasty.QuickCheck as QC
import Data.Proxy
import Test.Tasty.Travis
import Coalpit
data Basic = Basic Int String Double
deriving (Generic, Eq, Show)
instance ArgParser Basic
instance ToArgs Basic
instance Arbitrary Basic where arbitrary = genericArbitraryU
data WithLists = WithLists [Int] [String] [Double]
deriving (Generic, Eq, Show)
instance ArgParser WithLists
instance ToArgs WithLists
instance Arbitrary WithLists where arbitrary = genericArbitraryU
data Record = Record { maybeInt :: Maybe Int
, maybeDouble :: Maybe Double
, str :: String
, listOfStrings :: [String]
, maybeListOfNumbers :: Maybe [Int]
, otherString :: String
} deriving (Generic, Eq, Show)
instance ArgParser Record
instance ToArgs Record
instance Arbitrary Record where arbitrary = genericArbitraryU
data Sum = Foo Int
| Bar
| Baz String Double
deriving (Generic, Eq, Show)
instance ArgParser Sum
instance ToArgs Sum
instance Arbitrary Sum where arbitrary = genericArbitraryU
data Nested = Nested Record Basic WithLists Sum
deriving (Generic, Eq, Show)
instance ArgParser Nested
instance ToArgs Nested
instance Arbitrary Nested where arbitrary = genericArbitraryU
data Polymorphic a b = Polymorphic (Maybe a) [b] (Either a b)
deriving (Generic, Eq, Show)
instance (ArgParser a, ArgParser b) => ArgParser (Polymorphic a b)
instance (ToArgs a, ToArgs b) => ToArgs (Polymorphic a b)
instance (Arbitrary a, Arbitrary b) => Arbitrary (Polymorphic a b) where
arbitrary = genericArbitraryU
data Recursive = RecursiveA
| RecursiveB Recursive
deriving (Generic, Eq, Show)
instance ArgParser Recursive
instance ToArgs Recursive
instance Arbitrary Recursive where arbitrary = genericArbitraryU
data NestedRecord = NestedRecord { record1 :: Maybe Record
, record2 :: Maybe Record
, record3 :: Maybe Record
} deriving (Generic, Eq, Show)
instance ArgParser NestedRecord
instance ToArgs NestedRecord
instance Arbitrary NestedRecord where arbitrary = genericArbitraryU
data NestedSum = NestedFoo Record
| NestedBar Sum Basic Nested
| NestedBaz (Polymorphic Int Double)
deriving (Generic, Eq, Show)
instance ArgParser NestedSum
instance ToArgs NestedSum
instance Arbitrary NestedSum where arbitrary = genericArbitraryU
printAndParse :: (ArgParser a, ToArgs a, Eq a)
=> Proxy a -> a -> Bool
printAndParse _ r = Right r == fromArgs defMod (toArgs defMod r)
mkTest :: (ArgParser a, ToArgs a, Eq a, Show a, Arbitrary a)
=> Proxy a -> String -> TestTree
mkTest p n = QC.testProperty ("id == parse . print for " ++ n) (printAndParse p)
main :: IO ()
main = travisTestReporter defaultConfig [] qcProps
qcProps :: TestTree
qcProps = testGroup "Quickcheck properties"
[ mkTest (Proxy :: Proxy Basic) "Basic"
, mkTest (Proxy :: Proxy WithLists) "WithLists"
, mkTest (Proxy :: Proxy Record) "Record"
, mkTest (Proxy :: Proxy Sum) "Sum"
, mkTest (Proxy :: Proxy Nested) "Nested"
, mkTest (Proxy :: Proxy (Polymorphic Int Double))
"Polymorphic Int Double"
, mkTest (Proxy :: Proxy (Polymorphic Basic Record))
"Polymorphic Basic Record"
, mkTest (Proxy :: Proxy (Polymorphic Nested (Polymorphic Basic Sum)))
"Polymorphic Nested (Polymorphic Basic Sum)"
, mkTest (Proxy :: Proxy Recursive) "Recursive"
, mkTest (Proxy :: Proxy NestedRecord) "NestedRecord"
, mkTest (Proxy :: Proxy NestedSum) "NestedSum"
]
|
