summaryrefslogtreecommitdiff
path: root/test/Test.hs
blob: 4d965c94f52c548a7c73a21f886ca11aa1ccad7a (plain)
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
{-# 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 Data.Word
import Data.Int

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, (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) [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 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 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