Skip to content

Commit 5402f67

Browse files
romanroman
committed
[54] Move Spec.ConfigValue to its own attribute records
1 parent 4296d5f commit 5402f67

File tree

9 files changed

+114
-93
lines changed

9 files changed

+114
-93
lines changed

‎etc/src/System/Etc/Internal/Extra/EnvMisspell.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -34,7 +34,7 @@ data EnvMisspell
3434
lookupSpecEnvKeys :: ConfigSpec a -> Vector Text
3535
lookupSpecEnvKeys spec =
3636
let foldEnvSettings val acc = case val of
37-
ConfigValue { configSources } ->
37+
ConfigValue ConfigValueData { configSources } ->
3838
maybe acc (`Vector.cons` acc) (envVar configSources)
3939
SubConfig hsh -> HashMap.foldr foldEnvSettings acc hsh
4040
in foldEnvSettings (SubConfig $ specConfigValues spec) Vector.empty

‎etc/src/System/Etc/Internal/Resolver/Cli/Command.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -113,8 +113,8 @@ specToConfigValueCli
113113
-> (Text, Spec.ConfigValue cmd)
114114
-> m (HashMap cmd (Opt.Parser ConfigValue))
115115
specToConfigValueCli acc (specEntryKey, specConfigValue) = case specConfigValue of
116-
Spec.ConfigValue { Spec.configValueType, Spec.isSensitive, Spec.configSources } ->
117-
configValueSpecToCli acc specEntryKey configValueType isSensitive configSources
116+
Spec.ConfigValue Spec.ConfigValueData { Spec.configValueType, Spec.isSensitive, Spec.configSources }
117+
-> configValueSpecToCli acc specEntryKey configValueType isSensitive configSources
118118

119119
Spec.SubConfig subConfigSpec -> subConfigSpecToCli specEntryKey subConfigSpec acc
120120

‎etc/src/System/Etc/Internal/Resolver/Cli/Plain.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -92,8 +92,8 @@ specToConfigValueCli
9292
-> (Text, Spec.ConfigValue ())
9393
-> m (Opt.Parser ConfigValue)
9494
specToConfigValueCli acc (specEntryKey, specConfigValue) = case specConfigValue of
95-
Spec.ConfigValue { Spec.configValueType, Spec.isSensitive, Spec.configSources } ->
96-
configValueSpecToCli specEntryKey configValueType isSensitive configSources acc
95+
Spec.ConfigValue Spec.ConfigValueData { Spec.configValueType, Spec.isSensitive, Spec.configSources }
96+
-> configValueSpecToCli specEntryKey configValueType isSensitive configSources acc
9797

9898
Spec.SubConfig subConfigSpec -> subConfigSpecToCli specEntryKey subConfigSpec acc
9999

‎etc/src/System/Etc/Internal/Resolver/Default.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -20,7 +20,7 @@ buildDefaultResolver spec =
2020
let resolverReducer
2121
:: Text -> Spec.ConfigValue cmd -> Maybe ConfigValue -> Maybe ConfigValue
2222
resolverReducer specKey specValue mConfig = case specValue of
23-
Spec.ConfigValue { Spec.defaultValue, Spec.isSensitive } ->
23+
Spec.ConfigValue Spec.ConfigValueData { Spec.defaultValue, Spec.isSensitive } ->
2424
let mConfigSource = toDefaultConfigValue isSensitive <$> defaultValue
2525

2626
updateConfig = writeInSubConfig specKey <$> mConfigSource <*> mConfig

‎etc/src/System/Etc/Internal/Resolver/Env.hs‎

