diff --git a/Cabal-syntax/Cabal-syntax.cabal b/Cabal-syntax/Cabal-syntax.cabal index 85137dc147c..09edee0eced 100644 --- a/Cabal-syntax/Cabal-syntax.cabal +++ b/Cabal-syntax/Cabal-syntax.cabal @@ -121,6 +121,7 @@ library Distribution.Types.AbiDependency Distribution.Types.AbiHash Distribution.Types.Benchmark + Distribution.Types.BenchmarkStanza Distribution.Types.Benchmark.Lens Distribution.Types.BenchmarkInterface Distribution.Types.BenchmarkType @@ -160,6 +161,8 @@ library Distribution.Types.Library.Lens Distribution.Types.LibraryName Distribution.Types.LibraryVisibility + Distribution.Types.Imports + Distribution.Types.Imports.Lens Distribution.Types.MissingDependency Distribution.Types.MissingDependencyReason Distribution.Types.Mixin @@ -183,6 +186,7 @@ library Distribution.Types.SourceRepo Distribution.Types.SourceRepo.Lens Distribution.Types.TestSuite + Distribution.Types.TestSuiteStanza Distribution.Types.TestSuite.Lens Distribution.Types.TestSuiteInterface Distribution.Types.TestType diff --git a/Cabal-syntax/src/Distribution/PackageDescription.hs b/Cabal-syntax/src/Distribution/PackageDescription.hs index 47d46673e5f..bda173bd969 100644 --- a/Cabal-syntax/src/Distribution/PackageDescription.hs +++ b/Cabal-syntax/src/Distribution/PackageDescription.hs @@ -15,6 +15,9 @@ module Distribution.PackageDescription module Distribution.Types.PackageDescription , module Distribution.Types.GenericPackageDescription + -- * Working with Imports + , module Distribution.Types.Imports + -- * Components , module Distribution.Types.ComponentName @@ -29,11 +32,13 @@ module Distribution.PackageDescription -- ** TestSuite , module Distribution.Types.TestSuite + , module Distribution.Types.TestSuiteStanza , module Distribution.Types.TestType , module Distribution.Types.TestSuiteInterface -- ** Benchmark , module Distribution.Types.Benchmark + , module Distribution.Types.BenchmarkStanza , module Distribution.Types.BenchmarkType , module Distribution.Types.BenchmarkInterface @@ -88,6 +93,7 @@ import Prelude () import Distribution.Types.Benchmark import Distribution.Types.BenchmarkInterface +import Distribution.Types.BenchmarkStanza import Distribution.Types.BenchmarkType import Distribution.Types.BuildInfo import Distribution.Types.BuildType @@ -105,6 +111,7 @@ import Distribution.Types.ForeignLibOption import Distribution.Types.ForeignLibType import Distribution.Types.GenericPackageDescription import Distribution.Types.HookedBuildInfo +import Distribution.Types.Imports import Distribution.Types.IncludeRenaming import Distribution.Types.LegacyExeDependency import Distribution.Types.Library @@ -124,5 +131,6 @@ import Distribution.Types.SetupBuildInfo import Distribution.Types.SourceRepo import Distribution.Types.TestSuite import Distribution.Types.TestSuiteInterface +import Distribution.Types.TestSuiteStanza import Distribution.Types.TestType import Distribution.Types.UnqualComponentName diff --git a/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs b/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs index 24861389b8f..f08db2bc58f 100644 --- a/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs +++ b/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs @@ -22,22 +22,10 @@ module Distribution.PackageDescription.FieldGrammar , executableFieldGrammar -- * Test suite - , TestSuiteStanza (..) , testSuiteFieldGrammar - , validateTestSuite - , unvalidateTestSuite - - -- ** Lenses - , testStanzaTestType - , testStanzaMainIs - , testStanzaTestModule - , testStanzaBuildInfo -- * Benchmark - , BenchmarkStanza (..) , benchmarkFieldGrammar - , validateBenchmark - , unvalidateBenchmark -- * Field grammars , formatDependencyList @@ -48,12 +36,6 @@ module Distribution.PackageDescription.FieldGrammar , formatOtherExtensions , formatOtherModules - -- ** Lenses - , benchmarkStanzaBenchmarkType - , benchmarkStanzaMainIs - , benchmarkStanzaBenchmarkModule - , benchmarkStanzaBuildInfo - -- * Flag , flagFieldGrammar @@ -290,43 +272,6 @@ executableFieldGrammar n = {-# SPECIALIZE executableFieldGrammar :: UnqualComponentName -> ParsecFieldGrammar' Executable #-} {-# SPECIALIZE executableFieldGrammar :: UnqualComponentName -> PrettyFieldGrammar' Executable #-} -------------------------------------------------------------------------------- --- TestSuite -------------------------------------------------------------------------------- - --- | An intermediate type just used for parsing the test-suite stanza. --- After validation it is converted into the proper 'TestSuite' type. -data TestSuiteStanza = TestSuiteStanza - { _testStanzaTestType :: Maybe TestType - , _testStanzaMainIs :: Maybe (RelativePath Source File) - , _testStanzaTestModule :: Maybe ModuleName - , _testStanzaBuildInfo :: BuildInfo - , _testStanzaCodeGenerators :: [String] - } - -instance L.HasBuildInfo TestSuiteStanza where - buildInfo = testStanzaBuildInfo - -testStanzaTestType :: Lens' TestSuiteStanza (Maybe TestType) -testStanzaTestType f s = fmap (\x -> s{_testStanzaTestType = x}) (f (_testStanzaTestType s)) -{-# INLINE testStanzaTestType #-} - -testStanzaMainIs :: Lens' TestSuiteStanza (Maybe (RelativePath Source File)) -testStanzaMainIs f s = fmap (\x -> s{_testStanzaMainIs = x}) (f (_testStanzaMainIs s)) -{-# INLINE testStanzaMainIs #-} - -testStanzaTestModule :: Lens' TestSuiteStanza (Maybe ModuleName) -testStanzaTestModule f s = fmap (\x -> s{_testStanzaTestModule = x}) (f (_testStanzaTestModule s)) -{-# INLINE testStanzaTestModule #-} - -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) @@ -361,117 +306,10 @@ testSuiteFieldGrammar = <*> monoidalFieldAla "code-generators" (alaList' CommaFSep Token) testStanzaCodeGenerators ^^^ availableSince CabalSpecV3_8 [] -validateTestSuite :: CabalSpecVersion -> Position -> TestSuiteStanza -> ParseResult src TestSuite -validateTestSuite cabalSpecVersion pos stanza = case testSuiteType of - Nothing -> pure basicTestSuite - Just tt@(TestTypeUnknown _ _) -> - pure - basicTestSuite - { testInterface = TestSuiteUnsupported tt - } - Just tt - | tt `notElem` knownTestTypes -> - pure - basicTestSuite - { testInterface = TestSuiteUnsupported tt - } - Just tt@(TestTypeExe ver) -> case _testStanzaMainIs stanza of - Nothing -> do - parseFailure pos (missingField "main-is" tt) - pure emptyTestSuite - Just file -> do - when (isJust (_testStanzaTestModule stanza)) $ - parseWarning pos PWTExtraBenchmarkModule (extraField "test-module" tt) - pure - basicTestSuite - { testInterface = TestSuiteExeV10 ver file - } - Just tt@(TestTypeLib ver) -> case _testStanzaTestModule stanza of - Nothing -> do - parseFailure pos (missingField "test-module" tt) - pure emptyTestSuite - Just module_ -> do - when (isJust (_testStanzaMainIs stanza)) $ - parseWarning pos PWTExtraMainIs (extraField "main-is" tt) - pure - basicTestSuite - { testInterface = TestSuiteLibV09 ver module_ - } - where - testSuiteType = - _testStanzaTestType stanza - <|> do - guard (cabalSpecVersion >= CabalSpecV3_8) - - testTypeExe <$ _testStanzaMainIs stanza - <|> testTypeLib <$ _testStanzaTestModule stanza - - 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 - TestSuiteExeV10 ver file -> (Just $ TestTypeExe ver, Just file, Nothing) - TestSuiteLibV09 ver modu -> (Just $ TestTypeLib ver, Nothing, Just modu) - _ -> (Nothing, Nothing, Nothing) - ------------------------------------------------------------------------------- -- Benchmark ------------------------------------------------------------------------------- --- | An intermediate type just used for parsing the benchmark stanza. --- After validation it is converted into the proper 'Benchmark' type. -data BenchmarkStanza = BenchmarkStanza - { _benchmarkStanzaBenchmarkType :: Maybe BenchmarkType - , _benchmarkStanzaMainIs :: Maybe (RelativePath Source File) - , _benchmarkStanzaBenchmarkModule :: Maybe ModuleName - , _benchmarkStanzaBuildInfo :: BuildInfo - } - -instance L.HasBuildInfo BenchmarkStanza where - buildInfo = benchmarkStanzaBuildInfo - -benchmarkStanzaBenchmarkType :: Lens' BenchmarkStanza (Maybe BenchmarkType) -benchmarkStanzaBenchmarkType f s = fmap (\x -> s{_benchmarkStanzaBenchmarkType = x}) (f (_benchmarkStanzaBenchmarkType s)) -{-# INLINE benchmarkStanzaBenchmarkType #-} - -benchmarkStanzaMainIs :: Lens' BenchmarkStanza (Maybe (RelativePath Source File)) -benchmarkStanzaMainIs f s = fmap (\x -> s{_benchmarkStanzaMainIs = x}) (f (_benchmarkStanzaMainIs s)) -{-# INLINE benchmarkStanzaMainIs #-} - -benchmarkStanzaBenchmarkModule :: Lens' BenchmarkStanza (Maybe ModuleName) -benchmarkStanzaBenchmarkModule f s = fmap (\x -> s{_benchmarkStanzaBenchmarkModule = x}) (f (_benchmarkStanzaBenchmarkModule s)) -{-# INLINE benchmarkStanzaBenchmarkModule #-} - -benchmarkStanzaBuildInfo :: Lens' BenchmarkStanza BuildInfo -benchmarkStanzaBuildInfo f s = fmap (\x -> s{_benchmarkStanzaBuildInfo = x}) (f (_benchmarkStanzaBuildInfo s)) -{-# INLINE benchmarkStanzaBuildInfo #-} - benchmarkFieldGrammar :: ( FieldGrammar c g , Applicative (g BenchmarkStanza) @@ -503,76 +341,6 @@ benchmarkFieldGrammar = <*> optionalField "benchmark-module" benchmarkStanzaBenchmarkModule <*> blurFieldGrammar benchmarkStanzaBuildInfo buildInfoFieldGrammar -validateBenchmark :: CabalSpecVersion -> Position -> BenchmarkStanza -> ParseResult src Benchmark -validateBenchmark cabalSpecVersion pos stanza = case benchmarkStanzaType of - Nothing -> - pure - emptyBenchmark - { benchmarkBuildInfo = _benchmarkStanzaBuildInfo stanza - } - Just tt@(BenchmarkTypeUnknown _ _) -> - pure - emptyBenchmark - { benchmarkInterface = BenchmarkUnsupported tt - , benchmarkBuildInfo = _benchmarkStanzaBuildInfo stanza - } - Just tt - | tt `notElem` knownBenchmarkTypes -> - pure - emptyBenchmark - { benchmarkInterface = BenchmarkUnsupported tt - , benchmarkBuildInfo = _benchmarkStanzaBuildInfo stanza - } - Just tt@(BenchmarkTypeExe ver) -> case _benchmarkStanzaMainIs stanza of - Nothing -> do - parseFailure pos (missingField "main-is" tt) - pure emptyBenchmark - Just file -> do - when (isJust (_benchmarkStanzaBenchmarkModule stanza)) $ - parseWarning pos PWTExtraBenchmarkModule (extraField "benchmark-module" tt) - pure - emptyBenchmark - { benchmarkInterface = BenchmarkExeV10 ver file - , benchmarkBuildInfo = _benchmarkStanzaBuildInfo stanza - } - where - benchmarkStanzaType = - _benchmarkStanzaBenchmarkType stanza <|> do - guard (cabalSpecVersion >= CabalSpecV3_8) - - benchmarkTypeExe <$ _benchmarkStanzaMainIs stanza - - missingField name tt = - "The '" - ++ name - ++ "' field is required for the " - ++ prettyShow tt - ++ " benchmark type." - - extraField name tt = - "The '" - ++ name - ++ "' field is not used for the '" - ++ prettyShow tt - ++ "' benchmark type." - -unvalidateBenchmark :: Benchmark -> BenchmarkStanza -unvalidateBenchmark b = - BenchmarkStanza - { _benchmarkStanzaBenchmarkType = ty - , _benchmarkStanzaMainIs = ma - , _benchmarkStanzaBenchmarkModule = mo - , _benchmarkStanzaBuildInfo = benchmarkBuildInfo b - } - where - (ty, ma, mo) = case benchmarkInterface b of - BenchmarkExeV10 ver ma' - | getSymbolicPath ma' == "" -> - (Just $ BenchmarkTypeExe ver, Nothing, Nothing) - | otherwise -> - (Just $ BenchmarkTypeExe ver, Just ma', Nothing) - _ -> (Nothing, Nothing, Nothing) - ------------------------------------------------------------------------------- -- Build info ------------------------------------------------------------------------------- diff --git a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs index c7e327ddb7f..4b605c93268 100644 --- a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs +++ b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs @@ -63,8 +63,6 @@ import qualified Data.Set as Set import qualified Distribution.Compat.Newtype as Newtype import qualified Distribution.Compat.NonEmptySet as NES import qualified Distribution.Types.BuildInfo.Lens as L -import qualified Distribution.Types.Executable.Lens as L -import qualified Distribution.Types.ForeignLib.Lens as L import qualified Distribution.Types.GenericPackageDescription.Lens as L import qualified Distribution.Types.PackageDescription.Lens as L import qualified Distribution.Types.SetupBuildInfo.Lens as L @@ -129,14 +127,14 @@ type SectionParser src = StateT SectionS (ParseResult src) -- | State of section parser data SectionS = SectionS { _stateGpd :: !GenericPackageDescription - , _stateCommonStanzas :: !(Map String CondTreeBuildInfo) + , _stateCommonStanzas :: !(Map String CondTreeBuildInfoWithImports) } stateGpd :: Lens' SectionS GenericPackageDescription stateGpd f (SectionS gpd cs) = (\x -> SectionS x cs) <$> f gpd {-# INLINE stateGpd #-} -stateCommonStanzas :: Lens' SectionS (Map String CondTreeBuildInfo) +stateCommonStanzas :: Lens' SectionS (Map String CondTreeBuildInfoWithImports) stateCommonStanzas f (SectionS gpd cs) = SectionS gpd <$> f cs {-# INLINE stateCommonStanzas #-} @@ -240,9 +238,15 @@ parseGenericPackageDescription' scannedVer lexWarnings utf8WarnPos fs = do cabalFormatVersionsDesc :: String cabalFormatVersionsDesc = "Current cabal-version values are listed at https://cabal.readthedocs.io/en/stable/file-format-changelog.html." -goSections :: CabalSpecVersion -> [Field Position] -> SectionParser src () -goSections specVer = traverse_ process +goSections :: forall src. CabalSpecVersion -> [Field Position] -> SectionParser src () +goSections specVer fieldPositions = do + traverse_ process fieldPositions + + -- Retain commen stanzas after parsing sections + commonStanzas <- use stateCommonStanzas + (stateGpd . L.gpdCommonStanzas) .= commonStanzas where + process :: Field Position -> SectionParser src () process (Field (Name pos name) _) = lift $ parseWarning pos PWTTrailingFields $ @@ -259,11 +263,10 @@ goSections specVer = traverse_ process :: L.HasBuildInfo a => ParsecFieldGrammar' a -- \^ grammar - -> (BuildInfo -> a) - -> Map String CondTreeBuildInfo + -> Map String CondTreeBuildInfoWithImports -- \^ common stanzas -> [Field Position] - -> ParseResult src (CondTree ConfVar [Dependency] a) + -> ParseResult src (CondTree ConfVar [Dependency] (WithImports a)) parseCondTree' = parseCondTreeWithCommonStanzas specVer parseSection :: Name Position -> [SectionArg Position] -> [Field Position] -> SectionParser src () @@ -274,8 +277,7 @@ goSections specVer = traverse_ process | name == "common" = do commonStanzas <- use stateCommonStanzas name' <- lift $ parseCommonName pos args - biTree <- lift $ parseCondTree' buildInfoFieldGrammar id commonStanzas fields - + biTree <- lift $ parseCondTree' buildInfoFieldGrammar commonStanzas fields case Map.lookup name' commonStanzas of Nothing -> stateCommonStanzas .= Map.insert name' biTree commonStanzas Just _ -> @@ -283,18 +285,18 @@ goSections specVer = traverse_ process parseFailure pos $ "Duplicate common stanza: " ++ name' | name == "library" && null args = do - prev <- use $ stateGpd . L.condLibrary + prev <- use $ stateGpd . L.condLibraryUnmerged when (isJust prev) $ lift $ parseFailure pos $ "Multiple main libraries; have you forgotten to specify a name for an internal library?" commonStanzas <- use stateCommonStanzas - let name'' = LMainLibName - lib <- lift $ parseCondTree' (libraryFieldGrammar name'') (libraryFromBuildInfo name'') commonStanzas fields + let name' = LMainLibName + lib <- lift $ parseCondTree' (libraryFieldGrammar name') commonStanzas fields -- -- TODO check that not set - stateGpd . L.condLibrary ?= lib + stateGpd . L.condLibraryUnmerged ?= lib -- Sublibraries -- TODO: check cabal-version @@ -302,18 +304,18 @@ goSections specVer = traverse_ process commonStanzas <- use stateCommonStanzas name' <- parseUnqualComponentName pos args let name'' = LSubLibName name' - lib <- lift $ parseCondTree' (libraryFieldGrammar name'') (libraryFromBuildInfo name'') commonStanzas fields + lib <- lift $ parseCondTree' (libraryFieldGrammar name'') commonStanzas fields -- TODO check duplicate name here? - stateGpd . L.condSubLibraries %= snoc (name', lib) + stateGpd . L.condSubLibrariesUnmerged %= snoc (name', lib) -- TODO: check cabal-version | name == "foreign-library" = do commonStanzas <- use stateCommonStanzas name' <- parseUnqualComponentName pos args - flib <- lift $ parseCondTree' (foreignLibFieldGrammar name') (fromBuildInfo' name') commonStanzas fields + flib <- lift $ parseCondTree' (foreignLibFieldGrammar name') commonStanzas fields let hasType ts = foreignLibType ts /= foreignLibType mempty - unless (onAllBranches hasType flib) $ + unless (onAllBranches hasType (mapTreeData unImportNames flib)) $ lift $ parseFailure pos $ concat @@ -325,21 +327,28 @@ goSections specVer = traverse_ process ] -- TODO check duplicate name here? - stateGpd . L.condForeignLibs %= snoc (name', flib) + stateGpd . L.condForeignLibsUnmerged %= snoc (name', flib) | name == "executable" = do commonStanzas <- use stateCommonStanzas name' <- parseUnqualComponentName pos args - exe <- lift $ parseCondTree' (executableFieldGrammar name') (fromBuildInfo' name') commonStanzas fields + exe <- lift $ parseCondTree' (executableFieldGrammar name') commonStanzas fields -- TODO check duplicate name here? - stateGpd . L.condExecutables %= snoc (name', exe) + stateGpd . L.condExecutablesUnmerged %= snoc (name', exe) | name == "test-suite" = do commonStanzas <- use stateCommonStanzas name' <- parseUnqualComponentName pos args - testStanza <- lift $ parseCondTree' testSuiteFieldGrammar (fromBuildInfo' name') commonStanzas fields - testSuite <- lift $ traverse (validateTestSuite specVer pos) testStanza + testStanza <- lift $ parseCondTree' testSuiteFieldGrammar commonStanzas fields + + -- Patching depends on merging, validation depends on patching + let testStanza' :: CondTree ConfVar [Dependency] TestSuiteStanza + testStanza' = + mergeTestSuiteStanza commonStanzas testStanza + & fmap (patchTestSuiteType specVer) + _ok <- lift $ traverse (validateTestSuite pos) testStanza' + let validated = mapTreeData convertTestSuite testStanza' let hasType ts = testInterface ts /= testInterface mempty - unless (onAllBranches hasType testSuite) $ + unless (onAllBranches hasType validated) $ lift $ parseFailure pos $ concat @@ -359,15 +368,23 @@ goSections specVer = traverse_ process ] -- TODO check duplicate name here? - stateGpd . L.condTestSuites %= snoc (name', testSuite) + -- Store the unmerged unvalidated version + stateGpd . L.condTestSuitesUnmerged %= snoc (name', testStanza) | name == "benchmark" = do commonStanzas <- use stateCommonStanzas name' <- parseUnqualComponentName pos args - benchStanza <- lift $ parseCondTree' benchmarkFieldGrammar (fromBuildInfo' name') commonStanzas fields - bench <- lift $ traverse (validateBenchmark specVer pos) benchStanza + benchStanza <- lift $ parseCondTree' benchmarkFieldGrammar commonStanzas fields + + -- Patching depends on merging, validation depends on patching + let benchStanza' :: CondTree ConfVar [Dependency] BenchmarkStanza + benchStanza' = + mergeBenchmarkStanza commonStanzas benchStanza + & fmap (patchBenchmarkType specVer) + _ok <- lift $ traverse (validateBenchmark pos . unImportNames) benchStanza + let validated = mapTreeData convertBenchmark benchStanza' let hasType ts = benchmarkInterface ts /= benchmarkInterface mempty - unless (onAllBranches hasType bench) $ + unless (onAllBranches hasType validated) $ lift $ parseFailure pos $ concat @@ -387,7 +404,7 @@ goSections specVer = traverse_ process ] -- TODO check duplicate name here? - stateGpd . L.condBenchmarks %= snoc (name', bench) + stateGpd . L.condBenchmarksUnmerged %= snoc (name', benchStanza) | name == "flag" = do name' <- parseNameBS pos args name'' <- lift $ runFieldParser' [pos] parsec specVer (fieldLineStreamFromBS name') `recoverWith` mkFlagName "" @@ -469,34 +486,32 @@ warnInvalidSubsection (MkSection (Name pos name) _ _) = parseCondTree :: forall src a - . L.HasBuildInfo a - => CabalSpecVersion + . CabalSpecVersion -> HasElif -- ^ accept @elif@ -> ParsecFieldGrammar' a -- ^ grammar - -> Map String CondTreeBuildInfo + -> Map String CondTreeBuildInfoWithImports -- ^ common stanzas - -> (BuildInfo -> a) - -- ^ constructor from buildInfo -> (a -> [Dependency]) -- ^ condition extractor -> [Field Position] - -> ParseResult src (CondTree ConfVar [Dependency] a) -parseCondTree v hasElif grammar commonStanzas fromBuildInfo cond = go + -> ParseResult src (CondTree ConfVar [Dependency] (WithImports a)) +parseCondTree v hasElif grammar commonStanzas cond = go where + go :: [Field Position] -> ParseResult src (CondTree ConfVar [Dependency] (WithImports a)) go fields0 = do - (fields, endo) <- + (fields, imports) <- if v >= CabalSpecV3_0 - then processImports v fromBuildInfo commonStanzas fields0 - else traverse (warnImport v) fields0 >>= \fields1 -> return (catMaybes fields1, id) + then processImports v commonStanzas fields0 + else traverse (warnImport v) fields0 >>= \fields1 -> return (catMaybes fields1, mempty) let (fs, ss) = partitionFields fields x <- parseFieldGrammar v fs grammar branches <- concat <$> traverse parseIfs ss - return $ endo $ CondNode x (cond x) branches + return $ CondNode (WithImports imports x) (cond x) branches - parseIfs :: [Section Position] -> ParseResult src [CondBranch ConfVar [Dependency] a] + parseIfs :: [Section Position] -> ParseResult src [CondBranch ConfVar [Dependency] (WithImports a)] parseIfs [] = return [] parseIfs (MkSection (Name pos name) test fields : sections) | name == "if" = do test' <- parseConditionConfVar (startOfSection (incPos 2 pos) test) test @@ -509,7 +524,7 @@ parseCondTree v hasElif grammar commonStanzas fromBuildInfo cond = go parseElseIfs :: [Section Position] - -> ParseResult src (Maybe (CondTree ConfVar [Dependency] a), [CondBranch ConfVar [Dependency] a]) + -> ParseResult src (Maybe (CondTree ConfVar [Dependency] (WithImports a)), [CondBranch ConfVar [Dependency] (WithImports a)]) parseElseIfs [] = return (Nothing, []) parseElseIfs (MkSection (Name pos name) args fields : sections) | name == "else" = do unless (null args) $ @@ -526,7 +541,7 @@ parseCondTree v hasElif grammar commonStanzas fromBuildInfo cond = go (elseFields, sections') <- parseElseIfs sections -- we parse an empty 'Fields', to get empty value for a node a <- parseFieldGrammar v mempty grammar - return (Just $ CondNode a (cond a) [CondBranch test' fields' elseFields], sections') + return (Just $ CondNode (noImports a) (cond a) [CondBranch test' fields' elseFields], sections') parseElseIfs (MkSection (Name pos name) _ _ : sections) | name == "elif" = do parseWarning pos PWTInvalidSubsection $ "invalid subsection \"elif\". You should set cabal-version: 2.2 or larger to use elif-conditionals." (,) Nothing <$> parseIfs sections @@ -594,36 +609,7 @@ with new AST, this all need to be rewritten. -- The approach is simple, and have good properties: -- -- * Common stanzas are parsed exactly once, even if not-used. Thus we report errors in them. -type CondTreeBuildInfo = CondTree ConfVar [Dependency] BuildInfo - --- | Create @a@ from 'BuildInfo'. --- This class is used to implement common stanza parsing. --- --- Law: @view buildInfo . fromBuildInfo = id@ --- --- This takes name, as 'FieldGrammar's take names too. -class L.HasBuildInfo a => FromBuildInfo a where - fromBuildInfo' :: UnqualComponentName -> BuildInfo -> a - -libraryFromBuildInfo :: LibraryName -> BuildInfo -> Library -libraryFromBuildInfo n bi = - emptyLibrary - { libName = n - , libVisibility = case n of - LMainLibName -> LibraryVisibilityPublic - LSubLibName _ -> LibraryVisibilityPrivate - , libBuildInfo = bi - } - -instance FromBuildInfo BuildInfo where fromBuildInfo' _ = id -instance FromBuildInfo ForeignLib where fromBuildInfo' n bi = set L.foreignLibName n $ set L.buildInfo bi emptyForeignLib -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 [] - -instance FromBuildInfo BenchmarkStanza where - fromBuildInfo' _ bi = BenchmarkStanza Nothing Nothing Nothing bi +type CondTreeBuildInfoWithImports = CondTree ConfVar [Dependency] (WithImports BuildInfo) parseCondTreeWithCommonStanzas :: forall src a @@ -631,36 +617,44 @@ parseCondTreeWithCommonStanzas => CabalSpecVersion -> ParsecFieldGrammar' a -- ^ grammar - -> (BuildInfo -> a) - -- ^ construct fromBuildInfo - -> Map String CondTreeBuildInfo + -> Map String CondTreeBuildInfoWithImports -- ^ common stanzas -> [Field Position] - -> ParseResult src (CondTree ConfVar [Dependency] a) -parseCondTreeWithCommonStanzas v grammar fromBuildInfo commonStanzas fields = do - (fields', endo) <- processImports v fromBuildInfo commonStanzas fields - x <- parseCondTree v hasElif grammar commonStanzas fromBuildInfo (view L.targetBuildDepends) fields' - return (endo x) + -> ParseResult src (CondTree ConfVar [Dependency] (WithImports a)) +parseCondTreeWithCommonStanzas v grammar commonStanzas fields = do + (fields', imports) <- processImports v commonStanzas fields + x <- parseCondTree v hasElif grammar commonStanzas (view L.targetBuildDepends) fields' + -- We replace the imports from parseCondTree, because it comes right after + -- the import processing and hence is always empty, if such imports should + -- exist in the grammar, that is >= cabal 3.0. + return (replaceImportsOnRoot imports x) where hasElif = specHasElif v +-- | only attach import annotation on root +replaceImportsOnRoot + :: [ImportName] + -> CondTree v c (WithImports a) + -> CondTree v c (WithImports a) +replaceImportsOnRoot imports = mapTreeData' (WithImports imports . unImportNames) id + processImports - :: forall src a - . L.HasBuildInfo a - => CabalSpecVersion - -> (BuildInfo -> a) - -- ^ construct fromBuildInfo - -> Map String CondTreeBuildInfo + :: CabalSpecVersion + -> Map String CondTreeBuildInfoWithImports -- ^ common stanzas -> [Field Position] - -> ParseResult src ([Field Position], CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a) -processImports v fromBuildInfo commonStanzas = go [] + -> ParseResult src ([Field Position], [ImportName]) +processImports v commonStanzas = go [] where hasCommonStanzas = specHasCommonStanzas v getList' :: List CommaFSep Token String -> [String] getList' = Newtype.unpack + go + :: [ImportName] + -> [Field Position] + -> ParseResult src ([Field Position], [ImportName]) go acc (Field (Name pos name) _ : fields) | name == "import" , hasCommonStanzas == NoCommonStanzas = do @@ -669,20 +663,19 @@ processImports v fromBuildInfo commonStanzas = go [] -- supported: go acc (Field (Name pos name) fls : fields) | name == "import" = do names <- getList' <$> runFieldParser pos parsec v fls - names' <- for names $ \commonName -> - case Map.lookup commonName commonStanzas of - Nothing -> do + validNames <- for names $ \commonName -> + if Map.member commonName commonStanzas + then pure (Just commonName) + else do parseFailure pos $ "Undefined common stanza imported: " ++ commonName pure Nothing - Just commonTree -> - pure (Just commonTree) - go (acc ++ catMaybes names') fields + go (acc ++ catMaybes validNames) fields -- parse actual CondTree - go acc fields = do + go names fields = do fields' <- catMaybes <$> traverse (warnImport v) fields - pure $ (fields', \x -> foldr (mergeCommonStanza fromBuildInfo) x acc) + pure (fields', names) -- | Warn on "import" fields, also map to Maybe, so erroneous fields can be filtered warnImport :: CabalSpecVersion -> Field Position -> ParseResult src (Maybe (Field Position)) @@ -693,21 +686,6 @@ warnImport v (Field (Name pos name) _) | name == "import" = do return Nothing warnImport _ f = pure (Just f) -mergeCommonStanza - :: L.HasBuildInfo a - => (BuildInfo -> a) - -> CondTree ConfVar [Dependency] BuildInfo - -> CondTree ConfVar [Dependency] a - -> CondTree ConfVar [Dependency] a -mergeCommonStanza fromBuildInfo (CondNode bi _ bis) (CondNode x _ cs) = - CondNode x' (x' ^. L.targetBuildDepends) cs' - where - -- new value is old value with buildInfo field _prepended_. - x' = x & L.buildInfo %~ (bi <>) - - -- tree components are appended together. - cs' = map (fmap fromBuildInfo) bis ++ cs - ------------------------------------------------------------------------------- -- Branches ------------------------------------------------------------------------------- diff --git a/Cabal-syntax/src/Distribution/PackageDescription/PrettyPrint.hs b/Cabal-syntax/src/Distribution/PackageDescription/PrettyPrint.hs index 15c2c15fe09..7998a477a16 100644 --- a/Cabal-syntax/src/Distribution/PackageDescription/PrettyPrint.hs +++ b/Cabal-syntax/src/Distribution/PackageDescription/PrettyPrint.hs @@ -53,7 +53,6 @@ import Distribution.PackageDescription.FieldGrammar import Distribution.Pretty import Distribution.Utils.Generic (writeFileAtomic, writeUTF8File) -import qualified Distribution.PackageDescription.FieldGrammar as FG import qualified Distribution.Types.BuildInfo.Lens as L import qualified Distribution.Types.SetupBuildInfo.Lens as L @@ -171,14 +170,14 @@ ppCondExecutables v exes = ppCondTestSuites :: CabalSpecVersion -> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)] -> [PrettyField ()] ppCondTestSuites v suites = [ PrettySection () "test-suite" [pretty n] $ - ppCondTree2 v testSuiteFieldGrammar (fmap FG.unvalidateTestSuite condTree) + ppCondTree2 v testSuiteFieldGrammar (fmap unvalidateTestSuite condTree) | (n, condTree) <- suites ] ppCondBenchmarks :: CabalSpecVersion -> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)] -> [PrettyField ()] ppCondBenchmarks v suites = [ PrettySection () "benchmark" [pretty n] $ - ppCondTree2 v benchmarkFieldGrammar (fmap FG.unvalidateBenchmark condTree) + ppCondTree2 v benchmarkFieldGrammar (fmap unvalidateBenchmark condTree) | (n, condTree) <- suites ] diff --git a/Cabal-syntax/src/Distribution/Types/BenchmarkStanza.hs b/Cabal-syntax/src/Distribution/Types/BenchmarkStanza.hs new file mode 100644 index 00000000000..b57610a2c35 --- /dev/null +++ b/Cabal-syntax/src/Distribution/Types/BenchmarkStanza.hs @@ -0,0 +1,135 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuantifiedConstraints #-} + +module Distribution.Types.BenchmarkStanza where + +import Distribution.Compat.Lens +import Distribution.Compat.Prelude +import Prelude () + +import Distribution.CabalSpecVersion +import Distribution.Fields +import Distribution.ModuleName (ModuleName) +import Distribution.Parsec +import Distribution.Pretty (prettyShow) +import Distribution.Types.Benchmark +import Distribution.Types.BenchmarkInterface +import Distribution.Types.BenchmarkType +import Distribution.Types.BuildInfo +import qualified Distribution.Types.BuildInfo.Lens as L +import Distribution.Utils.Path + +-- | An intermediate type just used for parsing the benchmark stanza. +-- After validation it is converted into the proper 'Benchmark' type. +data BenchmarkStanza = BenchmarkStanza + { _benchmarkStanzaBenchmarkType :: Maybe BenchmarkType + , _benchmarkStanzaMainIs :: Maybe (RelativePath Source File) + , _benchmarkStanzaBenchmarkModule :: Maybe ModuleName + , _benchmarkStanzaBuildInfo :: BuildInfo + } + deriving (Show, Eq, Data, Generic) + +instance Binary BenchmarkStanza +instance Structured BenchmarkStanza +instance NFData BenchmarkStanza where rnf = genericRnf + +validateBenchmark :: Position -> BenchmarkStanza -> ParseResult src () +validateBenchmark pos stanza = case _benchmarkStanzaBenchmarkType stanza of + Nothing -> pure () + Just (BenchmarkTypeUnknown _ _) -> pure () + Just tt | tt `notElem` knownBenchmarkTypes -> pure () + Just tt@(BenchmarkTypeExe _ver) -> case _benchmarkStanzaMainIs stanza of + Nothing -> parseFailure pos (missingField "main-is" tt) + Just _file -> + when (isJust (_benchmarkStanzaBenchmarkModule stanza)) $ + parseWarning pos PWTExtraBenchmarkModule (extraField "benchmark-module" tt) + where + missingField name tt = + "The '" + ++ name + ++ "' field is required for the " + ++ prettyShow tt + ++ " benchmark type." + + extraField name tt = + "The '" + ++ name + ++ "' field is not used for the '" + ++ prettyShow tt + ++ "' benchmark type." + +convertBenchmark :: BenchmarkStanza -> Benchmark +convertBenchmark stanza = case _benchmarkStanzaBenchmarkType stanza of + Nothing -> + emptyBenchmark + { benchmarkBuildInfo = _benchmarkStanzaBuildInfo stanza + } + Just tt@(BenchmarkTypeUnknown _ _) -> + emptyBenchmark + { benchmarkInterface = BenchmarkUnsupported tt + , benchmarkBuildInfo = _benchmarkStanzaBuildInfo stanza + } + Just tt + | tt `notElem` knownBenchmarkTypes -> + emptyBenchmark + { benchmarkInterface = BenchmarkUnsupported tt + , benchmarkBuildInfo = _benchmarkStanzaBuildInfo stanza + } + Just (BenchmarkTypeExe ver) -> case _benchmarkStanzaMainIs stanza of + Nothing -> emptyBenchmark + Just file -> + emptyBenchmark + { benchmarkInterface = BenchmarkExeV10 ver file + , benchmarkBuildInfo = _benchmarkStanzaBuildInfo stanza + } + +unvalidateBenchmark :: Benchmark -> BenchmarkStanza +unvalidateBenchmark b = + BenchmarkStanza + { _benchmarkStanzaBenchmarkType = ty + , _benchmarkStanzaMainIs = ma + , _benchmarkStanzaBenchmarkModule = mo + , _benchmarkStanzaBuildInfo = benchmarkBuildInfo b + } + where + (ty, ma, mo) = case benchmarkInterface b of + BenchmarkExeV10 ver ma' + | getSymbolicPath ma' == "" -> + (Just $ BenchmarkTypeExe ver, Nothing, Nothing) + | otherwise -> + (Just $ BenchmarkTypeExe ver, Just ma', Nothing) + _ -> (Nothing, Nothing, Nothing) + +patchBenchmarkType :: CabalSpecVersion -> BenchmarkStanza -> BenchmarkStanza +patchBenchmarkType cabalSpecVersion stanza = + stanza + { _benchmarkStanzaBenchmarkType = + _benchmarkStanzaBenchmarkType stanza <|> do + guard (cabalSpecVersion >= CabalSpecV3_8) + benchmarkTypeExe <$ _benchmarkStanzaMainIs stanza + } + +instance L.HasBuildInfo BenchmarkStanza where + buildInfo = benchmarkStanzaBuildInfo + +benchmarkStanzaBenchmarkType :: Lens' BenchmarkStanza (Maybe BenchmarkType) +benchmarkStanzaBenchmarkType f s = fmap (\x -> s{_benchmarkStanzaBenchmarkType = x}) (f (_benchmarkStanzaBenchmarkType s)) +{-# INLINE benchmarkStanzaBenchmarkType #-} + +benchmarkStanzaMainIs :: Lens' BenchmarkStanza (Maybe (RelativePath Source File)) +benchmarkStanzaMainIs f s = fmap (\x -> s{_benchmarkStanzaMainIs = x}) (f (_benchmarkStanzaMainIs s)) +{-# INLINE benchmarkStanzaMainIs #-} + +benchmarkStanzaBenchmarkModule :: Lens' BenchmarkStanza (Maybe ModuleName) +benchmarkStanzaBenchmarkModule f s = fmap (\x -> s{_benchmarkStanzaBenchmarkModule = x}) (f (_benchmarkStanzaBenchmarkModule s)) +{-# INLINE benchmarkStanzaBenchmarkModule #-} + +benchmarkStanzaBuildInfo :: Lens' BenchmarkStanza BuildInfo +benchmarkStanzaBuildInfo f s = fmap (\x -> s{_benchmarkStanzaBuildInfo = x}) (f (_benchmarkStanzaBuildInfo s)) +{-# INLINE benchmarkStanzaBuildInfo #-} diff --git a/Cabal-syntax/src/Distribution/Types/CondTree.hs b/Cabal-syntax/src/Distribution/Types/CondTree.hs index c74ffdf6395..0fb035fadae 100644 --- a/Cabal-syntax/src/Distribution/Types/CondTree.hs +++ b/Cabal-syntax/src/Distribution/Types/CondTree.hs @@ -13,6 +13,7 @@ module Distribution.Types.CondTree , mapTreeConstrs , mapTreeConds , mapTreeData + , mapTreeData' , traverseCondTreeV , traverseCondBranchV , traverseCondTreeC @@ -123,6 +124,26 @@ mapTreeConds f = mapCondTree id id f mapTreeData :: (a -> b) -> CondTree v c a -> CondTree v c b mapTreeData f = mapCondTree f id id +-- | Transform data and branches differently +mapTreeData' + :: (a -> b) + -- ^ transform root + -> (a -> b) + -- ^ transform subtrees + -> CondTree v c a + -> CondTree v c b +mapTreeData' f g n = + n + { condTreeData = f (condTreeData n) + , condTreeComponents = map g' (condTreeComponents n) + } + where + g' (CondBranch cond ifTrue ifFalse) = + CondBranch + (cond) + (mapTreeData' g g $ ifTrue) + (mapTreeData' g g <$> ifFalse) + -- | @@Traversal@@ for the variables traverseCondTreeV :: L.Traversal (CondTree v c a) (CondTree w c a) v w traverseCondTreeV f (CondNode a c ifs) = diff --git a/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs b/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs index 97f4ed8cccb..910e127078b 100644 --- a/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs +++ b/Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs @@ -1,11 +1,42 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ViewPatterns #-} +#if __GLASGOW_HASKELL__ >= 914 +{-# LANGUAGE ExplicitNamespaces #-} +#endif module Distribution.Types.GenericPackageDescription ( GenericPackageDescription (..) +#if __GLASGOW_HASKELL__ >= 914 + , data GenericPackageDescription +#else + , pattern GenericPackageDescription +#endif , emptyGenericPackageDescription + , mergeImports + + -- * Accessors from 'PatternSynonyms'\'s record syntax + , packageDescription + , gpdScannedVersion + , genPackageFlags + , condLibrary + , condSubLibraries + , condForeignLibs + , condExecutables + , condTestSuites + , condBenchmarks + + -- * Merging helpers + , mergeCondLibrary + , mergeCondSubLibraries + , mergeCondForeignLibs + , mergeCondExecutables + , mergeTestSuiteStanza + , mergeBenchmarkStanza ) where import Distribution.Compat.Prelude @@ -15,26 +46,42 @@ import Prelude () import Distribution.Compat.Lens as L import qualified Distribution.Types.BuildInfo.Lens as L +-- TODO(leana8959): fix it this orphan +import qualified Distribution.Types.Imports.Lens as L () + import Distribution.Types.PackageDescription +import Distribution.CabalSpecVersion import Distribution.Package import Distribution.Types.Benchmark +import Distribution.Types.BenchmarkStanza +import Distribution.Types.BuildInfo import Distribution.Types.CondTree import Distribution.Types.ConfVar import Distribution.Types.Executable import Distribution.Types.Flag import Distribution.Types.ForeignLib +import Distribution.Types.Imports import Distribution.Types.Library +import Distribution.Types.LibraryName +import Distribution.Types.LibraryVisibility import Distribution.Types.TestSuite +import Distribution.Types.TestSuiteStanza import Distribution.Types.UnqualComponentName import Distribution.Version +import qualified Data.Map as Map + -- --------------------------------------------------------------------------- -- The 'GenericPackageDescription' type -data GenericPackageDescription = GenericPackageDescription - { packageDescription :: PackageDescription - , gpdScannedVersion :: Maybe Version +type DependencyTree a = CondTree ConfVar [Dependency] a + +-- | The internal representation of 'GenericPackageDescription', containing the unmerged stanzas +-- We provide a pattern below for backward compatibility, as well for hiding the internals of wiring the imports +data GenericPackageDescription = GenericPackageDescription' + { packageDescriptionInternal :: PackageDescription + , gpdScannedVersionInternal :: Maybe Version -- ^ This is a version as specified in source. -- We populate this field in index reading for dummy GPDs, -- only when GPD reading failed, but scanning haven't. @@ -43,35 +90,283 @@ data GenericPackageDescription = GenericPackageDescription -- -- Perfectly, PackageIndex should have sum type, so we don't need to -- have dummy GPDs. - , genPackageFlags :: [PackageFlag] - , condLibrary :: Maybe (CondTree ConfVar [Dependency] Library) + , genPackageFlagsInternal :: [PackageFlag] + , gpdCommonStanzas :: Map ImportName (DependencyTree (WithImports BuildInfo)) + , condLibraryUnmerged :: Maybe (DependencyTree (WithImports Library)) + , condSubLibrariesUnmerged :: [(UnqualComponentName, DependencyTree (WithImports Library))] + , condForeignLibsUnmerged :: [(UnqualComponentName, DependencyTree (WithImports ForeignLib))] + , condExecutablesUnmerged :: [(UnqualComponentName, DependencyTree (WithImports Executable))] + , condTestSuitesUnmerged :: [(UnqualComponentName, DependencyTree (WithImports TestSuiteStanza))] + , condBenchmarksUnmerged :: [(UnqualComponentName, DependencyTree (WithImports BenchmarkStanza))] + } + deriving (Show, Eq, Data, Generic) + +pattern GenericPackageDescription + :: PackageDescription + -> Maybe Version + -> [PackageFlag] + -> Maybe (DependencyTree Library) + -> [(UnqualComponentName, DependencyTree Library)] + -> [(UnqualComponentName, DependencyTree ForeignLib)] + -> [(UnqualComponentName, DependencyTree Executable)] + -> [(UnqualComponentName, DependencyTree TestSuite)] + -> [(UnqualComponentName, DependencyTree Benchmark)] + -> GenericPackageDescription +pattern GenericPackageDescription + { packageDescription + , gpdScannedVersion + , genPackageFlags + , condLibrary , condSubLibraries - :: [ ( UnqualComponentName - , CondTree ConfVar [Dependency] Library - ) - ] , condForeignLibs - :: [ ( UnqualComponentName - , CondTree ConfVar [Dependency] ForeignLib - ) - ] , condExecutables - :: [ ( UnqualComponentName - , CondTree ConfVar [Dependency] Executable - ) - ] , condTestSuites - :: [ ( UnqualComponentName - , CondTree ConfVar [Dependency] TestSuite - ) - ] , condBenchmarks - :: [ ( UnqualComponentName - , CondTree ConfVar [Dependency] Benchmark - ) - ] - } - deriving (Show, Eq, Data, Generic) + } <- + ( viewGenericPackageDescription -> + ( packageDescription + , gpdScannedVersion + , genPackageFlags + , condLibrary + , condSubLibraries + , condForeignLibs + , condExecutables + , condTestSuites + , condBenchmarks + ) + ) + where + GenericPackageDescription + pd + scannedVersion + packageFlags + lib + sublibs + flibs + exes + tests + bms = + GenericPackageDescription' + pd + scannedVersion + packageFlags + mempty + ((fmap . fmap) noImports lib) + ((fmap . fmap . fmap) noImports sublibs) + ((fmap . fmap . fmap) noImports flibs) + ((fmap . fmap . fmap) noImports exes) + ((fmap . fmap . fmap) (noImports . unvalidateTestSuite) tests) + ((fmap . fmap . fmap) (noImports . unvalidateBenchmark) bms) + +{-# COMPLETE GenericPackageDescription #-} + +viewGenericPackageDescription + :: GenericPackageDescription + -> ( PackageDescription + , Maybe Version + , [PackageFlag] + , Maybe (DependencyTree Library) + , [(UnqualComponentName, DependencyTree Library)] + , [(UnqualComponentName, DependencyTree ForeignLib)] + , [(UnqualComponentName, DependencyTree Executable)] + , [(UnqualComponentName, DependencyTree TestSuite)] + , [(UnqualComponentName, DependencyTree Benchmark)] + ) +viewGenericPackageDescription gpd = + ( packageDescriptionInternal gpd + , gpdScannedVersionInternal gpd + , genPackageFlagsInternal gpd + , condLibrary' gpd + , condSubLibraries' gpd + , condForeignLibs' gpd + , condExecutables' gpd + , condTestSuites' gpd + , condBenchmarks' gpd + ) + +libraryFromBuildInfo :: LibraryName -> BuildInfo -> Library +libraryFromBuildInfo n bi = + emptyLibrary + { libName = n + , libVisibility = case n of + LMainLibName -> LibraryVisibilityPublic + LSubLibName _ -> LibraryVisibilityPrivate + , libBuildInfo = bi + } + +foreignLibFromBuildInfo :: UnqualComponentName -> BuildInfo -> ForeignLib +foreignLibFromBuildInfo n bi = emptyForeignLib{foreignLibName = n, foreignLibBuildInfo = bi} + +executableFromBuildInfo :: UnqualComponentName -> BuildInfo -> Executable +executableFromBuildInfo n bi = emptyExecutable{exeName = n, buildInfo = bi} + +testSuiteStanzaFromBuildInfo :: BuildInfo -> TestSuiteStanza +testSuiteStanzaFromBuildInfo bi = TestSuiteStanza Nothing Nothing Nothing bi [] + +benchmarkStanzaFromBuildInfo :: BuildInfo -> BenchmarkStanza +benchmarkStanzaFromBuildInfo bi = BenchmarkStanza Nothing Nothing Nothing bi + +condLibrary' + :: GenericPackageDescription + -> Maybe (DependencyTree Library) +condLibrary' gpd = mergeCondLibrary (gpdCommonStanzas gpd) <$> (condLibraryUnmerged gpd) + +mergeCondLibrary + :: Map ImportName (DependencyTree (WithImports BuildInfo)) + -> DependencyTree (WithImports Library) + -> DependencyTree Library +mergeCondLibrary = flip mergeImports fromBuildInfo + where + fromBuildInfo = libraryFromBuildInfo . libName + +condSubLibraries' + :: GenericPackageDescription + -> [(UnqualComponentName, DependencyTree Library)] +condSubLibraries' gpd = mergeCondSubLibraries (gpdCommonStanzas gpd) (condSubLibrariesUnmerged gpd) + +mergeCondSubLibraries + :: Map ImportName (DependencyTree (WithImports BuildInfo)) + -> [(UnqualComponentName, DependencyTree (WithImports Library))] + -> [(UnqualComponentName, DependencyTree Library)] +mergeCondSubLibraries commonStanzas = map (mergeCondLibrary commonStanzas <$>) + +condForeignLibs' + :: GenericPackageDescription + -> [(UnqualComponentName, DependencyTree ForeignLib)] +condForeignLibs' gpd = mergeCondForeignLibs (gpdCommonStanzas gpd) (condForeignLibsUnmerged gpd) + +mergeCondForeignLibs + :: Map ImportName (DependencyTree (WithImports BuildInfo)) + -> [(UnqualComponentName, DependencyTree (WithImports ForeignLib))] + -> [(UnqualComponentName, DependencyTree ForeignLib)] +mergeCondForeignLibs commonStanzas = map $ \(name, tree) -> + -- TODO(leana8959): is the name within the foreignlib important or we should use the name in the tuple? + (name, mergeImports commonStanzas (const $ foreignLibFromBuildInfo name) tree) + +condExecutables' + :: GenericPackageDescription + -> [(UnqualComponentName, DependencyTree Executable)] +condExecutables' gpd = mergeCondExecutables (gpdCommonStanzas gpd) (condExecutablesUnmerged gpd) + +mergeCondExecutables + :: Map ImportName (DependencyTree (WithImports BuildInfo)) + -> [(UnqualComponentName, DependencyTree (WithImports Executable))] + -> [(UnqualComponentName, DependencyTree Executable)] +mergeCondExecutables commonStanzas = map $ \(name, tree) -> + (name, mergeImports commonStanzas (const $ executableFromBuildInfo name) tree) + +mergeTestSuiteStanza + :: Map ImportName (DependencyTree (WithImports BuildInfo)) + -> DependencyTree (WithImports TestSuiteStanza) + -> DependencyTree TestSuiteStanza +mergeTestSuiteStanza commonStanza = + mergeImports commonStanza (const $ testSuiteStanzaFromBuildInfo) + +mergeBenchmarkStanza + :: Map ImportName (DependencyTree (WithImports BuildInfo)) + -> DependencyTree (WithImports BenchmarkStanza) + -> DependencyTree BenchmarkStanza +mergeBenchmarkStanza commonStanza = + mergeImports commonStanza (const $ benchmarkStanzaFromBuildInfo) + +condTestSuites' + :: GenericPackageDescription + -> [(UnqualComponentName, DependencyTree TestSuite)] +condTestSuites' gpd = + mergeTestSuiteStanza' (gpdCommonStanzas gpd) (condTestSuitesUnmerged gpd) + & (map . fmap . mapTreeData) (convertTestSuite . patchTestSuiteType specVer) + where + specVer :: CabalSpecVersion + specVer = specVersion . packageDescriptionInternal $ gpd + +mergeTestSuiteStanza' + :: Map ImportName (DependencyTree (WithImports BuildInfo)) + -> [(UnqualComponentName, DependencyTree (WithImports TestSuiteStanza))] + -> [(UnqualComponentName, DependencyTree TestSuiteStanza)] +mergeTestSuiteStanza' commonStanza = + map $ + fmap $ + mergeImports commonStanza (const $ testSuiteStanzaFromBuildInfo) + +condBenchmarks' + :: GenericPackageDescription + -> [(UnqualComponentName, DependencyTree Benchmark)] +condBenchmarks' gpd = + mergeBenchmarkStanza' (gpdCommonStanzas gpd) (condBenchmarksUnmerged gpd) + & (map . fmap . mapTreeData) (convertBenchmark . patchBenchmarkType specVer) + where + specVer :: CabalSpecVersion + specVer = specVersion . packageDescriptionInternal $ gpd + +mergeBenchmarkStanza' + :: Map ImportName (DependencyTree (WithImports BuildInfo)) + -> [(UnqualComponentName, DependencyTree (WithImports BenchmarkStanza))] + -> [(UnqualComponentName, DependencyTree BenchmarkStanza)] +mergeBenchmarkStanza' commonStanza = + map $ + fmap $ + mergeImports commonStanza (const $ benchmarkStanzaFromBuildInfo) + +mergeImports + :: forall a + . L.HasBuildInfo a + => Map ImportName (DependencyTree (WithImports BuildInfo)) + -> (a -> (BuildInfo -> a)) + -- ^ We need the information regarding the root node to be able to build such a constructor function + -> DependencyTree (WithImports a) + -> DependencyTree a +mergeImports commonStanzas fromBuildInfo (CondNode root c zs) = + let endo :: DependencyTree a -> DependencyTree a + endo = resolveImports (getImportNames root) + + tree :: DependencyTree a + tree = CondNode (unImportNames root) c (map goBranch zs) + in endo tree + where + goBranch + :: L.HasBuildInfo a + => CondBranch ConfVar [Dependency] (WithImports a) + -> CondBranch ConfVar [Dependency] a + goBranch (CondBranch cond ifTrue ifFalse) = CondBranch cond (goNode ifTrue) (goNode <$> ifFalse) + where + goNode = mergeImports commonStanzas fromBuildInfo + + resolveImports + :: L.HasBuildInfo a + => [ImportName] + -> (DependencyTree a -> DependencyTree a) + resolveImports importNames = + let commonTrees :: [DependencyTree (WithImports BuildInfo)] + commonTrees = + map + ( fromMaybe (error "failed to merge imports, did you mess with GenericPackageDescription?") + . flip Map.lookup commonStanzas + ) + importNames + + commonTrees' :: [DependencyTree BuildInfo] + commonTrees' = map goNode commonTrees + in \x -> foldr mergeCondTree x commonTrees' + where + goNode = mergeImports commonStanzas (const id) + + mergeCondTree + :: L.HasBuildInfo a + => DependencyTree BuildInfo + -> DependencyTree a + -> DependencyTree a + mergeCondTree (CondNode bi _ bis) (CondNode x _ cs) = CondNode x' (x' ^. L.targetBuildDepends) cs' + where + fromBuildInfo' :: (BuildInfo -> a) + fromBuildInfo' = fromBuildInfo (unImportNames root) + + -- new value is old value with buildInfo field _prepended_. + x' :: a + x' = x & L.buildInfo %~ (bi <>) + + -- tree components are appended together. + cs' :: [CondBranch ConfVar [Dependency] a] + cs' = map (fromBuildInfo' <$>) bis ++ cs instance Package GenericPackageDescription where packageId = packageId . packageDescription @@ -81,17 +376,29 @@ instance Structured GenericPackageDescription instance NFData GenericPackageDescription where rnf = genericRnf emptyGenericPackageDescription :: GenericPackageDescription -emptyGenericPackageDescription = GenericPackageDescription emptyPackageDescription Nothing [] Nothing [] [] [] [] [] +emptyGenericPackageDescription = + GenericPackageDescription + { packageDescription = emptyPackageDescription + , gpdScannedVersion = Nothing + , genPackageFlags = [] + , condLibrary = Nothing + , condSubLibraries = [] + , condForeignLibs = [] + , condExecutables = [] + , condTestSuites = [] + , condBenchmarks = [] + } -- ----------------------------------------------------------------------------- -- Traversal Instances instance L.HasBuildInfos GenericPackageDescription where - traverseBuildInfos f (GenericPackageDescription p v a1 x1 x2 x3 x4 x5 x6) = - GenericPackageDescription + traverseBuildInfos f (GenericPackageDescription' p v a1 commonStanzas x1 x2 x3 x4 x5 x6) = + GenericPackageDescription' <$> L.traverseBuildInfos f p <*> pure v <*> pure a1 + <*> (traverse . traverseCondTreeBuildInfo) f commonStanzas <*> (traverse . traverseCondTreeBuildInfo) f x1 <*> (traverse . L._2 . traverseCondTreeBuildInfo) f x2 <*> (traverse . L._2 . traverseCondTreeBuildInfo) f x3 diff --git a/Cabal-syntax/src/Distribution/Types/GenericPackageDescription/Lens.hs b/Cabal-syntax/src/Distribution/Types/GenericPackageDescription/Lens.hs index 213c97128f9..9a9593790e8 100644 --- a/Cabal-syntax/src/Distribution/Types/GenericPackageDescription/Lens.hs +++ b/Cabal-syntax/src/Distribution/Types/GenericPackageDescription/Lens.hs @@ -13,6 +13,7 @@ import Distribution.Compat.Prelude import Prelude () import qualified Distribution.Types.GenericPackageDescription as T +import qualified Distribution.Types.Imports as T -- We import types from their packages, so we can remove unused imports -- and have wider inter-module dependency graph @@ -20,16 +21,20 @@ import qualified Distribution.Types.GenericPackageDescription as T import Distribution.Compiler (CompilerFlavor) import Distribution.System (Arch, OS) import Distribution.Types.Benchmark (Benchmark) +import Distribution.Types.BenchmarkStanza (BenchmarkStanza) +import Distribution.Types.BuildInfo (BuildInfo) import Distribution.Types.CondTree (CondTree) import Distribution.Types.ConfVar (ConfVar (..)) import Distribution.Types.Dependency (Dependency) import Distribution.Types.Executable (Executable) import Distribution.Types.Flag (FlagName, PackageFlag (MkPackageFlag)) import Distribution.Types.ForeignLib (ForeignLib) -import Distribution.Types.GenericPackageDescription (GenericPackageDescription (GenericPackageDescription)) +import Distribution.Types.GenericPackageDescription +import Distribution.Types.Imports (ImportName) import Distribution.Types.Library (Library) import Distribution.Types.PackageDescription (PackageDescription) import Distribution.Types.TestSuite (TestSuite) +import Distribution.Types.TestSuiteStanza (TestSuiteStanza) import Distribution.Types.UnqualComponentName (UnqualComponentName) import Distribution.Version (Version, VersionRange) @@ -37,55 +42,99 @@ import Distribution.Version (Version, VersionRange) -- GenericPackageDescription ------------------------------------------------------------------------------- +type DependencyTree a = CondTree ConfVar [Dependency] a + +-- Merging drops commonStanzas! +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- When using an the bidirectional PatternSynonym 'GenericPackageDescription' and its accessors, +-- commonStanzas is filled with mempty. +-- +-- When there's no specific reason to use merging pattern accessors, use the internal one! + packageDescription :: Lens' GenericPackageDescription PackageDescription -packageDescription f s = fmap (\x -> s{T.packageDescription = x}) (f (T.packageDescription s)) +packageDescription f s = fmap (\x -> s{T.packageDescriptionInternal = x}) (f (T.packageDescriptionInternal s)) {-# INLINE packageDescription #-} gpdScannedVersion :: Lens' GenericPackageDescription (Maybe Version) -gpdScannedVersion f s = fmap (\x -> s{T.gpdScannedVersion = x}) (f (T.gpdScannedVersion s)) +gpdScannedVersion f s = fmap (\x -> s{T.gpdScannedVersionInternal = x}) (f (T.gpdScannedVersionInternal s)) {-# INLINE gpdScannedVersion #-} genPackageFlags :: Lens' GenericPackageDescription [PackageFlag] -genPackageFlags f s = fmap (\x -> s{T.genPackageFlags = x}) (f (T.genPackageFlags s)) +genPackageFlags f s = fmap (\x -> s{T.genPackageFlagsInternal = x}) (f (T.genPackageFlagsInternal s)) {-# INLINE genPackageFlags #-} -condLibrary :: Lens' GenericPackageDescription (Maybe (CondTree ConfVar [Dependency] Library)) +gpdCommonStanzas :: Lens' GenericPackageDescription (Map ImportName (DependencyTree (T.WithImports BuildInfo))) +gpdCommonStanzas f s = fmap (\x -> s{T.gpdCommonStanzas = x}) (f (T.gpdCommonStanzas s)) +{-# INLINE gpdCommonStanzas #-} + +condLibraryUnmerged :: Lens' GenericPackageDescription (Maybe (DependencyTree (T.WithImports Library))) +condLibraryUnmerged f s = fmap (\x -> s{T.condLibraryUnmerged = x}) (f (T.condLibraryUnmerged s)) +{-# INLINE condLibraryUnmerged #-} + +condSubLibrariesUnmerged :: Lens' GenericPackageDescription [(UnqualComponentName, (DependencyTree (T.WithImports Library)))] +condSubLibrariesUnmerged f s = fmap (\x -> s{T.condSubLibrariesUnmerged = x}) (f (T.condSubLibrariesUnmerged s)) +{-# INLINE condSubLibrariesUnmerged #-} + +condForeignLibsUnmerged :: Lens' GenericPackageDescription [(UnqualComponentName, (DependencyTree (T.WithImports ForeignLib)))] +condForeignLibsUnmerged f s = fmap (\x -> s{T.condForeignLibsUnmerged = x}) (f (T.condForeignLibsUnmerged s)) +{-# INLINE condForeignLibsUnmerged #-} + +condExecutablesUnmerged :: Lens' GenericPackageDescription [(UnqualComponentName, (DependencyTree (T.WithImports Executable)))] +condExecutablesUnmerged f s = fmap (\x -> s{T.condExecutablesUnmerged = x}) (f (T.condExecutablesUnmerged s)) +{-# INLINE condExecutablesUnmerged #-} + +condTestSuitesUnmerged :: Lens' GenericPackageDescription [(UnqualComponentName, (DependencyTree (T.WithImports TestSuiteStanza)))] +condTestSuitesUnmerged f s = fmap (\x -> s{T.condTestSuitesUnmerged = x}) (f (T.condTestSuitesUnmerged s)) +{-# INLINE condTestSuitesUnmerged #-} + +condBenchmarksUnmerged :: Lens' GenericPackageDescription [(UnqualComponentName, (DependencyTree (T.WithImports BenchmarkStanza)))] +condBenchmarksUnmerged f s = fmap (\x -> s{T.condBenchmarksUnmerged = x}) (f (T.condBenchmarksUnmerged s)) +{-# INLINE condBenchmarksUnmerged #-} + +-- TODO(leana8959): These accessor will merge the imports, apply f, and then put them back as if the imports weren't there +-- This is a good way to mask the import behaviour. +-- However, I do not know when this might be surprising +-- +-- If this is used in the parser for example, it would be a massive footgun because it would essentially "erase" all the imports and put the merged one back +condLibrary :: Lens' GenericPackageDescription (Maybe (DependencyTree (Library))) condLibrary f s = fmap (\x -> s{T.condLibrary = x}) (f (T.condLibrary s)) {-# INLINE condLibrary #-} -condSubLibraries :: Lens' GenericPackageDescription [(UnqualComponentName, (CondTree ConfVar [Dependency] Library))] +condSubLibraries :: Lens' GenericPackageDescription [(UnqualComponentName, (DependencyTree Library))] condSubLibraries f s = fmap (\x -> s{T.condSubLibraries = x}) (f (T.condSubLibraries s)) {-# INLINE condSubLibraries #-} -condForeignLibs :: Lens' GenericPackageDescription [(UnqualComponentName, (CondTree ConfVar [Dependency] ForeignLib))] +condForeignLibs :: Lens' GenericPackageDescription [(UnqualComponentName, (DependencyTree ForeignLib))] condForeignLibs f s = fmap (\x -> s{T.condForeignLibs = x}) (f (T.condForeignLibs s)) {-# INLINE condForeignLibs #-} -condExecutables :: Lens' GenericPackageDescription [(UnqualComponentName, (CondTree ConfVar [Dependency] Executable))] +condExecutables :: Lens' GenericPackageDescription [(UnqualComponentName, (DependencyTree Executable))] condExecutables f s = fmap (\x -> s{T.condExecutables = x}) (f (T.condExecutables s)) {-# INLINE condExecutables #-} -condTestSuites :: Lens' GenericPackageDescription [(UnqualComponentName, (CondTree ConfVar [Dependency] TestSuite))] +condTestSuites :: Lens' GenericPackageDescription [(UnqualComponentName, (DependencyTree TestSuite))] condTestSuites f s = fmap (\x -> s{T.condTestSuites = x}) (f (T.condTestSuites s)) {-# INLINE condTestSuites #-} -condBenchmarks :: Lens' GenericPackageDescription [(UnqualComponentName, (CondTree ConfVar [Dependency] Benchmark))] +condBenchmarks :: Lens' GenericPackageDescription [(UnqualComponentName, (DependencyTree Benchmark))] condBenchmarks f s = fmap (\x -> s{T.condBenchmarks = x}) (f (T.condBenchmarks s)) {-# INLINE condBenchmarks #-} allCondTrees :: Applicative f => ( forall a - . CondTree ConfVar [Dependency] a - -> f (CondTree ConfVar [Dependency] a) + . DependencyTree a + -> f (DependencyTree a) ) -> GenericPackageDescription -> f GenericPackageDescription -allCondTrees f (GenericPackageDescription p v a1 x1 x2 x3 x4 x5 x6) = - GenericPackageDescription +allCondTrees f (GenericPackageDescription' p v a1 commonStanzas x1 x2 x3 x4 x5 x6) = + GenericPackageDescription' <$> pure p <*> pure v <*> pure a1 + <*> traverse f commonStanzas <*> traverse f x1 <*> (traverse . _2) f x2 <*> (traverse . _2) f x3 diff --git a/Cabal-syntax/src/Distribution/Types/Imports.hs b/Cabal-syntax/src/Distribution/Types/Imports.hs new file mode 100644 index 00000000000..732322fe79d --- /dev/null +++ b/Cabal-syntax/src/Distribution/Types/Imports.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} + +module Distribution.Types.Imports where + +import Distribution.Compat.Prelude + +data WithImports a = WithImports + { getImportNames :: ![ImportName] + , unImportNames :: !a + } + deriving (Show, Functor, Eq, Ord, Read, Data, Generic) + +instance Binary a => Binary (WithImports a) +instance Structured a => Structured (WithImports a) +instance NFData a => NFData (WithImports a) where rnf = genericRnf + +type ImportName = String + +mapImports :: ([ImportName] -> [ImportName]) -> WithImports a -> WithImports a +mapImports f (WithImports imports x) = WithImports (f imports) x + +noImports :: a -> WithImports a +noImports = WithImports mempty diff --git a/Cabal-syntax/src/Distribution/Types/Imports/Lens.hs b/Cabal-syntax/src/Distribution/Types/Imports/Lens.hs new file mode 100644 index 00000000000..955163acce1 --- /dev/null +++ b/Cabal-syntax/src/Distribution/Types/Imports/Lens.hs @@ -0,0 +1,21 @@ +{-# OPTIONS_GHC "-Wno-orphans" #-} + +-- TODO(leana8959): how can I put HasBuildInfo elsewhere + +module Distribution.Types.Imports.Lens where + +import Distribution.Compat.Lens + +import qualified Distribution.Types.BuildInfo.Lens as L +import qualified Distribution.Types.Imports as T + +getImportNames :: Lens (T.WithImports a) (T.WithImports b) a b +getImportNames f (T.WithImports is x) = fmap (\y -> T.WithImports is y) (f x) +{-# INLINE getImportNames #-} + +unImportNames :: Lens' (T.WithImports a) [T.ImportName] +unImportNames f (T.WithImports is x) = fmap (\is' -> T.WithImports is' x) (f is) +{-# INLINE unImportNames #-} + +instance L.HasBuildInfo a => L.HasBuildInfo (T.WithImports a) where + buildInfo f (T.WithImports is x) = T.WithImports is <$> L.buildInfo f x diff --git a/Cabal-syntax/src/Distribution/Types/TestSuiteStanza.hs b/Cabal-syntax/src/Distribution/Types/TestSuiteStanza.hs new file mode 100644 index 00000000000..9e47a409b03 --- /dev/null +++ b/Cabal-syntax/src/Distribution/Types/TestSuiteStanza.hs @@ -0,0 +1,162 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuantifiedConstraints #-} + +module Distribution.Types.TestSuiteStanza where + +import Distribution.Compat.Lens +import Distribution.Compat.Prelude +import Prelude () + +import Distribution.CabalSpecVersion +import Distribution.Fields.ParseResult +import Distribution.ModuleName (ModuleName) +import Distribution.Parsec +import Distribution.Pretty (prettyShow) +import Distribution.Types.BuildInfo +import qualified Distribution.Types.BuildInfo.Lens as L +import Distribution.Types.TestSuite +import Distribution.Types.TestSuiteInterface +import Distribution.Types.TestType +import Distribution.Utils.Path + +-- | An intermediate type just used for parsing the test-suite stanza. +-- After validation it is converted into the proper 'TestSuite' type. +data TestSuiteStanza = TestSuiteStanza + { _testStanzaTestType :: Maybe TestType + , _testStanzaMainIs :: Maybe (RelativePath Source File) + , _testStanzaTestModule :: Maybe ModuleName + , _testStanzaBuildInfo :: BuildInfo + , _testStanzaCodeGenerators :: [String] + } + deriving (Show, Eq, Data, Generic) + +instance Binary TestSuiteStanza +instance Structured TestSuiteStanza +instance NFData TestSuiteStanza where rnf = genericRnf + +instance L.HasBuildInfo TestSuiteStanza where + buildInfo = testStanzaBuildInfo + +validateTestSuite :: Position -> TestSuiteStanza -> ParseResult src () +validateTestSuite pos stanza = case _testStanzaTestType stanza of + Nothing -> pure () + Just (TestTypeUnknown _ _) -> pure () + Just tt | tt `notElem` knownTestTypes -> pure () + Just tt@(TestTypeExe _ver) -> case _testStanzaMainIs stanza of + Nothing -> parseFailure pos (missingField "main-is" tt) + Just _file -> + when (isJust (_testStanzaTestModule stanza)) $ + parseWarning pos PWTExtraBenchmarkModule (extraField "test-module" tt) + Just tt@(TestTypeLib _ver) -> case _testStanzaTestModule stanza of + Nothing -> + parseFailure pos (missingField "test-module" tt) + Just _module -> + when (isJust (_testStanzaMainIs stanza)) $ + parseWarning pos PWTExtraMainIs (extraField "main-is" tt) + 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." + +-- | Convert a previously validated 'TestSuiteStanza' to 'GenericPackageDescription''s 'TestSuite' type +-- We do not check the validity here +convertTestSuite :: TestSuiteStanza -> TestSuite +convertTestSuite stanza = case _testStanzaTestType stanza of + Nothing -> basicTestSuite + Just tt@(TestTypeUnknown _ _) -> + basicTestSuite + { testInterface = TestSuiteUnsupported tt + } + Just tt + | tt `notElem` knownTestTypes -> + basicTestSuite + { testInterface = TestSuiteUnsupported tt + } + Just (TestTypeExe ver) -> case _testStanzaMainIs stanza of + Nothing -> failedToConvert + Just file -> + basicTestSuite + { testInterface = TestSuiteExeV10 ver file + } + Just (TestTypeLib ver) -> case _testStanzaTestModule stanza of + Nothing -> failedToConvert + Just module_ -> + basicTestSuite + { testInterface = TestSuiteLibV09 ver module_ + } + where + failedToConvert = + error $ + "Unexpected: the conversion from TestSuiteStanza to TestSuite failed\n" + <> "Did you mess with `GenericPackageDescription`?" + + 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 + TestSuiteExeV10 ver file -> (Just $ TestTypeExe ver, Just file, Nothing) + TestSuiteLibV09 ver modu -> (Just $ TestTypeLib ver, Nothing, Just modu) + _ -> (Nothing, Nothing, Nothing) + +-- TODO(leana8959): we need to keep a cabal spec version around, and then interpret this after the merging + +-- | We try to guess the TestSuiteType if it's not specified +patchTestSuiteType :: CabalSpecVersion -> TestSuiteStanza -> TestSuiteStanza +patchTestSuiteType cabalSpecVersion stanza = + stanza + { _testStanzaTestType = + _testStanzaTestType stanza + <|> do + guard (cabalSpecVersion >= CabalSpecV3_8) + testTypeExe <$ _testStanzaMainIs stanza + <|> testTypeLib <$ _testStanzaTestModule stanza + } + +testStanzaTestType :: Lens' TestSuiteStanza (Maybe TestType) +testStanzaTestType f s = fmap (\x -> s{_testStanzaTestType = x}) (f (_testStanzaTestType s)) +{-# INLINE testStanzaTestType #-} + +testStanzaMainIs :: Lens' TestSuiteStanza (Maybe (RelativePath Source File)) +testStanzaMainIs f s = fmap (\x -> s{_testStanzaMainIs = x}) (f (_testStanzaMainIs s)) +{-# INLINE testStanzaMainIs #-} + +testStanzaTestModule :: Lens' TestSuiteStanza (Maybe ModuleName) +testStanzaTestModule f s = fmap (\x -> s{_testStanzaTestModule = x}) (f (_testStanzaTestModule s)) +{-# INLINE testStanzaTestModule #-} + +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 #-} diff --git a/Cabal-tests/tests/HackageTests.hs b/Cabal-tests/tests/HackageTests.hs index 1265c6cb13e..ddc35545014 100644 --- a/Cabal-tests/tests/HackageTests.hs +++ b/Cabal-tests/tests/HackageTests.hs @@ -23,6 +23,17 @@ import Data.Monoid (Sum (..)) import Distribution.PackageDescription.Check (PackageCheck (..), checkPackage) import Distribution.PackageDescription.PrettyPrint (showGenericPackageDescription) import Distribution.PackageDescription.Quirks (patchQuirks) +import Distribution.PackageDescription + ( packageDescription + , gpdScannedVersion + , genPackageFlags + , condLibrary + , condSubLibraries + , condForeignLibs + , condExecutables + , condTestSuites + , condBenchmarks + ) import Distribution.Simple.Utils (fromUTF8BS, toUTF8BS) import Distribution.Fields.ParseResult import Distribution.Parsec.Source @@ -257,7 +268,20 @@ roundtripTest testFieldsTransform fpath bs = do let y = y0 & L.packageDescription . L.description .~ mempty let x = x0 & L.packageDescription . L.description .~ mempty - assertEqual' bs' x y + -- Due to the imports being merged, the structural comparison will fail + -- Instead, we check the equality after merging + let checkField field = assertEqual' bs' (field x) (field y) + sequence_ + [ checkField packageDescription + , checkField gpdScannedVersion + , checkField genPackageFlags + , checkField condLibrary + , checkField condSubLibraries + , checkField condForeignLibs + , checkField condExecutables + , checkField condTestSuites + , checkField condBenchmarks + ] -- fromParsecField, "shallow" parser/pretty roundtrip when testFieldsTransform $ diff --git a/Cabal-tests/tests/NoThunks.hs b/Cabal-tests/tests/NoThunks.hs index a53d404dd1e..5f461447cfa 100644 --- a/Cabal-tests/tests/NoThunks.hs +++ b/Cabal-tests/tests/NoThunks.hs @@ -61,8 +61,11 @@ noThunksParse = do -- NoThunks instances ------------------------------------------------------------------------------- +instance NoThunks a => NoThunks (WithImports a) + instance NoThunks Arch instance NoThunks Benchmark +instance NoThunks BenchmarkStanza instance NoThunks BenchmarkInterface instance NoThunks BenchmarkType instance NoThunks BuildInfo @@ -112,6 +115,7 @@ instance NoThunks SourceRepo instance NoThunks IncludeRenaming instance NoThunks ModuleRenaming instance NoThunks TestSuite +instance NoThunks TestSuiteStanza instance NoThunks TestSuiteInterface instance NoThunks TestType instance NoThunks UnqualComponentName diff --git a/Cabal-tests/tests/ParserTests.hs b/Cabal-tests/tests/ParserTests.hs index 8368ed19451..001399f088c 100644 --- a/Cabal-tests/tests/ParserTests.hs +++ b/Cabal-tests/tests/ParserTests.hs @@ -10,11 +10,29 @@ import Test.Tasty import Test.Tasty.Golden.Advanced (goldenTest) import Test.Tasty.HUnit -import Control.Monad (unless, void) +import Control.Monad (void) import Data.Algorithm.Diff (PolyDiff (..), getGroupedDiff) import Data.Maybe (isNothing) import Distribution.Fields (pwarning) -import Distribution.PackageDescription (GenericPackageDescription) +import Distribution.PackageDescription + ( GenericPackageDescription + , packageDescription + , gpdScannedVersion + , genPackageFlags + , gpdCommonStanzas + , condLibrary + , condSubLibraries + , condForeignLibs + , condExecutables + , condTestSuites + , condBenchmarks + , condLibraryUnmerged + , condSubLibrariesUnmerged + , condForeignLibsUnmerged + , condExecutablesUnmerged + , condTestSuitesUnmerged + , condBenchmarksUnmerged + ) import Distribution.PackageDescription.Parsec (parseGenericPackageDescription) import Distribution.PackageDescription.PrettyPrint (showGenericPackageDescription) import Distribution.Parsec (PWarnType (..), PWarning (..), showPErrorWithSource, showPWarningWithSource) @@ -41,6 +59,7 @@ import Data.TreeDiff.Instances.Cabal () tests :: TestTree tests = testGroup "parsec tests" [ regressionTests + , accessorsTests , warningTests , errorTests , ipiTests @@ -150,13 +169,49 @@ errorTest fp = cabalGoldenTest fp correct $ do input = "tests" "ParserTests" "errors" fp correct = replaceExtension input "errors" +------------------------------------------------------------------------------- +-- Internal accessors tests +------------------------------------------------------------------------------- + +accessorsTests :: TestTree +accessorsTests = testGroup "accessors" + [ +#ifdef MIN_VERSION_tree_diff + accessorsGoldenTest "library-merging.cabal" +#endif + ] + +#ifdef MIN_VERSION_tree_diff +-- Here, we test the unmerged internal representation +accessorsGoldenTest :: FilePath -> TestTree +accessorsGoldenTest fp = ediffGolden goldenTest "expr" exprFile $ do + contents <- BS.readFile input + let res = withSource (PCabalFile (fp, contents)) $ parseGenericPackageDescription contents + let (_, x) = runParseResult res + case x of + Right gpd -> pure $ toExpr + ( gpdCommonStanzas gpd + , condLibraryUnmerged gpd + , condSubLibrariesUnmerged gpd + , condForeignLibsUnmerged gpd + , condExecutablesUnmerged gpd + , condTestSuitesUnmerged gpd + , condBenchmarksUnmerged gpd + ) + Left (_, errs) -> fail $ unlines $ "ERROR" : map (showPErrorWithSource . fmap renderCabalFileSource) (NE.toList errs) + where + input = "tests" "ParserTests" "accessors" fp + exprFile = replaceExtension input "expr" +#endif + ------------------------------------------------------------------------------- -- Regressions ------------------------------------------------------------------------------- regressionTests :: TestTree regressionTests = testGroup "regressions" - [ regressionTest "encoding-0.8.cabal" + [ regressionTest "supervisors-0.1.cabal" + , regressionTest "encoding-0.8.cabal" , regressionTest "Octree-0.5.cabal" , regressionTest "nothing-unicode.cabal" , regressionTest "multiple-libs-2.cabal" @@ -233,12 +288,22 @@ formatGoldenTest fp = cabalGoldenTest "format" correct $ do #ifdef MIN_VERSION_tree_diff treeDiffGoldenTest :: FilePath -> TestTree treeDiffGoldenTest fp = ediffGolden goldenTest "expr" exprFile $ do - contents <- BS.readFile input - let res = withSource (PCabalFile (fp, contents)) $ parseGenericPackageDescription contents - let (_, x) = runParseResult res - case x of - Right gpd -> pure (toExpr gpd) - Left (_, errs) -> fail $ unlines $ "ERROR" : map (showPErrorWithSource . fmap renderCabalFileSource) (NE.toList errs) + contents <- BS.readFile input + let res = withSource (PCabalFile (fp, contents)) $ parseGenericPackageDescription contents + let (_, x) = runParseResult res + case x of + Right gpd -> pure $ toExpr + ( packageDescription gpd + , gpdScannedVersion gpd + , genPackageFlags gpd + , condLibrary gpd + , condSubLibraries gpd + , condForeignLibs gpd + , condExecutables gpd + , condTestSuites gpd + , condBenchmarks gpd + ) + Left (_, errs) -> fail $ unlines $ "ERROR" : map (showPErrorWithSource . fmap renderCabalFileSource) (NE.toList errs) where input = "tests" "ParserTests" "regressions" fp exprFile = replaceExtension input "expr" @@ -250,24 +315,38 @@ formatRoundTripTest fp = testCase "roundtrip" $ do x <- parse contents let contents' = showGenericPackageDescription x y <- parse (toUTF8BS contents') - -- previously we mangled licenses a bit - let y' = y + + let checkField field = + field x == field y @? {- FOURMOLU_DISABLE -} - unless (x == y') $ #ifdef MIN_VERSION_tree_diff - assertFailure $ unlines - [ "re-parsed doesn't match" - , show $ ansiWlEditExpr $ ediff x y - ] + unlines + [ "re-parsed doesn't match" + , show $ ansiWlEditExpr $ ediff x y + ] #else - assertFailure $ unlines - [ "re-parsed doesn't match" - , "expected" - , show x - , "actual" - , show y - ] + unlines + [ "re-parsed doesn't match" + , "expected" + , show x + , "actual" + , show y + ] #endif + -- Due to the imports being merged, the structural comparison will fail + -- Instead, we check the equality after merging + sequence_ + [ checkField packageDescription + , checkField gpdScannedVersion + , checkField genPackageFlags + , checkField condLibrary + , checkField condSubLibraries + , checkField condForeignLibs + , checkField condExecutables + , checkField condTestSuites + , checkField condBenchmarks + ] + where parse :: BS.ByteString -> IO GenericPackageDescription parse c = do diff --git a/Cabal-tests/tests/ParserTests/accessors/library-merging.cabal b/Cabal-tests/tests/ParserTests/accessors/library-merging.cabal new file mode 100644 index 00000000000..6f8ed6ad6c0 --- /dev/null +++ b/Cabal-tests/tests/ParserTests/accessors/library-merging.cabal @@ -0,0 +1,30 @@ +cabal-version: 3.0 +name: Library-merging +version: 0 +synopsis: Tests the correctness of deferred merging in imports +build-type: Simple + +flag foo + manual: True + default: True + +common windows + if os(windows) + build-depends: Win32 + +common deps + import: windows + buildable: True + build-depends: + base >=4.10 && <4.11, + containers + +library + if flag(foo) + import: deps + + default-language: Haskell2010 + exposed-modules: ElseIf + + build-depends: + ghc-prim diff --git a/Cabal-tests/tests/ParserTests/accessors/library-merging.expr b/Cabal-tests/tests/ParserTests/accessors/library-merging.expr new file mode 100644 index 00000000000..4b7bf5e773c --- /dev/null +++ b/Cabal-tests/tests/ParserTests/accessors/library-merging.expr @@ -0,0 +1,384 @@ +`(,,,,,,)` + (Map.fromList + [ + _×_ + "deps" + CondNode { + condTreeData = WithImports { + getImportNames = ["windows"], + unImportNames = BuildInfo { + buildable = True, + buildTools = [], + buildToolDepends = [], + cppOptions = [], + asmOptions = [], + cmmOptions = [], + ccOptions = [], + cxxOptions = [], + jsppOptions = [], + ldOptions = [], + hsc2hsOptions = [], + pkgconfigDepends = [], + frameworks = [], + extraFrameworkDirs = [], + asmSources = [], + cmmSources = [], + cSources = [], + cxxSources = [], + jsSources = [], + hsSourceDirs = [], + otherModules = [], + virtualModules = [], + autogenModules = [], + defaultLanguage = Nothing, + otherLanguages = [], + defaultExtensions = [], + otherExtensions = [], + oldExtensions = [], + extraLibs = [], + extraLibsStatic = [], + extraGHCiLibs = [], + extraBundledLibs = [], + extraLibFlavours = [], + extraDynLibFlavours = [], + extraLibDirs = [], + extraLibDirsStatic = [], + includeDirs = [], + includes = [], + autogenIncludes = [], + installIncludes = [], + options = PerCompilerFlavor + [] + [], + profOptions = PerCompilerFlavor + [] + [], + sharedOptions = + PerCompilerFlavor [] [], + profSharedOptions = + PerCompilerFlavor [] [], + staticOptions = + PerCompilerFlavor [] [], + customFieldsBI = [], + targetBuildDepends = [ + Dependency + (PackageName "base") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [4, 10])) + (EarlierVersion + (mkVersion [4, 11]))) + mainLibSet, + Dependency + (PackageName "containers") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + mixins = []}}, + condTreeConstraints = [ + Dependency + (PackageName "base") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [4, 10])) + (EarlierVersion + (mkVersion [4, 11]))) + mainLibSet, + Dependency + (PackageName "containers") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + condTreeComponents = []}, + _×_ + "windows" + CondNode { + condTreeData = WithImports { + getImportNames = [], + unImportNames = BuildInfo { + buildable = True, + buildTools = [], + buildToolDepends = [], + cppOptions = [], + asmOptions = [], + cmmOptions = [], + ccOptions = [], + cxxOptions = [], + jsppOptions = [], + ldOptions = [], + hsc2hsOptions = [], + pkgconfigDepends = [], + frameworks = [], + extraFrameworkDirs = [], + asmSources = [], + cmmSources = [], + cSources = [], + cxxSources = [], + jsSources = [], + hsSourceDirs = [], + otherModules = [], + virtualModules = [], + autogenModules = [], + defaultLanguage = Nothing, + otherLanguages = [], + defaultExtensions = [], + otherExtensions = [], + oldExtensions = [], + extraLibs = [], + extraLibsStatic = [], + extraGHCiLibs = [], + extraBundledLibs = [], + extraLibFlavours = [], + extraDynLibFlavours = [], + extraLibDirs = [], + extraLibDirsStatic = [], + includeDirs = [], + includes = [], + autogenIncludes = [], + installIncludes = [], + options = PerCompilerFlavor + [] + [], + profOptions = PerCompilerFlavor + [] + [], + sharedOptions = + PerCompilerFlavor [] [], + profSharedOptions = + PerCompilerFlavor [] [], + staticOptions = + PerCompilerFlavor [] [], + customFieldsBI = [], + targetBuildDepends = [], + mixins = []}}, + condTreeConstraints = [], + condTreeComponents = [ + CondBranch { + condBranchCondition = + `Var (OS Windows)`, + condBranchIfTrue = CondNode { + condTreeData = WithImports { + getImportNames = [], + unImportNames = BuildInfo { + buildable = True, + buildTools = [], + buildToolDepends = [], + cppOptions = [], + asmOptions = [], + cmmOptions = [], + ccOptions = [], + cxxOptions = [], + jsppOptions = [], + ldOptions = [], + hsc2hsOptions = [], + pkgconfigDepends = [], + frameworks = [], + extraFrameworkDirs = [], + asmSources = [], + cmmSources = [], + cSources = [], + cxxSources = [], + jsSources = [], + hsSourceDirs = [], + otherModules = [], + virtualModules = [], + autogenModules = [], + defaultLanguage = Nothing, + otherLanguages = [], + defaultExtensions = [], + otherExtensions = [], + oldExtensions = [], + extraLibs = [], + extraLibsStatic = [], + extraGHCiLibs = [], + extraBundledLibs = [], + extraLibFlavours = [], + extraDynLibFlavours = [], + extraLibDirs = [], + extraLibDirsStatic = [], + includeDirs = [], + includes = [], + autogenIncludes = [], + installIncludes = [], + options = PerCompilerFlavor + [] + [], + profOptions = PerCompilerFlavor + [] + [], + sharedOptions = + PerCompilerFlavor [] [], + profSharedOptions = + PerCompilerFlavor [] [], + staticOptions = + PerCompilerFlavor [] [], + customFieldsBI = [], + targetBuildDepends = [ + Dependency + (PackageName "Win32") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + mixins = []}}, + condTreeConstraints = [ + Dependency + (PackageName "Win32") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + condTreeComponents = []}, + condBranchIfFalse = Nothing}]}]) + (Just + CondNode { + condTreeData = WithImports { + getImportNames = [], + unImportNames = Library { + libName = LMainLibName, + exposedModules = [ + ModuleName "ElseIf"], + reexportedModules = [], + signatures = [], + libExposed = True, + libVisibility = + LibraryVisibilityPublic, + libBuildInfo = BuildInfo { + buildable = True, + buildTools = [], + buildToolDepends = [], + cppOptions = [], + asmOptions = [], + cmmOptions = [], + ccOptions = [], + cxxOptions = [], + jsppOptions = [], + ldOptions = [], + hsc2hsOptions = [], + pkgconfigDepends = [], + frameworks = [], + extraFrameworkDirs = [], + asmSources = [], + cmmSources = [], + cSources = [], + cxxSources = [], + jsSources = [], + hsSourceDirs = [], + otherModules = [], + virtualModules = [], + autogenModules = [], + defaultLanguage = Just + Haskell2010, + otherLanguages = [], + defaultExtensions = [], + otherExtensions = [], + oldExtensions = [], + extraLibs = [], + extraLibsStatic = [], + extraGHCiLibs = [], + extraBundledLibs = [], + extraLibFlavours = [], + extraDynLibFlavours = [], + extraLibDirs = [], + extraLibDirsStatic = [], + includeDirs = [], + includes = [], + autogenIncludes = [], + installIncludes = [], + options = PerCompilerFlavor + [] + [], + profOptions = PerCompilerFlavor + [] + [], + sharedOptions = + PerCompilerFlavor [] [], + profSharedOptions = + PerCompilerFlavor [] [], + staticOptions = + PerCompilerFlavor [] [], + customFieldsBI = [], + targetBuildDepends = [ + Dependency + (PackageName "ghc-prim") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + mixins = []}}}, + condTreeConstraints = [ + Dependency + (PackageName "ghc-prim") + (OrLaterVersion (mkVersion [0])) + mainLibSet], + condTreeComponents = [ + CondBranch { + condBranchCondition = + `Var (PackageFlag (FlagName "foo"))`, + condBranchIfTrue = CondNode { + condTreeData = WithImports { + getImportNames = ["deps"], + unImportNames = Library { + libName = LMainLibName, + exposedModules = [], + reexportedModules = [], + signatures = [], + libExposed = True, + libVisibility = + LibraryVisibilityPublic, + libBuildInfo = BuildInfo { + buildable = True, + buildTools = [], + buildToolDepends = [], + cppOptions = [], + asmOptions = [], + cmmOptions = [], + ccOptions = [], + cxxOptions = [], + jsppOptions = [], + ldOptions = [], + hsc2hsOptions = [], + pkgconfigDepends = [], + frameworks = [], + extraFrameworkDirs = [], + asmSources = [], + cmmSources = [], + cSources = [], + cxxSources = [], + jsSources = [], + hsSourceDirs = [], + otherModules = [], + virtualModules = [], + autogenModules = [], + defaultLanguage = Nothing, + otherLanguages = [], + defaultExtensions = [], + otherExtensions = [], + oldExtensions = [], + extraLibs = [], + extraLibsStatic = [], + extraGHCiLibs = [], + extraBundledLibs = [], + extraLibFlavours = [], + extraDynLibFlavours = [], + extraLibDirs = [], + extraLibDirsStatic = [], + includeDirs = [], + includes = [], + autogenIncludes = [], + installIncludes = [], + options = PerCompilerFlavor + [] + [], + profOptions = PerCompilerFlavor + [] + [], + sharedOptions = + PerCompilerFlavor [] [], + profSharedOptions = + PerCompilerFlavor [] [], + staticOptions = + PerCompilerFlavor [] [], + customFieldsBI = [], + targetBuildDepends = [], + mixins = []}}}, + condTreeConstraints = [], + condTreeComponents = []}, + condBranchIfFalse = Nothing}]}) + [] + [] + [] + [] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/Octree-0.5.expr b/Cabal-tests/tests/ParserTests/regressions/Octree-0.5.expr index 634b27b8828..247f70ac3de 100644 --- a/Cabal-tests/tests/ParserTests/regressions/Octree-0.5.expr +++ b/Cabal-tests/tests/ParserTests/regressions/Octree-0.5.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV1_8, package = PackageIdentifier { @@ -67,10 +66,10 @@ GenericPackageDescription { extraSrcFiles = [], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [], - condLibrary = Just + extraFiles = []} + Nothing + [] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -86,11 +85,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -178,11 +177,11 @@ GenericPackageDescription { (OrLaterVersion (mkVersion [2, 4, 0])) mainLibSet], - condTreeComponents = []}, - condSubLibraries = [], - condForeignLibs = [], - condExecutables = [], - condTestSuites = [ + condTreeComponents = []}) + [] + [] + [] + [ _×_ (UnqualComponentName "test_Octree") @@ -199,11 +198,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -303,11 +302,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -400,5 +399,5 @@ GenericPackageDescription { (PackageName "markdown-unlit") (OrLaterVersion (mkVersion [0])) mainLibSet], - condTreeComponents = []}], - condBenchmarks = []} + condTreeComponents = []}] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/anynone.expr b/Cabal-tests/tests/ParserTests/regressions/anynone.expr index 927605d6058..ead1ea3d662 100644 --- a/Cabal-tests/tests/ParserTests/regressions/anynone.expr +++ b/Cabal-tests/tests/ParserTests/regressions/anynone.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV3_0, package = PackageIdentifier { @@ -33,10 +32,10 @@ GenericPackageDescription { extraSrcFiles = [], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [], - condLibrary = Just + extraFiles = []} + Nothing + [] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -52,11 +51,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -113,9 +112,9 @@ GenericPackageDescription { (PackageName "base") (OrLaterVersion (mkVersion [0])) mainLibSet], - condTreeComponents = []}, - condSubLibraries = [], - condForeignLibs = [], - condExecutables = [], - condTestSuites = [], - condBenchmarks = []} + condTreeComponents = []}) + [] + [] + [] + [] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/big-version.expr b/Cabal-tests/tests/ParserTests/regressions/big-version.expr index 4d3659e4592..ad19d7949c4 100644 --- a/Cabal-tests/tests/ParserTests/regressions/big-version.expr +++ b/Cabal-tests/tests/ParserTests/regressions/big-version.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV3_0, package = PackageIdentifier { @@ -35,10 +34,10 @@ GenericPackageDescription { extraSrcFiles = [], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [], - condLibrary = Just + extraFiles = []} + Nothing + [] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -53,11 +52,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -106,9 +105,9 @@ GenericPackageDescription { targetBuildDepends = [], mixins = []}}, condTreeConstraints = [], - condTreeComponents = []}, - condSubLibraries = [], - condForeignLibs = [], - condExecutables = [], - condTestSuites = [], - condBenchmarks = []} + condTreeComponents = []}) + [] + [] + [] + [] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/common-conditional.expr b/Cabal-tests/tests/ParserTests/regressions/common-conditional.expr index 41e0fd5377a..5dcae95adf2 100644 --- a/Cabal-tests/tests/ParserTests/regressions/common-conditional.expr +++ b/Cabal-tests/tests/ParserTests/regressions/common-conditional.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV3_0, package = PackageIdentifier { @@ -45,15 +44,15 @@ GenericPackageDescription { extraSrcFiles = [], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [ + extraFiles = []} + Nothing + [ MkPackageFlag { flagName = FlagName "foo", flagDescription = "", flagDefault = True, - flagManual = True}], - condLibrary = Just + flagManual = True}] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -69,11 +68,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -148,11 +147,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -242,11 +241,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -304,11 +303,11 @@ GenericPackageDescription { mainLibSet], condTreeComponents = []}, condBranchIfFalse = Nothing}]}, - condBranchIfFalse = Nothing}]}, - condSubLibraries = [], - condForeignLibs = [], - condExecutables = [], - condTestSuites = [ + condBranchIfFalse = Nothing}]}) + [] + [] + [] + [ _×_ (UnqualComponentName "tests") CondNode { @@ -323,11 +322,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -402,11 +401,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -474,11 +473,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -569,11 +568,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -649,11 +648,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -712,5 +711,5 @@ GenericPackageDescription { mainLibSet], condTreeComponents = []}, condBranchIfFalse = Nothing}]}, - condBranchIfFalse = Nothing}]}], - condBenchmarks = []} + condBranchIfFalse = Nothing}]}] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/common.expr b/Cabal-tests/tests/ParserTests/regressions/common.expr index e8c766460f2..74a5b764371 100644 --- a/Cabal-tests/tests/ParserTests/regressions/common.expr +++ b/Cabal-tests/tests/ParserTests/regressions/common.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV1_10, package = PackageIdentifier { @@ -48,10 +47,10 @@ GenericPackageDescription { extraSrcFiles = [], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [], - condLibrary = Just + extraFiles = []} + Nothing + [] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -67,11 +66,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -128,11 +127,11 @@ GenericPackageDescription { (PackageName "ghc-prim") (OrLaterVersion (mkVersion [0])) mainLibSet], - condTreeComponents = []}, - condSubLibraries = [], - condForeignLibs = [], - condExecutables = [], - condTestSuites = [ + condTreeComponents = []}) + [] + [] + [] + [ _×_ (UnqualComponentName "tests") CondNode { @@ -147,11 +146,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -208,5 +207,5 @@ GenericPackageDescription { (PackageName "HUnit") (OrLaterVersion (mkVersion [0])) mainLibSet], - condTreeComponents = []}], - condBenchmarks = []} + condTreeComponents = []}] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/common2.expr b/Cabal-tests/tests/ParserTests/regressions/common2.expr index af882207fc4..91d471240ca 100644 --- a/Cabal-tests/tests/ParserTests/regressions/common2.expr +++ b/Cabal-tests/tests/ParserTests/regressions/common2.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV2_2, package = PackageIdentifier { @@ -44,10 +43,10 @@ GenericPackageDescription { extraSrcFiles = [], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [], - condLibrary = Just + extraFiles = []} + Nothing + [] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -63,11 +62,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -166,11 +165,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -227,8 +226,8 @@ GenericPackageDescription { (OrLaterVersion (mkVersion [0])) mainLibSet], condTreeComponents = []}, - condBranchIfFalse = Nothing}]}, - condSubLibraries = [ + condBranchIfFalse = Nothing}]}) + [ _×_ (UnqualComponentName "internal") CondNode { @@ -248,11 +247,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -353,11 +352,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -414,10 +413,10 @@ GenericPackageDescription { (OrLaterVersion (mkVersion [0])) mainLibSet], condTreeComponents = []}, - condBranchIfFalse = Nothing}]}], - condForeignLibs = [], - condExecutables = [], - condTestSuites = [ + condBranchIfFalse = Nothing}]}] + [] + [] + [ _×_ (UnqualComponentName "tests") CondNode { @@ -432,11 +431,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -535,11 +534,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -615,11 +614,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -695,11 +694,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -749,5 +748,5 @@ GenericPackageDescription { testCodeGenerators = []}, condTreeConstraints = [], condTreeComponents = []}, - condBranchIfFalse = Nothing}]}], - condBenchmarks = []} + condBranchIfFalse = Nothing}]}] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/common3.expr b/Cabal-tests/tests/ParserTests/regressions/common3.expr index be783c4cab6..cbe8a978ea8 100644 --- a/Cabal-tests/tests/ParserTests/regressions/common3.expr +++ b/Cabal-tests/tests/ParserTests/regressions/common3.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV2_2, package = PackageIdentifier { @@ -48,10 +47,10 @@ GenericPackageDescription { extraSrcFiles = [], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [], - condLibrary = Just + extraFiles = []} + Nothing + [] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -67,11 +66,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -128,11 +127,11 @@ GenericPackageDescription { (PackageName "ghc-prim") (OrLaterVersion (mkVersion [0])) mainLibSet], - condTreeComponents = []}, - condSubLibraries = [], - condForeignLibs = [], - condExecutables = [], - condTestSuites = [ + condTreeComponents = []}) + [] + [] + [] + [ _×_ (UnqualComponentName "tests") CondNode { @@ -147,11 +146,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -232,5 +231,5 @@ GenericPackageDescription { (PackageName "HUnit") (OrLaterVersion (mkVersion [0])) mainLibSet], - condTreeComponents = []}], - condBenchmarks = []} + condTreeComponents = []}] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/elif.expr b/Cabal-tests/tests/ParserTests/regressions/elif.expr index e04821eaaef..d93ce0fe88b 100644 --- a/Cabal-tests/tests/ParserTests/regressions/elif.expr +++ b/Cabal-tests/tests/ParserTests/regressions/elif.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV1_10, package = PackageIdentifier { @@ -43,10 +42,10 @@ GenericPackageDescription { extraSrcFiles = [], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [], - condLibrary = Just + extraFiles = []} + Nothing + [] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -62,11 +61,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -133,11 +132,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -194,9 +193,9 @@ GenericPackageDescription { (OrLaterVersion (mkVersion [0])) mainLibSet], condTreeComponents = []}, - condBranchIfFalse = Nothing}]}, - condSubLibraries = [], - condForeignLibs = [], - condExecutables = [], - condTestSuites = [], - condBenchmarks = []} + condBranchIfFalse = Nothing}]}) + [] + [] + [] + [] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/elif2.expr b/Cabal-tests/tests/ParserTests/regressions/elif2.expr index 88eb02d59d7..052996447c7 100644 --- a/Cabal-tests/tests/ParserTests/regressions/elif2.expr +++ b/Cabal-tests/tests/ParserTests/regressions/elif2.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV2_2, package = PackageIdentifier { @@ -43,10 +42,10 @@ GenericPackageDescription { extraSrcFiles = [], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [], - condLibrary = Just + extraFiles = []} + Nothing + [] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -62,11 +61,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -133,11 +132,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -209,11 +208,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -279,11 +278,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -355,11 +354,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -407,9 +406,9 @@ GenericPackageDescription { targetBuildDepends = [], mixins = []}}, condTreeConstraints = [], - condTreeComponents = []}}]}}]}, - condSubLibraries = [], - condForeignLibs = [], - condExecutables = [], - condTestSuites = [], - condBenchmarks = []} + condTreeComponents = []}}]}}]}) + [] + [] + [] + [] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/encoding-0.8.expr b/Cabal-tests/tests/ParserTests/regressions/encoding-0.8.expr index 02c4a4222c7..f267fa9a404 100644 --- a/Cabal-tests/tests/ParserTests/regressions/encoding-0.8.expr +++ b/Cabal-tests/tests/ParserTests/regressions/encoding-0.8.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV1_12, package = PackageIdentifier { @@ -48,10 +47,10 @@ GenericPackageDescription { SymbolicPath "--"], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [], - condLibrary = Just + extraFiles = []} + Nothing + [] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -67,11 +66,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -140,9 +139,9 @@ GenericPackageDescription { (ThisVersion (mkVersion [4, 4]))) mainLibSet], - condTreeComponents = []}, - condSubLibraries = [], - condForeignLibs = [], - condExecutables = [], - condTestSuites = [], - condBenchmarks = []} + condTreeComponents = []}) + [] + [] + [] + [] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/generics-sop.expr b/Cabal-tests/tests/ParserTests/regressions/generics-sop.expr index a7cdf1a4300..9f63d24ff43 100644 --- a/Cabal-tests/tests/ParserTests/regressions/generics-sop.expr +++ b/Cabal-tests/tests/ParserTests/regressions/generics-sop.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV1_10, package = PackageIdentifier { @@ -124,10 +123,10 @@ GenericPackageDescription { SymbolicPath "CHANGELOG.md"], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [], - condLibrary = Just + extraFiles = []} + Nothing + [] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -163,11 +162,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -334,11 +333,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -421,11 +420,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -526,11 +525,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -599,11 +598,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -654,11 +653,11 @@ GenericPackageDescription { mixins = []}}, condTreeConstraints = [], condTreeComponents = []}, - condBranchIfFalse = Nothing}]}, - condSubLibraries = [], - condForeignLibs = [], - condExecutables = [], - condTestSuites = [ + condBranchIfFalse = Nothing}]}) + [] + [] + [] + [ _×_ (UnqualComponentName "doctests") CondNode { @@ -673,11 +672,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -771,11 +770,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -851,5 +850,5 @@ GenericPackageDescription { (PackageName "generics-sop") (OrLaterVersion (mkVersion [0])) mainLibSet], - condTreeComponents = []}], - condBenchmarks = []} + condTreeComponents = []}] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/hasktorch.expr b/Cabal-tests/tests/ParserTests/regressions/hasktorch.expr index 9dfa089a3d5..5c0961709d2 100644 --- a/Cabal-tests/tests/ParserTests/regressions/hasktorch.expr +++ b/Cabal-tests/tests/ParserTests/regressions/hasktorch.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV2_2, package = PackageIdentifier { @@ -55,9 +54,9 @@ GenericPackageDescription { extraSrcFiles = [], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [ + extraFiles = []} + Nothing + [ MkPackageFlag { flagName = FlagName "cuda", flagDescription = @@ -69,8 +68,8 @@ GenericPackageDescription { flagDescription = "only build with Double and Long support", flagDefault = False, - flagManual = False}], - condLibrary = Just + flagManual = False}] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -268,11 +267,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -603,11 +602,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -848,11 +847,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -1051,11 +1050,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -1105,8 +1104,7 @@ GenericPackageDescription { condTreeConstraints = [], condTreeComponents = []}, condBranchIfFalse = Nothing}]}, - condBranchIfFalse = Nothing}]}, - condSubLibraries = + condBranchIfFalse = Nothing}]}) [ _×_ (UnqualComponentName @@ -1391,11 +1389,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -2713,11 +2711,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -2805,11 +2803,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -5034,11 +5032,11 @@ GenericPackageDescription { cppOptions = [ "-DCUDA", "-DHASKTORCH_INTERNAL_CUDA"], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -6406,11 +6404,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -6499,11 +6497,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -8169,11 +8167,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -8660,11 +8658,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -9426,11 +9424,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -9531,9 +9529,9 @@ GenericPackageDescription { (EarlierVersion (mkVersion [0, 0, 2]))) mainLibSet], - condTreeComponents = []}], - condForeignLibs = [], - condExecutables = [ + condTreeComponents = []}] + [] + [ _×_ (UnqualComponentName "isdefinite-cpu") @@ -9549,11 +9547,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -9657,11 +9655,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -9765,11 +9763,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -9862,11 +9860,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -9944,8 +9942,8 @@ GenericPackageDescription { (PackageName "hasktorch") (OrLaterVersion (mkVersion [0])) mainLibSet], - condTreeComponents = []}], - condTestSuites = [ + condTreeComponents = []}] + [ _×_ (UnqualComponentName "spec") CondNode { @@ -9960,11 +9958,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -10244,5 +10242,5 @@ GenericPackageDescription { (PackageName "generic-lens") (OrLaterVersion (mkVersion [0])) mainLibSet], - condTreeComponents = []}], - condBenchmarks = []} + condTreeComponents = []}] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/hidden-main-lib.expr b/Cabal-tests/tests/ParserTests/regressions/hidden-main-lib.expr index 553b88dc595..eb2439d74fe 100644 --- a/Cabal-tests/tests/ParserTests/regressions/hidden-main-lib.expr +++ b/Cabal-tests/tests/ParserTests/regressions/hidden-main-lib.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV3_0, package = PackageIdentifier { @@ -35,10 +34,10 @@ GenericPackageDescription { extraSrcFiles = [], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [], - condLibrary = Just + extraFiles = []} + Nothing + [] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -54,11 +53,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -115,9 +114,9 @@ GenericPackageDescription { (PackageName "base") (OrLaterVersion (mkVersion [0])) mainLibSet], - condTreeComponents = []}, - condSubLibraries = [], - condForeignLibs = [], - condExecutables = [], - condTestSuites = [], - condBenchmarks = []} + condTreeComponents = []}) + [] + [] + [] + [] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/indentation.expr b/Cabal-tests/tests/ParserTests/regressions/indentation.expr index f36a8997717..461ac4e71f5 100644 --- a/Cabal-tests/tests/ParserTests/regressions/indentation.expr +++ b/Cabal-tests/tests/ParserTests/regressions/indentation.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV3_0, package = PackageIdentifier { @@ -45,10 +44,10 @@ GenericPackageDescription { extraSrcFiles = [], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [], - condLibrary = Just + extraFiles = []} + Nothing + [] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -63,11 +62,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -116,9 +115,9 @@ GenericPackageDescription { targetBuildDepends = [], mixins = []}}, condTreeConstraints = [], - condTreeComponents = []}, - condSubLibraries = [], - condForeignLibs = [], - condExecutables = [], - condTestSuites = [], - condBenchmarks = []} + condTreeComponents = []}) + [] + [] + [] + [] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/indentation2.expr b/Cabal-tests/tests/ParserTests/regressions/indentation2.expr index 11afbcfd5d3..29498ea153f 100644 --- a/Cabal-tests/tests/ParserTests/regressions/indentation2.expr +++ b/Cabal-tests/tests/ParserTests/regressions/indentation2.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV3_0, package = PackageIdentifier { @@ -38,10 +37,10 @@ GenericPackageDescription { extraSrcFiles = [], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [], - condLibrary = Just + extraFiles = []} + Nothing + [] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -56,11 +55,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -109,9 +108,9 @@ GenericPackageDescription { targetBuildDepends = [], mixins = []}}, condTreeConstraints = [], - condTreeComponents = []}, - condSubLibraries = [], - condForeignLibs = [], - condExecutables = [], - condTestSuites = [], - condBenchmarks = []} + condTreeComponents = []}) + [] + [] + [] + [] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/indentation3.expr b/Cabal-tests/tests/ParserTests/regressions/indentation3.expr index 964bad3f924..4ff93a5f792 100644 --- a/Cabal-tests/tests/ParserTests/regressions/indentation3.expr +++ b/Cabal-tests/tests/ParserTests/regressions/indentation3.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV3_0, package = PackageIdentifier { @@ -40,10 +39,10 @@ GenericPackageDescription { extraSrcFiles = [], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [], - condLibrary = Just + extraFiles = []} + Nothing + [] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -58,11 +57,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -111,9 +110,9 @@ GenericPackageDescription { targetBuildDepends = [], mixins = []}}, condTreeConstraints = [], - condTreeComponents = []}, - condSubLibraries = [], - condForeignLibs = [], - condExecutables = [], - condTestSuites = [], - condBenchmarks = []} + condTreeComponents = []}) + [] + [] + [] + [] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-5055.expr b/Cabal-tests/tests/ParserTests/regressions/issue-5055.expr index 996fa26eece..3c4bc89b0f8 100644 --- a/Cabal-tests/tests/ParserTests/regressions/issue-5055.expr +++ b/Cabal-tests/tests/ParserTests/regressions/issue-5055.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV2_0, package = PackageIdentifier { @@ -35,13 +34,13 @@ GenericPackageDescription { extraSrcFiles = [], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [], - condLibrary = Nothing, - condSubLibraries = [], - condForeignLibs = [], - condExecutables = [ + extraFiles = []} + Nothing + [] + Nothing + [] + [] + [ _×_ (UnqualComponentName "flag-test-exe") @@ -57,11 +56,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -126,8 +125,8 @@ GenericPackageDescription { (EarlierVersion (mkVersion [5]))) mainLibSet], - condTreeComponents = []}], - condTestSuites = [ + condTreeComponents = []}] + [ _×_ (UnqualComponentName "flag-cabal-test") @@ -143,11 +142,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -231,11 +230,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -285,5 +284,5 @@ GenericPackageDescription { testCodeGenerators = []}, condTreeConstraints = [], condTreeComponents = []}, - condBranchIfFalse = Nothing}]}], - condBenchmarks = []} + condBranchIfFalse = Nothing}]}] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-5846.expr b/Cabal-tests/tests/ParserTests/regressions/issue-5846.expr index c3e08359046..1fb51537e27 100644 --- a/Cabal-tests/tests/ParserTests/regressions/issue-5846.expr +++ b/Cabal-tests/tests/ParserTests/regressions/issue-5846.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV3_0, package = PackageIdentifier { @@ -33,10 +32,10 @@ GenericPackageDescription { extraSrcFiles = [], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [], - condLibrary = Just + extraFiles = []} + Nothing + [] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -51,11 +50,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -176,9 +175,9 @@ GenericPackageDescription { (UnqualComponentName "a"), LSubLibName (UnqualComponentName "b")]))], - condTreeComponents = []}, - condSubLibraries = [], - condForeignLibs = [], - condExecutables = [], - condTestSuites = [], - condBenchmarks = []} + condTreeComponents = []}) + [] + [] + [] + [] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-6083-a.expr b/Cabal-tests/tests/ParserTests/regressions/issue-6083-a.expr index 001d3c86515..0068ed026a3 100644 --- a/Cabal-tests/tests/ParserTests/regressions/issue-6083-a.expr +++ b/Cabal-tests/tests/ParserTests/regressions/issue-6083-a.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV3_4, package = PackageIdentifier { @@ -33,10 +32,10 @@ GenericPackageDescription { extraSrcFiles = [], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [], - condLibrary = Just + extraFiles = []} + Nothing + [] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -51,11 +50,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -130,8 +129,8 @@ GenericPackageDescription { LSubLibName (UnqualComponentName "sublib")]))], - condTreeComponents = []}, - condSubLibraries = [ + condTreeComponents = []}) + [ _×_ (UnqualComponentName "sublib") CondNode { @@ -149,11 +148,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -202,9 +201,9 @@ GenericPackageDescription { targetBuildDepends = [], mixins = []}}, condTreeConstraints = [], - condTreeComponents = []}], - condForeignLibs = [], - condExecutables = [ + condTreeComponents = []}] + [] + [ _×_ (UnqualComponentName "demo-a") CondNode { @@ -219,11 +218,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -302,11 +301,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -380,6 +379,6 @@ GenericPackageDescription { LSubLibName (UnqualComponentName "sublib")]))], - condTreeComponents = []}], - condTestSuites = [], - condBenchmarks = []} + condTreeComponents = []}] + [] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-6083-b.expr b/Cabal-tests/tests/ParserTests/regressions/issue-6083-b.expr index ca99e3d554f..bc3bc498439 100644 --- a/Cabal-tests/tests/ParserTests/regressions/issue-6083-b.expr +++ b/Cabal-tests/tests/ParserTests/regressions/issue-6083-b.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV3_0, package = PackageIdentifier { @@ -33,10 +32,10 @@ GenericPackageDescription { extraSrcFiles = [], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [], - condLibrary = Just + extraFiles = []} + Nothing + [] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -51,11 +50,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -130,8 +129,8 @@ GenericPackageDescription { LSubLibName (UnqualComponentName "sublib")]))], - condTreeComponents = []}, - condSubLibraries = [ + condTreeComponents = []}) + [ _×_ (UnqualComponentName "sublib") CondNode { @@ -149,11 +148,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -202,9 +201,9 @@ GenericPackageDescription { targetBuildDepends = [], mixins = []}}, condTreeConstraints = [], - condTreeComponents = []}], - condForeignLibs = [], - condExecutables = [ + condTreeComponents = []}] + [] + [ _×_ (UnqualComponentName "demo-a") CondNode { @@ -219,11 +218,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -312,11 +311,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -390,6 +389,6 @@ GenericPackageDescription { LSubLibName (UnqualComponentName "sublib")]))], - condTreeComponents = []}], - condTestSuites = [], - condBenchmarks = []} + condTreeComponents = []}] + [] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-6083-c.expr b/Cabal-tests/tests/ParserTests/regressions/issue-6083-c.expr index b2f47a1a938..6027c9e9024 100644 --- a/Cabal-tests/tests/ParserTests/regressions/issue-6083-c.expr +++ b/Cabal-tests/tests/ParserTests/regressions/issue-6083-c.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV2_4, package = PackageIdentifier { @@ -33,10 +32,10 @@ GenericPackageDescription { extraSrcFiles = [], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [], - condLibrary = Just + extraFiles = []} + Nothing + [] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -51,11 +50,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -130,8 +129,8 @@ GenericPackageDescription { LSubLibName (UnqualComponentName "sublib")]))], - condTreeComponents = []}, - condSubLibraries = [ + condTreeComponents = []}) + [ _×_ (UnqualComponentName "sublib") CondNode { @@ -149,11 +148,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -202,8 +201,8 @@ GenericPackageDescription { targetBuildDepends = [], mixins = []}}, condTreeConstraints = [], - condTreeComponents = []}], - condForeignLibs = [], - condExecutables = [], - condTestSuites = [], - condBenchmarks = []} + condTreeComponents = []}] + [] + [] + [] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-6083-pkg-pkg.expr b/Cabal-tests/tests/ParserTests/regressions/issue-6083-pkg-pkg.expr index ce7c453e697..c65067d2cc0 100644 --- a/Cabal-tests/tests/ParserTests/regressions/issue-6083-pkg-pkg.expr +++ b/Cabal-tests/tests/ParserTests/regressions/issue-6083-pkg-pkg.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV3_0, package = PackageIdentifier { @@ -33,10 +32,10 @@ GenericPackageDescription { extraSrcFiles = [], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [], - condLibrary = Just + extraFiles = []} + Nothing + [] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -51,11 +50,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -120,9 +119,9 @@ GenericPackageDescription { (PackageName "freetype") (OrLaterVersion (mkVersion [0])) mainLibSet], - condTreeComponents = []}, - condSubLibraries = [], - condForeignLibs = [], - condExecutables = [], - condTestSuites = [], - condBenchmarks = []} + condTreeComponents = []}) + [] + [] + [] + [] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-774.expr b/Cabal-tests/tests/ParserTests/regressions/issue-774.expr index 4aeb65cb960..6a049b22cb6 100644 --- a/Cabal-tests/tests/ParserTests/regressions/issue-774.expr +++ b/Cabal-tests/tests/ParserTests/regressions/issue-774.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV1_12, package = PackageIdentifier { @@ -42,10 +41,10 @@ GenericPackageDescription { extraSrcFiles = [], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [], - condLibrary = Just + extraFiles = []} + Nothing + [] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -61,11 +60,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -118,9 +117,9 @@ GenericPackageDescription { targetBuildDepends = [], mixins = []}}, condTreeConstraints = [], - condTreeComponents = []}, - condSubLibraries = [], - condForeignLibs = [], - condExecutables = [], - condTestSuites = [], - condBenchmarks = []} + condTreeComponents = []}) + [] + [] + [] + [] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/jaeger-flamegraph.expr b/Cabal-tests/tests/ParserTests/regressions/jaeger-flamegraph.expr index b6dc81fee1b..97750a5aa8e 100644 --- a/Cabal-tests/tests/ParserTests/regressions/jaeger-flamegraph.expr +++ b/Cabal-tests/tests/ParserTests/regressions/jaeger-flamegraph.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV2_2, package = PackageIdentifier { @@ -74,10 +73,10 @@ GenericPackageDescription { extraSrcFiles = [], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [], - condLibrary = Just + extraFiles = []} + Nothing + [] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -93,11 +92,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -175,10 +174,10 @@ GenericPackageDescription { (MajorBoundVersion (mkVersion [2, 12, 6, 1])) mainLibSet], - condTreeComponents = []}, - condSubLibraries = [], - condForeignLibs = [], - condExecutables = [ + condTreeComponents = []}) + [] + [] + [ _×_ (UnqualComponentName "jaeger-flamegraph") @@ -194,11 +193,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -339,8 +338,8 @@ GenericPackageDescription { (MajorBoundVersion (mkVersion [1, 2, 3, 1])) mainLibSet], - condTreeComponents = []}], - condTestSuites = [ + condTreeComponents = []}] + [ _×_ (UnqualComponentName "tests") CondNode { @@ -361,11 +360,11 @@ GenericPackageDescription { (MajorBoundVersion (mkVersion [4, 2, 1]))], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -476,5 +475,5 @@ GenericPackageDescription { (MajorBoundVersion (mkVersion [0, 10])) mainLibSet], - condTreeComponents = []}], - condBenchmarks = []} + condTreeComponents = []}] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/leading-comma-2.expr b/Cabal-tests/tests/ParserTests/regressions/leading-comma-2.expr index 3a1d7d5f075..ccacd5b5422 100644 --- a/Cabal-tests/tests/ParserTests/regressions/leading-comma-2.expr +++ b/Cabal-tests/tests/ParserTests/regressions/leading-comma-2.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV3_0, package = PackageIdentifier { @@ -35,10 +34,10 @@ GenericPackageDescription { extraSrcFiles = [], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [], - condLibrary = Just + extraFiles = []} + Nothing + [] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -61,11 +60,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -162,9 +161,9 @@ GenericPackageDescription { (PackageName "directory") (OrLaterVersion (mkVersion [0])) mainLibSet], - condTreeComponents = []}, - condSubLibraries = [], - condForeignLibs = [], - condExecutables = [], - condTestSuites = [], - condBenchmarks = []} + condTreeComponents = []}) + [] + [] + [] + [] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/leading-comma.expr b/Cabal-tests/tests/ParserTests/regressions/leading-comma.expr index 230ebf53136..8ae9d323ce7 100644 --- a/Cabal-tests/tests/ParserTests/regressions/leading-comma.expr +++ b/Cabal-tests/tests/ParserTests/regressions/leading-comma.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV2_2, package = PackageIdentifier { @@ -35,10 +34,10 @@ GenericPackageDescription { extraSrcFiles = [], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [], - condLibrary = Just + extraFiles = []} + Nothing + [] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -54,11 +53,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -155,9 +154,9 @@ GenericPackageDescription { (PackageName "directory") (OrLaterVersion (mkVersion [0])) mainLibSet], - condTreeComponents = []}, - condSubLibraries = [], - condForeignLibs = [], - condExecutables = [], - condTestSuites = [], - condBenchmarks = []} + condTreeComponents = []}) + [] + [] + [] + [] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/libpq1.expr b/Cabal-tests/tests/ParserTests/regressions/libpq1.expr index b331abffcca..ff665dc58b5 100644 --- a/Cabal-tests/tests/ParserTests/regressions/libpq1.expr +++ b/Cabal-tests/tests/ParserTests/regressions/libpq1.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV1_8, package = PackageIdentifier { @@ -112,16 +111,16 @@ GenericPackageDescription { SymbolicPath "CHANGELOG.md"], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [ + extraFiles = []} + Nothing + [ MkPackageFlag { flagName = FlagName "use-pkg-config", flagDescription = "", flagDefault = False, - flagManual = True}], - condLibrary = Just + flagManual = True}] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -144,11 +143,11 @@ GenericPackageDescription { (mkVersion [0]))], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -250,11 +249,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -337,11 +336,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -424,11 +423,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [ @@ -499,11 +498,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -569,11 +568,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -637,11 +636,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -707,11 +706,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -761,9 +760,9 @@ GenericPackageDescription { condTreeConstraints = [], condTreeComponents = []}, condBranchIfFalse = - Nothing}]}}]}}]}, - condSubLibraries = [], - condForeignLibs = [], - condExecutables = [], - condTestSuites = [], - condBenchmarks = []} + Nothing}]}}]}}]}) + [] + [] + [] + [] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/libpq2.expr b/Cabal-tests/tests/ParserTests/regressions/libpq2.expr index 9f6a16ada6e..4369c33fb02 100644 --- a/Cabal-tests/tests/ParserTests/regressions/libpq2.expr +++ b/Cabal-tests/tests/ParserTests/regressions/libpq2.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV3_0, package = PackageIdentifier { @@ -116,16 +115,16 @@ GenericPackageDescription { SymbolicPath "CHANGELOG.md"], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [ + extraFiles = []} + Nothing + [ MkPackageFlag { flagName = FlagName "use-pkg-config", flagDescription = "", flagDefault = False, - flagManual = True}], - condLibrary = Just + flagManual = True}] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -149,11 +148,11 @@ GenericPackageDescription { (OrLaterVersion (mkVersion [0]))], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -255,11 +254,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -342,11 +341,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -429,11 +428,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [ @@ -501,11 +500,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -571,11 +570,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -639,11 +638,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -709,11 +708,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -763,9 +762,9 @@ GenericPackageDescription { condTreeConstraints = [], condTreeComponents = []}, condBranchIfFalse = - Nothing}]}}]}}]}, - condSubLibraries = [], - condForeignLibs = [], - condExecutables = [], - condTestSuites = [], - condBenchmarks = []} + Nothing}]}}]}}]}) + [] + [] + [] + [] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/mixin-1.expr b/Cabal-tests/tests/ParserTests/regressions/mixin-1.expr index 0a137660468..b5c4b707678 100644 --- a/Cabal-tests/tests/ParserTests/regressions/mixin-1.expr +++ b/Cabal-tests/tests/ParserTests/regressions/mixin-1.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV2_0, package = PackageIdentifier { @@ -33,13 +32,13 @@ GenericPackageDescription { extraSrcFiles = [], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [], - condLibrary = Nothing, - condSubLibraries = [], - condForeignLibs = [], - condExecutables = [ + extraFiles = []} + Nothing + [] + Nothing + [] + [] + [ _×_ (UnqualComponentName "str-example") @@ -55,11 +54,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -160,6 +159,6 @@ GenericPackageDescription { (PackageName "str-bytestring") (OrLaterVersion (mkVersion [0])) mainLibSet], - condTreeComponents = []}], - condTestSuites = [], - condBenchmarks = []} + condTreeComponents = []}] + [] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/mixin-2.expr b/Cabal-tests/tests/ParserTests/regressions/mixin-2.expr index 6c2239df825..025264cc0b8 100644 --- a/Cabal-tests/tests/ParserTests/regressions/mixin-2.expr +++ b/Cabal-tests/tests/ParserTests/regressions/mixin-2.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV3_0, package = PackageIdentifier { @@ -33,13 +32,13 @@ GenericPackageDescription { extraSrcFiles = [], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [], - condLibrary = Nothing, - condSubLibraries = [], - condForeignLibs = [], - condExecutables = [ + extraFiles = []} + Nothing + [] + Nothing + [] + [] + [ _×_ (UnqualComponentName "str-example") @@ -55,11 +54,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -160,6 +159,6 @@ GenericPackageDescription { (PackageName "str-bytestring") (OrLaterVersion (mkVersion [0])) mainLibSet], - condTreeComponents = []}], - condTestSuites = [], - condBenchmarks = []} + condTreeComponents = []}] + [] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/mixin-3.expr b/Cabal-tests/tests/ParserTests/regressions/mixin-3.expr index a4a94aac32c..ff0211a8a5a 100644 --- a/Cabal-tests/tests/ParserTests/regressions/mixin-3.expr +++ b/Cabal-tests/tests/ParserTests/regressions/mixin-3.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV3_0, package = PackageIdentifier { @@ -33,13 +32,13 @@ GenericPackageDescription { extraSrcFiles = [], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [], - condLibrary = Nothing, - condSubLibraries = [], - condForeignLibs = [], - condExecutables = [ + extraFiles = []} + Nothing + [] + Nothing + [] + [] + [ _×_ (UnqualComponentName "str-example") @@ -55,11 +54,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -143,6 +142,6 @@ GenericPackageDescription { (PackageName "str-bytestring") (OrLaterVersion (mkVersion [0])) mainLibSet], - condTreeComponents = []}], - condTestSuites = [], - condBenchmarks = []} + condTreeComponents = []}] + [] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/monad-param.expr b/Cabal-tests/tests/ParserTests/regressions/monad-param.expr index db28c928ddb..b0607d45fba 100644 --- a/Cabal-tests/tests/ParserTests/regressions/monad-param.expr +++ b/Cabal-tests/tests/ParserTests/regressions/monad-param.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV1_0, package = PackageIdentifier { @@ -43,10 +42,10 @@ GenericPackageDescription { extraSrcFiles = [], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [], - condLibrary = Just + extraFiles = []} + Nothing + [] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -63,11 +62,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -154,9 +153,9 @@ GenericPackageDescription { (PackageName "stm") (OrLaterVersion (mkVersion [0])) mainLibSet], - condTreeComponents = []}, - condSubLibraries = [], - condForeignLibs = [], - condExecutables = [], - condTestSuites = [], - condBenchmarks = []} + condTreeComponents = []}) + [] + [] + [] + [] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/multiple-libs-2.expr b/Cabal-tests/tests/ParserTests/regressions/multiple-libs-2.expr index d2f1efdd913..4395c5c5e88 100644 --- a/Cabal-tests/tests/ParserTests/regressions/multiple-libs-2.expr +++ b/Cabal-tests/tests/ParserTests/regressions/multiple-libs-2.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV2_0, package = PackageIdentifier { @@ -35,10 +34,10 @@ GenericPackageDescription { extraSrcFiles = [], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [], - condLibrary = Just + extraFiles = []} + Nothing + [] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -54,11 +53,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -115,8 +114,8 @@ GenericPackageDescription { (PackageName "base") (OrLaterVersion (mkVersion [0])) mainLibSet], - condTreeComponents = []}, - condSubLibraries = [ + condTreeComponents = []}) + [ _×_ (UnqualComponentName "public") CondNode { @@ -135,11 +134,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -196,8 +195,8 @@ GenericPackageDescription { (PackageName "base") (OrLaterVersion (mkVersion [0])) mainLibSet], - condTreeComponents = []}], - condForeignLibs = [], - condExecutables = [], - condTestSuites = [], - condBenchmarks = []} + condTreeComponents = []}] + [] + [] + [] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/noVersion.expr b/Cabal-tests/tests/ParserTests/regressions/noVersion.expr index 838f87733eb..8e462c3dcb5 100644 --- a/Cabal-tests/tests/ParserTests/regressions/noVersion.expr +++ b/Cabal-tests/tests/ParserTests/regressions/noVersion.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV1_22, package = PackageIdentifier { @@ -35,10 +34,10 @@ GenericPackageDescription { extraSrcFiles = [], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [], - condLibrary = Just + extraFiles = []} + Nothing + [] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -54,11 +53,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -115,9 +114,9 @@ GenericPackageDescription { (PackageName "bad-package") (EarlierVersion (mkVersion [0])) mainLibSet], - condTreeComponents = []}, - condSubLibraries = [], - condForeignLibs = [], - condExecutables = [], - condTestSuites = [], - condBenchmarks = []} + condTreeComponents = []}) + [] + [] + [] + [] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/nothing-unicode.expr b/Cabal-tests/tests/ParserTests/regressions/nothing-unicode.expr index ccfe4421c7b..37d799dfcc8 100644 --- a/Cabal-tests/tests/ParserTests/regressions/nothing-unicode.expr +++ b/Cabal-tests/tests/ParserTests/regressions/nothing-unicode.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV1_10, package = PackageIdentifier { @@ -45,15 +44,15 @@ GenericPackageDescription { extraSrcFiles = [], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [ + extraFiles = []} + Nothing + [ MkPackageFlag { flagName = FlagName "\28961", flagDescription = "\28961", flagDefault = True, - flagManual = False}], - condLibrary = Just + flagManual = False}] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -69,11 +68,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -140,11 +139,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -193,9 +192,9 @@ GenericPackageDescription { mixins = []}}, condTreeConstraints = [], condTreeComponents = []}, - condBranchIfFalse = Nothing}]}, - condSubLibraries = [], - condForeignLibs = [], - condExecutables = [], - condTestSuites = [], - condBenchmarks = []} + condBranchIfFalse = Nothing}]}) + [] + [] + [] + [] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/shake.expr b/Cabal-tests/tests/ParserTests/regressions/shake.expr index 5be08b04064..57fec04d172 100644 --- a/Cabal-tests/tests/ParserTests/regressions/shake.expr +++ b/Cabal-tests/tests/ParserTests/regressions/shake.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV1_18, package = PackageIdentifier { @@ -150,16 +149,16 @@ GenericPackageDescription { extraDocFiles = [ SymbolicPath "CHANGES.txt", SymbolicPath "README.md"], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [ + extraFiles = []} + Nothing + [ MkPackageFlag { flagName = FlagName "portable", flagDescription = "Obtain FileTime using portable functions", flagDefault = False, - flagManual = True}], - condLibrary = Just + flagManual = True}] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -189,11 +188,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -480,11 +479,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = ["-DPORTABLE"], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -550,11 +549,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -627,11 +626,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -697,11 +696,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -778,11 +777,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -839,10 +838,10 @@ GenericPackageDescription { (OrLaterVersion (mkVersion [0])) mainLibSet], condTreeComponents = []}, - condBranchIfFalse = Nothing}]}, - condSubLibraries = [], - condForeignLibs = [], - condExecutables = [ + condBranchIfFalse = Nothing}]}) + [] + [] + [ _×_ (UnqualComponentName "shake") CondNode { @@ -857,11 +856,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -1183,11 +1182,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -1253,11 +1252,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = ["-DPORTABLE"], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -1320,11 +1319,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -1394,11 +1393,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -1461,11 +1460,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -1539,11 +1538,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -1600,8 +1599,8 @@ GenericPackageDescription { (OrLaterVersion (mkVersion [0])) mainLibSet], condTreeComponents = []}, - condBranchIfFalse = Nothing}]}], - condTestSuites = [ + condBranchIfFalse = Nothing}]}] + [ _×_ (UnqualComponentName "shake-test") @@ -1617,11 +1616,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -1992,11 +1991,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -2064,11 +2063,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -2136,11 +2135,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = ["-DPORTABLE"], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -2207,11 +2206,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -2285,11 +2284,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -2356,11 +2355,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -2438,11 +2437,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -2500,5 +2499,5 @@ GenericPackageDescription { (OrLaterVersion (mkVersion [0])) mainLibSet], condTreeComponents = []}, - condBranchIfFalse = Nothing}]}], - condBenchmarks = []} + condBranchIfFalse = Nothing}]}] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/spdx-1.expr b/Cabal-tests/tests/ParserTests/regressions/spdx-1.expr index 88500d2d365..3a07138ce1a 100644 --- a/Cabal-tests/tests/ParserTests/regressions/spdx-1.expr +++ b/Cabal-tests/tests/ParserTests/regressions/spdx-1.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV2_0, package = PackageIdentifier { @@ -34,10 +33,10 @@ GenericPackageDescription { extraSrcFiles = [], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [], - condLibrary = Just + extraFiles = []} + Nothing + [] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -52,11 +51,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -105,9 +104,9 @@ GenericPackageDescription { targetBuildDepends = [], mixins = []}}, condTreeConstraints = [], - condTreeComponents = []}, - condSubLibraries = [], - condForeignLibs = [], - condExecutables = [], - condTestSuites = [], - condBenchmarks = []} + condTreeComponents = []}) + [] + [] + [] + [] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/spdx-2.expr b/Cabal-tests/tests/ParserTests/regressions/spdx-2.expr index 9cd00ea1103..660f49c9da0 100644 --- a/Cabal-tests/tests/ParserTests/regressions/spdx-2.expr +++ b/Cabal-tests/tests/ParserTests/regressions/spdx-2.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV2_2, package = PackageIdentifier { @@ -38,10 +37,10 @@ GenericPackageDescription { extraSrcFiles = [], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [], - condLibrary = Just + extraFiles = []} + Nothing + [] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -56,11 +55,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -109,9 +108,9 @@ GenericPackageDescription { targetBuildDepends = [], mixins = []}}, condTreeConstraints = [], - condTreeComponents = []}, - condSubLibraries = [], - condForeignLibs = [], - condExecutables = [], - condTestSuites = [], - condBenchmarks = []} + condTreeComponents = []}) + [] + [] + [] + [] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/spdx-3.expr b/Cabal-tests/tests/ParserTests/regressions/spdx-3.expr index e8b2eca8989..17fa80ed692 100644 --- a/Cabal-tests/tests/ParserTests/regressions/spdx-3.expr +++ b/Cabal-tests/tests/ParserTests/regressions/spdx-3.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV2_4, package = PackageIdentifier { @@ -38,10 +37,10 @@ GenericPackageDescription { extraSrcFiles = [], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [], - condLibrary = Just + extraFiles = []} + Nothing + [] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -56,11 +55,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -109,9 +108,9 @@ GenericPackageDescription { targetBuildDepends = [], mixins = []}}, condTreeConstraints = [], - condTreeComponents = []}, - condSubLibraries = [], - condForeignLibs = [], - condExecutables = [], - condTestSuites = [], - condBenchmarks = []} + condTreeComponents = []}) + [] + [] + [] + [] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/supervisors-0.1.cabal b/Cabal-tests/tests/ParserTests/regressions/supervisors-0.1.cabal new file mode 100644 index 00000000000..7383cc88244 --- /dev/null +++ b/Cabal-tests/tests/ParserTests/regressions/supervisors-0.1.cabal @@ -0,0 +1,68 @@ +cabal-version: 2.2 +name: supervisors +version: 0.2.1.0 +stability: Experimental +synopsis: Monitor groups of threads with non-hierarchical lifetimes. +description: + The @supervisors@ package provides a useful abstraction for managing the + groups of Haskell threads, which may not have a strictly hierarchical + structure to their lifetimes. + . + Concretely, the library provides a `Supervisor` construct, which can be + used to safely spawn threads while guaranteeing that: + . + * When the supervisor is killed, all of the threads it supervises will be + killed. + * Child threads can terminate in any order, and memory usage will always + be proportional to the number of *live* supervised threads. + . + One way to think of it is that @supervisors@ is to @async@ as + @resourcet@ is to @bracket@. + . + Note that this package is EXPERIMENTAL; it needs more careful testing before + I can earnestly recommend relying on it. + . + See the README and module documentation for more information. +homepage: https://github.com/zenhack/haskell-supervisors +bug-reports: https://github.com/zenhack/haskell-supervisors/issues +license: MIT +license-file: LICENSE +author: Ian Denhardt +maintainer: ian@zenhack.net +copyright: 2018 Ian Denhardt +category: Concurrency +build-type: Simple +extra-source-files: + CHANGELOG.md + , README.md + , .gitignore + +common shared-opts + build-depends: + base >=4.11 && <5 + +library + import: shared-opts + exposed-modules: Supervisors + hs-source-dirs: src/ + build-depends: + stm ^>=2.5 + , containers >=0.5.9 && <0.7 + , safe-exceptions ^>= 0.1.7 + , async ^>=2.2.1 + default-language: Haskell2010 + +test-suite tests + import: shared-opts + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: tests/ + build-depends: + supervisors + , hspec >=2.6.0 && <2.8 + default-language: Haskell2010 + +source-repository head + type: git + branch: master + location: https://github.com/zenhack/haskell-supervisors.git diff --git a/Cabal-tests/tests/ParserTests/regressions/supervisors-0.1.expr b/Cabal-tests/tests/ParserTests/regressions/supervisors-0.1.expr new file mode 100644 index 00000000000..eb1a75e7943 --- /dev/null +++ b/Cabal-tests/tests/ParserTests/regressions/supervisors-0.1.expr @@ -0,0 +1,329 @@ +`(,,,,,,,,)` + PackageDescription { + specVersion = CabalSpecV2_2, + package = PackageIdentifier { + pkgName = PackageName + "supervisors", + pkgVersion = mkVersion + [0, 2, 1, 0]}, + licenseRaw = Left + (License + (ELicense + (ELicenseId MIT) + Nothing)), + licenseFiles = [ + SymbolicPath "LICENSE"], + copyright = "2018 Ian Denhardt", + maintainer = "ian@zenhack.net", + author = "Ian Denhardt", + stability = "Experimental", + testedWith = [], + homepage = + "https://github.com/zenhack/haskell-supervisors", + pkgUrl = "", + bugReports = + "https://github.com/zenhack/haskell-supervisors/issues", + sourceRepos = [ + SourceRepo { + repoKind = RepoHead, + repoType = Just + (KnownRepoType Git), + repoLocation = Just + "https://github.com/zenhack/haskell-supervisors.git", + repoModule = Nothing, + repoBranch = Just "master", + repoTag = Nothing, + repoSubdir = Nothing}], + synopsis = + "Monitor groups of threads with non-hierarchical lifetimes.", + description = + concat + [ + "The @supervisors@ package provides a useful abstraction for managing the\n", + "groups of Haskell threads, which may not have a strictly hierarchical\n", + "structure to their lifetimes.\n", + "\n", + "Concretely, the library provides a `Supervisor` construct, which can be\n", + "used to safely spawn threads while guaranteeing that:\n", + "\n", + "* When the supervisor is killed, all of the threads it supervises will be\n", + "killed.\n", + "* Child threads can terminate in any order, and memory usage will always\n", + "be proportional to the number of *live* supervised threads.\n", + "\n", + "One way to think of it is that @supervisors@ is to @async@ as\n", + "@resourcet@ is to @bracket@.\n", + "\n", + "Note that this package is EXPERIMENTAL; it needs more careful testing before\n", + "I can earnestly recommend relying on it.\n", + "\n", + "See the README and module documentation for more information."], + category = "Concurrency", + customFieldsPD = [], + buildTypeRaw = Just Simple, + setupBuildInfo = Nothing, + library = Nothing, + subLibraries = [], + executables = [], + foreignLibs = [], + testSuites = [], + benchmarks = [], + dataFiles = [], + dataDir = SymbolicPath ".", + extraSrcFiles = [ + SymbolicPath "CHANGELOG.md", + SymbolicPath "README.md", + SymbolicPath ".gitignore"], + extraTmpFiles = [], + extraDocFiles = [], + extraFiles = []} + Nothing + [] + (Just + CondNode { + condTreeData = Library { + libName = LMainLibName, + exposedModules = [ + ModuleName "Supervisors"], + reexportedModules = [], + signatures = [], + libExposed = True, + libVisibility = + LibraryVisibilityPublic, + libBuildInfo = BuildInfo { + buildable = True, + buildTools = [], + buildToolDepends = [], + cppOptions = [], + asmOptions = [], + cmmOptions = [], + ccOptions = [], + cxxOptions = [], + jsppOptions = [], + ldOptions = [], + hsc2hsOptions = [], + pkgconfigDepends = [], + frameworks = [], + extraFrameworkDirs = [], + asmSources = [], + cmmSources = [], + cSources = [], + cxxSources = [], + jsSources = [], + hsSourceDirs = [ + SymbolicPath "src/"], + otherModules = [], + virtualModules = [], + autogenModules = [], + defaultLanguage = Just + Haskell2010, + otherLanguages = [], + defaultExtensions = [], + otherExtensions = [], + oldExtensions = [], + extraLibs = [], + extraLibsStatic = [], + extraGHCiLibs = [], + extraBundledLibs = [], + extraLibFlavours = [], + extraDynLibFlavours = [], + extraLibDirs = [], + extraLibDirsStatic = [], + includeDirs = [], + includes = [], + autogenIncludes = [], + installIncludes = [], + options = PerCompilerFlavor + [] + [], + profOptions = PerCompilerFlavor + [] + [], + sharedOptions = + PerCompilerFlavor [] [], + profSharedOptions = + PerCompilerFlavor [] [], + staticOptions = + PerCompilerFlavor [] [], + customFieldsBI = [], + targetBuildDepends = [ + Dependency + (PackageName "base") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [4, 11])) + (EarlierVersion + (mkVersion [5]))) + mainLibSet, + Dependency + (PackageName "stm") + (MajorBoundVersion + (mkVersion [2, 5])) + mainLibSet, + Dependency + (PackageName "containers") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [0, 5, 9])) + (EarlierVersion + (mkVersion [0, 7]))) + mainLibSet, + Dependency + (PackageName "safe-exceptions") + (MajorBoundVersion + (mkVersion [0, 1, 7])) + mainLibSet, + Dependency + (PackageName "async") + (MajorBoundVersion + (mkVersion [2, 2, 1])) + mainLibSet], + mixins = []}}, + condTreeConstraints = [ + Dependency + (PackageName "base") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [4, 11])) + (EarlierVersion + (mkVersion [5]))) + mainLibSet, + Dependency + (PackageName "stm") + (MajorBoundVersion + (mkVersion [2, 5])) + mainLibSet, + Dependency + (PackageName "containers") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [0, 5, 9])) + (EarlierVersion + (mkVersion [0, 7]))) + mainLibSet, + Dependency + (PackageName "safe-exceptions") + (MajorBoundVersion + (mkVersion [0, 1, 7])) + mainLibSet, + Dependency + (PackageName "async") + (MajorBoundVersion + (mkVersion [2, 2, 1])) + mainLibSet], + condTreeComponents = []}) + [] + [] + [] + [ + _×_ + (UnqualComponentName "tests") + CondNode { + condTreeData = TestSuite { + testName = UnqualComponentName + "", + testInterface = TestSuiteExeV10 + (mkVersion [1, 0]) + (SymbolicPath "Main.hs"), + testBuildInfo = BuildInfo { + buildable = True, + buildTools = [], + buildToolDepends = [], + cppOptions = [], + asmOptions = [], + cmmOptions = [], + ccOptions = [], + cxxOptions = [], + jsppOptions = [], + ldOptions = [], + hsc2hsOptions = [], + pkgconfigDepends = [], + frameworks = [], + extraFrameworkDirs = [], + asmSources = [], + cmmSources = [], + cSources = [], + cxxSources = [], + jsSources = [], + hsSourceDirs = [ + SymbolicPath "tests/"], + otherModules = [], + virtualModules = [], + autogenModules = [], + defaultLanguage = Just + Haskell2010, + otherLanguages = [], + defaultExtensions = [], + otherExtensions = [], + oldExtensions = [], + extraLibs = [], + extraLibsStatic = [], + extraGHCiLibs = [], + extraBundledLibs = [], + extraLibFlavours = [], + extraDynLibFlavours = [], + extraLibDirs = [], + extraLibDirsStatic = [], + includeDirs = [], + includes = [], + autogenIncludes = [], + installIncludes = [], + options = PerCompilerFlavor + [] + [], + profOptions = PerCompilerFlavor + [] + [], + sharedOptions = + PerCompilerFlavor [] [], + profSharedOptions = + PerCompilerFlavor [] [], + staticOptions = + PerCompilerFlavor [] [], + customFieldsBI = [], + targetBuildDepends = [ + Dependency + (PackageName "base") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [4, 11])) + (EarlierVersion + (mkVersion [5]))) + mainLibSet, + Dependency + (PackageName "supervisors") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "hspec") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [2, 6, 0])) + (EarlierVersion + (mkVersion [2, 8]))) + mainLibSet], + mixins = []}, + testCodeGenerators = []}, + condTreeConstraints = [ + Dependency + (PackageName "base") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [4, 11])) + (EarlierVersion + (mkVersion [5]))) + mainLibSet, + Dependency + (PackageName "supervisors") + (OrLaterVersion (mkVersion [0])) + mainLibSet, + Dependency + (PackageName "hspec") + (IntersectVersionRanges + (OrLaterVersion + (mkVersion [2, 6, 0])) + (EarlierVersion + (mkVersion [2, 8]))) + mainLibSet], + condTreeComponents = []}] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/supervisors-0.1.format b/Cabal-tests/tests/ParserTests/regressions/supervisors-0.1.format new file mode 100644 index 00000000000..036bc904e3f --- /dev/null +++ b/Cabal-tests/tests/ParserTests/regressions/supervisors-0.1.format @@ -0,0 +1,65 @@ +cabal-version: 2.2 +name: supervisors +version: 0.2.1.0 +license: MIT +license-file: LICENSE +copyright: 2018 Ian Denhardt +maintainer: ian@zenhack.net +author: Ian Denhardt +stability: Experimental +homepage: https://github.com/zenhack/haskell-supervisors +bug-reports: https://github.com/zenhack/haskell-supervisors/issues +synopsis: Monitor groups of threads with non-hierarchical lifetimes. +description: + The @supervisors@ package provides a useful abstraction for managing the + groups of Haskell threads, which may not have a strictly hierarchical + structure to their lifetimes. + . + Concretely, the library provides a `Supervisor` construct, which can be + used to safely spawn threads while guaranteeing that: + . + * When the supervisor is killed, all of the threads it supervises will be + killed. + * Child threads can terminate in any order, and memory usage will always + be proportional to the number of *live* supervised threads. + . + One way to think of it is that @supervisors@ is to @async@ as + @resourcet@ is to @bracket@. + . + Note that this package is EXPERIMENTAL; it needs more careful testing before + I can earnestly recommend relying on it. + . + See the README and module documentation for more information. + +category: Concurrency +build-type: Simple +extra-source-files: + CHANGELOG.md + README.md + .gitignore + +source-repository head + type: git + location: https://github.com/zenhack/haskell-supervisors.git + branch: master + +library + exposed-modules: Supervisors + hs-source-dirs: src/ + default-language: Haskell2010 + build-depends: + base >=4.11 && <5, + stm ^>=2.5, + containers >=0.5.9 && <0.7, + safe-exceptions ^>=0.1.7, + async ^>=2.2.1 + +test-suite tests + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: tests/ + default-language: Haskell2010 + build-depends: + base >=4.11 && <5, + supervisors, + hspec >=2.6.0 && <2.8 diff --git a/Cabal-tests/tests/ParserTests/regressions/th-lift-instances.expr b/Cabal-tests/tests/ParserTests/regressions/th-lift-instances.expr index 2db686aa40f..af67967879c 100644 --- a/Cabal-tests/tests/ParserTests/regressions/th-lift-instances.expr +++ b/Cabal-tests/tests/ParserTests/regressions/th-lift-instances.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV1_10, package = PackageIdentifier { @@ -62,10 +61,10 @@ GenericPackageDescription { SymbolicPath "README.md"], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [], - condLibrary = Just + extraFiles = []} + Nothing + [] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -81,11 +80,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -235,11 +234,11 @@ GenericPackageDescription { (EarlierVersion (mkVersion [0, 11]))) mainLibSet], - condTreeComponents = []}, - condSubLibraries = [], - condForeignLibs = [], - condExecutables = [], - condTestSuites = [ + condTreeComponents = []}) + [] + [] + [] + [ _×_ (UnqualComponentName "tests") CondNode { @@ -254,11 +253,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -435,11 +434,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -544,11 +543,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -598,5 +597,5 @@ GenericPackageDescription { testCodeGenerators = []}, condTreeConstraints = [], condTreeComponents = []}, - condBranchIfFalse = Nothing}]}], - condBenchmarks = []} + condBranchIfFalse = Nothing}]}] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/version-sets.expr b/Cabal-tests/tests/ParserTests/regressions/version-sets.expr index c086ae618aa..d95cb453c7b 100644 --- a/Cabal-tests/tests/ParserTests/regressions/version-sets.expr +++ b/Cabal-tests/tests/ParserTests/regressions/version-sets.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV3_0, package = PackageIdentifier { @@ -60,10 +59,10 @@ GenericPackageDescription { extraSrcFiles = [], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [], - condLibrary = Just + extraFiles = []} + Nothing + [] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -78,11 +77,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -259,9 +258,9 @@ GenericPackageDescription { (MajorBoundVersion (mkVersion [2, 2, 0, 0]))) mainLibSet], - condTreeComponents = []}, - condSubLibraries = [], - condForeignLibs = [], - condExecutables = [], - condTestSuites = [], - condBenchmarks = []} + condTreeComponents = []}) + [] + [] + [] + [] + [] diff --git a/Cabal-tests/tests/ParserTests/regressions/wl-pprint-indef.expr b/Cabal-tests/tests/ParserTests/regressions/wl-pprint-indef.expr index e4e6a457a3d..c2749e7204a 100644 --- a/Cabal-tests/tests/ParserTests/regressions/wl-pprint-indef.expr +++ b/Cabal-tests/tests/ParserTests/regressions/wl-pprint-indef.expr @@ -1,5 +1,4 @@ -GenericPackageDescription { - packageDescription = +`(,,,,,,,,)` PackageDescription { specVersion = CabalSpecV1_6, package = PackageIdentifier { @@ -52,10 +51,10 @@ GenericPackageDescription { extraSrcFiles = [], extraTmpFiles = [], extraDocFiles = [], - extraFiles = []}, - gpdScannedVersion = Nothing, - genPackageFlags = [], - condLibrary = Just + extraFiles = []} + Nothing + [] + (Just CondNode { condTreeData = Library { libName = LMainLibName, @@ -72,11 +71,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -142,10 +141,10 @@ GenericPackageDescription { (OrLaterVersion (mkVersion [0, 1, 0, 0])) mainLibSet], - condTreeComponents = []}, - condSubLibraries = [], - condForeignLibs = [], - condExecutables = [ + condTreeComponents = []}) + [] + [] + [ _×_ (UnqualComponentName "wl-pprint-string-example") @@ -161,11 +160,11 @@ GenericPackageDescription { buildTools = [], buildToolDepends = [], cppOptions = [], - jsppOptions = [], asmOptions = [], cmmOptions = [], ccOptions = [], cxxOptions = [], + jsppOptions = [], ldOptions = [], hsc2hsOptions = [], pkgconfigDepends = [], @@ -241,6 +240,6 @@ GenericPackageDescription { (PackageName "wl-pprint-indef") (OrLaterVersion (mkVersion [0])) mainLibSet], - condTreeComponents = []}], - condTestSuites = [], - condBenchmarks = []} + condTreeComponents = []}] + [] + [] diff --git a/Cabal-tests/tests/UnitTests/Distribution/Types/GenericPackageDescription.hs b/Cabal-tests/tests/UnitTests/Distribution/Types/GenericPackageDescription.hs index b8653abd38f..4554df8028e 100644 --- a/Cabal-tests/tests/UnitTests/Distribution/Types/GenericPackageDescription.hs +++ b/Cabal-tests/tests/UnitTests/Distribution/Types/GenericPackageDescription.hs @@ -17,14 +17,16 @@ tests = gpdFields :: [(String, GenericPackageDescription -> GenericPackageDescription)] gpdFields = - [ ("packageDescription", \gpd -> gpd { packageDescription = undefined }) - , ("genPackageFlags", \gpd -> gpd { genPackageFlags = undefined }) - , ("condLibrary", \gpd -> gpd { condLibrary = undefined }) - , ("condSubLibraries", \gpd -> gpd { condSubLibraries = undefined }) - , ("condForeignLibs", \gpd -> gpd { condForeignLibs = undefined }) - , ("condExecutables", \gpd -> gpd { condExecutables = undefined }) - , ("condTestSuites", \gpd -> gpd { condTestSuites = undefined }) - , ("condBenchmarks", \gpd -> gpd { condBenchmarks = undefined }) + [ ("packageDescriptionInternal", \gpd -> gpd { packageDescriptionInternal = undefined }) + , ("gpdScannedVersionInternal", \gpd -> gpd { gpdScannedVersionInternal = undefined }) + , ("genPackageFlagsInternal", \gpd -> gpd { genPackageFlagsInternal = undefined }) + , ("gpdCommonStanzas", \gpd -> gpd { gpdCommonStanzas = undefined }) + , ("condLibraryUnmerged", \gpd -> gpd { condLibraryUnmerged = undefined }) + , ("condSubLibrariesUnmerged", \gpd -> gpd { condSubLibrariesUnmerged = undefined }) + , ("condForeignLibsUnmerged", \gpd -> gpd { condForeignLibsUnmerged = undefined }) + , ("condExecutablesUnmerged", \gpd -> gpd { condExecutablesUnmerged = undefined }) + , ("condTestSuitesUnmerged", \gpd -> gpd { condTestSuitesUnmerged = undefined }) + , ("condBenchmarksUnmerged", \gpd -> gpd { condBenchmarksUnmerged = undefined }) ] gpdDeepseq :: Assertion diff --git a/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs b/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs index 129f8d0d85c..6be8ff30239 100644 --- a/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs +++ b/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs @@ -29,7 +29,7 @@ md5Check proxy md5Int = structureHash proxy @?= md5FromInteger md5Int md5CheckGenericPackageDescription :: Proxy GenericPackageDescription -> Assertion md5CheckGenericPackageDescription proxy = md5Check proxy - 0xc039c6741dead5203ad2b33bd3bf4dc8 + 0xf530c0714e09f028a58ab1527d235e0f md5CheckLocalBuildInfo :: Proxy LocalBuildInfo -> Assertion md5CheckLocalBuildInfo proxy = md5Check proxy diff --git a/Cabal-tests/tests/custom-setup/CabalDoctestSetup.hs b/Cabal-tests/tests/custom-setup/CabalDoctestSetup.hs index fc2268bad56..7f499e3b3aa 100644 --- a/Cabal-tests/tests/custom-setup/CabalDoctestSetup.hs +++ b/Cabal-tests/tests/custom-setup/CabalDoctestSetup.hs @@ -143,7 +143,9 @@ import Distribution.Types.UnqualComponentName import Distribution.PackageDescription (CondTree (..)) import Distribution.Types.GenericPackageDescription - (GenericPackageDescription (condTestSuites)) + ( GenericPackageDescription + , condTestSuites + ) import Distribution.Version (mkVersion) diff --git a/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs b/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs index f7e7ca5b7b6..06ad3db57e6 100644 --- a/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs +++ b/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs @@ -55,11 +55,53 @@ instance ToExpr Dependency where instance ToExpr (SymbolicPathX allowAbs from to) instance ToExpr a => ToExpr (InstallDirs a) +instance ToExpr a => ToExpr (WithImports a) + +instance + ( ToExpr a + , ToExpr b + , ToExpr c + , ToExpr d + , ToExpr e + , ToExpr f + , ToExpr g + ) => + ToExpr ( a + , b + , c + , d + , e + , f + , g + ) + +instance + ( ToExpr a + , ToExpr b + , ToExpr c + , ToExpr d + , ToExpr e + , ToExpr f + , ToExpr g + , ToExpr h + , ToExpr i + ) => + ToExpr ( a + , b + , c + , d + , e + , f + , g + , h + , i + ) instance ToExpr AbiDependency instance ToExpr AbiHash instance ToExpr Arch instance ToExpr Benchmark +instance ToExpr BenchmarkStanza instance ToExpr BenchmarkInterface instance ToExpr BenchmarkType instance ToExpr BuildInfo @@ -117,6 +159,7 @@ instance ToExpr SetupBuildInfo instance ToExpr SourceRepo instance ToExpr TestShowDetails instance ToExpr TestSuite +instance ToExpr TestSuiteStanza instance ToExpr TestSuiteInterface instance ToExpr TestType instance ToExpr UnitId diff --git a/Cabal/src/Distribution/PackageDescription/Check.hs b/Cabal/src/Distribution/PackageDescription/Check.hs index 0593ce8d905..27cb2aa5d55 100644 --- a/Cabal/src/Distribution/PackageDescription/Check.hs +++ b/Cabal/src/Distribution/PackageDescription/Check.hs @@ -238,8 +238,7 @@ checkGenericPackageDescription checkPackageDescription packageDescription_ -- Targets should be present... let condAllLibraries = - maybeToList condLibrary_ - ++ (map snd condSubLibraries_) + maybeToList condLibrary_ ++ map snd condSubLibraries_ checkP ( and [ null condExecutables_ @@ -958,24 +957,12 @@ pd2gpd pd = gpd gpd = emptyGenericPackageDescription { packageDescription = pd - , condLibrary = fmap t2c (library pd) + , condLibrary = t2c <$> (library pd) , condSubLibraries = map (t2cName ln id) (subLibraries pd) - , condForeignLibs = - map - (t2cName foreignLibName id) - (foreignLibs pd) - , condExecutables = - map - (t2cName exeName id) - (executables pd) - , condTestSuites = - map - (t2cName testName remTest) - (testSuites pd) - , condBenchmarks = - map - (t2cName benchmarkName remBench) - (benchmarks pd) + , condForeignLibs = map (t2cName foreignLibName id) (foreignLibs pd) + , condExecutables = map (t2cName exeName id) (executables pd) + , condTestSuites = map (t2cName testName remTest) (testSuites pd) + , condBenchmarks = map (t2cName benchmarkName remBench) (benchmarks pd) } -- From target to simple, unconditional CondTree. diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs b/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs index 72d0b8193e3..38dc41e0885 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs @@ -218,7 +218,7 @@ convGPD os arch cinfo constraints strfl solveExes pn libComps = [ (ExposedLib LMainLibName, libToComponentInfo lib) | lib <- maybeToList mlib ] subLibComps = [ (ExposedLib (LSubLibName name), libToComponentInfo lib) - | (name, lib) <- sub_libs ] + | (name, lib) <- sub_libs ] exeComps = [ ( ExposedExe name , ComponentInfo { compIsVisible = IsVisible True diff --git a/cabal-install/src/Distribution/Client/IndexUtils.hs b/cabal-install/src/Distribution/Client/IndexUtils.hs index f85db2b74c1..8d30ac06c73 100644 --- a/cabal-install/src/Distribution/Client/IndexUtils.hs +++ b/cabal-install/src/Distribution/Client/IndexUtils.hs @@ -4,6 +4,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} @@ -80,7 +81,17 @@ import Distribution.Package import Distribution.PackageDescription ( GenericPackageDescription (..) , PackageDescription (..) + , condBenchmarks + , condExecutables + , condForeignLibs + , condLibrary + , condSubLibraries + , condTestSuites , emptyPackageDescription + , genPackageFlags + , gpdScannedVersion + , packageDescription + , pattern GenericPackageDescription ) import Distribution.Simple.Compiler import qualified Distribution.Simple.Configure as Configure diff --git a/cabal-install/src/Distribution/Client/Install.hs b/cabal-install/src/Distribution/Client/Install.hs index bd28046db6e..fb779cc1029 100644 --- a/cabal-install/src/Distribution/Client/Install.hs +++ b/cabal-install/src/Distribution/Client/Install.hs @@ -163,8 +163,8 @@ import Distribution.Package , packageVersion ) import Distribution.PackageDescription - ( GenericPackageDescription (..) - , PackageDescription + ( PackageDescription + , genPackageFlags ) import qualified Distribution.PackageDescription as PackageDescription import Distribution.PackageDescription.Configuration diff --git a/cabal-install/src/Distribution/Client/ScriptUtils.hs b/cabal-install/src/Distribution/Client/ScriptUtils.hs index 1c78d537c19..4e437d28766 100644 --- a/cabal-install/src/Distribution/Client/ScriptUtils.hs +++ b/cabal-install/src/Distribution/Client/ScriptUtils.hs @@ -157,6 +157,7 @@ import Distribution.Types.Executable import Distribution.Types.GenericPackageDescription as GPD ( GenericPackageDescription (..) , emptyGenericPackageDescription + , packageDescription ) import Distribution.Types.PackageDescription ( PackageDescription (..) diff --git a/cabal-install/src/Distribution/Client/SetupWrapper.hs b/cabal-install/src/Distribution/Client/SetupWrapper.hs index 69c8f888698..f11790c7441 100644 --- a/cabal-install/src/Distribution/Client/SetupWrapper.hs +++ b/cabal-install/src/Distribution/Client/SetupWrapper.hs @@ -48,7 +48,7 @@ import Distribution.Package ) import Distribution.PackageDescription ( BuildType (..) - , GenericPackageDescription (packageDescription) + , packageDescription , PackageDescription (..) , buildType , specVersion