feat(cabal-install): introduce ProjectConfigToolchain

Author: andreabedini

cabal-install-solver/src/Distribution/Solver/Types/Toolchain.hs

@@ -23,6 +23,9 @@ data Toolchain = Toolchain
   { toolchainPlatform :: Platform
   , toolchainCompiler :: Compiler
   , toolchainProgramDb :: ProgramDb
+  -- NOTE: actually the solver does not care about package dbs, perhaps it's better
+  -- to have a separate Toolchain type for project planning.
+  , toolchainPackageDBs :: PackageDBStackCWD
   }
   deriving (Show, Generic)
 

cabal-install/cabal-install.cabal

@@ -215,6 +215,7 @@ library
         Distribution.Client.TargetProblem
         Distribution.Client.TargetSelector
         Distribution.Client.Targets
+        Distribution.Client.Toolchain
         Distribution.Client.Types
         Distribution.Client.Types.AllowNewer
         Distribution.Client.Types.BuildResults

cabal-install/parser-tests/Tests/ParserTests.hs

@@ -179,6 +179,7 @@ testProjectConfigShared = do
   assertConfigEquals expected config legacy (projectConfigShared . condTreeData)
   where
     expected = ProjectConfigShared{..}
+    projectConfigToolchain = ProjectConfigToolchain{..}
     projectConfigDistDir = toFlag "something"
     projectConfigConfigFile = mempty -- cli only
     projectConfigProjectFileParser = mempty -- cli only
@@ -188,9 +189,13 @@ testProjectConfigShared = do
     projectConfigHcFlavor = toFlag GHCJS
     projectConfigHcPath = toFlag "/some/path/to/compiler"
     projectConfigHcPkg = toFlag "/some/path/to/ghc-pkg"
+    projectConfigPackageDBs = [Nothing, Just (SpecificPackageDB "foo"), Nothing, Just (SpecificPackageDB "bar"), Just (SpecificPackageDB "baz")]
+    projectConfigBuildHcFlavor = toFlag GHCJS
+    projectConfigBuildHcPath = toFlag "/some/path/to/compiler"
+    projectConfigBuildHcPkg = toFlag "/some/path/to/ghc-pkg"
+    projectConfigBuildPackageDBs = [Nothing, Just (SpecificPackageDB "foo"), Nothing, Just (SpecificPackageDB "bar"), Just (SpecificPackageDB "baz")]
     projectConfigHaddockIndex = toFlag $ toPathTemplate "/path/to/haddock-index"
     projectConfigInstallDirs = mempty -- tested below in testInstallDirs
-    projectConfigPackageDBs = [Nothing, Just (SpecificPackageDB "foo"), Nothing, Just (SpecificPackageDB "bar"), Just (SpecificPackageDB "baz")]
     projectConfigRemoteRepos = mempty -- tested below in testRemoteRepos
     projectConfigLocalNoIndexRepos = mempty -- tested below in testLocalNoIndexRepos
     projectConfigActiveRepos = Flag (ActiveRepos [ActiveRepo (RepoName "hackage.haskell.org") CombineStrategyMerge, ActiveRepo (RepoName "my-repository") CombineStrategyOverride])

cabal-install/src/Distribution/Client/CmdInstall.hs

@@ -68,7 +68,8 @@ import Distribution.Client.NixStyleOptions
   , nixStyleOptions
   )
 import Distribution.Client.ProjectConfig