Lines changed: 9 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -36,14 +36,15 @@ buildEnvVarResolver lookupEnv spec =
3636
resolverReducer
3737
:: Text -> Spec.ConfigValue cmd -> Maybe ConfigValue -> Maybe ConfigValue
3838
resolverReducer specKey specValue mConfig = case specValue of
39-
Spec.ConfigValue { Spec.isSensitive, Spec.configValueType, Spec.configSources } ->
40-
let updateConfig = do
41-
envSource' <- resolveEnvVarSource lookupEnv
42-
configValueType
43-
isSensitive
44-
configSources
45-
writeInSubConfig specKey (ConfigValue $ Set.singleton envSource') <$> mConfig
46-
in updateConfig <|> mConfig
39+
Spec.ConfigValue Spec.ConfigValueData { Spec.isSensitive, Spec.configValueType, Spec.configSources }
40+
-> let updateConfig = do
41+
envSource' <- resolveEnvVarSource lookupEnv
42+
configValueType
43+
isSensitive
44+
configSources
45+
writeInSubConfig specKey (ConfigValue $ Set.singleton envSource')
46+
<$> mConfig
47+
in updateConfig <|> mConfig
4748

4849
Spec.SubConfig specConfigMap ->
4950
let mSubConfig =

‎etc/src/System/Etc/Internal/Resolver/File.hs‎

Lines changed: 8 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -67,13 +67,14 @@ parseConfigValue keys spec fileIndex fileSource' json =
6767

6868
(Spec.SubConfig{}, _) -> throwM $ SubConfigEntryExpected currentKey json
6969

70-
(Spec.ConfigValue { Spec.isSensitive, Spec.configValueType }, _) -> do
71-
either throwM return $ Spec.assertMatchingConfigValueType json configValueType
72-
return $ ConfigValue
73-
(Set.singleton $ fileSource 1 fileIndex fileSource' $ markAsSensitive
74-
isSensitive
75-
json
76-
)
70+
(Spec.ConfigValue Spec.ConfigValueData { Spec.isSensitive, Spec.configValueType }, _)
71+
-> do
72+
either throwM return $ Spec.assertMatchingConfigValueType json configValueType
73+
return $ ConfigValue
74+
(Set.singleton $ fileSource 1 fileIndex fileSource' $ markAsSensitive
75+
isSensitive
76+
json
77+
)
7778

7879

7980

‎etc/src/System/Etc/Internal/Spec/Parser.hs‎

Lines changed: 17 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -222,13 +222,14 @@ instance JSON.FromJSON cmd => JSON.FromJSON (ConfigValue cmd) where
222222
mSensitive <- fieldSpec .:? "sensitive"
223223
mCvType <- fieldSpec .:? "type"
224224
let sensitive = fromMaybe False mSensitive
225-
ConfigValue
226-
<$> pure mDefaultValue
227-
<*> getConfigValueType mDefaultValue mCvType
228-
<*> pure sensitive
229-
<*> (ConfigSources <$> fieldSpec .:? "env"
230-
<*> fieldSpec .:? "cli")
231-
<*> pure json
225+
ConfigValue <$>
226+
(ConfigValueData
227+
<$> pure mDefaultValue
228+
<*> getConfigValueType mDefaultValue mCvType
229+
<*> pure sensitive
230+
<*> (ConfigSources <$> fieldSpec .:? "env"
231+
<*> fieldSpec .:? "cli")
232+
<*> pure json)
232233
else
233234
fail "etc/spec object can only contain one key"
234235

@@ -239,14 +240,15 @@ instance JSON.FromJSON cmd => JSON.FromJSON (ConfigValue cmd) where
239240
_ -> do
240241
cvType <- either fail pure $ jsonToConfigValueType json
241242
return
242-
ConfigValue
243-
{
244-
defaultValue = Just json
245-
, configValueType = cvType
246-
, isSensitive = False
247-
, configSources = ConfigSources Nothing Nothing
248-
, rawConfigValue = json
249-
}
243+
$ ConfigValue
244+
ConfigValueData
245+
{
246+
defaultValue = Just json
247+
, configValueType = cvType
248+
, isSensitive = False
249+
, configSources = ConfigSources Nothing Nothing
250+
, rawConfigValue = json
251+
}
250252

251253
parseFiles :: JSON.Value -> JSON.Parser FilesSpec
252254
parseFiles = JSON.withObject "FilesSpec" $ \object -> do

‎etc/src/System/Etc/Internal/Spec/Types.hs‎

Lines changed: 14 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -142,23 +142,29 @@ instance Display ConfigValueType where
142142
CVTSingle singleVal -> display singleVal
143143
CVTArray singleVal -> display $ "[" <> display singleVal <> "]"
144144

145-
data ConfigValue cmd
146-
= ConfigValue {
145+
data ConfigValueData cmd =
146+
ConfigValueData {
147147
defaultValue :: !(Maybe JSON.Value)
148148
, configValueType :: !ConfigValueType
149149
, isSensitive :: !Bool
150150
, configSources :: !(ConfigSources cmd)
151151
, rawConfigValue :: !JSON.Value
152152
}
153-
| SubConfig {
154-
subConfig :: !(HashMap Text (ConfigValue cmd))
155-
}
153+
deriving (Generic, Show, Eq)
154+
155+
instance Lift cmd => Lift (ConfigValueData cmd) where
156+
lift ConfigValueData {defaultValue, configValueType, isSensitive, configSources, rawConfigValue } =
157+
[| ConfigValueData defaultValue configValueType isSensitive configSources rawConfigValue |]
158+
159+
data ConfigValue cmd
160+
= ConfigValue !(ConfigValueData cmd)
161+
| SubConfig !(HashMap Text (ConfigValue cmd))
156162
deriving (Generic, Show, Eq)
157163

158164
instance Lift cmd => Lift (ConfigValue cmd) where
159-
lift ConfigValue {defaultValue, configValueType, isSensitive, configSources, rawConfigValue } =
160-
[| ConfigValue defaultValue configValueType isSensitive configSources rawConfigValue |]
161-
lift SubConfig {subConfig} =
165+
lift (ConfigValue configValueData) =
166+
[| ConfigValue configValueData |]
167+
lift (SubConfig subConfig) =
162168
[| SubConfig (HashMap.fromList $ map (first Text.pack) subConfigList) |]
163169
where
164170
subConfigList = map (first Text.unpack) $ HashMap.toList subConfig

‎etc/test/System/Etc/SpecTest.hs‎

Lines changed: 60 additions & 49 deletions
Original file line numberDiff line numberDiff line change
@@ -79,26 +79,26 @@ general_tests = testGroup
7979
let input = "{\"etc/entries\":{\"greeting\":123}}"
8080
keys = ["greeting"]
8181

82-
config <- SUT.parseConfigSpec input
82+
(config :: ConfigSpec ()) <- SUT.parseConfigSpec input
8383
case getConfigValue keys (specConfigValues config) of
84-
Nothing -> assertFailure
84+
Just (ConfigValue value) -> assertEqual "should contain default value"
85+
(Just (JSON.Number 123))
86+
(defaultValue value)
87+
_ -> assertFailure
8588
(show keys ++ " should map to a config value, got sub config map instead")
86-
Just (value :: ConfigValue ()) -> assertEqual "should contain default value"
87-
(Just (JSON.Number 123))
88-
(defaultValue value)
8989
, testCase "entries that finish with arrays sets them as default value" $ do
9090
let input = "{\"etc/entries\":{\"greeting\":[123]}}"
9191
keys = ["greeting"]
9292

93-
config <- SUT.parseConfigSpec input
93+
(config :: ConfigSpec ()) <- SUT.parseConfigSpec input
9494

9595
case getConfigValue keys (specConfigValues config) of
96-
Nothing -> assertFailure
97-
(show keys ++ " should map to a config value, got sub config map instead")
98-
Just (value :: ConfigValue ()) -> assertEqual
96+
Just (ConfigValue value) -> assertEqual
9997
"should contain default value"
10098
(Just (JSON.Array (Vector.fromList [JSON.Number 123])))
10199
(defaultValue value)
100+
_ -> assertFailure
101+
(show keys ++ " should map to a config value, got sub config map instead")
102102
, testCase "entries with empty arrays as values fail because type cannot be infered" $ do
103103
let input = "{\"etc/entries\":{\"greeting\": []}}"
104104
case SUT.parseConfigSpec input of
@@ -115,44 +115,43 @@ general_tests = testGroup
115115
= "{\"etc/entries\":{\"greeting\":{\"etc/spec\":{\"default\":[],\"type\":\"[string]\"}}}}"
116116
keys = ["greeting"]
117117

118-
config <- SUT.parseConfigSpec input
118+
(config :: ConfigSpec ()) <- SUT.parseConfigSpec input
119119
case getConfigValue keys (specConfigValues config) of
120-
Nothing -> assertFailure
121-
(show keys ++ " should map to an array config value, got sub config map instead")
120+
Just (ConfigValue value) -> assertEqual "should contain default array value"
121+
(Just (JSON.Array (Vector.fromList [])))
122+
(defaultValue value)
122123

123-
Just (value :: ConfigValue ()) -> assertEqual
124-
"should contain default array value"
125-
(Just (JSON.Array (Vector.fromList [])))
126-
(defaultValue value)
124+
_ -> assertFailure
125+
(show keys ++ " should map to an array config value, got sub config map instead")
127126
, testCase "entries with array of objects do not fail" $ do
128127
let
129128
input
130129
= "{\"etc/entries\":{\"greeting\":{\"etc/spec\":{\"default\":[{\"hello\":\"world\"}],\"type\":\"[object]\"}}}}"
131130
keys = ["greeting"]
132131

133-
config <- SUT.parseConfigSpec input
132+
(config :: ConfigSpec ()) <- SUT.parseConfigSpec input
134133
case getConfigValue keys (specConfigValues config) of
135-
Nothing -> assertFailure
136-
(show keys ++ " should map to an array config value, got sub config map instead")
137-
138-
Just (value :: ConfigValue ()) -> assertEqual
134+
Just (ConfigValue value) -> assertEqual
139135
"should contain default array value"
140136
(Just
141137
(JSON.Array (Vector.fromList [JSON.object ["hello" JSON..= ("world" :: Text)]]))
142138
)
143139
(defaultValue value)
140+
141+
_ -> assertFailure
142+
(show keys ++ " should map to an array config value, got sub config map instead")
144143
, testCase "entries can have many levels of nesting" $ do
145144
let input = "{\"etc/entries\":{\"english\":{\"greeting\":\"hello\"}}}"
146145
keys = ["english", "greeting"]
147146

148-
config <- SUT.parseConfigSpec input
147+
(config :: ConfigSpec ()) <- SUT.parseConfigSpec input
149148

150149
case getConfigValue keys (specConfigValues config) of
151-
Nothing -> assertFailure
150+
Just (ConfigValue value) -> assertEqual "should contain default value"
151+
(Just (JSON.String "hello"))
152+
(defaultValue value)
153+
_ -> assertFailure
152154
(show keys ++ " should map to a config value, got sub config map instead")
153-
Just (value :: ConfigValue ()) -> assertEqual "should contain default value"
154-
(Just (JSON.String "hello"))
155-
(defaultValue value)
156155
, testCase "spec map cannot be empty object" $ do
157156
let input = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":{}}}"
158157

@@ -233,11 +232,15 @@ cli_tests =
233232

234233
let
235234
result = do
236-
value <- getConfigValue keys (specConfigValues config)
237-
let valueType = configValueType value
238-
PlainEntry metadata <- cliEntry (configSources value)
239-
short <- optShort metadata
240-
return (short, valueType)
235+
configValue <- getConfigValue keys (specConfigValues config)
236+
case configValue of
237+
ConfigValue value -> do
238+
let valueType = configValueType value
239+
PlainEntry metadata <- cliEntry (configSources value)
240+
short <- optShort metadata
241+
return (short, valueType)
242+
_ ->
243+
Nothing
241244

242245
case result of
243246
Nothing ->
@@ -255,11 +258,15 @@ cli_tests =
255258

256259
let
257260
result = do
258-
value <- getConfigValue keys (specConfigValues config)
259-
let valueType = configValueType value
260-
PlainEntry metadata <- cliEntry (configSources value)
261-
long <- optLong metadata
262-
return (long, valueType)
261+
configValue <- getConfigValue keys (specConfigValues config)
262+
case configValue of
263+
ConfigValue value -> do
264+
let valueType = configValueType value
265+
PlainEntry metadata <- cliEntry (configSources value)
266+
long <- optLong metadata
267+
return (long, valueType)
268+
_ ->
269+
Nothing
263270

264271
case result of
265272
Nothing ->
@@ -277,11 +284,15 @@ cli_tests =
277284

278285
let
279286
result = do
280-
value <- getConfigValue keys (specConfigValues config)
281-
let valueType = configValueType value
282-
CmdEntry cmd metadata <- cliEntry (configSources value)
283-
long <- optLong metadata
284-
return (cmd, long, valueType)
287+
configValue <- getConfigValue keys (specConfigValues config)
288+
case configValue of
289+
(ConfigValue value) -> do
290+
let valueType = configValueType value
291+
CmdEntry cmd metadata <- cliEntry (configSources value)
292+
long <- optLong metadata
293+
return (cmd, long, valueType)
294+
_ ->
295+
Nothing
285296

286297
case result of
287298
Nothing ->
@@ -317,11 +328,11 @@ envvar_tests = testGroup
317328
(config :: ConfigSpec ()) <- SUT.parseConfigSpec input
318329

319330
case getConfigValue keys (specConfigValues config) of
320-
Nothing -> assertFailure
331+
Just (ConfigValue value) -> assertEqual "should contain EnvVar value"
332+
(ConfigSources (Just "GREETING") Nothing)
333+
(configSources value)
334+
_ -> assertFailure
321335
(show keys ++ " should map to a config value, got sub config map instead")
322-
Just value -> assertEqual "should contain EnvVar value"
323-
(ConfigSources (Just "GREETING") Nothing)
324-
(configSources value)
325336
]
326337

327338
#ifdef WITH_YAML
@@ -341,13 +352,13 @@ yaml_tests =
341352

342353
Right (config :: ConfigSpec ()) ->
343354
case getConfigValue keys (specConfigValues config) of
344-
Nothing ->
345-
assertFailure (show keys ++ " should map to a config value, got sub config map instead")
346-
347-
Just value ->
355+
Just (ConfigValue value) ->
348356
assertEqual "should contain EnvVar value"
349357
(ConfigSources (Just "GREETING") Nothing)
350358
(configSources value)
359+
_ ->
360+
assertFailure (show keys ++ " should map to a config value, got sub config map instead")
361+
351362
]
352363
#endif
353364

0 commit comments

Comments
 (0)