File: OptionTypes.hs

package info (click to toggle)
haskell-options 1.2.1.1-10
  • links: PTS, VCS
  • area: main
  • in suites: bookworm
  • size: 184 kB
  • sloc: haskell: 2,143; ansic: 91; makefile: 2
file content (317 lines) | stat: -rw-r--r-- 10,846 bytes parent folder | download | duplicates (4)
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
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

-- Copyright (C) 2012 John Millikin <jmillikin@gmail.com>
--
-- See license.txt for details
module OptionsTests.OptionTypes
	( suite_OptionTypes
	) where

import           Data.Int
import qualified Data.Map as Map
import qualified Data.Set as Set
import           Data.Word

import           Test.Chell

import           Options

suite_OptionTypes :: Suite
suite_OptionTypes = suite "option-types"
	[ test_Bool
	, test_String
	, test_Int
	, test_Int8
	, test_Int16
	, test_Int32
	, test_Int64
	, test_Word
	, test_Word8
	, test_Word16
	, test_Word32
	, test_Word64
	, test_Integer
	, test_Float
	, test_Double
	, test_Maybe
	, test_List
	, test_Set
	, test_Map
	, test_Enum
	]

parseValid :: (Show a, Eq a) => OptionType a -> String -> a -> Assertion
parseValid t s expected = equal (optionTypeParse t s) (Right expected)

parseInvalid :: (Show a, Eq a) => OptionType a -> String -> String -> Assertion
parseInvalid t s err = equal (optionTypeParse t s) (Left err)

test_Bool :: Test
test_Bool = assertions "bool" $ do
	$expect (parseValid optionType_bool "true" True)
	$expect (parseValid optionType_bool "false" False)
	$expect (parseInvalid optionType_bool "" "\"\" is not in {\"true\", \"false\"}.")

test_String :: Test
test_String = assertions "string" $ do
	let valid = parseValid optionType_string
	let invalid = parseInvalid optionType_string
	
	$expect (valid "" "")
	$expect (valid "a" "a")
	$expect (valid "\12354" "\12354")
	$expect (valid "\56507" "\56507")
	$expect (valid "\61371" "\61371")

test_Int :: Test
test_Int = assertions "int" $ do
	let valid = parseValid optionType_int
	let invalid = parseInvalid optionType_int
	
	$expect (valid "-1" (-1 :: Int))
	$expect (valid "1" (1 :: Int))
	$expect (invalid "a" "\"a\" is not an integer.")
	
	let pastMin = show (toInteger (minBound :: Int) - 1)
	let pastMax = show (toInteger (maxBound :: Int) + 1)
	let errBounds = " is not within bounds [" ++ show (minBound :: Int) ++ ":" ++ show (maxBound :: Int) ++ "] of type int."
	
	$expect (invalid pastMin (pastMin ++ errBounds))
	$expect (valid (show (minBound :: Int)) minBound)
	$expect (valid (show (maxBound :: Int)) maxBound)
	$expect (invalid pastMax (pastMax ++ errBounds))

test_Int8 :: Test
test_Int8 = assertions "int8" $ do
	let valid = parseValid optionType_int8
	let invalid = parseInvalid optionType_int8
	
	$expect (valid "-1" (-1 :: Int8))
	$expect (valid "1" (1 :: Int8))
	$expect (invalid "a" "\"a\" is not an integer.")
	
	let pastMin = show (toInteger (minBound :: Int8) - 1)
	let pastMax = show (toInteger (maxBound :: Int8) + 1)
	$expect (invalid pastMin "-129 is not within bounds [-128:127] of type int8.")
	$expect (valid (show (minBound :: Int8)) minBound)
	$expect (valid (show (maxBound :: Int8)) maxBound)
	$expect (invalid pastMax "128 is not within bounds [-128:127] of type int8.")

test_Int16 :: Test
test_Int16 = assertions "int16" $ do
	let valid = parseValid optionType_int16
	let invalid = parseInvalid optionType_int16
	
	$expect (valid "-1" (-1 :: Int16))
	$expect (valid "1" (1 :: Int16))
	$expect (invalid "a" "\"a\" is not an integer.")
	
	let pastMin = show (toInteger (minBound :: Int16) - 1)
	let pastMax = show (toInteger (maxBound :: Int16) + 1)
	$expect (invalid pastMin "-32769 is not within bounds [-32768:32767] of type int16.")
	$expect (valid (show (minBound :: Int16)) minBound)
	$expect (valid (show (maxBound :: Int16)) maxBound)
	$expect (invalid pastMax "32768 is not within bounds [-32768:32767] of type int16.")