-  ( ProjectPackageLocation (..)
+  ( ProjectConfigToolchain (..)
+  , ProjectPackageLocation (..)
   , fetchAndReadSourcePackages
   , projectConfigWithBuilderRepoContext
   , resolveBuildTimeSettings
@@ -413,12 +414,15 @@ installAction flags@NixStyleFlags{extraFlags, configFlags, installFlags, project
           }
       , projectConfigShared =
         ProjectConfigShared
-          { projectConfigHcFlavor
-          , projectConfigHcPath
-          , projectConfigHcPkg
+          { projectConfigToolchain =
+            ProjectConfigToolchain
+              { projectConfigHcFlavor
+              , projectConfigHcPath
+              , projectConfigHcPkg
+              , projectConfigPackageDBs
+              }
           , projectConfigStoreDir
           , projectConfigProgPathExtra
-          , projectConfigPackageDBs
           }
       , projectConfigLocalPackages =
         PackageConfig

cabal-install/src/Distribution/Client/CmdPath.hs

@@ -46,6 +46,9 @@ import Distribution.Client.ScriptUtils
 import Distribution.Client.Setup
   ( yesNoOpt
   )
+import Distribution.Client.Toolchain
+  ( Toolchain (..)
+  )
 import Distribution.Client.Utils.Json
   ( (.=)
   )
@@ -244,10 +247,10 @@ pathAction flags@NixStyleFlags{extraFlags = pathFlags'} cliTargetStrings globalF
     if not $ fromFlagOrDefault False (pathCompiler pathFlags)
       then pure Nothing
       else do
-        (compiler, _, progDb) <- runRebuild (distProjectRootDirectory . distDirLayout $ baseCtx) $ configureCompiler verbosity (distDirLayout baseCtx) (projectConfig baseCtx)
-        compilerProg <- requireCompilerProg verbosity compiler
-        (configuredCompilerProg, _) <- requireProgram verbosity compilerProg progDb
-        pure $ Just $ mkCompilerInfo configuredCompilerProg compiler
+        toolchain <- runRebuild (distProjectRootDirectory . distDirLayout $ baseCtx) $ configureCompiler verbosity (distDirLayout baseCtx) (projectConfig baseCtx)
+        compilerProg <- requireCompilerProg verbosity (toolchainCompiler toolchain)
+        (configuredCompilerProg, _) <- requireProgram verbosity compilerProg (toolchainProgramDb toolchain)
+        pure $ Just $ mkCompilerInfo configuredCompilerProg (toolchainCompiler toolchain)
 
   paths <- for (fromFlagOrDefault [] $ pathDirectories pathFlags) $ \p -> do
     t <- getPathLocation baseCtx p

cabal-install/src/Distribution/Client/ProjectConfig.hs

@@ -14,6 +14,7 @@ module Distribution.Client.ProjectConfig
   , ProjectConfigBuildOnly (..)
   , ProjectConfigShared (..)
   , ProjectConfigSkeleton
+  , ProjectConfigToolchain (..)
   , ProjectConfigProvenance (..)
   , PackageConfig (..)
   , MapLast (..)

cabal-install/src/Distribution/Client/ProjectConfig/FieldGrammar.hs

@@ -12,7 +12,14 @@ import qualified Data.Set as Set
 import Distribution.CabalSpecVersion (CabalSpecVersion (..))
 import Distribution.Client.CmdInstall.ClientInstallFlags (clientInstallFlagsGrammar)
 import qualified Distribution.Client.ProjectConfig.Lens as L
-import Distribution.Client.ProjectConfig.Types (PackageConfig (..), ProjectConfig (..), ProjectConfigBuildOnly (..), ProjectConfigProvenance (..), ProjectConfigShared (..))
+import Distribution.Client.ProjectConfig.Types
+  ( PackageConfig (..)
+  , ProjectConfig (..)
+  , ProjectConfigBuildOnly (..)
+  , ProjectConfigProvenance (..)
+  , ProjectConfigShared (..)
+  , ProjectConfigToolchain (..)
+  )
 import Distribution.Client.Utils.Parsec
 import Distribution.Compat.Prelude
 import Distribution.FieldGrammar
@@ -76,12 +83,9 @@ projectConfigSharedFieldGrammar source =
     <*> optionalFieldDefAla "project-file" (alaFlag FilePathNT) L.projectConfigProjectFile mempty
     <*> pure mempty -- You can't set the parser type in the project file.
     <*> optionalFieldDef "ignore-project" L.projectConfigIgnoreProject mempty
-    <*> optionalFieldDef "compiler" L.projectConfigHcFlavor mempty
-    <*> optionalFieldDefAla "with-compiler" (alaFlag FilePathNT) L.projectConfigHcPath mempty
-    <*> optionalFieldDefAla "with-hc-pkg" (alaFlag FilePathNT) L.projectConfigHcPkg mempty
+    <*> blurFieldGrammar L.projectConfigToolchain projectConfigToolchainFieldGrammar
     <*> optionalFieldDef "doc-index-file" L.projectConfigHaddockIndex mempty
     <*> blurFieldGrammar L.projectConfigInstallDirs installDirsGrammar
-    <*> monoidalFieldAla "package-dbs" (alaList' CommaFSep PackageDBNT) L.projectConfigPackageDBs
     <*> pure mempty -- repository stanza for projectConfigRemoteRepos
     <*> pure mempty -- repository stanza for projectConfigLocalNoIndexRepos
     <*> monoidalField "active-repositories" L.projectConfigActiveRepos
@@ -108,6 +112,14 @@ projectConfigSharedFieldGrammar source =
     <*> monoidalFieldAla "extra-prog-path-shared-only" (alaNubList' FSep FilePathNT) L.projectConfigProgPathExtra
     <*> optionalFieldDef "multi-repl" L.projectConfigMultiRepl mempty
 
+projectConfigToolchainFieldGrammar :: ParsecFieldGrammar' ProjectConfigToolchain
+projectConfigToolchainFieldGrammar =
+  ProjectConfigToolchain
+    <$> optionalFieldDef "compiler" L.projectConfigHcFlavor mempty
+    <*> optionalFieldDefAla "with-compiler" (alaFlag FilePathNT) L.projectConfigHcPath mempty
+    <*> optionalFieldDefAla "with-hc-pkg" (alaFlag FilePathNT) L.projectConfigHcPkg mempty
+    <*> monoidalFieldAla "package-dbs" (alaList' CommaFSep PackageDBNT) L.projectConfigPackageDBs
+
 packageConfigFieldGrammar :: [String] -> ParsecFieldGrammar' PackageConfig
 packageConfigFieldGrammar knownPrograms =
   mkPackageConfig

cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs

@@ -385,7 +385,7 @@ parseProjectSkeleton cacheDir httpTransport verbosity projectDir source (Project
     modifiesCompiler :: ProjectConfig -> Bool
     modifiesCompiler pc = isSet projectConfigHcFlavor || isSet projectConfigHcPath || isSet projectConfigHcPkg
       where
-        isSet f = f (projectConfigShared pc) /= NoFlag
+        isSet f = f (projectConfigToolchain $ projectConfigShared pc) /= NoFlag
 
     sanityWalkPCS :: Bool -> ProjectConfigSkeleton -> ProjectParseResult ProjectConfigSkeleton
     sanityWalkPCS underConditional t@(CondNode d (listToMaybe -> c) comps)
@@ -716,17 +716,16 @@ convertLegacyAllPackageFlags globalFlags configFlags configExFlags installFlags
       , globalStoreDir = projectConfigStoreDir
       } = globalFlags
 
+    projectConfigToolchain = ProjectConfigToolchain{..}
     projectConfigPackageDBs = (fmap . fmap) (interpretPackageDB Nothing) projectConfigPackageDBs_
 
     ConfigFlags
       { configCommonFlags = commonFlags
       , configHcFlavor = projectConfigHcFlavor
       , configHcPath = projectConfigHcPath
       , configHcPkg = projectConfigHcPkg
-      , -- configProgramPathExtra    = projectConfigProgPathExtra DELETE ME
-      configInstallDirs = projectConfigInstallDirs
-      , -- configUserInstall         = projectConfigUserInstall,
-      configPackageDBs = projectConfigPackageDBs_
+      , configInstallDirs = projectConfigInstallDirs
+      , configPackageDBs = projectConfigPackageDBs_
       } = configFlags
 
     CommonSetupFlags
@@ -965,10 +964,7 @@ convertToLegacySharedConfig
   ProjectConfig
     { projectConfigBuildOnly = ProjectConfigBuildOnly{..}
     , projectConfigShared = ProjectConfigShared{..}
-    , projectConfigAllPackages =
-      PackageConfig
-        { packageConfigDocumentation
-        }
+    , projectConfigAllPackages = PackageConfig{..}
     } =
     LegacySharedConfig
       { legacyGlobalFlags = globalFlags
@@ -980,6 +976,7 @@ convertToLegacySharedConfig
       , legacyMultiRepl = projectConfigMultiRepl
       }
     where
+      ProjectConfigToolchain{..} = projectConfigToolchain
       globalFlags =
         GlobalFlags
           { globalVersion = mempty
@@ -1085,6 +1082,8 @@ convertToLegacyAllPackageConfig
       , legacyBenchmarkFlags = mempty
       }
     where
+      ProjectConfigToolchain{..} = projectConfigToolchain
+
       commonFlags =
         mempty
 

cabal-install/src/Distribution/Client/ProjectConfig/Lens.hs

@@ -7,7 +7,16 @@ import Distribution.Client.IndexUtils.ActiveRepos
   ( ActiveRepos
   )
 import Distribution.Client.IndexUtils.IndexState (TotalIndexState)
-import Distribution.Client.ProjectConfig.Types (MapLast, MapMappend, PackageConfig, ProjectConfig (..), ProjectConfigBuildOnly (..), ProjectConfigProvenance, ProjectConfigShared)
+import Distribution.Client.ProjectConfig.Types
+  ( MapLast
+  , MapMappend
+  , PackageConfig
+  , ProjectConfig (..)
+  , ProjectConfigBuildOnly (..)
+  , ProjectConfigProvenance
+  , ProjectConfigShared
+  , ProjectConfigToolchain (..)
+  )
 import qualified Distribution.Client.ProjectConfig.Types as T
 import Distribution.Client.Targets (UserConstraint)
 import Distribution.Client.Types.AllowNewer (AllowNewer, AllowOlder)
@@ -187,18 +196,26 @@ projectConfigIgnoreProject :: Lens' ProjectConfigShared (Flag Bool)
 projectConfigIgnoreProject f s = fmap (\x -> s{T.projectConfigIgnoreProject = x}) (f (T.projectConfigIgnoreProject s))
 {-# INLINEABLE projectConfigIgnoreProject #-}
 
-projectConfigHcFlavor :: Lens' ProjectConfigShared (Flag CompilerFlavor)
+projectConfigToolchain :: Lens' ProjectConfigShared ProjectConfigToolchain
+projectConfigToolchain f s = fmap (\x -> s{T.projectConfigToolchain = x}) (f (T.projectConfigToolchain s))
+{-# INLINEABLE projectConfigToolchain #-}
+
+projectConfigHcFlavor :: Lens' ProjectConfigToolchain (Flag CompilerFlavor)
 projectConfigHcFlavor f s = fmap (\x -> s{T.projectConfigHcFlavor = x}) (f (T.projectConfigHcFlavor s))
 {-# INLINEABLE projectConfigHcFlavor #-}
 
-projectConfigHcPath :: Lens' ProjectConfigShared (Flag FilePath)
+projectConfigHcPath :: Lens' ProjectConfigToolchain (Flag FilePath)
 projectConfigHcPath f s = fmap (\x -> s{T.projectConfigHcPath = x}) (f (T.projectConfigHcPath s))
 {-# INLINEABLE projectConfigHcPath #-}
 
-projectConfigHcPkg :: Lens' ProjectConfigShared (Flag FilePath)
+projectConfigHcPkg :: Lens' ProjectConfigToolchain (Flag FilePath)
 projectConfigHcPkg f s = fmap (\x -> s{T.projectConfigHcPkg = x}) (f (T.projectConfigHcPkg s))
 {-# INLINEABLE projectConfigHcPkg #-}
 
+projectConfigPackageDBs :: Lens' ProjectConfigToolchain [Maybe PackageDBCWD]
+projectConfigPackageDBs f s = fmap (\x -> s{T.projectConfigPackageDBs = x}) (f (T.projectConfigPackageDBs s))
+{-# INLINEABLE projectConfigPackageDBs #-}
+
 projectConfigHaddockIndex :: Lens' ProjectConfigShared (Flag PathTemplate)
 projectConfigHaddockIndex f s = fmap (\x -> s{T.projectConfigHaddockIndex = x}) (f (T.projectConfigHaddockIndex s))
 {-# INLINEABLE projectConfigHaddockIndex #-}
@@ -207,10 +224,6 @@ projectConfigInstallDirs :: Lens' ProjectConfigShared (InstallDirs (Flag PathTem
 projectConfigInstallDirs f s = fmap (\x -> s{T.projectConfigInstallDirs = x}) (f (T.projectConfigInstallDirs s))
 {-# INLINEABLE projectConfigInstallDirs #-}
 
-projectConfigPackageDBs :: Lens' ProjectConfigShared [Maybe PackageDBCWD]
-projectConfigPackageDBs f s = fmap (\x -> s{T.projectConfigPackageDBs = x}) (f (T.projectConfigPackageDBs s))
-{-# INLINEABLE projectConfigPackageDBs #-}
-
 projectConfigLocalNoIndexRepos :: Lens' ProjectConfigShared (NubList LocalRepo)
 projectConfigLocalNoIndexRepos f s = fmap (\x -> s{T.projectConfigLocalNoIndexRepos = x}) (f (T.projectConfigLocalNoIndexRepos s))
 {-# INLINEABLE projectConfigLocalNoIndexRepos #-}

cabal-install/src/Distribution/Client/ProjectConfig/Parsec.hs

@@ -209,7 +209,7 @@ parseProjectSkeleton cacheDir httpTransport verbosity projectDir source (Project
     modifiesCompiler :: ProjectConfig -> Bool
     modifiesCompiler pc = isSet projectConfigHcFlavor || isSet projectConfigHcPath || isSet projectConfigHcPkg
       where
-        isSet f = f (projectConfigShared pc) /= NoFlag
+        isSet f = f (projectConfigToolchain (projectConfigShared pc)) /= NoFlag
 
     sanityWalkPCS :: Bool -> ProjectConfigSkeleton -> ParseResult ProjectFileSource ProjectConfigSkeleton
     sanityWalkPCS underConditional t@(CondNode d _c comps)