@@ -268,6 +268,7 @@ data TestSuiteStanza = TestSuiteStanza
268
268
, _testStanzaMainIs :: Maybe FilePath
269
269
, _testStanzaTestModule :: Maybe ModuleName
270
270
, _testStanzaBuildInfo :: BuildInfo
271
+ , _testStanzaCodeGenerators :: [String ]
271
272
}
272
273
273
274
instance L. HasBuildInfo TestSuiteStanza where
@@ -289,13 +290,18 @@ testStanzaBuildInfo :: Lens' TestSuiteStanza BuildInfo
289
290
testStanzaBuildInfo f s = fmap (\ x -> s { _testStanzaBuildInfo = x }) (f (_testStanzaBuildInfo s))
290
291
{-# INLINE testStanzaBuildInfo #-}
291
292
293
+ testStanzaCodeGenerators :: Lens' TestSuiteStanza [String ]
294
+ testStanzaCodeGenerators f s = fmap (\ x -> s { _testStanzaCodeGenerators = x }) (f (_testStanzaCodeGenerators s))
295
+ {-# INLINE testStanzaCodeGenerators #-}
296
+
292
297
testSuiteFieldGrammar
293
298
:: ( FieldGrammar c g , Applicative (g TestSuiteStanza ), Applicative (g BuildInfo )
294
299
, c (Identity ModuleName )
295
300
, c (Identity TestType )
296
301
, c (List CommaFSep (Identity ExeDependency ) ExeDependency )
297
302
, c (List CommaFSep (Identity LegacyExeDependency ) LegacyExeDependency )
298
303
, c (List CommaFSep (Identity PkgconfigDependency ) PkgconfigDependency )
304
+ , c (List CommaFSep Token String )
299
305
, c (List CommaVCat (Identity Dependency ) Dependency )
300
306
, c (List CommaVCat (Identity Mixin ) Mixin )
301
307
, c (List FSep (MQuoted Extension ) Extension )
@@ -315,23 +321,20 @@ testSuiteFieldGrammar = TestSuiteStanza
315
321
<*> optionalFieldAla " main-is" FilePathNT testStanzaMainIs
316
322
<*> optionalField " test-module" testStanzaTestModule
317
323
<*> blurFieldGrammar testStanzaBuildInfo buildInfoFieldGrammar
324
+ <*> monoidalFieldAla " code-generators" (alaList' CommaFSep Token ) testStanzaCodeGenerators
325
+ ^^^ availableSince CabalSpecV3_6 [] -- TODO 3_8
318
326
319
327
validateTestSuite :: Position -> TestSuiteStanza -> ParseResult TestSuite
320
328
validateTestSuite pos stanza = case _testStanzaTestType stanza of
321
- Nothing -> return $
322
- emptyTestSuite { testBuildInfo = _testStanzaBuildInfo stanza }
329
+ Nothing -> pure basicTestSuite
323
330
324
331
Just tt@ (TestTypeUnknown _ _) ->
325
- pure emptyTestSuite
326
- { testInterface = TestSuiteUnsupported tt
327
- , testBuildInfo = _testStanzaBuildInfo stanza
328
- }
332
+ pure basicTestSuite
333
+ { testInterface = TestSuiteUnsupported tt }
329
334
330
335
Just tt | tt `notElem` knownTestTypes ->
331
- pure emptyTestSuite
332
- { testInterface = TestSuiteUnsupported tt
333
- , testBuildInfo = _testStanzaBuildInfo stanza
334
- }
336
+ pure basicTestSuite
337
+ { testInterface = TestSuiteUnsupported tt }
335
338
336
339
Just tt@ (TestTypeExe ver) -> case _testStanzaMainIs stanza of
337
340
Nothing -> do
@@ -340,36 +343,38 @@ validateTestSuite pos stanza = case _testStanzaTestType stanza of
340
343
Just file -> do
341
344
when (isJust (_testStanzaTestModule stanza)) $
342
345
parseWarning pos PWTExtraBenchmarkModule (extraField " test-module" tt)
343
- pure emptyTestSuite
344
- { testInterface = TestSuiteExeV10 ver file
345
- , testBuildInfo = _testStanzaBuildInfo stanza
346
- }
346
+ pure basicTestSuite
347
+ { testInterface = TestSuiteExeV10 ver file }
347
348
348
349
Just tt@ (TestTypeLib ver) -> case _testStanzaTestModule stanza of
349
350
Nothing -> do
350
- parseFailure pos (missingField " test-module" tt)
351
- pure emptyTestSuite
351
+ parseFailure pos (missingField " test-module" tt)
352
+ pure emptyTestSuite
352
353
Just module_ -> do
353
354
when (isJust (_testStanzaMainIs stanza)) $
354
355
parseWarning pos PWTExtraMainIs (extraField " main-is" tt)
355
- pure emptyTestSuite
356
- { testInterface = TestSuiteLibV09 ver module_
357
- , testBuildInfo = _testStanzaBuildInfo stanza
358
- }
356
+ pure basicTestSuite
357
+ { testInterface = TestSuiteLibV09 ver module_ }
359
358
360
359
where
361
360
missingField name tt = " The '" ++ name ++ " ' field is required for the "
362
361
++ prettyShow tt ++ " test suite type."
363
362
364
363
extraField name tt = " The '" ++ name ++ " ' field is not used for the '"
365
364
++ prettyShow tt ++ " ' test suite type."
365
+ basicTestSuite =
366
+ emptyTestSuite {
367
+ testBuildInfo = _testStanzaBuildInfo stanza
368
+ , testCodeGenerators = _testStanzaCodeGenerators stanza
369
+ }
366
370
367
371
unvalidateTestSuite :: TestSuite -> TestSuiteStanza
368
372
unvalidateTestSuite t = TestSuiteStanza
369
373
{ _testStanzaTestType = ty
370
374
, _testStanzaMainIs = ma
371
375
, _testStanzaTestModule = mo
372
376
, _testStanzaBuildInfo = testBuildInfo t
377
+ , _testStanzaCodeGenerators = testCodeGenerators t
373
378
}
374
379
where
375
380
(ty, ma, mo) = case testInterface t of
0 commit comments