test_Int32 :: Test
test_Int32 = assertions "int32" $ do
	let valid = parseValid optionType_int32
	let invalid = parseInvalid optionType_int32
	
	$expect (valid "-1" (-1 :: Int32))
	$expect (valid "1" (1 :: Int32))
	$expect (invalid "a" "\"a\" is not an integer.")
	
	let pastMin = show (toInteger (minBound :: Int32) - 1)
	let pastMax = show (toInteger (maxBound :: Int32) + 1)
	$expect (invalid pastMin "-2147483649 is not within bounds [-2147483648:2147483647] of type int32.")
	$expect (valid (show (minBound :: Int32)) minBound)
	$expect (valid (show (maxBound :: Int32)) maxBound)
	$expect (invalid pastMax "2147483648 is not within bounds [-2147483648:2147483647] of type int32.")

test_Int64 :: Test
test_Int64 = assertions "int64" $ do
	let valid = parseValid optionType_int64
	let invalid = parseInvalid optionType_int64
	
	$expect (valid "-1" (-1 :: Int64))
	$expect (valid "1" (1 :: Int64))
	$expect (invalid "a" "\"a\" is not an integer.")
	
	let pastMin = show (toInteger (minBound :: Int64) - 1)
	let pastMax = show (toInteger (maxBound :: Int64) + 1)
	$expect (invalid pastMin "-9223372036854775809 is not within bounds [-9223372036854775808:9223372036854775807] of type int64.")
	$expect (valid (show (minBound :: Int64)) minBound)
	$expect (valid (show (maxBound :: Int64)) maxBound)
	$expect (invalid pastMax "9223372036854775808 is not within bounds [-9223372036854775808:9223372036854775807] of type int64.")

test_Word :: Test
test_Word = assertions "word" $ do
	let valid = parseValid optionType_word
	let invalid = parseInvalid optionType_word
	
	let pastMax = show (toInteger (maxBound :: Word) + 1)
	let errBounds = " is not within bounds [0:" ++ show (maxBound :: Word) ++ "] of type uint."
	
	$expect (invalid "-1" ("-1" ++ errBounds))
	$expect (valid "0" (0 :: Word))
	$expect (valid "1" (1 :: Word))
	$expect (invalid "a" "\"a\" is not an integer.")
	
	$expect (valid (show (maxBound :: Word)) maxBound)
	$expect (invalid pastMax (pastMax ++ errBounds))

test_Word8 :: Test
test_Word8 = assertions "word8" $ do
	let valid = parseValid optionType_word8
	let invalid = parseInvalid optionType_word8
	
	$expect (invalid "-1" "-1 is not within bounds [0:255] of type uint8.")
	$expect (valid "0" (0 :: Word8))
	$expect (valid "1" (1 :: Word8))
	$expect (invalid "a" "\"a\" is not an integer.")
	
	let pastMax = show (toInteger (maxBound :: Word8) + 1)
	$expect (valid (show (maxBound :: Word8)) maxBound)
	$expect (invalid pastMax "256 is not within bounds [0:255] of type uint8.")

test_Word16 :: Test
test_Word16 = assertions "word16" $ do
	let valid = parseValid optionType_word16
	let invalid = parseInvalid optionType_word16
	
	$expect (invalid "-1" "-1 is not within bounds [0:65535] of type uint16.")
	$expect (valid "0" (0 :: Word16))
	$expect (valid "1" (1 :: Word16))
	$expect (invalid "a" "\"a\" is not an integer.")
	
	let pastMax = show (toInteger (maxBound :: Word16) + 1)
	$expect (valid (show (maxBound :: Word16)) maxBound)
	$expect (invalid pastMax "65536 is not within bounds [0:65535] of type uint16.")

test_Word32 :: Test
test_Word32 = assertions "word32" $ do
	let valid = parseValid optionType_word32
	let invalid = parseInvalid optionType_word32
	
	$expect (invalid "-1" "-1 is not within bounds [0:4294967295] of type uint32.")
	$expect (valid "0" (0 :: Word32))
	$expect (valid "1" (1 :: Word32))
	$expect (invalid "a" "\"a\" is not an integer.")
	
	let pastMax = show (toInteger (maxBound :: Word32) + 1)
	$expect (valid (show (maxBound :: Word32)) maxBound)
	$expect (invalid pastMax "4294967296 is not within bounds [0:4294967295] of type uint32.")

