Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

code-generators field in test stanza. #7688

Merged
merged 10 commits into from
Feb 25, 2022
Merged

code-generators field in test stanza. #7688

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
10 commits
Select commit Hold shift + click to select a range
4f941ee
wip to add test-code-generators field to test stanzas
gbaz Sep 20, 2021
bc89056
fixups
gbaz Sep 27, 2021
c3e0eb9
Merge branch 'master' into gb/test-code-generator
gbaz Jan 7, 2022
d1b5f99
change hashes
gbaz Jan 7, 2022
a9f54e1
regen golden parser test output
gbaz Jan 8, 2022
1e5affd
Merge branch 'master' into gb/test-code-generator
gbaz Feb 1, 2022
085fd48
docs and changelog
gbaz Feb 1, 2022
c167bfb
test
gbaz Feb 1, 2022
0141a2c
Update pr-7688
gbaz Feb 1, 2022
b21ff9e
tweak test
gbaz Feb 2, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
45 changes: 25 additions & 20 deletions Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -268,6 +268,7 @@ data TestSuiteStanza = TestSuiteStanza
, _testStanzaMainIs :: Maybe FilePath
, _testStanzaTestModule :: Maybe ModuleName
, _testStanzaBuildInfo :: BuildInfo
, _testStanzaCodeGenerators :: [String]
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

String isn't a good name for a type as it does not reflect its intended semantics. It is also badly searchable across the code base.

type CodeGenerator = String
type CodeGenerators = [CodeGenerator]

and then use these type synonyms.
Extra points for a newtype!

}

instance L.HasBuildInfo TestSuiteStanza where
Expand All @@ -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)
Expand All @@ -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
andreasabel marked this conversation as resolved.
Show resolved Hide resolved

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
Expand All @@ -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
Expand Down
4 changes: 2 additions & 2 deletions Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand Down
9 changes: 6 additions & 3 deletions Cabal-syntax/src/Distribution/Types/TestSuite.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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]
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

A comment would be in order explaining this new field, maybe linking to this PR.

In particular I wonder, should this field be non-revisable on Hackage?
(By default, I suppose, "yes, cannot change in a revision". But on the other hand, what is the harm of revising this? It's just for the test suite. Also, version of dependencies can be arbitrary revised, to the point of completely changing functionality... Why not test generaters...?)

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

our principle for allowing revisions has always been "by default, negative, and allow revision only if there's demonstrated need"

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Thanks for the justification.

}
deriving (Generic, Show, Read, Eq, Typeable, Data)

Expand All @@ -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
Expand Down
Loading