From 713e5116c440f2be8060ebac7c19181dbdd092b6 Mon Sep 17 00:00:00 2001 From: Colton Clemmer Date: Sat, 23 Apr 2022 16:36:24 -0500 Subject: [PATCH 01/12] Fix --ignore-project flag --- .../src/Distribution/Client/CmdSdist.hs | 7 ++-- .../src/Distribution/Client/ProjectConfig.hs | 7 ++-- .../Client/ProjectOrchestration.hs | 6 ++- .../Distribution/Client/ProjectPlanning.hs | 7 ++-- cabal-install/tests/IntegrationTests2.hs | 39 +++++++++++++------ .../build/ignore-project/A.hs | 4 ++ .../build/ignore-project/Setup.hs | 2 + .../build/ignore-project/a.cabal | 10 +++++ .../build/ignore-project/cabal.project | 3 ++ 9 files changed, 62 insertions(+), 23 deletions(-) create mode 100644 cabal-install/tests/IntegrationTests2/build/ignore-project/A.hs create mode 100644 cabal-install/tests/IntegrationTests2/build/ignore-project/Setup.hs create mode 100644 cabal-install/tests/IntegrationTests2/build/ignore-project/a.cabal create mode 100644 cabal-install/tests/IntegrationTests2/build/ignore-project/cabal.project diff --git a/cabal-install/src/Distribution/Client/CmdSdist.hs b/cabal-install/src/Distribution/Client/CmdSdist.hs index d4f87074a2a..f193901f727 100644 --- a/cabal-install/src/Distribution/Client/CmdSdist.hs +++ b/cabal-install/src/Distribution/Client/CmdSdist.hs @@ -27,9 +27,9 @@ import Distribution.Solver.Types.SourcePackage import Distribution.Client.Types ( PackageSpecifier(..), PackageLocation(..), UnresolvedSourcePackage ) import Distribution.Client.DistDirLayout - ( DistDirLayout(..), ProjectRoot (..) ) + ( DistDirLayout(..), ProjectRoot (..), CabalDirLayout (cabalLogsDirectory) ) import Distribution.Client.ProjectConfig - ( ProjectConfig, withProjectOrGlobalConfig, commandLineFlagsToProjectConfig, projectConfigConfigFile, projectConfigShared ) + ( ProjectConfig (projectPackagesOptional, projectConfigAllPackages), withProjectOrGlobalConfig, commandLineFlagsToProjectConfig, projectConfigConfigFile, projectConfigShared, PackageConfig (packageConfigTests), projectPackages ) import Distribution.Client.ProjectFlags ( ProjectFlags (..), defaultProjectFlags, projectFlagsOptions ) @@ -174,7 +174,6 @@ sdistAction (ProjectFlags{..}, SdistFlags{..}) targetStrings globalFlags = do | listSources -> "-" | otherwise -> distSdistFile distDirLayout (packageId pkg) - case reifyTargetSelectors localPkgs targetSelectors of Left errs -> die' verbosity . unlines . fmap renderTargetProblem $ errs Right pkgs @@ -210,7 +209,7 @@ sdistAction (ProjectFlags{..}, SdistFlags{..}) targetStrings globalFlags = do withoutProject :: ProjectConfig -> IO (ProjectBaseContext, DistDirLayout) withoutProject config = do cwd <- getCurrentDirectory - baseCtx <- establishProjectBaseContextWithRoot verbosity (config <> prjConfig) (ProjectRootImplicit cwd) OtherCommand + baseCtx <- establishProjectBaseContextWithRoot verbosity (config <> prjConfig) True (ProjectRootImplicit cwd) OtherCommand return (baseCtx, distDirLayout baseCtx) data OutputFormat = SourceList Char diff --git a/cabal-install/src/Distribution/Client/ProjectConfig.hs b/cabal-install/src/Distribution/Client/ProjectConfig.hs index 0883e4cea74..f649cba94de 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig.hs @@ -504,15 +504,17 @@ withProjectOrGlobalConfig' verbosity globalConfigFlag with without = do -- readProjectConfig :: Verbosity -> HttpTransport + -> Bool -> Flag FilePath -> DistDirLayout -> Rebuild ProjectConfigSkeleton -readProjectConfig verbosity httpTransport configFileFlag distDirLayout = do +readProjectConfig verbosity httpTransport ignoreProjectFlag configFileFlag distDirLayout = do global <- singletonProjectConfigSkeleton <$> readGlobalConfig verbosity configFileFlag local <- readProjectLocalConfigOrDefault verbosity httpTransport distDirLayout freeze <- readProjectLocalFreezeConfig verbosity httpTransport distDirLayout extra <- readProjectLocalExtraConfig verbosity httpTransport distDirLayout - return (global <> local <> freeze <> extra) + if ignoreProjectFlag then return global + else return (global <> local <> freeze <> extra) -- | Reads an explicit @cabal.project@ file in the given project root dir, @@ -793,7 +795,6 @@ findProjectPackages DistDirLayout{distProjectRootDirectory} optionalPkgs <- findPackageLocations False projectPackagesOptional let repoPkgs = map ProjectPackageRemoteRepo projectPackagesRepo namedPkgs = map ProjectPackageNamed projectPackagesNamed - return (concat [requiredPkgs, optionalPkgs, repoPkgs, namedPkgs]) where findPackageLocations :: Bool -> [String] -> Rebuild [ProjectPackageLocation] diff --git a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs index d7933b6c2a9..549ab02cbe7 100644 --- a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs +++ b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs @@ -209,7 +209,7 @@ establishProjectBaseContext -> IO ProjectBaseContext establishProjectBaseContext verbosity cliConfig currentCommand = do projectRoot <- either throwIO return =<< findProjectRoot Nothing mprojectFile - establishProjectBaseContextWithRoot verbosity cliConfig projectRoot currentCommand + establishProjectBaseContextWithRoot verbosity cliConfig False projectRoot currentCommand where mprojectFile = Setup.flagToMaybe projectConfigProjectFile ProjectConfigShared { projectConfigProjectFile} = projectConfigShared cliConfig @@ -218,10 +218,11 @@ establishProjectBaseContext verbosity cliConfig currentCommand = do establishProjectBaseContextWithRoot :: Verbosity -> ProjectConfig + -> Bool -> ProjectRoot -> CurrentCommand -> IO ProjectBaseContext -establishProjectBaseContextWithRoot verbosity cliConfig projectRoot currentCommand = do +establishProjectBaseContextWithRoot verbosity cliConfig ignoreLocalProjectFile projectRoot currentCommand = do cabalDir <- getCabalDir let distDirLayout = defaultDistDirLayout projectRoot mdistDirectory @@ -233,6 +234,7 @@ establishProjectBaseContextWithRoot verbosity cliConfig projectRoot currentComma (projectConfig, localPackages) <- rebuildProjectConfig verbosity httpTransport + ignoreLocalProjectFile distDirLayout cliConfig diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index 2e447c2cdff..3b07d57af0f 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -304,12 +304,14 @@ sanityCheckElaboratedPackage ElaboratedConfiguredPackage{..} -- rebuildProjectConfig :: Verbosity -> HttpTransport + -> Bool -> DistDirLayout -> ProjectConfig -> IO ( ProjectConfig , [PackageSpecifier UnresolvedSourcePackage] ) rebuildProjectConfig verbosity httpTransport + ignoreLocalProjectFile distDirLayout@DistDirLayout { distProjectRootDirectory, distDirectory, @@ -318,7 +320,7 @@ rebuildProjectConfig verbosity distProjectFile } cliConfig = do - + fileMonitorProjectConfigKey <- do configPath <- getConfigFilePath projectConfigConfigFile return (configPath, distProjectFile "") @@ -364,7 +366,7 @@ rebuildProjectConfig verbosity -- phaseReadProjectConfig :: Rebuild ProjectConfigSkeleton phaseReadProjectConfig = do - readProjectConfig verbosity httpTransport projectConfigConfigFile distDirLayout + readProjectConfig verbosity httpTransport ignoreLocalProjectFile projectConfigConfigFile distDirLayout -- Look for all the cabal packages in the project -- some of which may be local src dirs, tarballs etc @@ -376,7 +378,6 @@ rebuildProjectConfig verbosity projectConfigBuildOnly } = do pkgLocations <- findProjectPackages distDirLayout projectConfig - -- Create folder only if findProjectPackages did not throw a -- BadPackageLocations exception. liftIO $ do diff --git a/cabal-install/tests/IntegrationTests2.hs b/cabal-install/tests/IntegrationTests2.hs index 94fbac61578..cb303ef73fd 100644 --- a/cabal-install/tests/IntegrationTests2.hs +++ b/cabal-install/tests/IntegrationTests2.hs @@ -53,6 +53,7 @@ import Distribution.Simple.Setup (toFlag, HaddockFlags(..), defaultHaddockFlags) import Distribution.Client.Setup (globalCommand) import Distribution.Simple.Compiler import Distribution.Simple.Command +import qualified Distribution.Simple.Flag as Flg import Distribution.System import Distribution.Version import Distribution.ModuleName (ModuleName) @@ -147,7 +148,8 @@ tests config = ] , testGroup "Flag tests" $ [ - testCase "Test Nix Flag" testNixFlags + testCase "Test Nix Flag" testNixFlags, + testCase "Test Ignore Project Flag" testIgnoreProjectFlag ] ] @@ -172,7 +174,7 @@ testExceptionFindProjectRoot = do testTargetSelectors :: (String -> IO ()) -> Assertion testTargetSelectors reportSubCase = do - (_, _, _, localPackages, _) <- configureProject testdir config + (_, _, _, localPackages, _) <- configureProject False testdir config let readTargetSelectors' = readTargetSelectorsWith (dirActions testdir) localPackages Nothing @@ -284,7 +286,7 @@ testTargetSelectors reportSubCase = do testTargetSelectorBadSyntax :: Assertion testTargetSelectorBadSyntax = do - (_, _, _, localPackages, _) <- configureProject testdir config + (_, _, _, localPackages, _) <- configureProject False testdir config let targets = [ "foo bar", " foo" , "foo:", "foo::bar" , "foo: ", "foo: :bar" @@ -526,7 +528,7 @@ instance IsString PackageIdentifier where testTargetSelectorNoCurrentPackage :: Assertion testTargetSelectorNoCurrentPackage = do - (_, _, _, localPackages, _) <- configureProject testdir config + (_, _, _, localPackages, _) <- configureProject False testdir config let readTargetSelectors' = readTargetSelectorsWith (dirActions testdir) localPackages Nothing @@ -549,7 +551,7 @@ testTargetSelectorNoCurrentPackage = do testTargetSelectorNoTargets :: Assertion testTargetSelectorNoTargets = do - (_, _, _, localPackages, _) <- configureProject testdir config + (_, _, _, localPackages, _) <- configureProject False testdir config Left errs <- readTargetSelectors localPackages Nothing [] errs @?= [TargetSelectorNoTargetsInCwd True] cleanProject testdir @@ -560,7 +562,7 @@ testTargetSelectorNoTargets = do testTargetSelectorProjectEmpty :: Assertion testTargetSelectorProjectEmpty = do - (_, _, _, localPackages, _) <- configureProject testdir config + (_, _, _, localPackages, _) <- configureProject False testdir config Left errs <- readTargetSelectors localPackages Nothing [] errs @?= [TargetSelectorNoTargetsInProject] cleanProject testdir @@ -574,7 +576,7 @@ testTargetSelectorProjectEmpty = do -- drive capitalisation mismatch when no targets are given testTargetSelectorCanonicalizedPath :: Assertion testTargetSelectorCanonicalizedPath = do - (_, _, _, localPackages, _) <- configureProject testdir config + (_, _, _, localPackages, _) <- configureProject False testdir config cwd <- getCurrentDirectory let virtcwd = cwd basedir symlink -- Check that the symlink is there before running test as on Windows @@ -1674,8 +1676,8 @@ type ProjDetails = (DistDirLayout, [PackageSpecifier UnresolvedSourcePackage], BuildTimeSettings) -configureProject :: FilePath -> ProjectConfig -> IO ProjDetails -configureProject testdir cliConfig = do +configureProject :: Bool -> FilePath -> ProjectConfig -> IO ProjDetails +configureProject ignoreLocalProject testdir cliConfig = do cabalDir <- getCabalDir let cabalDirLayout = defaultCabalDirLayout cabalDir @@ -1696,6 +1698,7 @@ configureProject testdir cliConfig = do (projectConfig, localPackages) <- rebuildProjectConfig verbosity httpTransport + ignoreLocalProject distDirLayout cliConfig @@ -1721,7 +1724,7 @@ planProject testdir cliConfig = do cabalDirLayout, projectConfig, localPackages, - _buildSettings) <- configureProject testdir cliConfig + _buildSettings) <- configureProject False testdir cliConfig (elaboratedPlan, _, elaboratedShared, _, _) <- rebuildInstallPlan verbosity @@ -1960,4 +1963,18 @@ testNixFlags = do fromFlag NoFlag = Nothing getFlags :: CommandUI GlobalFlags -> CommandParse (GlobalFlags -> GlobalFlags, [String]) -> Maybe GlobalFlags getFlags cui (CommandReadyToGo (mkflags, _)) = Just . mkflags . commandDefaultFlags $ cui - getFlags _ _ = Nothing \ No newline at end of file + getFlags _ _ = Nothing + +testIgnoreProjectFlag :: Assertion +testIgnoreProjectFlag = do + -- Coverage flag should be false globally by default (~/.cabal folder) + (_, _, prjConfigGlobal, _, _) <- configureProject True testdir emptyConfig + let globalCoverageFlag = packageConfigCoverage . projectConfigLocalPackages $ prjConfigGlobal + False @=? Flg.fromFlagOrDefault False globalCoverageFlag + -- It is set to true in the cabal.project file + (_, _, prjConfigLocal, _, _) <- configureProject False testdir emptyConfig + let localCoverageFlag = packageConfigCoverage . projectConfigLocalPackages $ prjConfigLocal + True @=? Flg.fromFlagOrDefault False localCoverageFlag + where + testdir = "build/ignore-project" + emptyConfig = mempty \ No newline at end of file diff --git a/cabal-install/tests/IntegrationTests2/build/ignore-project/A.hs b/cabal-install/tests/IntegrationTests2/build/ignore-project/A.hs new file mode 100644 index 00000000000..9dcbc07578f --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/build/ignore-project/A.hs @@ -0,0 +1,4 @@ +module A where + +a :: Int +a = 42 diff --git a/cabal-install/tests/IntegrationTests2/build/ignore-project/Setup.hs b/cabal-install/tests/IntegrationTests2/build/ignore-project/Setup.hs new file mode 100644 index 00000000000..9a994af677b --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/build/ignore-project/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cabal-install/tests/IntegrationTests2/build/ignore-project/a.cabal b/cabal-install/tests/IntegrationTests2/build/ignore-project/a.cabal new file mode 100644 index 00000000000..e5830a70b26 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/build/ignore-project/a.cabal @@ -0,0 +1,10 @@ +name: a +version: 0.1 +build-type: Simple +cabal-version: >= 1.10 + +library + exposed-modules: A + build-depends: base + default-language: Haskell2010 + profiling: true \ No newline at end of file diff --git a/cabal-install/tests/IntegrationTests2/build/ignore-project/cabal.project b/cabal-install/tests/IntegrationTests2/build/ignore-project/cabal.project new file mode 100644 index 00000000000..3b1b4b67d20 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/build/ignore-project/cabal.project @@ -0,0 +1,3 @@ +packages: . + +coverage: true \ No newline at end of file From 3cfa9b6342b7c4ec8008f62d099be4d958f842e7 Mon Sep 17 00:00:00 2001 From: Colton Clemmer Date: Sat, 23 Apr 2022 16:42:18 -0500 Subject: [PATCH 02/12] Remove unused imports --- cabal-install/src/Distribution/Client/CmdSdist.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdSdist.hs b/cabal-install/src/Distribution/Client/CmdSdist.hs index f193901f727..aff9d90983a 100644 --- a/cabal-install/src/Distribution/Client/CmdSdist.hs +++ b/cabal-install/src/Distribution/Client/CmdSdist.hs @@ -27,9 +27,9 @@ import Distribution.Solver.Types.SourcePackage import Distribution.Client.Types ( PackageSpecifier(..), PackageLocation(..), UnresolvedSourcePackage ) import Distribution.Client.DistDirLayout - ( DistDirLayout(..), ProjectRoot (..), CabalDirLayout (cabalLogsDirectory) ) + ( DistDirLayout(..), ProjectRoot (..) ) import Distribution.Client.ProjectConfig - ( ProjectConfig (projectPackagesOptional, projectConfigAllPackages), withProjectOrGlobalConfig, commandLineFlagsToProjectConfig, projectConfigConfigFile, projectConfigShared, PackageConfig (packageConfigTests), projectPackages ) + ( ProjectConfig, withProjectOrGlobalConfig, commandLineFlagsToProjectConfig, projectConfigConfigFile, projectConfigShared ) import Distribution.Client.ProjectFlags ( ProjectFlags (..), defaultProjectFlags, projectFlagsOptions ) From 9a2ff3e4e4db624088d291f617fc412a0d500c1f Mon Sep 17 00:00:00 2001 From: Colton Clemmer Date: Sat, 23 Apr 2022 16:45:14 -0500 Subject: [PATCH 03/12] Undo whitespace changes --- cabal-install/src/Distribution/Client/CmdSdist.hs | 1 + cabal-install/src/Distribution/Client/ProjectConfig.hs | 1 + cabal-install/src/Distribution/Client/ProjectPlanning.hs | 3 ++- 3 files changed, 4 insertions(+), 1 deletion(-) diff --git a/cabal-install/src/Distribution/Client/CmdSdist.hs b/cabal-install/src/Distribution/Client/CmdSdist.hs index aff9d90983a..7141a19e818 100644 --- a/cabal-install/src/Distribution/Client/CmdSdist.hs +++ b/cabal-install/src/Distribution/Client/CmdSdist.hs @@ -174,6 +174,7 @@ sdistAction (ProjectFlags{..}, SdistFlags{..}) targetStrings globalFlags = do | listSources -> "-" | otherwise -> distSdistFile distDirLayout (packageId pkg) + case reifyTargetSelectors localPkgs targetSelectors of Left errs -> die' verbosity . unlines . fmap renderTargetProblem $ errs Right pkgs diff --git a/cabal-install/src/Distribution/Client/ProjectConfig.hs b/cabal-install/src/Distribution/Client/ProjectConfig.hs index f649cba94de..f4d38d64fc4 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig.hs @@ -795,6 +795,7 @@ findProjectPackages DistDirLayout{distProjectRootDirectory} optionalPkgs <- findPackageLocations False projectPackagesOptional let repoPkgs = map ProjectPackageRemoteRepo projectPackagesRepo namedPkgs = map ProjectPackageNamed projectPackagesNamed + return (concat [requiredPkgs, optionalPkgs, repoPkgs, namedPkgs]) where findPackageLocations :: Bool -> [String] -> Rebuild [ProjectPackageLocation] diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index 3b07d57af0f..a537032d30e 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -320,7 +320,7 @@ rebuildProjectConfig verbosity distProjectFile } cliConfig = do - + fileMonitorProjectConfigKey <- do configPath <- getConfigFilePath projectConfigConfigFile return (configPath, distProjectFile "") @@ -377,6 +377,7 @@ rebuildProjectConfig verbosity projectConfigShared, projectConfigBuildOnly } = do + pkgLocations <- findProjectPackages distDirLayout projectConfig -- Create folder only if findProjectPackages did not throw a -- BadPackageLocations exception. From 1437fb77e06220ad7dcba18719c2b778c379ae23 Mon Sep 17 00:00:00 2001 From: Colton Clemmer Date: Sat, 23 Apr 2022 17:22:05 -0500 Subject: [PATCH 04/12] Merge local foo.cabal file with global config --- .../src/Distribution/Client/ProjectConfig.hs | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/cabal-install/src/Distribution/Client/ProjectConfig.hs b/cabal-install/src/Distribution/Client/ProjectConfig.hs index f4d38d64fc4..85290860a7c 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig.hs @@ -513,7 +513,7 @@ readProjectConfig verbosity httpTransport ignoreProjectFlag configFileFlag distD local <- readProjectLocalConfigOrDefault verbosity httpTransport distDirLayout freeze <- readProjectLocalFreezeConfig verbosity httpTransport distDirLayout extra <- readProjectLocalExtraConfig verbosity httpTransport distDirLayout - if ignoreProjectFlag then return global + if ignoreProjectFlag then return (global <> (singletonProjectConfigSkeleton defaultImplicitProjectConfig)) else return (global <> local <> freeze <> extra) @@ -537,14 +537,13 @@ readProjectLocalConfigOrDefault verbosity httpTransport distDirLayout = do projectFile :: FilePath projectFile = distProjectFile distDirLayout "" - defaultImplicitProjectConfig :: ProjectConfig - defaultImplicitProjectConfig = - mempty { - -- We expect a package in the current directory. - projectPackages = [ "./*.cabal" ], +defaultImplicitProjectConfig :: ProjectConfig +defaultImplicitProjectConfig = mempty { + -- We expect a package in the current directory. + projectPackages = [ "./*.cabal" ], - projectConfigProvenance = Set.singleton Implicit - } + projectConfigProvenance = Set.singleton Implicit +} -- | Reads a @cabal.project.local@ file in the given project root dir, -- or returns empty. This file gets written by @cabal configure@, or in From 9d00a8efde44cb21c2c04a47e19f0cbc7e076bf8 Mon Sep 17 00:00:00 2001 From: Colton Clemmer Date: Sat, 23 Apr 2022 17:23:27 -0500 Subject: [PATCH 05/12] Add changelog file --- changelog.d/issue-7965 | 4 ++++ 1 file changed, 4 insertions(+) create mode 100644 changelog.d/issue-7965 diff --git a/changelog.d/issue-7965 b/changelog.d/issue-7965 new file mode 100644 index 00000000000..21ee88844d5 --- /dev/null +++ b/changelog.d/issue-7965 @@ -0,0 +1,4 @@ +synopsis: Ensure that v2-sdist command respects the --ignore-project flag +packages: cabal-install +issues: #7965 +prs: #8109 \ No newline at end of file From ec035b47a70bbe51b1940459facb448a85769aec Mon Sep 17 00:00:00 2001 From: Colton Clemmer Date: Sat, 23 Apr 2022 20:19:59 -0500 Subject: [PATCH 06/12] Ensure that --project-file flag overrides --ignore-project-flag --- cabal-install/src/Distribution/Client/ProjectFlags.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/cabal-install/src/Distribution/Client/ProjectFlags.hs b/cabal-install/src/Distribution/Client/ProjectFlags.hs index 6884708b30e..7871b2945fb 100644 --- a/cabal-install/src/Distribution/Client/ProjectFlags.hs +++ b/cabal-install/src/Distribution/Client/ProjectFlags.hs @@ -14,7 +14,7 @@ import Distribution.ReadE (succeedReadE) import Distribution.Simple.Command ( MkOptDescr, OptionField(optionName), ShowOrParseArgs (..), boolOpt', option , reqArg ) -import Distribution.Simple.Setup (Flag (..), flagToList, flagToMaybe, toFlag, trueArg) +import Distribution.Simple.Setup (Flag (..), flagToList, flagToMaybe, toFlag, trueArg, fromFlagOrDefault) data ProjectFlags = ProjectFlags { flagProjectFileName :: Flag FilePath @@ -47,7 +47,8 @@ projectFlagsOptions showOrParseArgs = (reqArg "FILE" (succeedReadE Flag) flagToList) , option ['z'] ["ignore-project"] "Ignore local project configuration" - flagIgnoreProject (\v flags -> flags { flagIgnoreProject = v }) + -- If the "--project-file" flag is set, then this will always be false + flagIgnoreProject (\v flags -> flags { flagIgnoreProject = toFlag (not ((not (fromFlagOrDefault False v)) || (NoFlag /= (flagProjectFileName flags)))) }) (yesNoOpt showOrParseArgs) ] From c2ee7714f23a338ef9a28f108fde8c871ded90aa Mon Sep 17 00:00:00 2001 From: Colton Clemmer Date: Sat, 30 Apr 2022 18:04:06 -0500 Subject: [PATCH 07/12] Change default definition --- .../src/Distribution/Client/ProjectConfig.hs | 21 +++++++++++-------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/cabal-install/src/Distribution/Client/ProjectConfig.hs b/cabal-install/src/Distribution/Client/ProjectConfig.hs index 85290860a7c..55a199f9df6 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig.hs @@ -513,9 +513,13 @@ readProjectConfig verbosity httpTransport ignoreProjectFlag configFileFlag distD local <- readProjectLocalConfigOrDefault verbosity httpTransport distDirLayout freeze <- readProjectLocalFreezeConfig verbosity httpTransport distDirLayout extra <- readProjectLocalExtraConfig verbosity httpTransport distDirLayout - if ignoreProjectFlag then return (global <> (singletonProjectConfigSkeleton defaultImplicitProjectConfig)) + if ignoreProjectFlag then return (global <> (singletonProjectConfigSkeleton defaultProject)) else return (global <> local <> freeze <> extra) - + where + defaultProject :: ProjectConfig + defaultProject = mempty { + projectPackages = ["./"] + } -- | Reads an explicit @cabal.project@ file in the given project root dir, -- or returns the default project config for an implicitly defined project. @@ -536,14 +540,13 @@ readProjectLocalConfigOrDefault verbosity httpTransport distDirLayout = do where projectFile :: FilePath projectFile = distProjectFile distDirLayout "" + defaultImplicitProjectConfig :: ProjectConfig + defaultImplicitProjectConfig = mempty { + -- We expect a package in the current directory. + projectPackages = [ "./*.cabal" ], -defaultImplicitProjectConfig :: ProjectConfig -defaultImplicitProjectConfig = mempty { - -- We expect a package in the current directory. - projectPackages = [ "./*.cabal" ], - - projectConfigProvenance = Set.singleton Implicit -} + projectConfigProvenance = Set.singleton Implicit + } -- | Reads a @cabal.project.local@ file in the given project root dir, -- or returns empty. This file gets written by @cabal configure@, or in From 8b13d6a1b2d9d1e9cc17409ca52bdf31dee7dbcc Mon Sep 17 00:00:00 2001 From: Colton Clemmer Date: Sat, 30 Apr 2022 18:05:25 -0500 Subject: [PATCH 08/12] Fix tests --- cabal-testsuite/PackageTests/Regression/T5318/cabal.project | 1 + .../PackageTests/Regression/T5318/sdist-list-sources.test.hs | 2 +- cabal-testsuite/PackageTests/SDist/T5195/cabal.project | 1 + cabal-testsuite/PackageTests/SDist/T5195/cabal.test.hs | 2 +- cabal-testsuite/PackageTests/SDist/T7028/cabal.test.hs | 2 +- cabal-testsuite/PackageTests/SDist/T7124/cabal-list.test.hs | 2 +- cabal-testsuite/PackageTests/SDist/T7124/cabal.test.hs | 2 +- cabal-testsuite/PackageTests/SDist/T7698/cabal.test.hs | 2 +- 8 files changed, 8 insertions(+), 6 deletions(-) create mode 100644 cabal-testsuite/PackageTests/Regression/T5318/cabal.project create mode 100644 cabal-testsuite/PackageTests/SDist/T5195/cabal.project diff --git a/cabal-testsuite/PackageTests/Regression/T5318/cabal.project b/cabal-testsuite/PackageTests/Regression/T5318/cabal.project new file mode 100644 index 00000000000..6f920794c80 --- /dev/null +++ b/cabal-testsuite/PackageTests/Regression/T5318/cabal.project @@ -0,0 +1 @@ +packages: ./ diff --git a/cabal-testsuite/PackageTests/Regression/T5318/sdist-list-sources.test.hs b/cabal-testsuite/PackageTests/Regression/T5318/sdist-list-sources.test.hs index 3c68fbc9d75..f5d95cc9eaf 100644 --- a/cabal-testsuite/PackageTests/Regression/T5318/sdist-list-sources.test.hs +++ b/cabal-testsuite/PackageTests/Regression/T5318/sdist-list-sources.test.hs @@ -2,6 +2,6 @@ import Test.Cabal.Prelude main = cabalTest $ do tmpdir <- fmap testTmpDir getTestEnv let fn = tmpdir "empty-data-dir-0.list" - cabal "v2-sdist" ["--ignore-project", "--list-only", "--output-directory", tmpdir] + cabal "v2-sdist" ["--list-only", "--output-directory", tmpdir] -- --list-sources outputs with slashes on posix and backslashes on Windows. 'normalise' converts our needle to the necessary format. assertFileDoesContain fn $ normalise "foo.dat" diff --git a/cabal-testsuite/PackageTests/SDist/T5195/cabal.project b/cabal-testsuite/PackageTests/SDist/T5195/cabal.project new file mode 100644 index 00000000000..bfe62896560 --- /dev/null +++ b/cabal-testsuite/PackageTests/SDist/T5195/cabal.project @@ -0,0 +1 @@ +packages: ./ \ No newline at end of file diff --git a/cabal-testsuite/PackageTests/SDist/T5195/cabal.test.hs b/cabal-testsuite/PackageTests/SDist/T5195/cabal.test.hs index cb252f135e9..c0ff953560b 100644 --- a/cabal-testsuite/PackageTests/SDist/T5195/cabal.test.hs +++ b/cabal-testsuite/PackageTests/SDist/T5195/cabal.test.hs @@ -1,5 +1,5 @@ import Test.Cabal.Prelude main = cabalTest $ do tmpdir <- fmap testTmpDir getTestEnv - res <- fails $ cabal' "v2-sdist" ["--ignore-project", "--list-only", "--output-directory", tmpdir] + res <- fails $ cabal' "v2-sdist" ["--list-only", "--output-directory", tmpdir] assertOutputContains "filepath wildcard './actually-a-directory' does not match any files" res diff --git a/cabal-testsuite/PackageTests/SDist/T7028/cabal.test.hs b/cabal-testsuite/PackageTests/SDist/T7028/cabal.test.hs index 42e1f616313..2fa53d6a63a 100644 --- a/cabal-testsuite/PackageTests/SDist/T7028/cabal.test.hs +++ b/cabal-testsuite/PackageTests/SDist/T7028/cabal.test.hs @@ -1,4 +1,4 @@ import Test.Cabal.Prelude main = cabalTest $ do tmpdir <- fmap testTmpDir getTestEnv - cabal "v2-sdist" ["--ignore-project", "--list-only", "--output-directory", tmpdir, "t7028"] + cabal "v2-sdist" ["--list-only", "--output-directory", tmpdir, "t7028"] diff --git a/cabal-testsuite/PackageTests/SDist/T7124/cabal-list.test.hs b/cabal-testsuite/PackageTests/SDist/T7124/cabal-list.test.hs index c5d2dd1fc0a..6d87bc30da7 100644 --- a/cabal-testsuite/PackageTests/SDist/T7124/cabal-list.test.hs +++ b/cabal-testsuite/PackageTests/SDist/T7124/cabal-list.test.hs @@ -6,4 +6,4 @@ import Test.Cabal.Prelude main :: IO () main = cabalTest $ do tmpdir <- fmap testTmpDir getTestEnv - fails $ cabal "v2-sdist" ["--ignore-project", "--list-only", "--output-directory", tmpdir, "all"] + fails $ cabal "v2-sdist" ["--list-only", "--output-directory", tmpdir, "all"] diff --git a/cabal-testsuite/PackageTests/SDist/T7124/cabal.test.hs b/cabal-testsuite/PackageTests/SDist/T7124/cabal.test.hs index b482cc0f7bf..5e69370a088 100644 --- a/cabal-testsuite/PackageTests/SDist/T7124/cabal.test.hs +++ b/cabal-testsuite/PackageTests/SDist/T7124/cabal.test.hs @@ -6,4 +6,4 @@ import Test.Cabal.Prelude main :: IO () main = cabalTest $ do tmpdir <- fmap testTmpDir getTestEnv - fails $ cabal "v2-sdist" ["--ignore-project", "--output-directory", tmpdir, "all"] + fails $ cabal "v2-sdist" ["--output-directory", tmpdir, "all"] diff --git a/cabal-testsuite/PackageTests/SDist/T7698/cabal.test.hs b/cabal-testsuite/PackageTests/SDist/T7698/cabal.test.hs index acd42461a38..87598963710 100644 --- a/cabal-testsuite/PackageTests/SDist/T7698/cabal.test.hs +++ b/cabal-testsuite/PackageTests/SDist/T7698/cabal.test.hs @@ -1,4 +1,4 @@ import Test.Cabal.Prelude main = cabalTest $ do tmpdir <- fmap testTmpDir getTestEnv - cabal "v2-sdist" ["--ignore-project", "--list-only", "--output-directory", tmpdir, "all"] + cabal "v2-sdist" ["--list-only", "--output-directory", tmpdir, "all"] From b164f51deab02218fe2329d0c78e6a513208fff9 Mon Sep 17 00:00:00 2001 From: Colton Clemmer Date: Mon, 2 May 2022 15:01:51 -0500 Subject: [PATCH 09/12] Update docs --- changelog.d/issue-7965 | 1 + doc/cabal-project.rst | 7 +++++++ 2 files changed, 8 insertions(+) diff --git a/changelog.d/issue-7965 b/changelog.d/issue-7965 index 21ee88844d5..093d91f20a0 100644 --- a/changelog.d/issue-7965 +++ b/changelog.d/issue-7965 @@ -1,4 +1,5 @@ synopsis: Ensure that v2-sdist command respects the --ignore-project flag +-- If the "--project-file" flag is set, then this [--ignore-project] will always be false packages: cabal-install issues: #7965 prs: #8109 \ No newline at end of file diff --git a/doc/cabal-project.rst b/doc/cabal-project.rst index c9b7c3bd309..f548b968f20 100644 --- a/doc/cabal-project.rst +++ b/doc/cabal-project.rst @@ -295,6 +295,13 @@ package, and thus apply globally: This option cannot be specified via a ``cabal.project`` file. +-- option:: --ignore-project + + Ignores the local ``cabal.project`` file and uses the default + configuration with the local ``foo.cabal`` file. Note that + if this flag is set while the ``--project-file`` flag is also + set then this flag will be ignored. + .. option:: --store-dir=DIR Specifies the name of the directory of the global package store. From 0338592ff220843ebb595cb3cfd200e6095a0de3 Mon Sep 17 00:00:00 2001 From: Colton Clemmer Date: Mon, 2 May 2022 15:40:38 -0500 Subject: [PATCH 10/12] Refactor --ignore-project flag parameter to be a flag instead of a bool --- .../src/Distribution/Client/CmdSdist.hs | 5 ++-- .../src/Distribution/Client/ProjectConfig.hs | 6 ++--- .../src/Distribution/Client/ProjectFlags.hs | 8 ++++--- .../Client/ProjectOrchestration.hs | 8 +++---- .../Distribution/Client/ProjectPlanning.hs | 6 ++--- cabal-install/tests/IntegrationTests2.hs | 24 +++++++++---------- 6 files changed, 29 insertions(+), 28 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdSdist.hs b/cabal-install/src/Distribution/Client/CmdSdist.hs index 7141a19e818..92a9e54a95f 100644 --- a/cabal-install/src/Distribution/Client/CmdSdist.hs +++ b/cabal-install/src/Distribution/Client/CmdSdist.hs @@ -138,7 +138,7 @@ sdistOptions showOrParseArgs = sdistAction :: (ProjectFlags, SdistFlags) -> [String] -> GlobalFlags -> IO () sdistAction (ProjectFlags{..}, SdistFlags{..}) targetStrings globalFlags = do - (baseCtx, distDirLayout) <- withProjectOrGlobalConfig verbosity ignoreProject globalConfigFlag withProject withoutProject + (baseCtx, distDirLayout) <- withProjectOrGlobalConfig verbosity flagIgnoreProject globalConfigFlag withProject withoutProject let localPkgs = localPackages baseCtx @@ -187,7 +187,6 @@ sdistAction (ProjectFlags{..}, SdistFlags{..}) targetStrings globalFlags = do listSources = fromFlagOrDefault False sdistListSources nulSeparated = fromFlagOrDefault False sdistNulSeparated mOutputPath = flagToMaybe sdistOutputPath - ignoreProject = flagIgnoreProject prjConfig :: ProjectConfig prjConfig = commandLineFlagsToProjectConfig @@ -210,7 +209,7 @@ sdistAction (ProjectFlags{..}, SdistFlags{..}) targetStrings globalFlags = do withoutProject :: ProjectConfig -> IO (ProjectBaseContext, DistDirLayout) withoutProject config = do cwd <- getCurrentDirectory - baseCtx <- establishProjectBaseContextWithRoot verbosity (config <> prjConfig) True (ProjectRootImplicit cwd) OtherCommand + baseCtx <- establishProjectBaseContextWithRoot verbosity (config <> prjConfig) flagIgnoreProject (ProjectRootImplicit cwd) OtherCommand return (baseCtx, distDirLayout baseCtx) data OutputFormat = SourceList Char diff --git a/cabal-install/src/Distribution/Client/ProjectConfig.hs b/cabal-install/src/Distribution/Client/ProjectConfig.hs index 55a199f9df6..30c1fb87bdb 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig.hs @@ -462,7 +462,7 @@ renderBadProjectRoot (BadProjectRootExplicitFile projectFile) = withProjectOrGlobalConfig :: Verbosity -- ^ verbosity - -> Flag Bool -- ^ whether to ignore local project + -> Flag Bool -- ^ whether to ignore local project (--ignore-project flag) -> Flag FilePath -- ^ @--cabal-config@ -> IO a -- ^ with project -> (ProjectConfig -> IO a) -- ^ without projet @@ -504,7 +504,7 @@ withProjectOrGlobalConfig' verbosity globalConfigFlag with without = do -- readProjectConfig :: Verbosity -> HttpTransport - -> Bool + -> Flag Bool -> Flag FilePath -> DistDirLayout -> Rebuild ProjectConfigSkeleton @@ -513,7 +513,7 @@ readProjectConfig verbosity httpTransport ignoreProjectFlag configFileFlag distD local <- readProjectLocalConfigOrDefault verbosity httpTransport distDirLayout freeze <- readProjectLocalFreezeConfig verbosity httpTransport distDirLayout extra <- readProjectLocalExtraConfig verbosity httpTransport distDirLayout - if ignoreProjectFlag then return (global <> (singletonProjectConfigSkeleton defaultProject)) + if ignoreProjectFlag == Flag True then return (global <> (singletonProjectConfigSkeleton defaultProject)) else return (global <> local <> freeze <> extra) where defaultProject :: ProjectConfig diff --git a/cabal-install/src/Distribution/Client/ProjectFlags.hs b/cabal-install/src/Distribution/Client/ProjectFlags.hs index 7871b2945fb..bf1d5789edc 100644 --- a/cabal-install/src/Distribution/Client/ProjectFlags.hs +++ b/cabal-install/src/Distribution/Client/ProjectFlags.hs @@ -14,7 +14,7 @@ import Distribution.ReadE (succeedReadE) import Distribution.Simple.Command ( MkOptDescr, OptionField(optionName), ShowOrParseArgs (..), boolOpt', option , reqArg ) -import Distribution.Simple.Setup (Flag (..), flagToList, flagToMaybe, toFlag, trueArg, fromFlagOrDefault) +import Distribution.Simple.Setup (Flag (..), flagToList, flagToMaybe, toFlag, trueArg) data ProjectFlags = ProjectFlags { flagProjectFileName :: Flag FilePath @@ -47,8 +47,10 @@ projectFlagsOptions showOrParseArgs = (reqArg "FILE" (succeedReadE Flag) flagToList) , option ['z'] ["ignore-project"] "Ignore local project configuration" - -- If the "--project-file" flag is set, then this will always be false - flagIgnoreProject (\v flags -> flags { flagIgnoreProject = toFlag (not ((not (fromFlagOrDefault False v)) || (NoFlag /= (flagProjectFileName flags)))) }) + -- Flag True: --ignore-project is given and --project-file is not given + -- Flag False: --ignore-project and --project-file is given + -- NoFlag: neither --ignore-project or --project-file is given + flagIgnoreProject (\v flags -> flags { flagIgnoreProject = if v == NoFlag then NoFlag else toFlag ((flagProjectFileName flags) == NoFlag && v == Flag True) }) (yesNoOpt showOrParseArgs) ] diff --git a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs index 549ab02cbe7..47c429d02ec 100644 --- a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs +++ b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs @@ -209,7 +209,7 @@ establishProjectBaseContext -> IO ProjectBaseContext establishProjectBaseContext verbosity cliConfig currentCommand = do projectRoot <- either throwIO return =<< findProjectRoot Nothing mprojectFile - establishProjectBaseContextWithRoot verbosity cliConfig False projectRoot currentCommand + establishProjectBaseContextWithRoot verbosity cliConfig Setup.NoFlag projectRoot currentCommand where mprojectFile = Setup.flagToMaybe projectConfigProjectFile ProjectConfigShared { projectConfigProjectFile} = projectConfigShared cliConfig @@ -218,11 +218,11 @@ establishProjectBaseContext verbosity cliConfig currentCommand = do establishProjectBaseContextWithRoot :: Verbosity -> ProjectConfig - -> Bool + -> Setup.Flag Bool -- ^ @--ignore-project@ -> ProjectRoot -> CurrentCommand -> IO ProjectBaseContext -establishProjectBaseContextWithRoot verbosity cliConfig ignoreLocalProjectFile projectRoot currentCommand = do +establishProjectBaseContextWithRoot verbosity cliConfig ignoreProjectFlag projectRoot currentCommand = do cabalDir <- getCabalDir let distDirLayout = defaultDistDirLayout projectRoot mdistDirectory @@ -234,7 +234,7 @@ establishProjectBaseContextWithRoot verbosity cliConfig ignoreLocalProjectFile p (projectConfig, localPackages) <- rebuildProjectConfig verbosity httpTransport - ignoreLocalProjectFile + ignoreProjectFlag distDirLayout cliConfig diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index a537032d30e..820e58e08be 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -304,14 +304,14 @@ sanityCheckElaboratedPackage ElaboratedConfiguredPackage{..} -- rebuildProjectConfig :: Verbosity -> HttpTransport - -> Bool + -> Flag Bool -> DistDirLayout -> ProjectConfig -> IO ( ProjectConfig , [PackageSpecifier UnresolvedSourcePackage] ) rebuildProjectConfig verbosity httpTransport - ignoreLocalProjectFile + ignoreProjectFlag -- ^ @--ignore-project@ distDirLayout@DistDirLayout { distProjectRootDirectory, distDirectory, @@ -366,7 +366,7 @@ rebuildProjectConfig verbosity -- phaseReadProjectConfig :: Rebuild ProjectConfigSkeleton phaseReadProjectConfig = do - readProjectConfig verbosity httpTransport ignoreLocalProjectFile projectConfigConfigFile distDirLayout + readProjectConfig verbosity httpTransport ignoreProjectFlag projectConfigConfigFile distDirLayout -- Look for all the cabal packages in the project -- some of which may be local src dirs, tarballs etc diff --git a/cabal-install/tests/IntegrationTests2.hs b/cabal-install/tests/IntegrationTests2.hs index cb303ef73fd..9657de8cef8 100644 --- a/cabal-install/tests/IntegrationTests2.hs +++ b/cabal-install/tests/IntegrationTests2.hs @@ -174,7 +174,7 @@ testExceptionFindProjectRoot = do testTargetSelectors :: (String -> IO ()) -> Assertion testTargetSelectors reportSubCase = do - (_, _, _, localPackages, _) <- configureProject False testdir config + (_, _, _, localPackages, _) <- configureProject NoFlag testdir config let readTargetSelectors' = readTargetSelectorsWith (dirActions testdir) localPackages Nothing @@ -286,7 +286,7 @@ testTargetSelectors reportSubCase = do testTargetSelectorBadSyntax :: Assertion testTargetSelectorBadSyntax = do - (_, _, _, localPackages, _) <- configureProject False testdir config + (_, _, _, localPackages, _) <- configureProject NoFlag testdir config let targets = [ "foo bar", " foo" , "foo:", "foo::bar" , "foo: ", "foo: :bar" @@ -528,7 +528,7 @@ instance IsString PackageIdentifier where testTargetSelectorNoCurrentPackage :: Assertion testTargetSelectorNoCurrentPackage = do - (_, _, _, localPackages, _) <- configureProject False testdir config + (_, _, _, localPackages, _) <- configureProject NoFlag testdir config let readTargetSelectors' = readTargetSelectorsWith (dirActions testdir) localPackages Nothing @@ -551,7 +551,7 @@ testTargetSelectorNoCurrentPackage = do testTargetSelectorNoTargets :: Assertion testTargetSelectorNoTargets = do - (_, _, _, localPackages, _) <- configureProject False testdir config + (_, _, _, localPackages, _) <- configureProject NoFlag testdir config Left errs <- readTargetSelectors localPackages Nothing [] errs @?= [TargetSelectorNoTargetsInCwd True] cleanProject testdir @@ -562,7 +562,7 @@ testTargetSelectorNoTargets = do testTargetSelectorProjectEmpty :: Assertion testTargetSelectorProjectEmpty = do - (_, _, _, localPackages, _) <- configureProject False testdir config + (_, _, _, localPackages, _) <- configureProject NoFlag testdir config Left errs <- readTargetSelectors localPackages Nothing [] errs @?= [TargetSelectorNoTargetsInProject] cleanProject testdir @@ -576,7 +576,7 @@ testTargetSelectorProjectEmpty = do -- drive capitalisation mismatch when no targets are given testTargetSelectorCanonicalizedPath :: Assertion testTargetSelectorCanonicalizedPath = do - (_, _, _, localPackages, _) <- configureProject False testdir config + (_, _, _, localPackages, _) <- configureProject NoFlag testdir config cwd <- getCurrentDirectory let virtcwd = cwd basedir symlink -- Check that the symlink is there before running test as on Windows @@ -1676,8 +1676,8 @@ type ProjDetails = (DistDirLayout, [PackageSpecifier UnresolvedSourcePackage], BuildTimeSettings) -configureProject :: Bool -> FilePath -> ProjectConfig -> IO ProjDetails -configureProject ignoreLocalProject testdir cliConfig = do +configureProject :: Flag Bool -> FilePath -> ProjectConfig -> IO ProjDetails +configureProject ignoreProjectFlag testdir cliConfig = do cabalDir <- getCabalDir let cabalDirLayout = defaultCabalDirLayout cabalDir @@ -1698,7 +1698,7 @@ configureProject ignoreLocalProject testdir cliConfig = do (projectConfig, localPackages) <- rebuildProjectConfig verbosity httpTransport - ignoreLocalProject + ignoreProjectFlag distDirLayout cliConfig @@ -1724,7 +1724,7 @@ planProject testdir cliConfig = do cabalDirLayout, projectConfig, localPackages, - _buildSettings) <- configureProject False testdir cliConfig + _buildSettings) <- configureProject NoFlag testdir cliConfig (elaboratedPlan, _, elaboratedShared, _, _) <- rebuildInstallPlan verbosity @@ -1968,11 +1968,11 @@ testNixFlags = do testIgnoreProjectFlag :: Assertion testIgnoreProjectFlag = do -- Coverage flag should be false globally by default (~/.cabal folder) - (_, _, prjConfigGlobal, _, _) <- configureProject True testdir emptyConfig + (_, _, prjConfigGlobal, _, _) <- configureProject (Flag True) testdir emptyConfig let globalCoverageFlag = packageConfigCoverage . projectConfigLocalPackages $ prjConfigGlobal False @=? Flg.fromFlagOrDefault False globalCoverageFlag -- It is set to true in the cabal.project file - (_, _, prjConfigLocal, _, _) <- configureProject False testdir emptyConfig + (_, _, prjConfigLocal, _, _) <- configureProject NoFlag testdir emptyConfig let localCoverageFlag = packageConfigCoverage . projectConfigLocalPackages $ prjConfigLocal True @=? Flg.fromFlagOrDefault False localCoverageFlag where From 0db08418a79c89780e30562a529b5141bdf28098 Mon Sep 17 00:00:00 2001 From: Colton Clemmer Date: Mon, 2 May 2022 16:49:41 -0500 Subject: [PATCH 11/12] Move ignore flag paramater to use the cli config params --- .../src/Distribution/Client/CmdSdist.hs | 2 +- .../src/Distribution/Client/ProjectConfig.hs | 2 +- .../Client/ProjectOrchestration.hs | 6 ++--- .../Distribution/Client/ProjectPlanning.hs | 7 ++--- cabal-install/tests/IntegrationTests2.hs | 27 ++++++++++--------- 5 files changed, 22 insertions(+), 22 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdSdist.hs b/cabal-install/src/Distribution/Client/CmdSdist.hs index 92a9e54a95f..f9920ecd6ea 100644 --- a/cabal-install/src/Distribution/Client/CmdSdist.hs +++ b/cabal-install/src/Distribution/Client/CmdSdist.hs @@ -209,7 +209,7 @@ sdistAction (ProjectFlags{..}, SdistFlags{..}) targetStrings globalFlags = do withoutProject :: ProjectConfig -> IO (ProjectBaseContext, DistDirLayout) withoutProject config = do cwd <- getCurrentDirectory - baseCtx <- establishProjectBaseContextWithRoot verbosity (config <> prjConfig) flagIgnoreProject (ProjectRootImplicit cwd) OtherCommand + baseCtx <- establishProjectBaseContextWithRoot verbosity (config <> prjConfig) (ProjectRootImplicit cwd) OtherCommand return (baseCtx, distDirLayout baseCtx) data OutputFormat = SourceList Char diff --git a/cabal-install/src/Distribution/Client/ProjectConfig.hs b/cabal-install/src/Distribution/Client/ProjectConfig.hs index 30c1fb87bdb..bd066d4479b 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig.hs @@ -504,7 +504,7 @@ withProjectOrGlobalConfig' verbosity globalConfigFlag with without = do -- readProjectConfig :: Verbosity -> HttpTransport - -> Flag Bool + -> Flag Bool -- ^ @--ignore-project@ -> Flag FilePath -> DistDirLayout -> Rebuild ProjectConfigSkeleton diff --git a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs index 47c429d02ec..d7933b6c2a9 100644 --- a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs +++ b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs @@ -209,7 +209,7 @@ establishProjectBaseContext -> IO ProjectBaseContext establishProjectBaseContext verbosity cliConfig currentCommand = do projectRoot <- either throwIO return =<< findProjectRoot Nothing mprojectFile - establishProjectBaseContextWithRoot verbosity cliConfig Setup.NoFlag projectRoot currentCommand + establishProjectBaseContextWithRoot verbosity cliConfig projectRoot currentCommand where mprojectFile = Setup.flagToMaybe projectConfigProjectFile ProjectConfigShared { projectConfigProjectFile} = projectConfigShared cliConfig @@ -218,11 +218,10 @@ establishProjectBaseContext verbosity cliConfig currentCommand = do establishProjectBaseContextWithRoot :: Verbosity -> ProjectConfig - -> Setup.Flag Bool -- ^ @--ignore-project@ -> ProjectRoot -> CurrentCommand -> IO ProjectBaseContext -establishProjectBaseContextWithRoot verbosity cliConfig ignoreProjectFlag projectRoot currentCommand = do +establishProjectBaseContextWithRoot verbosity cliConfig projectRoot currentCommand = do cabalDir <- getCabalDir let distDirLayout = defaultDistDirLayout projectRoot mdistDirectory @@ -234,7 +233,6 @@ establishProjectBaseContextWithRoot verbosity cliConfig ignoreProjectFlag projec (projectConfig, localPackages) <- rebuildProjectConfig verbosity httpTransport - ignoreProjectFlag distDirLayout cliConfig diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index 820e58e08be..7962f92791c 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -304,14 +304,12 @@ sanityCheckElaboratedPackage ElaboratedConfiguredPackage{..} -- rebuildProjectConfig :: Verbosity -> HttpTransport - -> Flag Bool -> DistDirLayout -> ProjectConfig -> IO ( ProjectConfig , [PackageSpecifier UnresolvedSourcePackage] ) rebuildProjectConfig verbosity httpTransport - ignoreProjectFlag -- ^ @--ignore-project@ distDirLayout@DistDirLayout { distProjectRootDirectory, distDirectory, @@ -354,6 +352,9 @@ rebuildProjectConfig verbosity ProjectConfigShared { projectConfigConfigFile } = projectConfigShared cliConfig + ProjectConfigShared { projectConfigIgnoreProject } = + projectConfigShared cliConfig + fileMonitorProjectConfig :: FileMonitor (FilePath, FilePath) @@ -366,7 +367,7 @@ rebuildProjectConfig verbosity -- phaseReadProjectConfig :: Rebuild ProjectConfigSkeleton phaseReadProjectConfig = do - readProjectConfig verbosity httpTransport ignoreProjectFlag projectConfigConfigFile distDirLayout + readProjectConfig verbosity httpTransport projectConfigIgnoreProject projectConfigConfigFile distDirLayout -- Look for all the cabal packages in the project -- some of which may be local src dirs, tarballs etc diff --git a/cabal-install/tests/IntegrationTests2.hs b/cabal-install/tests/IntegrationTests2.hs index 9657de8cef8..b24938365d4 100644 --- a/cabal-install/tests/IntegrationTests2.hs +++ b/cabal-install/tests/IntegrationTests2.hs @@ -174,7 +174,7 @@ testExceptionFindProjectRoot = do testTargetSelectors :: (String -> IO ()) -> Assertion testTargetSelectors reportSubCase = do - (_, _, _, localPackages, _) <- configureProject NoFlag testdir config + (_, _, _, localPackages, _) <- configureProject testdir config let readTargetSelectors' = readTargetSelectorsWith (dirActions testdir) localPackages Nothing @@ -286,7 +286,7 @@ testTargetSelectors reportSubCase = do testTargetSelectorBadSyntax :: Assertion testTargetSelectorBadSyntax = do - (_, _, _, localPackages, _) <- configureProject NoFlag testdir config + (_, _, _, localPackages, _) <- configureProject testdir config let targets = [ "foo bar", " foo" , "foo:", "foo::bar" , "foo: ", "foo: :bar" @@ -528,7 +528,7 @@ instance IsString PackageIdentifier where testTargetSelectorNoCurrentPackage :: Assertion testTargetSelectorNoCurrentPackage = do - (_, _, _, localPackages, _) <- configureProject NoFlag testdir config + (_, _, _, localPackages, _) <- configureProject testdir config let readTargetSelectors' = readTargetSelectorsWith (dirActions testdir) localPackages Nothing @@ -551,7 +551,7 @@ testTargetSelectorNoCurrentPackage = do testTargetSelectorNoTargets :: Assertion testTargetSelectorNoTargets = do - (_, _, _, localPackages, _) <- configureProject NoFlag testdir config + (_, _, _, localPackages, _) <- configureProject testdir config Left errs <- readTargetSelectors localPackages Nothing [] errs @?= [TargetSelectorNoTargetsInCwd True] cleanProject testdir @@ -562,7 +562,7 @@ testTargetSelectorNoTargets = do testTargetSelectorProjectEmpty :: Assertion testTargetSelectorProjectEmpty = do - (_, _, _, localPackages, _) <- configureProject NoFlag testdir config + (_, _, _, localPackages, _) <- configureProject testdir config Left errs <- readTargetSelectors localPackages Nothing [] errs @?= [TargetSelectorNoTargetsInProject] cleanProject testdir @@ -576,7 +576,7 @@ testTargetSelectorProjectEmpty = do -- drive capitalisation mismatch when no targets are given testTargetSelectorCanonicalizedPath :: Assertion testTargetSelectorCanonicalizedPath = do - (_, _, _, localPackages, _) <- configureProject NoFlag testdir config + (_, _, _, localPackages, _) <- configureProject testdir config cwd <- getCurrentDirectory let virtcwd = cwd basedir symlink -- Check that the symlink is there before running test as on Windows @@ -1676,8 +1676,8 @@ type ProjDetails = (DistDirLayout, [PackageSpecifier UnresolvedSourcePackage], BuildTimeSettings) -configureProject :: Flag Bool -> FilePath -> ProjectConfig -> IO ProjDetails -configureProject ignoreProjectFlag testdir cliConfig = do +configureProject :: FilePath -> ProjectConfig -> IO ProjDetails +configureProject testdir cliConfig = do cabalDir <- getCabalDir let cabalDirLayout = defaultCabalDirLayout cabalDir @@ -1698,7 +1698,6 @@ configureProject ignoreProjectFlag testdir cliConfig = do (projectConfig, localPackages) <- rebuildProjectConfig verbosity httpTransport - ignoreProjectFlag distDirLayout cliConfig @@ -1724,7 +1723,7 @@ planProject testdir cliConfig = do cabalDirLayout, projectConfig, localPackages, - _buildSettings) <- configureProject NoFlag testdir cliConfig + _buildSettings) <- configureProject testdir cliConfig (elaboratedPlan, _, elaboratedShared, _, _) <- rebuildInstallPlan verbosity @@ -1968,13 +1967,15 @@ testNixFlags = do testIgnoreProjectFlag :: Assertion testIgnoreProjectFlag = do -- Coverage flag should be false globally by default (~/.cabal folder) - (_, _, prjConfigGlobal, _, _) <- configureProject (Flag True) testdir emptyConfig + (_, _, prjConfigGlobal, _, _) <- configureProject testdir ignoreSetConfig let globalCoverageFlag = packageConfigCoverage . projectConfigLocalPackages $ prjConfigGlobal False @=? Flg.fromFlagOrDefault False globalCoverageFlag -- It is set to true in the cabal.project file - (_, _, prjConfigLocal, _, _) <- configureProject NoFlag testdir emptyConfig + (_, _, prjConfigLocal, _, _) <- configureProject testdir emptyConfig let localCoverageFlag = packageConfigCoverage . projectConfigLocalPackages $ prjConfigLocal True @=? Flg.fromFlagOrDefault False localCoverageFlag where testdir = "build/ignore-project" - emptyConfig = mempty \ No newline at end of file + emptyConfig = mempty + ignoreSetConfig :: ProjectConfig + ignoreSetConfig = mempty { projectConfigShared = mempty { projectConfigIgnoreProject = Flag True } } \ No newline at end of file From 0c6749ebcf8e1f543cf26cf378ed080f5a33ac8a Mon Sep 17 00:00:00 2001 From: Colton Clemmer Date: Thu, 5 May 2022 16:25:13 -0500 Subject: [PATCH 12/12] Change "Flg" import to "Flag" --- cabal-install/tests/IntegrationTests2.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/cabal-install/tests/IntegrationTests2.hs b/cabal-install/tests/IntegrationTests2.hs index b24938365d4..da1652aadd6 100644 --- a/cabal-install/tests/IntegrationTests2.hs +++ b/cabal-install/tests/IntegrationTests2.hs @@ -53,7 +53,7 @@ import Distribution.Simple.Setup (toFlag, HaddockFlags(..), defaultHaddockFlags) import Distribution.Client.Setup (globalCommand) import Distribution.Simple.Compiler import Distribution.Simple.Command -import qualified Distribution.Simple.Flag as Flg +import qualified Distribution.Simple.Flag as Flag import Distribution.System import Distribution.Version import Distribution.ModuleName (ModuleName) @@ -1969,13 +1969,13 @@ testIgnoreProjectFlag = do -- Coverage flag should be false globally by default (~/.cabal folder) (_, _, prjConfigGlobal, _, _) <- configureProject testdir ignoreSetConfig let globalCoverageFlag = packageConfigCoverage . projectConfigLocalPackages $ prjConfigGlobal - False @=? Flg.fromFlagOrDefault False globalCoverageFlag + False @=? Flag.fromFlagOrDefault False globalCoverageFlag -- It is set to true in the cabal.project file (_, _, prjConfigLocal, _, _) <- configureProject testdir emptyConfig let localCoverageFlag = packageConfigCoverage . projectConfigLocalPackages $ prjConfigLocal - True @=? Flg.fromFlagOrDefault False localCoverageFlag + True @=? Flag.fromFlagOrDefault False localCoverageFlag where testdir = "build/ignore-project" emptyConfig = mempty ignoreSetConfig :: ProjectConfig - ignoreSetConfig = mempty { projectConfigShared = mempty { projectConfigIgnoreProject = Flag True } } \ No newline at end of file + ignoreSetConfig = mempty { projectConfigShared = mempty { projectConfigIgnoreProject = Flag True } }