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
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
|
{-# LANGUAGE DeriveGeneric, DeriveAnyClass, RankNTypes #-}
import GHC.Generics
import Generic.Random
import Test.Tasty
import Test.Tasty.QuickCheck as QC
import Data.Proxy
import Test.Tasty.Travis
import Data.Word
import Data.Int
import Data.Complex
import Data.Either
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]
, maybeNonEmptyListOfNumbers :: Maybe [Integer]
, otherString :: String
} deriving (Generic, Eq, Show, Coalpit)
instance Arbitrary Record where arbitrary = genericArbitraryU
data Sum = Foo Int Bool
| Bar
| Baz (Int8, (Complex Float, Word16), 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) (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 Char 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 (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 opt _ r = Right r == fromArgs opt (toArgs opt r)
printAndParseDSV :: (Coalpit a, Eq a)
-- It would take a long time to test with [a], so
-- just repeating it 0--2 times.
=> Options -> Proxy a -> (a, Int) -> Bool
printAndParseDSV opt _ (x, n) =
let xs = (replicate (n `mod` 3) x)
in xs == rights (readDSV opt (showDSV opt xs))
variousTypes :: (forall a. (Coalpit a, Eq a, Show a, Arbitrary a) =>
Proxy a -> String -> TestTree)
-> [TestTree]
variousTypes f =
[ f (Proxy :: Proxy Basic) "Basic"
, f (Proxy :: Proxy WithLists) "WithLists"
, f (Proxy :: Proxy Record) "Record"
, f (Proxy :: Proxy Sum) "Sum"
, f (Proxy :: Proxy Nested) "Nested"
, f (Proxy :: Proxy (Polymorphic Int Double)) "Polymorphic Int Double"
, f (Proxy :: Proxy (Polymorphic Basic Record)) "Polymorphic Basic Record"
, f (Proxy :: Proxy (Polymorphic Nested (Polymorphic Basic Sum)))
"Polymorphic Nested (Polymorphic Basic Sum)"
, f (Proxy :: Proxy Recursive) "Recursive"
, f (Proxy :: Proxy NestedRecord) "NestedRecord"
, f (Proxy :: Proxy NestedSum) "NestedSum"
, f (Proxy :: Proxy RecursiveRecordMaybe) "RecursiveRecordMaybe"
, f (Proxy :: Proxy RecursiveRecordMaybe2) "RecursiveRecordMaybe2"
, f (Proxy :: Proxy RecordStrings) "RecordStrings"
]
variousOptions :: (Options -> [TestTree]) -> [TestTree]
variousOptions tt =
[ 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"
[ testGroup "Right == fromArgs opt . toArgs opt"
(variousOptions $ \opt ->
variousTypes $ \p n -> QC.testProperty n (printAndParse opt p))
, testGroup "id == rights . readDSV opt . showDSV opt"
(variousOptions $ \opt ->
variousTypes $ \p n -> QC.testProperty n (printAndParseDSV opt p))
]
main :: IO ()
main = travisTestReporter defaultConfig [] qcProps
|