From 0fd2647dcc18d1aa863fd26054077b37b2d8e04f Mon Sep 17 00:00:00 2001
From: Gershom Bazerman <gershom@arista.com>
Date: Wed, 10 Aug 2022 18:41:07 -0400
Subject: [PATCH 1/7] only check for compiler when project file has
conditionals
---
.../src/Distribution/Client/CmdOutdated.hs | 4 ++--
.../Client/ProjectConfig/Legacy.hs | 19 ++++++++++++++-----
.../Distribution/Client/ProjectPlanning.hs | 7 +++++--
.../src/Distribution/Client/ScriptUtils.hs | 8 +++++---
4 files changed, 26 insertions(+), 12 deletions(-)
diff --git a/cabal-install/src/Distribution/Client/CmdOutdated.hs b/cabal-install/src/Distribution/Client/CmdOutdated.hs
index c511c53c1c6..b2bf423478e 100644
--- a/cabal-install/src/Distribution/Client/CmdOutdated.hs
+++ b/cabal-install/src/Distribution/Client/CmdOutdated.hs
@@ -30,7 +30,7 @@ import Distribution.Client.DistDirLayout
, DistDirLayout(distProjectRootDirectory, distProjectFile) )
import Distribution.Client.ProjectConfig
import Distribution.Client.ProjectConfig.Legacy
- ( instantiateProjectConfigSkeleton )
+ ( instantiateProjectConfigSkeletonWithCompiler )
import Distribution.Client.ProjectFlags
( projectFlagsOptions, ProjectFlags(..), defaultProjectFlags
, removeIgnoreProjectOption )
@@ -306,7 +306,7 @@ depsFromNewFreezeFile verbosity httpTransport compiler (Platform arch os) mproje
{- TODO: Support dist dir override -} Nothing
projectConfig <- runRebuild (distProjectRootDirectory distDirLayout) $ do
pcs <- readProjectLocalFreezeConfig verbosity httpTransport distDirLayout
- pure $ instantiateProjectConfigSkeleton os arch (compilerInfo compiler) mempty pcs
+ pure $ instantiateProjectConfigSkeletonWithCompiler os arch (compilerInfo compiler) mempty pcs
let ucnstrs = map fst . projectConfigConstraints . projectConfigShared
$ projectConfig
deps = userConstraintsToDependencies ucnstrs
diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs
index 8787e06ee19..1c7aba8243e 100644
--- a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs
+++ b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs
@@ -7,7 +7,8 @@ module Distribution.Client.ProjectConfig.Legacy (
-- Project config skeletons
ProjectConfigSkeleton,
parseProjectSkeleton,
- instantiateProjectConfigSkeleton,
+ instantiateProjectConfigSkeletonFetchingCompiler,
+ instantiateProjectConfigSkeletonWithCompiler,
singletonProjectConfigSkeleton,
projectSkeletonImports,
@@ -44,7 +45,7 @@ import Distribution.Client.CmdInstall.ClientInstallFlags
( ClientInstallFlags(..), defaultClientInstallFlags
, clientInstallOptions )
-import Distribution.Compat.Lens (view)
+import Distribution.Compat.Lens (view, toListOf)
import Distribution.Solver.Types.ConstraintSource
@@ -52,7 +53,7 @@ import Distribution.FieldGrammar
import Distribution.Package
import Distribution.Types.SourceRepo (RepoType)
import Distribution.Types.CondTree
- ( CondTree (..), CondBranch (..), mapTreeConds, traverseCondTreeC )
+ ( CondTree (..), CondBranch (..), mapTreeConds, traverseCondTreeC, traverseCondTreeV, ignoreConditions )
import Distribution.PackageDescription
( dispFlagAssignment, Condition (..), ConfVar (..), FlagAssignment )
import Distribution.PackageDescription.Configuration (simplifyWithSysParams)
@@ -135,8 +136,16 @@ type ProjectConfigImport = String
singletonProjectConfigSkeleton :: ProjectConfig -> ProjectConfigSkeleton
singletonProjectConfigSkeleton x = CondNode x mempty mempty
-instantiateProjectConfigSkeleton :: OS -> Arch -> CompilerInfo -> FlagAssignment -> ProjectConfigSkeleton -> ProjectConfig
-instantiateProjectConfigSkeleton os arch impl _flags skel = go $ mapTreeConds (fst . simplifyWithSysParams os arch impl) skel
+instantiateProjectConfigSkeletonFetchingCompiler :: Monad m => m (OS, Arch, CompilerInfo) -> FlagAssignment -> ProjectConfigSkeleton -> m ProjectConfig
+instantiateProjectConfigSkeletonFetchingCompiler fetch flags skel
+ | null (toListOf traverseCondTreeV skel) = pure $ fst (ignoreConditions skel)
+ | otherwise = do
+ (os, arch, impl) <- fetch
+ pure $ instantiateProjectConfigSkeletonWithCompiler os arch impl flags skel
+
+
+instantiateProjectConfigSkeletonWithCompiler :: OS -> Arch -> CompilerInfo -> FlagAssignment -> ProjectConfigSkeleton -> ProjectConfig
+instantiateProjectConfigSkeletonWithCompiler os arch impl _flags skel = go $ mapTreeConds (fst . simplifyWithSysParams os arch impl) skel
where
go :: CondTree
FlagName
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index a3464159923..07ac42e4ec0 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -333,8 +333,11 @@ rebuildProjectConfig verbosity
liftIO $ createDirectoryIfMissingVerbose verbosity True distProjectCacheDirectory
projectConfigSkeleton <- phaseReadProjectConfig
-- have to create the cache directory before configuring the compiler
- (compiler, Platform arch os, _) <- configureCompiler verbosity distDirLayout ((fst $ PD.ignoreConditions projectConfigSkeleton) <> cliConfig)
- let projectConfig = instantiateProjectConfigSkeleton os arch (compilerInfo compiler) mempty projectConfigSkeleton
+ let fetchCompiler = do
+ (compiler, Platform arch os, _) <- configureCompiler verbosity distDirLayout ((fst $ PD.ignoreConditions projectConfigSkeleton) <> cliConfig)
+ pure (os, arch, compilerInfo compiler)
+
+ projectConfig <- instantiateProjectConfigSkeletonFetchingCompiler fetchCompiler mempty projectConfigSkeleton
localPackages <- phaseReadLocalPackages (projectConfig <> cliConfig)
return (projectConfig, localPackages)
diff --git a/cabal-install/src/Distribution/Client/ScriptUtils.hs b/cabal-install/src/Distribution/Client/ScriptUtils.hs
index 6555b92ef7c..81d7c52bc20 100644
--- a/cabal-install/src/Distribution/Client/ScriptUtils.hs
+++ b/cabal-install/src/Distribution/Client/ScriptUtils.hs
@@ -37,7 +37,7 @@ import Distribution.Client.ProjectConfig
, projectConfigHttpTransport )
import Distribution.Client.ProjectConfig.Legacy
( ProjectConfigSkeleton
- , parseProjectSkeleton, instantiateProjectConfigSkeleton )
+ , parseProjectSkeleton, instantiateProjectConfigSkeletonFetchingCompiler )
import Distribution.Client.ProjectFlags
( flagIgnoreProject )
import Distribution.Client.RebuildMonad
@@ -243,9 +243,11 @@ withContextAndSelectors noTargets kind flags@NixStyleFlags {..} targetStrings gl
projectCfgSkeleton <- readProjectBlockFromScript verbosity httpTransport (distDirLayout ctx) (takeFileName script) scriptContents
- (compiler, Platform arch os, _) <- runRebuild (distProjectRootDirectory . distDirLayout $ ctx) $ configureCompiler verbosity (distDirLayout ctx) ((fst $ ignoreConditions projectCfgSkeleton) <> projectConfig ctx)
+ let fetchCompiler = do
+ (compiler, Platform arch os, _) <- runRebuild (distProjectRootDirectory . distDirLayout $ ctx) $ configureCompiler verbosity (distDirLayout ctx) ((fst $ ignoreConditions projectCfgSkeleton) <> projectConfig ctx)
+ pure (os, arch, compilerInfo compiler)
- let projectCfg = instantiateProjectConfigSkeleton os arch (compilerInfo compiler) mempty projectCfgSkeleton :: ProjectConfig
+ projectCfg <- instantiateProjectConfigSkeletonFetchingCompiler fetchCompiler mempty projectCfgSkeleton
let executable' = executable & L.buildInfo . L.defaultLanguage %~ maybe (Just Haskell2010) Just
ctx' = ctx & lProjectConfig %~ (<> projectCfg)
From 6de0540ed34f680fa1e3e5273440b8f7d40038f9 Mon Sep 17 00:00:00 2001
From: Gershom Bazerman <gershom@arista.com>
Date: Thu, 11 Aug 2022 16:08:04 -0400
Subject: [PATCH 2/7] fix sdist options a bit plus test
---
cabal-install/src/Distribution/Client/CmdSdist.hs | 3 ++-
cabal-testsuite/PackageTests/ConditionalAndImport/cabal.out | 4 ++++
.../PackageTests/ConditionalAndImport/cabal.test.hs | 4 ++++
3 files changed, 10 insertions(+), 1 deletion(-)
diff --git a/cabal-install/src/Distribution/Client/CmdSdist.hs b/cabal-install/src/Distribution/Client/CmdSdist.hs
index f9920ecd6ea..605403b0a3a 100644
--- a/cabal-install/src/Distribution/Client/CmdSdist.hs
+++ b/cabal-install/src/Distribution/Client/CmdSdist.hs
@@ -137,7 +137,7 @@ sdistOptions showOrParseArgs =
-------------------------------------------------------------------------------
sdistAction :: (ProjectFlags, SdistFlags) -> [String] -> GlobalFlags -> IO ()
-sdistAction (ProjectFlags{..}, SdistFlags{..}) targetStrings globalFlags = do
+sdistAction (pf@ProjectFlags{..}, SdistFlags{..}) targetStrings globalFlags = do
(baseCtx, distDirLayout) <- withProjectOrGlobalConfig verbosity flagIgnoreProject globalConfigFlag withProject withoutProject
let localPkgs = localPackages baseCtx
@@ -196,6 +196,7 @@ sdistAction (ProjectFlags{..}, SdistFlags{..}) targetStrings globalFlags = do
{ configVerbosity = sdistVerbosity
, configDistPref = sdistDistDir
}
+ , projectFlags = pf
}
mempty