test_Word64 :: Test
test_Word64 = assertions "word64" $ do
	let valid = parseValid optionType_word64
	let invalid = parseInvalid optionType_word64
	
	$expect (invalid "-1" "-1 is not within bounds [0:18446744073709551615] of type uint64.")
	$expect (valid "0" (0 :: Word64))
	$expect (valid "1" (1 :: Word64))
	$expect (invalid "a" "\"a\" is not an integer.")
	
	let pastMax = show (toInteger (maxBound :: Word64) + 1)
	$expect (valid (show (maxBound :: Word64)) maxBound)
	$expect (invalid pastMax "18446744073709551616 is not within bounds [0:18446744073709551615] of type uint64.")

test_Integer :: Test
test_Integer = assertions "integer" $ do
	let valid = parseValid optionType_integer
	let invalid = parseInvalid optionType_integer
	
	$expect (invalid "" "\"\" is not an integer.")
	$expect (valid "-1" (-1 :: Integer))
	$expect (valid "0" (0 :: Integer))
	$expect (valid "1" (1 :: Integer))
	$expect (invalid "a" "\"a\" is not an integer.")

test_Float :: Test
test_Float = assertions "float" $ do
	let valid = parseValid optionType_float
	let invalid = parseInvalid optionType_float
	
	$expect (valid "-1" (-1 :: Float))
	$expect (valid "0" (0 :: Float))
	$expect (valid "1" (1 :: Float))
	$expect (valid "1.5" (1.5 :: Float))
	$expect (valid "3e5" (3e5 :: Float))
	$expect (invalid "a" "\"a\" is not a number.")

test_Double :: Test
test_Double = assertions "double" $ do
	let valid = parseValid optionType_double
	let invalid = parseInvalid optionType_double
	
	$expect (valid "-1" (-1 :: Double))
	$expect (valid "0" (0 :: Double))
	$expect (valid "1" (1 :: Double))
	$expect (valid "1.5" (1.5 :: Double))
	$expect (valid "3e5" (3e5 :: Double))
	$expect (invalid "a" "\"a\" is not a number.")

test_Maybe :: Test
test_Maybe = assertions "maybe" $ do
	let t = optionType_maybe optionType_int
	let valid = parseValid t
	let invalid = parseInvalid t
	
	$expect (valid "" Nothing)
	$expect (valid "1" (Just 1))
	$expect (invalid "a" "\"a\" is not an integer.")

test_List :: Test
test_List = assertions "list" $ do
	let t = optionType_list ',' optionType_int
	let valid = parseValid t
	let invalid = parseInvalid t
	
	$expect (valid "" [])
	$expect (valid "1" [1])
	$expect (valid "1,2,3" [1, 2, 3])
	$expect (valid "1,1,2,3" [1, 1, 2, 3])
	$expect (invalid "1,a,3" "\"a\" is not an integer.")

test_Set :: Test
test_Set = assertions "set" $ do
	let t = optionType_set ',' optionType_int
	let valid = parseValid t
	let invalid = parseInvalid t
	
	$expect (valid "" Set.empty)
	$expect (valid "1" (Set.fromList [1]))
	$expect (valid "1,2,3" (Set.fromList [1, 2, 3]))
	$expect (valid "1,1,2,3" (Set.fromList [1, 2, 3]))
	$expect (invalid "1,a,3" "\"a\" is not an integer.")

test_Map :: Test
test_Map = assertions "map" $ do
	let t = optionType_map ',' '=' optionType_int optionType_int
	let valid = parseValid t
	let invalid = parseInvalid t
	
	$expect (valid "" Map.empty)
	$expect (valid "1=100" (Map.fromList [(1, 100)]))
	$expect (valid "1=100,2=200,3=300" (Map.fromList [(1, 100), (2, 200), (3, 300)]))
	$expect (valid "1=100,2=200,1=300" (Map.fromList [(1, 300), (2, 200)]))
	$expect (invalid "a=1" "\"a\" is not an integer.")
	$expect (invalid "1=a" "\"a\" is not an integer.")
	$expect (invalid "1=" "\"\" is not an integer.")
	$expect (invalid "1" "Map item \"1\" has no value.")

data TestEnum = Enum1 | Enum2 | Enum3
	deriving (Bounded, Enum, Eq, Show)

test_Enum :: Test
test_Enum = assertions "enum" $ do
	let t = optionType_enum "test enum"
	let valid = parseValid t
	let invalid = parseInvalid t
	
	$expect (valid "Enum1" Enum1)
	$expect (valid "Enum2" Enum2)
	$expect (invalid "Enum4" "\"Enum4\" is not in {\"Enum1\", \"Enum2\", \"Enum3\"}.")