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
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
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, Coalpit)
instance Arbitrary Basic where arbitrary = genericArbitraryU
data WithLists = WithLists [Int] [String] [Double]
deriving (Generic, Eq, Show, Coalpit)
instance Arbitrary WithLists where arbitrary = genericArbitraryU
data Record = Record { maybeInt :: Maybe Int
, maybeDouble :: Maybe Double
, str :: String
, listOfStrings :: [String]
, maybeListOfNumbers :: Maybe [Integer]
, otherString :: String
} deriving (Generic, Eq, Show, Coalpit)
instance Arbitrary Record where arbitrary = genericArbitraryU
data Sum = Foo Int Bool
| Bar
| Baz (String, (Double, Integer), Rational)
deriving (Generic, Eq, Show, Coalpit)
instance Arbitrary Sum where arbitrary = genericArbitraryU
data Nested = Nested Record Basic WithLists Sum
deriving (Generic, Eq, Show, Coalpit)
instance Arbitrary Nested where arbitrary = genericArbitraryU
data Polymorphic a b = Polymorphic (Maybe a) [b] (Either a b)
deriving (Generic, Eq, Show)
instance (Coalpit a, Coalpit b) => Coalpit (Polymorphic a b)
instance (Arbitrary a, Arbitrary b) => Arbitrary (Polymorphic a b) where
arbitrary = genericArbitraryU
data Recursive = RecursiveA
| RecursiveB Recursive
deriving (Generic, Eq, Show, Coalpit)
instance Arbitrary Recursive where arbitrary = genericArbitraryU
data NestedRecord = NestedRecord { record1 :: Maybe Record
, record2 :: Maybe Record
, record3 :: Maybe Record
} deriving (Generic, Eq, Show, Coalpit)
instance Arbitrary NestedRecord where arbitrary = genericArbitraryU
data NestedSum = NestedFoo Record
| NestedBar Sum Basic Nested
| NestedBaz (Polymorphic Int Double)
deriving (Generic, Eq, Show, Coalpit)
instance Arbitrary NestedSum where arbitrary = genericArbitraryU
data RecursiveRecordMaybe = RecursiveRecordMaybe
{ rrm :: Maybe RecursiveRecordMaybe
, record :: Maybe Record
, guard :: ()
} deriving (Generic, Eq, Show, Coalpit)
instance Arbitrary RecursiveRecordMaybe where arbitrary = genericArbitraryU
data RecursiveRecordMaybe2 = RecursiveRecordMaybe2
{ record1' :: Maybe Record
, rrm' :: Maybe RecursiveRecordMaybe2
, record2' :: Maybe Record
, guard' :: ()
} deriving (Generic, Eq, Show, Coalpit)
instance Arbitrary RecursiveRecordMaybe2 where arbitrary = genericArbitraryU
data RecordStrings = RecordStrings
{ s1 :: String
, s2 :: String
, s3 :: String
} deriving (Generic, Eq, Show, Coalpit)
instance Arbitrary RecordStrings where arbitrary = genericArbitraryU
printAndParse :: (Coalpit a, Eq a)
=> Options -> Proxy a -> a -> Bool
printAndParse m _ r = Right r == fromArgs m (toArgs m r)
mkTest :: (Coalpit a, Eq a, Show a, Arbitrary a)
=> Options -> Proxy a -> String -> TestTree
mkTest m p n = QC.testProperty n (printAndParse m p)
idEqToAndFrom :: Options -> TestTree
idEqToAndFrom m = testGroup "id == parse . print"
[ mkTest m (Proxy :: Proxy Basic) "Basic"
, mkTest m (Proxy :: Proxy WithLists) "WithLists"
, mkTest m (Proxy :: Proxy Record) "Record"
, mkTest m (Proxy :: Proxy Sum) "Sum"
, mkTest m (Proxy :: Proxy Nested) "Nested"
, mkTest m (Proxy :: Proxy (Polymorphic Int Double))
"Polymorphic Int Double"
, mkTest m (Proxy :: Proxy (Polymorphic Basic Record))
"Polymorphic Basic Record"
, mkTest m (Proxy :: Proxy (Polymorphic Nested (Polymorphic Basic Sum)))
"Polymorphic Nested (Polymorphic Basic Sum)"
, mkTest m (Proxy :: Proxy Recursive) "Recursive"
, mkTest m (Proxy :: Proxy NestedRecord) "NestedRecord"
, mkTest m (Proxy :: Proxy NestedSum) "NestedSum"
, mkTest m (Proxy :: Proxy RecursiveRecordMaybe) "RecursiveRecordMaybe"
, mkTest m (Proxy :: Proxy RecursiveRecordMaybe2) "RecursiveRecordMaybe2"
, mkTest m (Proxy :: Proxy RecordStrings) "RecordStrings"
]
variousOptions :: (Options -> TestTree) -> TestTree
variousOptions tt = testGroup "Various modifiers"
[ testGroup (concat [ "alwaysUseSelName = ", show ausn
, ", omitNamedOptions = ", show ono])
[tt defOpt { alwaysUseSelName = ausn
, omitNamedOptions = ono }]
| ausn <- [True, False]
, ono <- [True, False]
]
qcProps :: TestTree
qcProps = testGroup "Quickcheck properties"
[ variousOptions idEqToAndFrom ]
main :: IO ()
main = travisTestReporter defaultConfig [] qcProps
|