code-generators field in test stanza. (haskell#7688)

* wip to add test-code-generators field to test stanzas * fixups * change hashes * regen golden parser test output * docs and changelog * test * Update pr-7688 * tweak test Co-authored-by: Gershom Bazerman <[email protected]>
donsbot · Feb 25, 2022 · 9b300f3 · 9b300f3
1 parent 1c3cf3a
commit 9b300f3
Show file tree

Hide file tree

Showing 30 changed files with 7,090 additions and 6,942 deletions.
diff --git a/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs b/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs
@@ -268,6 +268,7 @@ data TestSuiteStanza = TestSuiteStanza
     , _testStanzaMainIs     :: Maybe FilePath
     , _testStanzaTestModule :: Maybe ModuleName
     , _testStanzaBuildInfo  :: BuildInfo
+    , _testStanzaCodeGenerators :: [String]
     }
 
 instance L.HasBuildInfo TestSuiteStanza where
@@ -289,13 +290,18 @@ testStanzaBuildInfo :: Lens' TestSuiteStanza BuildInfo
 testStanzaBuildInfo f s = fmap (\x -> s { _testStanzaBuildInfo = x }) (f (_testStanzaBuildInfo s))
 {-# INLINE testStanzaBuildInfo #-}
 
+testStanzaCodeGenerators :: Lens' TestSuiteStanza [String]
+testStanzaCodeGenerators f s = fmap (\x -> s { _testStanzaCodeGenerators = x }) (f (_testStanzaCodeGenerators s))
+{-# INLINE testStanzaCodeGenerators #-}
+
 testSuiteFieldGrammar
     :: ( FieldGrammar c g, Applicative (g TestSuiteStanza), Applicative (g BuildInfo)
        , c (Identity ModuleName)
        , c (Identity TestType)
        , c (List CommaFSep (Identity ExeDependency) ExeDependency)
        , c (List CommaFSep (Identity LegacyExeDependency) LegacyExeDependency)
        , c (List CommaFSep (Identity PkgconfigDependency) PkgconfigDependency)
+       , c (List CommaFSep Token String)
        , c (List CommaVCat (Identity Dependency) Dependency)
        , c (List CommaVCat (Identity Mixin) Mixin)
        , c (List FSep (MQuoted Extension) Extension)
@@ -315,23 +321,20 @@ testSuiteFieldGrammar = TestSuiteStanza
     <*> optionalFieldAla "main-is"     FilePathNT testStanzaMainIs
     <*> optionalField    "test-module"            testStanzaTestModule
     <*> blurFieldGrammar testStanzaBuildInfo buildInfoFieldGrammar
+    <*> monoidalFieldAla "code-generators"        (alaList'  CommaFSep Token)     testStanzaCodeGenerators
+          ^^^ availableSince CabalSpecV3_6 [] -- TODO 3_8
 
 validateTestSuite :: Position -> TestSuiteStanza -> ParseResult TestSuite
 validateTestSuite pos stanza = case _testStanzaTestType stanza of
-    Nothing -> return $
-        emptyTestSuite { testBuildInfo = _testStanzaBuildInfo stanza }
+    Nothing -> pure basicTestSuite
 
     Just tt@(TestTypeUnknown _ _) ->
-        pure emptyTestSuite
-            { testInterface = TestSuiteUnsupported tt
-            , testBuildInfo = _testStanzaBuildInfo stanza
-            }
+        pure basicTestSuite
+            { testInterface = TestSuiteUnsupported tt }
 
     Just tt | tt `notElem` knownTestTypes ->
-        pure emptyTestSuite
-            { testInterface = TestSuiteUnsupported tt
-            , testBuildInfo = _testStanzaBuildInfo stanza
-            }
+        pure basicTestSuite
+            { testInterface = TestSuiteUnsupported tt }
 
     Just tt@(TestTypeExe ver) -> case _testStanzaMainIs stanza of
         Nothing   -> do
@@ -340,36 +343,38 @@ validateTestSuite pos stanza = case _testStanzaTestType stanza of
         Just file -> do
             when (isJust (_testStanzaTestModule stanza)) $
                 parseWarning pos PWTExtraBenchmarkModule (extraField "test-module" tt)
-            pure emptyTestSuite
-                { testInterface = TestSuiteExeV10 ver file
-                , testBuildInfo = _testStanzaBuildInfo stanza
-                }
+            pure basicTestSuite
+                { testInterface = TestSuiteExeV10 ver file }
 
     Just tt@(TestTypeLib ver) -> case _testStanzaTestModule stanza of
          Nothing      -> do
-             parseFailure pos (missingField "test-module" tt)
-             pure emptyTestSuite
+            parseFailure pos (missingField "test-module" tt)
+            pure emptyTestSuite
          Just module_ -> do
             when (isJust (_testStanzaMainIs stanza)) $
                 parseWarning pos PWTExtraMainIs (extraField "main-is" tt)
-            pure emptyTestSuite
-                { testInterface = TestSuiteLibV09 ver module_
-                , testBuildInfo = _testStanzaBuildInfo stanza
-                }
+            pure basicTestSuite
+                { testInterface = TestSuiteLibV09 ver module_ }
 
   where
     missingField name tt = "The '" ++ name ++ "' field is required for the "
                         ++ prettyShow tt ++ " test suite type."
 
     extraField   name tt = "The '" ++ name ++ "' field is not used for the '"
                         ++ prettyShow tt ++ "' test suite type."
+    basicTestSuite =
+             emptyTestSuite {
+                  testBuildInfo = _testStanzaBuildInfo stanza
+                , testCodeGenerators = _testStanzaCodeGenerators stanza
+             }
 
 unvalidateTestSuite :: TestSuite -> TestSuiteStanza
 unvalidateTestSuite t = TestSuiteStanza
     { _testStanzaTestType   = ty
     , _testStanzaMainIs     = ma
     , _testStanzaTestModule = mo
     , _testStanzaBuildInfo  = testBuildInfo t
+    , _testStanzaCodeGenerators = testCodeGenerators t
     }
   where
     (ty, ma, mo) = case testInterface t of

diff --git a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs
@@ -566,7 +566,7 @@ instance FromBuildInfo ForeignLib where fromBuildInfo' n bi = set L.foreignLibNa
 instance FromBuildInfo Executable where fromBuildInfo' n bi = set L.exeName        n $ set L.buildInfo bi emptyExecutable
 
 instance FromBuildInfo TestSuiteStanza where
-    fromBuildInfo' _ bi = TestSuiteStanza Nothing Nothing Nothing bi
+    fromBuildInfo' _ bi = TestSuiteStanza Nothing Nothing Nothing bi []
 
 instance FromBuildInfo BenchmarkStanza where
     fromBuildInfo' _ bi = BenchmarkStanza Nothing Nothing Nothing bi
@@ -671,7 +671,7 @@ onAllBranches p = go mempty
 -- Post parsing checks
 -------------------------------------------------------------------------------
 
--- | Check that we 
+-- | Check that we
 --
 -- * don't use undefined flags (very bad)
 -- * define flags which are unused (just bad)

diff --git a/Cabal-syntax/src/Distribution/Types/TestSuite.hs b/Cabal-syntax/src/Distribution/Types/TestSuite.hs
@@ -26,7 +26,8 @@ import qualified Distribution.Types.BuildInfo.Lens as L
 data TestSuite = TestSuite {
         testName      :: UnqualComponentName,
         testInterface :: TestSuiteInterface,
-        testBuildInfo :: BuildInfo
+        testBuildInfo :: BuildInfo,
+        testCodeGenerators :: [String]
     }
     deriving (Generic, Show, Read, Eq, Typeable, Data)
 
@@ -42,15 +43,17 @@ instance Monoid TestSuite where
     mempty = TestSuite {
         testName      = mempty,
         testInterface = mempty,
-        testBuildInfo = mempty
+        testBuildInfo = mempty,
+        testCodeGenerators = mempty
     }
     mappend = (<>)
 
 instance Semigroup TestSuite where
     a <> b = TestSuite {
         testName      = combine' testName,
         testInterface = combine  testInterface,
-        testBuildInfo = combine  testBuildInfo
+        testBuildInfo = combine  testBuildInfo,
+        testCodeGenerators = combine testCodeGenerators
     }
         where combine  field = field a `mappend` field b
               combine' field = case ( unUnqualComponentName $ field a