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
|
{-|
Module : VeriFuzz.Config
Description : Configuration file format and parser.
Copyright : (c) 2019, Yann Herklotz
License : GPL-3
Maintainer : ymherklotz [at] gmail [dot] com
Stability : experimental
Portability : POSIX
Configuration file format and parser.
-}
{-# LANGUAGE TemplateHaskell #-}
module VeriFuzz.Config
( Config(..)
, defaultConfig
, Probability(..)
, probBlock
, probNonBlock
, probAssign
, probAlways
, probCond
, propSize
, propSeed
, propDepth
, configProbability
, configProperty
, parseConfigFile
, parseConfig
, configEncode
, configToFile
)
where
import Control.Applicative (Alternative)
import Control.Lens hiding ((.=))
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text.IO as T (writeFile)
import Toml (TomlCodec, (.=))
import qualified Toml
data Probability = Probability { _probAssign :: {-# UNPACK #-} !Int
, _probAlways :: {-# UNPACK #-} !Int
, _probBlock :: {-# UNPACK #-} !Int
, _probNonBlock :: {-# UNPACK #-} !Int
, _probCond :: {-# UNPACK #-} !Int
}
deriving (Eq, Show)
makeLenses ''Probability
data Property = Property { _propSize :: {-# UNPACK #-} !Int
, _propSeed :: !(Maybe Int)
, _propDepth :: {-# UNPACK #-} !Int
}
deriving (Eq, Show)
makeLenses ''Property
data Config = Config { _configProbability :: {-# UNPACK #-} !Probability
, _configProperty :: {-# UNPACK #-} !Property
}
deriving (Eq, Show)
makeLenses ''Config
defaultValue
:: (Alternative r, Applicative w)
=> b
-> Toml.Codec r w a b
-> Toml.Codec r w a b
defaultValue x = Toml.dimap Just (fromMaybe x) . Toml.dioptional
defaultConfig :: Config
defaultConfig = Config (Probability 5 1 5 1 1) (Property 20 Nothing 3)
twoKey :: Toml.Piece -> Toml.Piece -> Toml.Key
twoKey a b = Toml.Key (a :| [b])
probCodec :: TomlCodec Probability
probCodec =
Probability
<$> defaultValue (defProb probAssign)
(Toml.int $ twoKey "moditem" "assign")
.= _probAssign
<*> defaultValue (defProb probAlways)
(Toml.int $ twoKey "moditem" "always")
.= _probAlways
<*> defaultValue (defProb probBlock)
(Toml.int $ twoKey "statement" "blocking")
.= _probBlock
<*> defaultValue (defProb probNonBlock)
(Toml.int $ twoKey "statement" "nonblocking")
.= _probNonBlock
<*> defaultValue (defProb probNonBlock)
(Toml.int $ twoKey "statement" "conditional")
.= _probCond
where defProb i = defaultConfig ^. configProbability . i
propCodec :: TomlCodec Property
propCodec =
Property
<$> defaultValue (defProp propSize) (Toml.int "size")
.= _propSize
<*> Toml.dioptional (Toml.int "seed")
.= _propSeed
<*> defaultValue (defProp propDepth) (Toml.int "depth")
.= _propDepth
where defProp i = defaultConfig ^. configProperty . i
configCodec :: TomlCodec Config
configCodec =
Config
<$> defaultValue (defaultConfig ^. configProbability)
(Toml.table probCodec "probability")
.= _configProbability
<*> defaultValue (defaultConfig ^. configProperty)
(Toml.table propCodec "property")
.= _configProperty
parseConfigFile :: FilePath -> IO Config
parseConfigFile = Toml.decodeFile configCodec
parseConfig :: Text -> Config
parseConfig t = case Toml.decode configCodec t of
Right c -> c
Left Toml.TrivialError -> error "Trivial error while parsing Toml config"
Left (Toml.KeyNotFound k) -> error $ "Key " ++ show k ++ " not found"
Left (Toml.TableNotFound k) -> error $ "Table " ++ show k ++ " not found"
Left (Toml.TypeMismatch k _ _) ->
error $ "Type mismatch with key " ++ show k
Left (Toml.ParseError _) -> error "Config file parse error"
configEncode :: Config -> Text
configEncode = Toml.encode configCodec
configToFile :: FilePath -> Config -> IO ()
configToFile f = T.writeFile f . configEncode
|
