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
|
{-# LANGUAGE OverloadedStrings #-}
module Foundation.Check.Config
( Config(..)
, Seed
, DisplayOption(..)
, defaultConfig
, parseArgs
, configHelp
) where
import Basement.Imports
import Basement.IntegralConv
import Foundation.String.Read
import Foundation.Check.Gen
type Seed = Word64
data DisplayOption =
DisplayTerminalErrorOnly
| DisplayGroupOnly
| DisplayTerminalVerbose
deriving (Eq, Ord, Enum, Bounded, Show)
data Config = Config
{ udfSeed :: Maybe Seed -- ^ optional user specified seed
, getGenParams :: !GenParams
-- ^ Parameters for the generator
--
-- default:
-- * 32bits long numbers;
-- * array of 512 elements max;
-- * string of 8192 bytes max.
--
, numTests :: !Word64
-- ^ the number of tests to perform on every property.
--
-- default: 100
, listTests :: Bool
, testNameMatch :: [String]
, displayOptions :: !DisplayOption
, helpRequested :: Bool
}
-- | create the default configuration
--
-- see @Config@ for details
defaultConfig :: Config
defaultConfig = Config
{ udfSeed = Nothing
, getGenParams = params
, numTests = 100
, listTests = False
, testNameMatch = []
, displayOptions = DisplayGroupOnly
, helpRequested = False
}
where
params = GenParams
{ genMaxSizeIntegral = 32 -- 256 bits maximum numbers
, genMaxSizeArray = 512 -- 512 elements
, genMaxSizeString = 8192 -- 8K string
}
type ParamError = String
getInteger :: String -> String -> Either ParamError Integer
getInteger optionName s =
maybe (Left errMsg) Right $ readIntegral s
where
errMsg = "argument error for " <> optionName <> " expecting a number but got : " <> s
parseArgs :: [String] -> Config -> Either ParamError Config
parseArgs [] cfg = Right cfg
parseArgs ["--seed"] _ = Left "option `--seed' is missing a parameter"
parseArgs ("--seed":x:xs) cfg = getInteger "seed" x >>= \i -> parseArgs xs $ cfg { udfSeed = Just $ integralDownsize i }
parseArgs ["--tests"] _ = Left "option `--tests' is missing a parameter"
parseArgs ("--tests":x:xs) cfg = getInteger "tests" x >>= \i -> parseArgs xs $ cfg { numTests = integralDownsize i }
parseArgs ("--quiet":xs) cfg = parseArgs xs $ cfg { displayOptions = DisplayTerminalErrorOnly }
parseArgs ("--list-tests":xs) cfg = parseArgs xs $ cfg { listTests = True }
parseArgs ("--verbose":xs) cfg = parseArgs xs $ cfg { displayOptions = DisplayTerminalVerbose }
parseArgs ("--help":xs) cfg = parseArgs xs $ cfg { helpRequested = True }
parseArgs (x:xs) cfg = parseArgs xs $ cfg { testNameMatch = x : testNameMatch cfg }
configHelp :: [String]
configHelp =
[ "Usage: <program-name> [options] [test-name-match]\n"
, "\n"
, "Known options:\n"
, "\n"
, " --seed <seed>: a 64bit positive number to use as seed to generate arbitrary value.\n"
, " --tests <tests>: the number of tests to perform for every property tests.\n"
, " --quiet: print only the errors to the standard output\n"
, " --verbose: print every property tests to the stand output.\n"
, " --list-tests: print all test names.\n"
]
|
