From f03ad8d09cfbe3b64a17cb144bc191c8d0f61632 Mon Sep 17 00:00:00 2001
From: Andrea Bedini <andrea@andreabedini.com>
Date: Thu, 6 Mar 2025 17:54:46 +0800
Subject: [PATCH 01/82] feat: add per-file options to extra source files
---
Cabal-syntax/Cabal-syntax.cabal | 1 +
.../src/Distribution/PackageDescription.hs | 4 +
.../PackageDescription/FieldGrammar.hs | 19 +++--
.../src/Distribution/Types/BuildInfo.hs | 20 +++--
.../src/Distribution/Types/BuildInfo/Lens.hs | 13 +--
.../src/Distribution/Types/ExtraSource.hs | 48 +++++++++++
Cabal-tests/tests/NoThunks.hs | 2 +
.../Distribution/Utils/Structured.hs | 4 +-
.../src/Data/TreeDiff/Instances/Cabal.hs | 2 +
.../PackageDescription/Check/Target.hs | 14 ++--
Cabal/src/Distribution/Simple/Build.hs | 20 ++---
Cabal/src/Distribution/Simple/BuildTarget.hs | 10 +--
.../Simple/GHC/Build/ExtraSources.hs | 63 ++++++++-------
Cabal/src/Distribution/Simple/GHC/Internal.hs | 79 +++++++------------
Cabal/src/Distribution/Simple/GHCJS.hs | 32 ++++----
Cabal/src/Distribution/Simple/SrcDist.hs | 10 +--
.../src/Distribution/Client/SourceFiles.hs | 11 +--
.../src/Distribution/Client/TargetSelector.hs | 5 +-
cabal-install/tests/IntegrationTests2.hs | 4 +-
.../PackageTests/ExtraSources/cbits/test.c | 3 +
.../ExtraSources/extra-sources.cabal | 10 +++
.../PackageTests/ExtraSources/setup.out | 5 ++
.../PackageTests/ExtraSources/setup.test.hs | 5 ++
.../PackageTests/ExtraSources/src/MyLib.hs | 4 +
24 files changed, 235 insertions(+), 153 deletions(-)
create mode 100644 Cabal-syntax/src/Distribution/Types/ExtraSource.hs
create mode 100644 cabal-testsuite/PackageTests/ExtraSources/cbits/test.c
create mode 100644 cabal-testsuite/PackageTests/ExtraSources/extra-sources.cabal
create mode 100644 cabal-testsuite/PackageTests/ExtraSources/setup.out
create mode 100644 cabal-testsuite/PackageTests/ExtraSources/setup.test.hs
create mode 100644 cabal-testsuite/PackageTests/ExtraSources/src/MyLib.hs
diff --git a/Cabal-syntax/Cabal-syntax.cabal b/Cabal-syntax/Cabal-syntax.cabal
index 997b91363ce..64aee5d23a4 100644
--- a/Cabal-syntax/Cabal-syntax.cabal
+++ b/Cabal-syntax/Cabal-syntax.cabal
@@ -140,6 +140,7 @@ library
Distribution.Types.Executable
Distribution.Types.Executable.Lens
Distribution.Types.ExecutableScope
+ Distribution.Types.ExtraSource
Distribution.Types.ExposedModule
Distribution.Types.Flag
Distribution.Types.ForeignLib
diff --git a/Cabal-syntax/src/Distribution/PackageDescription.hs b/Cabal-syntax/src/Distribution/PackageDescription.hs
index 47d46673e5f..71078654e68 100644
--- a/Cabal-syntax/src/Distribution/PackageDescription.hs
+++ b/Cabal-syntax/src/Distribution/PackageDescription.hs
@@ -48,6 +48,9 @@ module Distribution.PackageDescription
, module Distribution.Types.HookedBuildInfo
, module Distribution.Types.SetupBuildInfo
+ -- * Extra sources
+ , module Distribution.Types.ExtraSource
+
-- * Flags
, module Distribution.Types.Flag
@@ -95,6 +98,7 @@ import Distribution.Types.ComponentName
import Distribution.Types.CondTree
import Distribution.Types.Condition
import Distribution.Types.ConfVar
+import Distribution.Types.ExtraSource
import Distribution.Types.Dependency
import Distribution.Types.ExeDependency
import Distribution.Types.Executable
diff --git a/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs b/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs
index 49db03ee3c1..bb6f3f25eee 100644
--- a/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs
+++ b/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs
@@ -174,6 +174,7 @@ libraryFieldGrammar
, c (List CommaFSep (Identity PkgconfigDependency) PkgconfigDependency)
, c (List CommaVCat (Identity Dependency) Dependency)
, c (List CommaVCat (Identity Mixin) Mixin)
+ , c (List VCat (Identity ExtraSource) ExtraSource)
, c (List CommaVCat (Identity ModuleReexport) ModuleReexport)
, c (List FSep (MQuoted Extension) Extension)
, c (List FSep (MQuoted Language) Language)
@@ -224,6 +225,7 @@ foreignLibFieldGrammar
, c (List CommaFSep (Identity PkgconfigDependency) PkgconfigDependency)
, c (List CommaVCat (Identity Dependency) Dependency)
, c (List CommaVCat (Identity Mixin) Mixin)
+ , c (List VCat (Identity ExtraSource) ExtraSource)
, c (List FSep (Identity ForeignLibOption) ForeignLibOption)
, c (List FSep (MQuoted Extension) Extension)
, c (List FSep (MQuoted Language) Language)
@@ -263,6 +265,7 @@ executableFieldGrammar
, c (List CommaFSep (Identity PkgconfigDependency) PkgconfigDependency)
, c (List CommaVCat (Identity Dependency) Dependency)
, c (List CommaVCat (Identity Mixin) Mixin)
+ , c (List VCat (Identity ExtraSource) ExtraSource)
, c (List FSep (MQuoted Extension) Extension)
, c (List FSep (MQuoted Language) Language)
, c (List FSep Token String)
@@ -339,6 +342,7 @@ testSuiteFieldGrammar
, c (List CommaFSep Token String)
, c (List CommaVCat (Identity Dependency) Dependency)
, c (List CommaVCat (Identity Mixin) Mixin)
+ , c (List VCat (Identity ExtraSource) ExtraSource)
, c (List FSep (MQuoted Extension) Extension)
, c (List FSep (MQuoted Language) Language)
, c (List FSep Token String)
@@ -483,6 +487,7 @@ benchmarkFieldGrammar
, c (List CommaFSep (Identity PkgconfigDependency) PkgconfigDependency)
, c (List CommaVCat (Identity Dependency) Dependency)
, c (List CommaVCat (Identity Mixin) Mixin)
+ , c (List VCat (Identity ExtraSource) ExtraSource)
, c (List FSep (MQuoted Extension) Extension)
, c (List FSep (MQuoted Language) Language)
, c (List FSep Token String)
@@ -585,6 +590,7 @@ buildInfoFieldGrammar
, c (List CommaFSep (Identity PkgconfigDependency) PkgconfigDependency)
, c (List CommaVCat (Identity Dependency) Dependency)
, c (List CommaVCat (Identity Mixin) Mixin)
+ , c (List VCat (Identity ExtraSource) ExtraSource)
, c (List FSep (MQuoted Extension) Extension)
, c (List FSep (MQuoted Language) Language)
, c (List FSep Token String)
@@ -627,14 +633,14 @@ buildInfoFieldGrammar =
<*> monoidalFieldAla "pkgconfig-depends" (alaList CommaFSep) L.pkgconfigDepends
<*> monoidalFieldAla "frameworks" (alaList' FSep RelativePathNT) L.frameworks
<*> monoidalFieldAla "extra-framework-dirs" (alaList' FSep SymbolicPathNT) L.extraFrameworkDirs
- <*> monoidalFieldAla "asm-sources" (alaList' VCat SymbolicPathNT) L.asmSources
+ <*> monoidalFieldAla "asm-sources" formatExtraSources L.asmSources
^^^ availableSince CabalSpecV3_0 []
- <*> monoidalFieldAla "cmm-sources" (alaList' VCat SymbolicPathNT) L.cmmSources
+ <*> monoidalFieldAla "cmm-sources" formatExtraSources L.cmmSources
^^^ availableSince CabalSpecV3_0 []
- <*> monoidalFieldAla "c-sources" (alaList' VCat SymbolicPathNT) L.cSources
- <*> monoidalFieldAla "cxx-sources" (alaList' VCat SymbolicPathNT) L.cxxSources
+ <*> monoidalFieldAla "c-sources" formatExtraSources L.cSources
+ <*> monoidalFieldAla "cxx-sources" formatExtraSources L.cxxSources
^^^ availableSince CabalSpecV2_2 []
- <*> monoidalFieldAla "js-sources" (alaList' VCat SymbolicPathNT) L.jsSources
+ <*> monoidalFieldAla "js-sources" formatExtraSources L.jsSources
<*> hsSourceDirsGrammar
<*> monoidalFieldAla "other-modules" formatOtherModules L.otherModules
<*> monoidalFieldAla "virtual-modules" (alaList' VCat MQuoted) L.virtualModules
@@ -834,6 +840,9 @@ formatOtherExtensions = alaList' FSep MQuoted
formatOtherModules :: [ModuleName] -> List VCat (MQuoted ModuleName) ModuleName
formatOtherModules = alaList' VCat MQuoted
+formatExtraSources :: [ExtraSource] -> List VCat (Identity ExtraSource) ExtraSource
+formatExtraSources = alaList' VCat Identity
+
-------------------------------------------------------------------------------
-- newtypes
-------------------------------------------------------------------------------
diff --git a/Cabal-syntax/src/Distribution/Types/BuildInfo.hs b/Cabal-syntax/src/Distribution/Types/BuildInfo.hs
index 2d7a5edeae1..a4a68546b92 100644
--- a/Cabal-syntax/src/Distribution/Types/BuildInfo.hs
+++ b/Cabal-syntax/src/Distribution/Types/BuildInfo.hs
@@ -21,6 +21,7 @@ import Prelude ()
import Distribution.Types.Dependency
import Distribution.Types.ExeDependency
+import Distribution.Types.ExtraSource
import Distribution.Types.LegacyExeDependency
import Distribution.Types.Mixin
import Distribution.Types.PkgconfigDependency
@@ -70,14 +71,17 @@ data BuildInfo = BuildInfo
, frameworks :: [RelativePath Framework File]
-- ^ support frameworks for Mac OS X
, extraFrameworkDirs :: [SymbolicPath Pkg (Dir Framework)]
- -- ^ extra locations to find frameworks.
- , asmSources :: [SymbolicPath Pkg File]
- -- ^ Assembly files.
- , cmmSources :: [SymbolicPath Pkg File]
- -- ^ C-- files.
- , cSources :: [SymbolicPath Pkg File]
- , cxxSources :: [SymbolicPath Pkg File]
- , jsSources :: [SymbolicPath Pkg File]
+ -- ^ extra locations to find frameworks
+ , asmSources :: [ExtraSource]
+ -- ^ Assembly source files
+ , cmmSources :: [ExtraSource]
+ -- ^ C-- source files
+ , cSources :: [ExtraSource]
+ -- ^ C source files
+ , cxxSources :: [ExtraSource]
+ -- ^ C++ source files
+ , jsSources :: [ExtraSource]
+ -- ^ JavaScript source file
, hsSourceDirs :: [SymbolicPath Pkg (Dir Source)]
-- ^ where to look for the Haskell module hierarchy
, -- NB: these are symbolic paths are not relative paths,
diff --git a/Cabal-syntax/src/Distribution/Types/BuildInfo/Lens.hs b/Cabal-syntax/src/Distribution/Types/BuildInfo/Lens.hs
index ac99f3c65a5..e50b41485a8 100644
--- a/Cabal-syntax/src/Distribution/Types/BuildInfo/Lens.hs
+++ b/Cabal-syntax/src/Distribution/Types/BuildInfo/Lens.hs
@@ -13,6 +13,7 @@ import Prelude ()
import Distribution.Compiler (PerCompilerFlavor)
import Distribution.ModuleName (ModuleName)
import Distribution.Types.BuildInfo (BuildInfo)
+import Distribution.Types.ExtraSource (ExtraSource)
import Distribution.Types.Dependency (Dependency)
import Distribution.Types.ExeDependency (ExeDependency)
import Distribution.Types.LegacyExeDependency (LegacyExeDependency)
@@ -79,23 +80,23 @@ class HasBuildInfo a where
extraFrameworkDirs = buildInfo . extraFrameworkDirs
{-# INLINE extraFrameworkDirs #-}
- asmSources :: Lens' a [SymbolicPath Pkg File]
+ asmSources :: Lens' a [ExtraSource]
asmSources = buildInfo . asmSources
{-# INLINE asmSources #-}
- cmmSources :: Lens' a [SymbolicPath Pkg File]
+ cmmSources :: Lens' a [ExtraSource]
cmmSources = buildInfo . cmmSources
{-# INLINE cmmSources #-}
- cSources :: Lens' a [SymbolicPath Pkg File]
+ cSources :: Lens' a [ExtraSource]
cSources = buildInfo . cSources
{-# INLINE cSources #-}
- cxxSources :: Lens' a [SymbolicPath Pkg File]
+ cxxSources :: Lens' a [ExtraSource]
cxxSources = buildInfo . cxxSources
{-# INLINE cxxSources #-}
- jsSources :: Lens' a [SymbolicPath Pkg File]
+ jsSources :: Lens' a [ExtraSource]
jsSources = buildInfo . jsSources
{-# INLINE jsSources #-}
@@ -267,7 +268,7 @@ instance HasBuildInfo BuildInfo where
cSources f s = fmap (\x -> s{T.cSources = x}) (f (T.cSources s))
{-# INLINE cSources #-}
- cxxSources f s = fmap (\x -> s{T.cSources = x}) (f (T.cxxSources s))
+ cxxSources f s = fmap (\x -> s{T.cxxSources = x}) (f (T.cxxSources s))
{-# INLINE cxxSources #-}
jsSources f s = fmap (\x -> s{T.jsSources = x}) (f (T.jsSources s))
diff --git a/Cabal-syntax/src/Distribution/Types/ExtraSource.hs b/Cabal-syntax/src/Distribution/Types/ExtraSource.hs
new file mode 100644
index 00000000000..f9ba481502c
--- /dev/null
+++ b/Cabal-syntax/src/Distribution/Types/ExtraSource.hs
@@ -0,0 +1,48 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DataKinds #-}
+
+module Distribution.Types.ExtraSource
+ ( ExtraSource (..)
+ , extraSourceFromPath
+ ) where
+
+import Distribution.Compat.Prelude
+import Prelude ()
+
+import Distribution.Parsec
+import Distribution.Pretty
+import Distribution.Utils.Path (SymbolicPath, FileOrDir(..), Pkg)
+
+import qualified Distribution.Compat.CharParsing as P
+import qualified Text.PrettyPrint as PP
+import Distribution.FieldGrammar.Newtypes (SymbolicPathNT(..))
+
+data ExtraSource = ExtraSource
+ { extraSourceFile :: SymbolicPath Pkg File
+ , extraSourceOpts :: [String]
+ }
+ deriving (Generic, Show, Read, Eq, Ord, Typeable, Data)
+
+instance Binary ExtraSource
+instance Structured ExtraSource
+instance NFData ExtraSource where rnf = genericRnf
+
+instance Parsec ExtraSource where
+ parsec = do
+ SymbolicPathNT path <- parsec <* P.spaces
+ opts <- P.optional (parensLax (P.sepBy p P.spaces))
+ return (ExtraSource path (fromMaybe mempty opts))
+ where
+ p :: P.CharParsing p => p String
+ p = some $ P.satisfy (\c -> not (isSpace c) && not (c == ')'))
+
+parensLax :: (P.CharParsing m) => m a -> m a
+parensLax p = P.between (P.char '(' *> P.spaces) (P.char ')' *> P.spaces) p
+
+instance Pretty ExtraSource where
+ pretty (ExtraSource path opts) =
+ pretty (SymbolicPathNT path) <<>> PP.parens (PP.hsep (map PP.text opts))
+
+extraSourceFromPath :: SymbolicPath Pkg File -> ExtraSource
+extraSourceFromPath fp = ExtraSource fp mempty
diff --git a/Cabal-tests/tests/NoThunks.hs b/Cabal-tests/tests/NoThunks.hs
index 6a81475dc03..ffc4a4da0d9 100644
--- a/Cabal-tests/tests/NoThunks.hs
+++ b/Cabal-tests/tests/NoThunks.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleInstances #-}
#if !(__GLASGOW_HASKELL__ >= 806 && defined(MIN_VERSION_nothunks))
module Main (main) where
main :: IO ()
@@ -72,6 +73,7 @@ instance NoThunks ConfVar
instance NoThunks Dependency
instance NoThunks Executable
instance NoThunks ExecutableScope
+instance NoThunks ExtraSource
instance NoThunks FlagName
instance NoThunks ForeignLib
instance NoThunks ForeignLibOption
diff --git a/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs b/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs
index 47a0cc1bd2c..cd0f73aeedd 100644
--- a/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs
+++ b/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs
@@ -29,8 +29,8 @@ md5Check proxy md5Int = structureHash proxy @?= md5FromInteger md5Int
md5CheckGenericPackageDescription :: Proxy GenericPackageDescription -> Assertion
md5CheckGenericPackageDescription proxy = md5Check proxy
- 0x09251b46ffc5178a7526d31e794d9c62
+ 0x77f4c09dc9b1c6967b07516ad35e73af
md5CheckLocalBuildInfo :: Proxy LocalBuildInfo -> Assertion
md5CheckLocalBuildInfo proxy = md5Check proxy
- 0x8fa7b2c8cc611407bfdcb734ecb460a2
+ 0x69dab39bf8b56871b28a2c14d423b18a
diff --git a/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs b/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs
index cb36fe680db..42ab97cc4b0 100644
--- a/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs
+++ b/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs
@@ -1,5 +1,6 @@
{-# OPTIONS_GHC -freduction-depth=0 #-}
{-# OPTIONS_GHC -Wno-orphans #-}
+{-# LANGUAGE FlexibleInstances #-}
module Data.TreeDiff.Instances.Cabal () where
import Data.TreeDiff
@@ -77,6 +78,7 @@ instance ToExpr ExeDependency
instance ToExpr Executable
instance ToExpr ExecutableScope
instance ToExpr ExposedModule
+instance ToExpr ExtraSource
instance ToExpr FlagAssignment
instance ToExpr FlagName
instance ToExpr ForeignLib
diff --git a/Cabal/src/Distribution/PackageDescription/Check/Target.hs b/Cabal/src/Distribution/PackageDescription/Check/Target.hs
index 0bf173cb980..c62f7e40756 100644
--- a/Cabal/src/Distribution/PackageDescription/Check/Target.hs
+++ b/Cabal/src/Distribution/PackageDescription/Check/Target.hs
@@ -445,11 +445,11 @@ checkBuildInfoPathsContent bi = do
-- Paths well-formedness check for BuildInfo.
checkBuildInfoPathsWellFormedness :: Monad m => BuildInfo -> CheckM m ()
checkBuildInfoPathsWellFormedness bi = do
- mapM_ (checkPath False "asm-sources" PathKindFile . getSymbolicPath) (asmSources bi)
- mapM_ (checkPath False "cmm-sources" PathKindFile . getSymbolicPath) (cmmSources bi)
- mapM_ (checkPath False "c-sources" PathKindFile . getSymbolicPath) (cSources bi)
- mapM_ (checkPath False "cxx-sources" PathKindFile . getSymbolicPath) (cxxSources bi)
- mapM_ (checkPath False "js-sources" PathKindFile . getSymbolicPath) (jsSources bi)
+ mapM_ (checkPath False "asm-sources" PathKindFile . getSymbolicPath . extraSourceFile) (asmSources bi)
+ mapM_ (checkPath False "cmm-sources" PathKindFile . getSymbolicPath . extraSourceFile) (cmmSources bi)
+ mapM_ (checkPath False "c-sources" PathKindFile . getSymbolicPath . extraSourceFile) (cSources bi)
+ mapM_ (checkPath False "cxx-sources" PathKindFile . getSymbolicPath . extraSourceFile) (cxxSources bi)
+ mapM_ (checkPath False "js-sources" PathKindFile . getSymbolicPath . extraSourceFile) (jsSources bi)
mapM_
(checkPath False "install-includes" PathKindFile . getSymbolicPath)
(installIncludes bi)
@@ -515,8 +515,8 @@ checkBuildInfoFeatures bi sv = do
(PackageBuildWarning CVExtensionsDeprecated)
-- asm-sources, cmm-sources and friends only w/ spec ≥ 1.10
- checkCVSources (map getSymbolicPath $ asmSources bi)
- checkCVSources (map getSymbolicPath $ cmmSources bi)
+ checkCVSources (map (getSymbolicPath . extraSourceFile) $ asmSources bi)
+ checkCVSources (map (getSymbolicPath . extraSourceFile) $ cmmSources bi)
checkCVSources (extraBundledLibs bi)
checkCVSources (extraLibFlavours bi)
diff --git a/Cabal/src/Distribution/Simple/Build.hs b/Cabal/src/Distribution/Simple/Build.hs
index 0ebd51e48ef..410db8d3062 100644
--- a/Cabal/src/Distribution/Simple/Build.hs
+++ b/Cabal/src/Distribution/Simple/Build.hs
@@ -642,35 +642,35 @@ generateCode codeGens nm pdesc bi lbi clbi verbosity = do
addExtraCSources :: BuildInfo -> [SymbolicPath Pkg File] -> BuildInfo
addExtraCSources bi extras = bi{cSources = new}
where
- new = ordNub (extras ++ cSources bi)
+ new = ordNub (map extraSourceFromPath extras ++ cSources bi)
-- | Add extra C++ sources generated by preprocessing to build
-- information.
addExtraCxxSources :: BuildInfo -> [SymbolicPath Pkg File] -> BuildInfo
addExtraCxxSources bi extras = bi{cxxSources = new}
where
- new = ordNub (extras ++ cxxSources bi)
+ new = ordNub (map extraSourceFromPath extras ++ cxxSources bi)
-- | Add extra C-- sources generated by preprocessing to build
-- information.
addExtraCmmSources :: BuildInfo -> [SymbolicPath Pkg File] -> BuildInfo
addExtraCmmSources bi extras = bi{cmmSources = new}
where
- new = ordNub (extras ++ cmmSources bi)
+ new = ordNub (map extraSourceFromPath extras ++ cmmSources bi)
-- | Add extra ASM sources generated by preprocessing to build
-- information.
addExtraAsmSources :: BuildInfo -> [SymbolicPath Pkg File] -> BuildInfo
addExtraAsmSources bi extras = bi{asmSources = new}
where
- new = ordNub (extras ++ asmSources bi)
+ new = ordNub (map extraSourceFromPath extras ++ asmSources bi)
-- | Add extra JS sources generated by preprocessing to build
-- information.
addExtraJsSources :: BuildInfo -> [SymbolicPath Pkg File] -> BuildInfo
addExtraJsSources bi extras = bi{jsSources = new}
where
- new = ordNub (extras ++ jsSources bi)
+ new = ordNub (map extraSourceFromPath extras ++ jsSources bi)
-- | Add extra HS modules generated by preprocessing to build
-- information.
@@ -716,7 +716,7 @@ replComponent
preprocessComponent pkg_descr comp lbi clbi False verbosity suffixHandlers
extras <- preprocessExtras verbosity comp lbi
let libbi = libBuildInfo lib
- lib' = lib{libBuildInfo = libbi{cSources = cSources libbi ++ extras}}
+ lib' = lib{libBuildInfo = libbi{cSources = cSources libbi ++ map extraSourceFromPath extras}}
replLib replFlags pkg lbi lib' libClbi
replComponent
replFlags
@@ -733,23 +733,23 @@ replComponent
case comp of
CLib lib -> do
let libbi = libBuildInfo lib
- lib' = lib{libBuildInfo = libbi{cSources = cSources libbi ++ extras}}
+ lib' = lib{libBuildInfo = libbi{cSources = cSources libbi ++ map extraSourceFromPath extras}}
replLib replFlags pkg_descr lbi lib' clbi
CFLib flib ->
replFLib replFlags pkg_descr lbi flib clbi
CExe exe -> do
let ebi = buildInfo exe
- exe' = exe{buildInfo = ebi{cSources = cSources ebi ++ extras}}
+ exe' = exe{buildInfo = ebi{cSources = cSources ebi ++ map extraSourceFromPath extras}}
replExe replFlags pkg_descr lbi exe' clbi
CTest test@TestSuite{testInterface = TestSuiteExeV10{}} -> do
let exe = testSuiteExeV10AsExe test
let ebi = buildInfo exe
- exe' = exe{buildInfo = ebi{cSources = cSources ebi ++ extras}}
+ exe' = exe{buildInfo = ebi{cSources = cSources ebi ++ map extraSourceFromPath extras}}
replExe replFlags pkg_descr lbi exe' clbi
CBench bm@Benchmark{benchmarkInterface = BenchmarkExeV10{}} -> do
let exe = benchmarkExeV10asExe bm
let ebi = buildInfo exe
- exe' = exe{buildInfo = ebi{cSources = cSources ebi ++ extras}}
+ exe' = exe{buildInfo = ebi{cSources = cSources ebi ++ map extraSourceFromPath extras}}
replExe replFlags pkg_descr lbi exe' clbi
#if __GLASGOW_HASKELL__ < 811
-- silence pattern-match warnings prior to GHC 9.0
diff --git a/Cabal/src/Distribution/Simple/BuildTarget.hs b/Cabal/src/Distribution/Simple/BuildTarget.hs
index ffa7a609e6b..1d987c7715f 100644
--- a/Cabal/src/Distribution/Simple/BuildTarget.hs
+++ b/Cabal/src/Distribution/Simple/BuildTarget.hs
@@ -497,11 +497,11 @@ pkgComponentInfo pkg =
, cinfoSrcDirs = map getSymbolicPath $ hsSourceDirs bi
, cinfoModules = componentModules c
, cinfoHsFiles = map getSymbolicPath $ componentHsFiles c
- , cinfoAsmFiles = map getSymbolicPath $ asmSources bi
- , cinfoCmmFiles = map getSymbolicPath $ cmmSources bi
- , cinfoCFiles = map getSymbolicPath $ cSources bi
- , cinfoCxxFiles = map getSymbolicPath $ cxxSources bi
- , cinfoJsFiles = map getSymbolicPath $ jsSources bi
+ , cinfoAsmFiles = map (getSymbolicPath . extraSourceFile) $ asmSources bi
+ , cinfoCmmFiles = map (getSymbolicPath . extraSourceFile) $ cmmSources bi
+ , cinfoCFiles = map (getSymbolicPath . extraSourceFile) $ cSources bi
+ , cinfoCxxFiles = map (getSymbolicPath . extraSourceFile) $ cxxSources bi
+ , cinfoJsFiles = map (getSymbolicPath . extraSourceFile) $ jsSources bi
}
| c <- pkgComponents pkg
, let bi = componentBuildInfo c
diff --git a/Cabal/src/Distribution/Simple/GHC/Build/ExtraSources.hs b/Cabal/src/Distribution/Simple/GHC/Build/ExtraSources.hs
index f2ca9aba02f..9304d3691ae 100644
--- a/Cabal/src/Distribution/Simple/GHC/Build/ExtraSources.hs
+++ b/Cabal/src/Distribution/Simple/GHC/Build/ExtraSources.hs
@@ -26,6 +26,7 @@ import Distribution.Simple.Program.Types
import Distribution.Simple.Setup.Common (commonSetupTempFileOptions)
import Distribution.System (Arch (JavaScript), Platform (..))
import Distribution.Types.ComponentLocalBuildInfo
+import Distribution.Types.ExtraSource (ExtraSource(..))
import Distribution.Utils.Path
import Distribution.Verbosity (Verbosity)
@@ -53,23 +54,21 @@ buildAllExtraSources =
, buildCmmSources
]
-buildCSources
- , buildCxxSources
- , buildJsSources
- , buildAsmSources
- , buildCmmSources
- :: Maybe (SymbolicPath Pkg File)
- -- ^ An optional non-Haskell Main file
- -> ConfiguredProgram
- -- ^ The GHC configured program
- -> SymbolicPath Pkg (Dir Artifacts)
- -- ^ The build directory for this target
- -> (Bool -> [BuildWay], Bool -> BuildWay, BuildWay)
- -- ^ Needed build ways
- -> PreBuildComponentInputs
- -- ^ The context and component being built in it.
- -> IO (NubListR (SymbolicPath Pkg File))
- -- ^ Returns the list of extra sources that were built
+type ExtraSourceBuilder =
+ Maybe (SymbolicPath Pkg File)
+ -- ^ An optional non-Haskell Main file
+ -> ConfiguredProgram
+ -- ^ The GHC configured program
+ -> SymbolicPath Pkg (Dir Artifacts)
+ -- ^ The build directory for this target
+ -> (Bool -> [BuildWay], Bool -> BuildWay, BuildWay)
+ -- ^ Needed build ways
+ -> PreBuildComponentInputs
+ -- ^ The context and component being built in it.
+ -> IO (NubListR (SymbolicPath Pkg File))
+ -- ^ Returns the list of extra sources that were built
+
+buildCSources :: ExtraSourceBuilder
buildCSources mbMainFile =
buildExtraSources
"C Sources"
@@ -80,9 +79,11 @@ buildCSources mbMainFile =
CExe{}
| Just main <- mbMainFile
, isC $ getSymbolicPath main ->
- cFiles ++ [main]
+ cFiles ++ [ExtraSource main mempty]
_otherwise -> cFiles
)
+
+buildCxxSources :: ExtraSourceBuilder
buildCxxSources mbMainFile =
buildExtraSources
"C++ Sources"
@@ -93,9 +94,11 @@ buildCxxSources mbMainFile =
CExe{}
| Just main <- mbMainFile
, isCxx $ getSymbolicPath main ->
- cxxFiles ++ [main]
+ cxxFiles ++ [ExtraSource main mempty]
_otherwise -> cxxFiles
)
+
+buildJsSources :: ExtraSourceBuilder
buildJsSources _mbMainFile ghcProg buildTargetDir neededWays = do
Platform hostArch _ <- hostPlatform <$> localBuildInfo
let hasJsSupport = hostArch == JavaScript
@@ -114,11 +117,15 @@ buildJsSources _mbMainFile ghcProg buildTargetDir neededWays = do
ghcProg
buildTargetDir
neededWays
+
+buildAsmSources :: ExtraSourceBuilder
buildAsmSources _mbMainFile =
buildExtraSources
"Assembler Sources"
Internal.componentAsmGhcOptions
(asmSources . componentBuildInfo)
+
+buildCmmSources :: ExtraSourceBuilder
buildCmmSources _mbMainFile =
buildExtraSources
"C-- Sources"
@@ -136,14 +143,14 @@ buildExtraSources
-> BuildInfo
-> ComponentLocalBuildInfo
-> SymbolicPath Pkg (Dir Artifacts)
- -> SymbolicPath Pkg File
+ -> ExtraSource
-> GhcOptions
)
-- ^ Function to determine the @'GhcOptions'@ for the
-- invocation of GHC when compiling these extra sources (e.g.
-- @'Internal.componentCxxGhcOptions'@,
-- @'Internal.componentCmmGhcOptions'@)
- -> (Component -> [SymbolicPath Pkg File])
+ -> (Component -> [ExtraSource])
-- ^ View the extra sources of a component, typically from
-- the build info (e.g. @'asmSources'@, @'cSources'@).
-- @'Executable'@ components might additionally add the
@@ -189,8 +196,8 @@ buildExtraSources
platform
mbWorkDir
- buildAction :: SymbolicPath Pkg File -> IO ()
- buildAction sourceFile = do
+ buildAction :: ExtraSource -> IO ()
+ buildAction extraSource = do
let baseSrcOpts =
componentSourceGhcOptions
verbosity
@@ -198,7 +205,7 @@ buildExtraSources
bi
clbi
buildTargetDir
- sourceFile
+ extraSource
vanillaSrcOpts =
-- -fPIC is used in case you are using the repl
-- of a dynamically linked GHC
@@ -228,9 +235,9 @@ buildExtraSources
odir = fromFlag (ghcOptObjDir vanillaSrcOpts)
compileIfNeeded :: GhcOptions -> IO ()
- compileIfNeeded opts = do
- needsRecomp <- checkNeedsRecompilation mbWorkDir sourceFile opts
- when needsRecomp $ runGhcProg opts
+ compileIfNeeded opts' = do
+ needsRecomp <- checkNeedsRecompilation mbWorkDir (extraSourceFile extraSource) opts'
+ when needsRecomp $ runGhcProg opts'
createDirectoryIfMissingVerbose verbosity True (i odir)
case targetComponent targetInfo of
@@ -269,4 +276,4 @@ buildExtraSources
else do
info verbosity ("Building " ++ description ++ "...")
traverse_ buildAction sources
- return (toNubListR sources)
+ return (toNubListR (map extraSourceFile sources))
diff --git a/Cabal/src/Distribution/Simple/GHC/Internal.hs b/Cabal/src/Distribution/Simple/GHC/Internal.hs
index 6e27b41bc83..f4083859dea 100644
--- a/Cabal/src/Distribution/Simple/GHC/Internal.hs
+++ b/Cabal/src/Distribution/Simple/GHC/Internal.hs
@@ -357,21 +357,24 @@ includePaths lbi bi clbi odir =
| dir <- mapMaybe (symbolicPathRelative_maybe . unsafeCoerceSymbolicPath) $ includeDirs bi
]
-componentCcGhcOptions
- :: Verbosity
- -> LocalBuildInfo
- -> BuildInfo
- -> ComponentLocalBuildInfo
- -> SymbolicPath Pkg (Dir Artifacts)
- -> SymbolicPath Pkg File
- -> GhcOptions
-componentCcGhcOptions verbosity lbi bi clbi odir filename =
+type ExtraSourceGhcOptions =
+ Verbosity
+ -> LocalBuildInfo
+ -> BuildInfo
+ -> ComponentLocalBuildInfo
+ -> SymbolicPath Pkg (Dir Artifacts)
+ -> ExtraSource
+ -> GhcOptions
+
+
+componentCcGhcOptions :: ExtraSourceGhcOptions
+componentCcGhcOptions verbosity lbi bi clbi odir extraSource =
mempty
{ -- Respect -v0, but don't crank up verbosity on GHC if
-- Cabal verbosity is requested. For that, use --ghc-option=-v instead!
ghcOptVerbosity = toFlag (min verbosity normal)
, ghcOptMode = toFlag GhcModeCompile
- , ghcOptInputFiles = toNubListR [filename]
+ , ghcOptInputFiles = toNubListR [extraSourceFile extraSource]
, ghcOptCppIncludePath = includePaths lbi bi clbi odir
, ghcOptHideAllPackages = toFlag True
, ghcOptPackageDBs = withPackageDB lbi
@@ -388,6 +391,7 @@ componentCcGhcOptions verbosity lbi bi clbi odir filename =
MaximalDebugInfo -> ["-g3"]
)
++ ccOptions bi
+ ++ extraSourceOpts extraSource
, ghcOptCcProgram =
maybeToFlag $
programPath
@@ -396,21 +400,14 @@ componentCcGhcOptions verbosity lbi bi clbi odir filename =
, ghcOptExtra = hcOptions GHC bi
}
-componentCxxGhcOptions
- :: Verbosity
- -> LocalBuildInfo
- -> BuildInfo
- -> ComponentLocalBuildInfo
- -> SymbolicPath Pkg (Dir Artifacts)
- -> SymbolicPath Pkg File
- -> GhcOptions
-componentCxxGhcOptions verbosity lbi bi clbi odir filename =
+componentCxxGhcOptions :: ExtraSourceGhcOptions
+componentCxxGhcOptions verbosity lbi bi clbi odir extraSource =
mempty
{ -- Respect -v0, but don't crank up verbosity on GHC if
-- Cabal verbosity is requested. For that, use --ghc-option=-v instead!
ghcOptVerbosity = toFlag (min verbosity normal)
, ghcOptMode = toFlag GhcModeCompile
- , ghcOptInputFiles = toNubListR [filename]
+ , ghcOptInputFiles = toNubListR [extraSourceFile extraSource]
, ghcOptCppIncludePath = includePaths lbi bi clbi odir
, ghcOptHideAllPackages = toFlag True
, ghcOptPackageDBs = withPackageDB lbi
@@ -427,6 +424,7 @@ componentCxxGhcOptions verbosity lbi bi clbi odir filename =
MaximalDebugInfo -> ["-g3"]
)
++ cxxOptions bi
+ ++ extraSourceOpts extraSource
, ghcOptCcProgram =
maybeToFlag $
programPath
@@ -435,21 +433,14 @@ componentCxxGhcOptions verbosity lbi bi clbi odir filename =
, ghcOptExtra = hcOptions GHC bi
}
-componentAsmGhcOptions
- :: Verbosity
- -> LocalBuildInfo
- -> BuildInfo
- -> ComponentLocalBuildInfo
- -> SymbolicPath Pkg (Dir Artifacts)
- -> SymbolicPath Pkg File
- -> GhcOptions
-componentAsmGhcOptions verbosity lbi bi clbi odir filename =
+componentAsmGhcOptions :: ExtraSourceGhcOptions
+componentAsmGhcOptions verbosity lbi bi clbi odir extraSource =
mempty
{ -- Respect -v0, but don't crank up verbosity on GHC if
-- Cabal verbosity is requested. For that, use --ghc-option=-v instead!
ghcOptVerbosity = toFlag (min verbosity normal)
, ghcOptMode = toFlag GhcModeCompile
- , ghcOptInputFiles = toNubListR [filename]
+ , ghcOptInputFiles = toNubListR [extraSourceFile extraSource]
, ghcOptCppIncludePath = includePaths lbi bi clbi odir
, ghcOptHideAllPackages = toFlag True
, ghcOptPackageDBs = withPackageDB lbi
@@ -469,21 +460,14 @@ componentAsmGhcOptions verbosity lbi bi clbi odir filename =
, ghcOptObjDir = toFlag odir
}
-componentJsGhcOptions
- :: Verbosity
- -> LocalBuildInfo
- -> BuildInfo
- -> ComponentLocalBuildInfo
- -> SymbolicPath Pkg (Dir Artifacts)
- -> SymbolicPath Pkg File
- -> GhcOptions
-componentJsGhcOptions verbosity lbi bi clbi odir filename =
+componentJsGhcOptions :: ExtraSourceGhcOptions
+componentJsGhcOptions verbosity lbi bi clbi odir extraSource =
mempty
{ -- Respect -v0, but don't crank up verbosity on GHC if
-- Cabal verbosity is requested. For that, use --ghc-option=-v instead!
ghcOptVerbosity = toFlag (min verbosity normal)
, ghcOptMode = toFlag GhcModeCompile
- , ghcOptInputFiles = toNubListR [filename]
+ , ghcOptInputFiles = toNubListR [extraSourceFile extraSource]
, ghcOptCppIncludePath = includePaths lbi bi clbi odir
, ghcOptHideAllPackages = toFlag True
, ghcOptPackageDBs = withPackageDB lbi
@@ -577,21 +561,14 @@ toGhcOptimisation NoOptimisation = mempty -- TODO perhaps override?
toGhcOptimisation NormalOptimisation = toFlag GhcNormalOptimisation
toGhcOptimisation MaximumOptimisation = toFlag GhcMaximumOptimisation
-componentCmmGhcOptions
- :: Verbosity
- -> LocalBuildInfo
- -> BuildInfo
- -> ComponentLocalBuildInfo
- -> SymbolicPath Pkg (Dir Artifacts)
- -> SymbolicPath Pkg File
- -> GhcOptions
-componentCmmGhcOptions verbosity lbi bi clbi odir filename =
+componentCmmGhcOptions :: ExtraSourceGhcOptions
+componentCmmGhcOptions verbosity lbi bi clbi odir extraSource =
mempty
{ -- Respect -v0, but don't crank up verbosity on GHC if
-- Cabal verbosity is requested. For that, use --ghc-option=-v instead!
ghcOptVerbosity = toFlag (min verbosity normal)
, ghcOptMode = toFlag GhcModeCompile
- , ghcOptInputFiles = toNubListR [filename]
+ , ghcOptInputFiles = toNubListR [extraSourceFile extraSource]
, ghcOptCppIncludePath = includePaths lbi bi clbi odir
, ghcOptCppOptions = cppOptions bi
, ghcOptCppIncludes =
@@ -602,7 +579,7 @@ componentCmmGhcOptions verbosity lbi bi clbi odir filename =
, ghcOptPackages = toNubListR $ mkGhcOptPackages (promisedPkgs lbi) clbi
, ghcOptOptimisation = toGhcOptimisation (withOptimization lbi)
, ghcOptDebugInfo = toFlag (withDebugInfo lbi)
- , ghcOptExtra = cmmOptions bi
+ , ghcOptExtra = cmmOptions bi ++ extraSourceOpts extraSource
, ghcOptObjDir = toFlag odir
}
diff --git a/Cabal/src/Distribution/Simple/GHCJS.hs b/Cabal/src/Distribution/Simple/GHCJS.hs
index ca71857828e..ddf65bf5f60 100644
--- a/Cabal/src/Distribution/Simple/GHCJS.hs
+++ b/Cabal/src/Distribution/Simple/GHCJS.hs
@@ -60,6 +60,7 @@ import Distribution.Simple.BuildPaths
import Distribution.Simple.Compiler
import Distribution.Simple.Errors
import Distribution.Simple.Flag
+import Distribution.Simple.GHC.Build.Utils (isCxx)
import Distribution.Simple.GHC.EnvironmentParser
import Distribution.Simple.GHC.ImplInfo
import qualified Distribution.Simple.GHC.Internal as Internal
@@ -509,8 +510,6 @@ buildOrReplLib mReplFlags verbosity numJobs _pkg_descr lbi lib clbi = do
-- See Note [Symbolic paths] in Distribution.Utils.Path
i = interpretSymbolicPathLBI lbi
- u :: SymbolicPathX allowAbs Pkg to -> FilePath
- u = getSymbolicPath
(ghcjsProg, _) <- requireProgram verbosity ghcjsProgram (withPrograms lbi)
let runGhcjsProg = runGHC verbosity ghcjsProg comp platform mbWorkDir
@@ -538,7 +537,7 @@ buildOrReplLib mReplFlags verbosity numJobs _pkg_descr lbi lib clbi = do
-- modules?
let cLikeFiles = fromNubListR $ toNubListR (cSources libBi) <> toNubListR (cxxSources libBi)
jsSrcs = jsSources libBi
- cObjs = map ((`replaceExtensionSymbolicPath` objExtension)) cLikeFiles
+ cObjs = map ((`replaceExtensionSymbolicPath` objExtension) . extraSourceFile) cLikeFiles
baseOpts = componentGhcOptions verbosity lbi libBi clbi libTargetDir
linkJsLibOpts =
mempty
@@ -546,9 +545,9 @@ buildOrReplLib mReplFlags verbosity numJobs _pkg_descr lbi lib clbi = do
[ "-link-js-lib"
, getHSLibraryName uid
, "-js-lib-outputdir"
- , u libTargetDir
+ , getSymbolicPath libTargetDir
]
- ++ map u jsSrcs
+ ++ foldMap (\(ExtraSource file opts) -> getSymbolicPath file : opts) jsSrcs
}
vanillaOptsNoJsLib =
baseOpts
@@ -702,7 +701,7 @@ buildOrReplLib mReplFlags verbosity numJobs _pkg_descr lbi lib clbi = do
info verbosity "Linking..."
let cSharedObjs =
map
- ((`replaceExtensionSymbolicPath` ("dyn_" ++ objExtension)))
+ ((`replaceExtensionSymbolicPath` ("dyn_" ++ objExtension)) . extraSourceFile)
(cSources libBi ++ cxxSources libBi)
compiler_id = compilerId (compiler lbi)
sharedLibFilePath = libTargetDir </> makeRelativePathEx (mkSharedLibName (hostPlatform lbi) compiler_id uid)
@@ -1115,8 +1114,8 @@ decodeMainIsArg arg
--
-- Used to correctly build and link sources.
data BuildSources = BuildSources
- { cSourcesFiles :: [SymbolicPath Pkg File]
- , cxxSourceFiles :: [SymbolicPath Pkg File]
+ { cSourcesFiles :: [ExtraSource]
+ , cxxSourceFiles :: [ExtraSource]
, inputSourceFiles :: [SymbolicPath Pkg File]
, inputSourceModules :: [ModuleName]
}
@@ -1167,7 +1166,7 @@ gbuildSources verbosity mbWorkDir pkgId specVer tmpDir bm =
return
BuildSources
- { cSourcesFiles = cSources bnfo
+ { cSourcesFiles = cSources bnfo
, cxxSourceFiles = cxxSources bnfo
, inputSourceFiles = [main]
, inputSourceModules = filter (/= mainModName) $ exeModules exe
@@ -1182,11 +1181,11 @@ gbuildSources verbosity mbWorkDir pkgId specVer tmpDir bm =
}
else
let (csf, cxxsf)
- | isCxx (getSymbolicPath main) = (cSources bnfo, main : cxxSources bnfo)
+ | isCxx (getSymbolicPath main) = (cSources bnfo, extraSourceFromPath main : cxxSources bnfo)
-- if main is not a Haskell source
-- and main is not a C++ source
-- then we assume that it is a C source
- | otherwise = (main : cSources bnfo, cxxSources bnfo)
+ | otherwise = (extraSourceFromPath main : cSources bnfo, cxxSources bnfo)
in return
BuildSources
{ cSourcesFiles = csf
@@ -1204,9 +1203,6 @@ gbuildSources verbosity mbWorkDir pkgId specVer tmpDir bm =
, inputSourceModules = foreignLibModules flib
}
- isCxx :: FilePath -> Bool
- isCxx fp = elem (takeExtension fp) [".cpp", ".cxx", ".c++"]
-
-- | FilePath has a Haskell extension: .hs or .lhs
isHaskell :: FilePath -> Bool
isHaskell fp = elem (takeExtension fp) [".hs", ".lhs"]
@@ -1267,8 +1263,8 @@ gbuild verbosity numJobs pkg_descr lbi bm clbi = do
inputModules = inputSourceModules buildSources
isGhcDynamic = isDynamic comp
dynamicTooSupported = supportsDynamicToo comp
- cObjs = map ((`replaceExtensionSymbolicPath` objExtension)) cSrcs
- cxxObjs = map ((`replaceExtensionSymbolicPath` objExtension)) cxxSrcs
+ cObjs = map ((`replaceExtensionSymbolicPath` objExtension) . extraSourceFile) cSrcs
+ cxxObjs = map ((`replaceExtensionSymbolicPath` objExtension) . extraSourceFile) cxxSrcs
needDynamic = gbuildNeedDynamic lbi bm
needProfiling = withProfExe lbi
@@ -1470,7 +1466,7 @@ gbuild verbosity numJobs pkg_descr lbi bm clbi = do
-- add a warning if this occurs.
odir = fromFlag (ghcOptObjDir opts)
createDirectoryIfMissingVerbose verbosity True (i odir)
- needsRecomp <- checkNeedsRecompilation mbWorkDir filename opts
+ needsRecomp <- checkNeedsRecompilation mbWorkDir (extraSourceFile filename) opts
when needsRecomp $
runGhcProg opts
| filename <- cxxSrcs
@@ -1512,7 +1508,7 @@ gbuild verbosity numJobs pkg_descr lbi bm clbi = do
| otherwise = vanillaCcOpts
odir = fromFlag (ghcOptObjDir opts)
createDirectoryIfMissingVerbose verbosity True (i odir)
- needsRecomp <- checkNeedsRecompilation mbWorkDir filename opts
+ needsRecomp <- checkNeedsRecompilation mbWorkDir (extraSourceFile filename) opts
when needsRecomp $
runGhcProg opts
| filename <- cSrcs
diff --git a/Cabal/src/Distribution/Simple/SrcDist.hs b/Cabal/src/Distribution/Simple/SrcDist.hs
index 67f901bf7fb..4e751ed1bbb 100644
--- a/Cabal/src/Distribution/Simple/SrcDist.hs
+++ b/Cabal/src/Distribution/Simple/SrcDist.hs
@@ -566,11 +566,11 @@ allSourcesBuildInfo verbosity rip mbWorkDir bi pps modules = do
return $
sources
++ catMaybes bootFiles
- ++ cSources bi
- ++ cxxSources bi
- ++ cmmSources bi
- ++ asmSources bi
- ++ jsSources bi
+ ++ map extraSourceFile (cSources bi)
+ ++ map extraSourceFile (cxxSources bi)
+ ++ map extraSourceFile (cmmSources bi)
+ ++ map extraSourceFile (asmSources bi)
+ ++ map extraSourceFile (jsSources bi)
where
nonEmpty' :: b -> ([a] -> b) -> [a] -> b
nonEmpty' x _ [] = x
diff --git a/cabal-install/src/Distribution/Client/SourceFiles.hs b/cabal-install/src/Distribution/Client/SourceFiles.hs
index 1166f333f3c..52b203d18c8 100644
--- a/cabal-install/src/Distribution/Client/SourceFiles.hs
+++ b/cabal-install/src/Distribution/Client/SourceFiles.hs
@@ -28,6 +28,7 @@ import Distribution.Types.BuildInfo
import Distribution.Types.Component
import Distribution.Types.ComponentRequestedSpec (ComponentRequestedSpec)
import Distribution.Types.Executable
+import Distribution.Types.ExtraSource
import Distribution.Types.ForeignLib
import Distribution.Types.Library
import Distribution.Types.PackageDescription
@@ -176,11 +177,11 @@ needBuildInfo pkg_descr bi modules = do
matchDirFileGlobWithDie normal (\_ _ -> return []) (specVersion pkg_descr) (Just $ makeSymbolicPath root) fpath
traverse_ needIfExists $
concat
- [ map getSymbolicPath $ cSources bi
- , map getSymbolicPath $ cxxSources bi
- , map getSymbolicPath $ jsSources bi
- , map getSymbolicPath $ cmmSources bi
- , map getSymbolicPath $ asmSources bi
+ [ map (getSymbolicPath . extraSourceFile) $ cSources bi
+ , map (getSymbolicPath . extraSourceFile) $ cxxSources bi
+ , map (getSymbolicPath . extraSourceFile) $ jsSources bi
+ , map (getSymbolicPath . extraSourceFile) $ cmmSources bi
+ , map (getSymbolicPath . extraSourceFile) $ asmSources bi
, map getSymbolicPath $ expandedExtraSrcFiles
]
for_ (fmap getSymbolicPath $ installIncludes bi) $ \f ->
diff --git a/cabal-install/src/Distribution/Client/TargetSelector.hs b/cabal-install/src/Distribution/Client/TargetSelector.hs
index b31655c59c6..61ca11f087a 100644
--- a/cabal-install/src/Distribution/Client/TargetSelector.hs
+++ b/cabal-install/src/Distribution/Client/TargetSelector.hs
@@ -72,6 +72,7 @@ import Distribution.PackageDescription
, BenchmarkInterface (..)
, BuildInfo (..)
, Executable (..)
+ , ExtraSource (..)
, PackageDescription
, TestSuite (..)
, TestSuiteInterface (..)
@@ -1921,8 +1922,8 @@ collectKnownComponentInfo pkg =
, cinfoSrcDirs = ordNub (map getSymbolicPath (hsSourceDirs bi))
, cinfoModules = ordNub (componentModules c)
, cinfoHsFiles = ordNub (componentHsFiles c)
- , cinfoCFiles = ordNub (map getSymbolicPath $ cSources bi)
- , cinfoJsFiles = ordNub (map getSymbolicPath $ jsSources bi)
+ , cinfoCFiles = ordNub (map (getSymbolicPath . extraSourceFile) $ cSources bi)
+ , cinfoJsFiles = ordNub (map (getSymbolicPath . extraSourceFile) $ jsSources bi)
}
| c <- pkgComponents pkg
, let bi = componentBuildInfo c
diff --git a/cabal-install/tests/IntegrationTests2.hs b/cabal-install/tests/IntegrationTests2.hs
index 2b25a64b6be..8ee582db616 100644
--- a/cabal-install/tests/IntegrationTests2.hs
+++ b/cabal-install/tests/IntegrationTests2.hs
@@ -658,7 +658,9 @@ testTargetSelectorAmbiguous reportSubCase = do
withCFiles :: Executable -> [FilePath] -> Executable
withCFiles exe files =
- exe{buildInfo = (buildInfo exe){cSources = map unsafeMakeSymbolicPath files}}
+ exe{buildInfo = (buildInfo exe){cSources = map (mkExtraSource . unsafeMakeSymbolicPath) files}}
+
+ mkExtraSource x = ExtraSource x []
withHsSrcDirs :: Executable -> [FilePath] -> Executable
withHsSrcDirs exe srcDirs =
diff --git a/cabal-testsuite/PackageTests/ExtraSources/cbits/test.c b/cabal-testsuite/PackageTests/ExtraSources/cbits/test.c
new file mode 100644
index 00000000000..e31c5a9b7b5
--- /dev/null
+++ b/cabal-testsuite/PackageTests/ExtraSources/cbits/test.c
@@ -0,0 +1,3 @@
+#ifndef DOIT
+#error "It does not work"
+#endif
diff --git a/cabal-testsuite/PackageTests/ExtraSources/extra-sources.cabal b/cabal-testsuite/PackageTests/ExtraSources/extra-sources.cabal
new file mode 100644
index 00000000000..0d340f5c6bd
--- /dev/null
+++ b/cabal-testsuite/PackageTests/ExtraSources/extra-sources.cabal
@@ -0,0 +1,10 @@
+cabal-version: 3.4
+name: extra-sources
+version: 0
+build-type: Simple
+
+library
+ hs-source-dirs: src
+ build-depends: base
+ exposed-modules: MyLib
+ c-sources: cbits/test.c (-D DOIT=1)
diff --git a/cabal-testsuite/PackageTests/ExtraSources/setup.out b/cabal-testsuite/PackageTests/ExtraSources/setup.out
new file mode 100644
index 00000000000..43a3574bd1b
--- /dev/null
+++ b/cabal-testsuite/PackageTests/ExtraSources/setup.out
@@ -0,0 +1,5 @@
+# Setup configure
+Configuring extra-sources-0...
+# Setup build
+Preprocessing library for extra-sources-0...
+Building library for extra-sources-0...
diff --git a/cabal-testsuite/PackageTests/ExtraSources/setup.test.hs b/cabal-testsuite/PackageTests/ExtraSources/setup.test.hs
new file mode 100644
index 00000000000..9e2abcb188b
--- /dev/null
+++ b/cabal-testsuite/PackageTests/ExtraSources/setup.test.hs
@@ -0,0 +1,5 @@
+import Test.Cabal.Prelude
+
+main = setupTest $ do
+ setup "configure" []
+ setup "build" []
diff --git a/cabal-testsuite/PackageTests/ExtraSources/src/MyLib.hs b/cabal-testsuite/PackageTests/ExtraSources/src/MyLib.hs
new file mode 100644
index 00000000000..bcdf120b02c
--- /dev/null
+++ b/cabal-testsuite/PackageTests/ExtraSources/src/MyLib.hs
@@ -0,0 +1,4 @@
+module MyLib where
+
+someFunc :: IO ()
+someFunc = mempty
From db19c2f56b46d2bd3177857d487a8e4eff7c94ed Mon Sep 17 00:00:00 2001
From: Andrea Bedini <andrea@andreabedini.com>
Date: Mon, 2 Dec 2024 10:31:43 +0800
Subject: [PATCH 02/82] feat(Cabal): include executables for simpleUserHooks
and autoconfUserHooks.
---
Cabal/Cabal.cabal | 14 ++++++++++++++
Cabal/src/main_configure.hs | 4 ++++
Cabal/src/main_simple.hs | 4 ++++
3 files changed, 22 insertions(+)
create mode 100644 Cabal/src/main_configure.hs
create mode 100644 Cabal/src/main_simple.hs
diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal
index 27f7c958016..dab60621228 100644
--- a/Cabal/Cabal.cabal
+++ b/Cabal/Cabal.cabal
@@ -415,3 +415,17 @@ library
TypeOperators
TypeSynonymInstances
UndecidableInstances
+
+executable cabal-main-simple
+ default-language: Haskell2010
+ main-is: src/main_simple.hs
+ build-depends:
+ base,
+ Cabal
+
+executable cabal-main-configure
+ default-language: Haskell2010
+ main-is: src/main_configure.hs
+ build-depends:
+ base,
+ Cabal
diff --git a/Cabal/src/main_configure.hs b/Cabal/src/main_configure.hs
new file mode 100644
index 00000000000..577b8311e90
--- /dev/null
+++ b/Cabal/src/main_configure.hs
@@ -0,0 +1,4 @@
+import Distribution.Simple
+
+main :: IO ()
+main = defaultMainWithHooks autoconfUserHooks
diff --git a/Cabal/src/main_simple.hs b/Cabal/src/main_simple.hs
new file mode 100644
index 00000000000..00bfe1fe441
--- /dev/null
+++ b/Cabal/src/main_simple.hs
@@ -0,0 +1,4 @@
+import Distribution.Simple
+
+main :: IO ()
+main = defaultMain
From 8d61712d54664c204f0ae294b9da96d7bffd97a6 Mon Sep 17 00:00:00 2001
From: Sylvain Henry <sylvain@haskus.fr>
Date: Fri, 21 Feb 2025 13:04:40 +0100
Subject: [PATCH 03/82] fix: don't build Setup programs with -threaded
Don't enable -threaded unconditionnally when building Setup.hs. We may only
have vanilla libraries (but maybe we don't have them either?)
Revert ae0e752eeab7d5a185295801fe54157e9012e2ba
---
cabal-install/src/Distribution/Client/SetupWrapper.hs | 5 ++++-
1 file changed, 4 insertions(+), 1 deletion(-)
diff --git a/cabal-install/src/Distribution/Client/SetupWrapper.hs b/cabal-install/src/Distribution/Client/SetupWrapper.hs
index 78833af6d15..55042e212cd 100644
--- a/cabal-install/src/Distribution/Client/SetupWrapper.hs
+++ b/cabal-install/src/Distribution/Client/SetupWrapper.hs
@@ -1072,7 +1072,10 @@ getExternalSetupMethod verbosity options pkg bt = do
(program, extraOpts) =
case compilerFlavor compiler of
GHCJS -> (ghcjsProgram, ["-build-runner"])
- _ -> (ghcProgram, ["-threaded"])
+ _ -> (ghcProgram, [])
+ -- FIXME: don't enable -threaded unconditionnally: we may
+ -- only have vanilla libraries (but maybe we don't have them
+ -- either?)
cabalDep =
maybe
[]
From fc017bd683d3c60f32908b48071e0e67c7fae373 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Sun, 23 Feb 2025 11:42:55 +0900
Subject: [PATCH 04/82] fix: static linking on MacOS by preventing
'-optl-static' flag
The treatment of --executable-static means we pass `-optl-static` to GHC, which
in turn just passes this to the linker. This flag can not work on macOS. Fully
static linking is impossible as libSystem must be linked dynamically.
Thus here we disable this flag for macOS.
---
Cabal/src/Distribution/Simple/GHC/Build/Link.hs | 8 ++++++++
1 file changed, 8 insertions(+)
diff --git a/Cabal/src/Distribution/Simple/GHC/Build/Link.hs b/Cabal/src/Distribution/Simple/GHC/Build/Link.hs
index e26e3890ba3..78f293e7656 100644
--- a/Cabal/src/Distribution/Simple/GHC/Build/Link.hs
+++ b/Cabal/src/Distribution/Simple/GHC/Build/Link.hs
@@ -121,6 +121,14 @@ linkOrLoadComponent
PD.ldOptions bi
++ [ "-static"
| withFullyStaticExe lbi
+ -- MacOS can not link fully statically.
+ -- Only kernels can be linked fully statically. Everything
+ -- linking against libSystem must link dynamically. Thus even
+ -- if we link all dependencies statically, we must not pass
+ -- '-optl-static', as that will cause the linker to try and
+ -- fail.
+ , let Platform _hostArch hostOS = hostPlatform lbi
+ in hostOS /= OSX
]
-- Pass extra `ld-options` given
-- through to GHC's linker.
From 438f94f0f9366117a0b16a9fe319adfc36abdebb Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Sun, 23 Feb 2025 12:23:16 +0900
Subject: [PATCH 05/82] feat: no more vowel dropping on macOS
This reverts b408167601 in spirit from #4656.
---
cabal-install/src/Distribution/Client/PackageHash.hs | 5 ++---
cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs | 5 -----
2 files changed, 2 insertions(+), 8 deletions(-)
diff --git a/cabal-install/src/Distribution/Client/PackageHash.hs b/cabal-install/src/Distribution/Client/PackageHash.hs
index e8975b0fc57..38240c3888a 100644
--- a/cabal-install/src/Distribution/Client/PackageHash.hs
+++ b/cabal-install/src/Distribution/Client/PackageHash.hs
@@ -147,8 +147,7 @@ hashedInstalledPackageIdShort pkghashinputs@PackageHashInputs{pkgHashPkgId} =
-- @store/<libraryname>/libHS<libraryname>.dylib@
-- where libraryname contains the libraries name, version and abi hash, but in
-- @store/lib/libHS<very short libraryname>.dylib@
--- where the very short library name drops all vowels from the package name,
--- and truncates the hash to 4 bytes.
+-- where the very short library name truncates the hash to 4 bytes.
--
-- We therefore we only need one \@rpath entry to @store/lib@ instead of one
-- \@rpath entry for each library. And the reduced library name saves some
@@ -168,7 +167,7 @@ hashedInstalledPackageIdVeryShort pkghashinputs@PackageHashInputs{pkgHashPkgId}
mkComponentId $
intercalate
"-"
- [ filter (not . flip elem "aeiou") (prettyShow name)
+ [ prettyShow name
, prettyShow version
, showHashValue (truncateHash 4 (hashPackageHashInputs pkghashinputs))
]
diff --git a/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs b/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs
index 6267a0f5684..1667106ac8b 100644
--- a/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs
+++ b/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs
@@ -115,11 +115,6 @@ normalizeOutput nenv =
-- and replace it with:
-- > "-package-id","<PACKAGEDEP>"
--
- -- Otherwise, output can not be properly normalized as on MacOs we remove
- -- vowels from packages to make the names shorter.
- -- E.g. "another-framework-0.8.1.1" -> "nthr-frmwrk-0.8.1.1"
- --
- -- This makes it impossible to have a stable package id, thus remove it completely.
-- Check manually in your test-cases if the package-id needs to be verified.
. resub ("\"-package-id\",\"([^\"]*)\"")
"\"-package-id\",\"<PACKAGEDEP>\""
From e5905848e1f9c2ff3389f4b7c445b7fce2f7af66 Mon Sep 17 00:00:00 2001
From: Erik de Castro Lopo <erikd@mega-nerd.com>
Date: Thu, 6 Mar 2025 21:12:38 +1100
Subject: [PATCH 06/82] feat: add pre and post build hooks
Run a program (named "preBuildHook") before doing a package build and
another program (named "postBuildHook") after the package is built.
The exit code from the pre-build hook is passed to the post-build
hook.
The commit includes documentation for the hooks and the security
safeguards implemented to avoid the running of malicious hook
files.
(cherry picked from commit 5f7b47fc943eaa5a4e12714935daefe0ddfc4281)
---
cabal-install/cabal-install.cabal | 1 +
.../src/Distribution/Client/CmdFreeze.hs | 1 +
.../src/Distribution/Client/CmdTarget.hs | 1 +
.../src/Distribution/Client/Errors.hs | 36 ++++++-
.../src/Distribution/Client/HashValue.hs | 6 ++
.../src/Distribution/Client/HookAccept.hs | 97 +++++++++++++++++++
.../Client/ProjectBuilding/UnpackedPackage.hs | 44 ++++++++-
.../Client/ProjectConfig/Legacy.hs | 2 +-
.../Client/ProjectConfig/Types.hs | 2 +
.../Client/ProjectOrchestration.hs | 8 ++
.../Distribution/Client/ProjectPlanning.hs | 11 ++-
.../Client/ProjectPlanning/Types.hs | 2 +
cabal-install/tests/IntegrationTests2.hs | 1 +
.../Distribution/Client/ProjectConfig.hs | 8 ++
.../Distribution/Client/TreeDiffInstances.hs | 4 +
changelog.d/pr-10799 | 15 +++
doc/build-hooks.rst | 83 ++++++++++++++++
doc/index.rst | 1 +
18 files changed, 319 insertions(+), 4 deletions(-)
create mode 100644 cabal-install/src/Distribution/Client/HookAccept.hs
create mode 100644 changelog.d/pr-10799
create mode 100644 doc/build-hooks.rst
diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal
index 5aedb23aeed..c237c9d891e 100644
--- a/cabal-install/cabal-install.cabal
+++ b/cabal-install/cabal-install.cabal
@@ -141,6 +141,7 @@ library
Distribution.Client.GlobalFlags
Distribution.Client.Haddock
Distribution.Client.HashValue
+ Distribution.Client.HookAccept
Distribution.Client.HttpUtils
Distribution.Client.IndexUtils
Distribution.Client.IndexUtils.ActiveRepos
diff --git a/cabal-install/src/Distribution/Client/CmdFreeze.hs b/cabal-install/src/Distribution/Client/CmdFreeze.hs
index 29718b5d441..d6dae289354 100644
--- a/cabal-install/src/Distribution/Client/CmdFreeze.hs
+++ b/cabal-install/src/Distribution/Client/CmdFreeze.hs
@@ -142,6 +142,7 @@ freezeAction flags@NixStyleFlags{..} extraArgs globalFlags = do
(_, elaboratedPlan, _, totalIndexState, activeRepos) <-
rebuildInstallPlan
verbosity
+ mempty
distDirLayout
cabalDirLayout
projectConfig
diff --git a/cabal-install/src/Distribution/Client/CmdTarget.hs b/cabal-install/src/Distribution/Client/CmdTarget.hs
index c2edeeec89c..4c9cc59ec24 100644
--- a/cabal-install/src/Distribution/Client/CmdTarget.hs
+++ b/cabal-install/src/Distribution/Client/CmdTarget.hs
@@ -160,6 +160,7 @@ targetAction flags@NixStyleFlags{..} ts globalFlags = do
(_, elaboratedPlan, _, _, _) <-
rebuildInstallPlan
verbosity
+ mempty
distDirLayout
cabalDirLayout
projectConfig
diff --git a/cabal-install/src/Distribution/Client/Errors.hs b/cabal-install/src/Distribution/Client/Errors.hs
index ff9ad369bef..493ce2fc98b 100644
--- a/cabal-install/src/Distribution/Client/Errors.hs
+++ b/cabal-install/src/Distribution/Client/Errors.hs
@@ -186,7 +186,9 @@ data CabalInstallException
| MissingPackageList Repo.RemoteRepo
| CmdPathAcceptsNoTargets
| CmdPathCommandDoesn'tSupportDryRun
- deriving (Show)
+ | HookAcceptUnknown FilePath FilePath String
+ | HookAcceptHashMismatch FilePath FilePath String String
+ deriving (Show, Typeable)
exceptionCodeCabalInstall :: CabalInstallException -> Int
exceptionCodeCabalInstall e = case e of
@@ -338,6 +340,8 @@ exceptionCodeCabalInstall e = case e of
MissingPackageList{} -> 7160
CmdPathAcceptsNoTargets{} -> 7161
CmdPathCommandDoesn'tSupportDryRun -> 7163
+ HookAcceptUnknown{} -> 7164
+ HookAcceptHashMismatch{} -> 7165
exceptionMessageCabalInstall :: CabalInstallException -> String
exceptionMessageCabalInstall e = case e of
@@ -860,6 +864,36 @@ exceptionMessageCabalInstall e = case e of
"The 'path' command accepts no target arguments."
CmdPathCommandDoesn'tSupportDryRun ->
"The 'path' command doesn't support the flag '--dry-run'."
+ HookAcceptUnknown hsPath fpath hash ->
+ concat
+ [ "The following file does not appear in the hooks-security file.\n"
+ , " hook file : "
+ , fpath
+ , "\n"
+ , " file hash : "
+ , hash
+ , "\n"
+ , "After checking the contents of that file, it should be added to the\n"
+ , "hooks-security file with either AcceptAlways or better yet an AcceptHash.\n"
+ , "The hooks-security file is (probably) located at: "
+ , hsPath
+ ]
+ HookAcceptHashMismatch hsPath fpath expected actual ->
+ concat
+ [ "\nHook file hash mismatch for:\n"
+ , " hook file : "
+ , fpath
+ , "\n"
+ , " expected hash: "
+ , expected
+ , "\n"
+ , " actual hash : "
+ , actual
+ , "\n"
+ , "The hook file should be inspected and if deemed ok, the hooks-security file updated.\n"
+ , "The hooks-security file is (probably) located at: "
+ , hsPath
+ ]
instance Exception (VerboseException CabalInstallException) where
displayException :: VerboseException CabalInstallException -> [Char]
diff --git a/cabal-install/src/Distribution/Client/HashValue.hs b/cabal-install/src/Distribution/Client/HashValue.hs
index c5698f27f1e..12616e07eaa 100644
--- a/cabal-install/src/Distribution/Client/HashValue.hs
+++ b/cabal-install/src/Distribution/Client/HashValue.hs
@@ -4,6 +4,7 @@
module Distribution.Client.HashValue
( HashValue
, hashValue
+ , hashValueFromHex
, truncateHash
, showHashValue
, readFileHashValue
@@ -51,6 +52,11 @@ instance Structured HashValue
hashValue :: LBS.ByteString -> HashValue
hashValue = HashValue . SHA256.hashlazy
+-- From a base16 encoded Bytestring to a HashValue with `Base16`'s
+-- error passing through.
+hashValueFromHex :: BS.ByteString -> Either String HashValue
+hashValueFromHex bs = HashValue <$> Base16.decode bs
+
showHashValue :: HashValue -> String
showHashValue (HashValue digest) = BS.unpack (Base16.encode digest)
diff --git a/cabal-install/src/Distribution/Client/HookAccept.hs b/cabal-install/src/Distribution/Client/HookAccept.hs
new file mode 100644
index 00000000000..fc7e5ae0460
--- /dev/null
+++ b/cabal-install/src/Distribution/Client/HookAccept.hs
@@ -0,0 +1,97 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Distribution.Client.HookAccept
+ ( HookAccept (..)
+ , assertHookHash
+ , loadHookHasheshMap
+ , parseHooks
+ ) where
+
+import Distribution.Client.Compat.Prelude
+
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as BS
+
+import qualified Data.Map.Strict as Map
+
+import Distribution.Client.Config (getConfigFilePath)
+import Distribution.Client.Errors (CabalInstallException (..))
+import Distribution.Client.HashValue (HashValue, hashValueFromHex, readFileHashValue, showHashValue)
+import Distribution.Simple.Setup (Flag (..))
+import Distribution.Simple.Utils (dieWithException)
+import Distribution.Verbosity (normal)
+
+import System.FilePath (takeDirectory, (</>))
+
+data HookAccept
+ = AcceptAlways
+ | AcceptHash HashValue
+ deriving (Eq, Show, Generic)
+
+instance Monoid HookAccept where
+ mempty = AcceptAlways -- Should never be needed.
+ mappend = (<>)
+
+instance Semigroup HookAccept where
+ AcceptAlways <> AcceptAlways = AcceptAlways
+ AcceptAlways <> AcceptHash h = AcceptHash h
+ AcceptHash h <> AcceptAlways = AcceptHash h
+ AcceptHash h <> _ = AcceptHash h
+
+instance Binary HookAccept
+instance Structured HookAccept
+
+assertHookHash :: Map FilePath HookAccept -> FilePath -> IO ()
+assertHookHash m fpath = do
+ actualHash <- readFileHashValue fpath
+ hsPath <- getHooksSecurityFilePath NoFlag
+ case Map.lookup fpath m of
+ Nothing ->
+ dieWithException normal $
+ HookAcceptUnknown hsPath fpath (showHashValue actualHash)
+ Just AcceptAlways -> pure ()
+ Just (AcceptHash expectedHash) ->
+ when (actualHash /= expectedHash) $
+ dieWithException normal $
+ HookAcceptHashMismatch
+ hsPath
+ fpath
+ (showHashValue expectedHash)
+ (showHashValue actualHash)
+
+getHooksSecurityFilePath :: Flag FilePath -> IO FilePath
+getHooksSecurityFilePath configFileFlag = do
+ hfpath <- getConfigFilePath configFileFlag
+ pure $ takeDirectory hfpath </> "hooks-security"
+
+loadHookHasheshMap :: Flag FilePath -> IO (Map FilePath HookAccept)
+loadHookHasheshMap configFileFlag = do
+ hookFilePath <- getHooksSecurityFilePath configFileFlag
+ handleNotExists $ fmap parseHooks (BS.readFile hookFilePath)
+ where
+ handleNotExists :: IO (Map FilePath HookAccept) -> IO (Map FilePath HookAccept)
+ handleNotExists action = catchIO action $ \_ -> return mempty
+
+parseHooks :: ByteString -> Map FilePath HookAccept
+parseHooks = Map.fromList . map parse . cleanUp . BS.lines
+ where
+ cleanUp :: [ByteString] -> [ByteString]
+ cleanUp = filter (not . BS.null) . map rmComments
+
+ rmComments :: ByteString -> ByteString
+ rmComments = fst . BS.breakSubstring "--"
+
+parse :: ByteString -> (FilePath, HookAccept)
+parse bs =
+ case BS.words bs of
+ [fp, "AcceptAlways"] -> (BS.unpack fp, AcceptAlways)
+ [fp, "AcceptHash"] -> buildAcceptHash fp "00"
+ [fp, "AcceptHash", h] -> buildAcceptHash fp h
+ _ -> error $ "Not able to parse:" ++ show bs
+ where
+ buildAcceptHash :: ByteString -> ByteString -> (FilePath, HookAccept)
+ buildAcceptHash fp h =
+ case hashValueFromHex h of
+ Left err -> error $ "Distribution.Client.HookAccept.parse :" ++ err
+ Right hv -> (BS.unpack fp, AcceptHash hv)
diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs b/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs
index e19c52157c0..fe5c10662e6 100644
--- a/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs
+++ b/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs
@@ -30,6 +30,7 @@ module Distribution.Client.ProjectBuilding.UnpackedPackage
import Distribution.Client.Compat.Prelude
import Prelude ()
+import Distribution.Client.HookAccept (assertHookHash)
import Distribution.Client.PackageHash (renderPackageHashInputs)
import Distribution.Client.ProjectBuilding.Types
import Distribution.Client.ProjectConfig
@@ -105,7 +106,7 @@ import qualified Data.ByteString.Lazy.Char8 as LBS.Char8
import qualified Data.List.NonEmpty as NE
import Control.Exception (ErrorCall, Handler (..), SomeAsyncException, assert, catches, onException)
-import System.Directory (canonicalizePath, createDirectoryIfMissing, doesDirectoryExist, doesFileExist, removeFile)
+import System.Directory (canonicalizePath, createDirectoryIfMissing, doesDirectoryExist, doesFileExist, getCurrentDirectory, removeFile)
import System.FilePath (dropDrive, normalise, takeDirectory, (<.>), (</>))
import System.IO (Handle, IOMode (AppendMode), withFile)
import System.Semaphore (SemaphoreName (..))
@@ -697,7 +698,48 @@ buildAndInstallUnpackedPackage
runConfigure
PBBuildPhase{runBuild} -> do
noticeProgress ProgressBuilding
+ hooksDir <- (</> "cabalHooks") <$> getCurrentDirectory
+ -- run preBuildHook. If it returns with 0, we assume the build was
+ -- successful. If not, run the build.
+ preBuildHookFile <- canonicalizePath (hooksDir </> "preBuildHook")
+ hookExists <- doesFileExist preBuildHookFile
+ preCode <-
+ if hookExists
+ then do
+ assertHookHash (pkgConfigHookHashes pkgshared) preBuildHookFile
+ rawSystemExitCode
+ verbosity
+ (Just srcdir)
+ preBuildHookFile
+ [ (unUnitId $ installedUnitId rpkg)
+ , (getSymbolicPath srcdir)
+ , (getSymbolicPath builddir)
+ ]
+ Nothing
+ `catchIO` (\_ -> pure (ExitFailure 10))
+ else pure ExitSuccess
+ -- Regardless of whether the preBuildHook exists or not, or whether it returned an
+ -- error or not, we want to run the build command.
+ -- If the preBuildHook downloads a cached version of the build products, the following
+ -- should be a NOOP.
runBuild
+ -- not sure, if we want to care about a failed postBuildHook?
+ postBuildHookFile <- canonicalizePath (hooksDir </> "postBuildHook")
+ hookExists' <- doesFileExist postBuildHookFile
+ when hookExists' $ do
+ assertHookHash (pkgConfigHookHashes pkgshared) postBuildHookFile
+ void $
+ rawSystemExitCode
+ verbosity
+ (Just srcdir)
+ postBuildHookFile
+ [ (unUnitId $ installedUnitId rpkg)
+ , (getSymbolicPath srcdir)
+ , (getSymbolicPath builddir)
+ , show preCode
+ ]
+ Nothing
+ `catchIO` (\_ -> pure (ExitFailure 10))
PBHaddockPhase{runHaddock} -> do
noticeProgress ProgressHaddock
runHaddock
diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs
index 10858d5601d..7d1bee02daa 100644
--- a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs
+++ b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs
@@ -714,7 +714,7 @@ convertLegacyAllPackageFlags globalFlags configFlags configExFlags installFlags
} = globalFlags
projectConfigPackageDBs = (fmap . fmap) (interpretPackageDB Nothing) projectConfigPackageDBs_
-
+ projectConfigHookHashes = mempty -- :: Map FilePath HookAccept
ConfigFlags
{ configCommonFlags = commonFlags
, configHcFlavor = projectConfigHcFlavor
diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs
index 1a2b6ae2fa6..4f1558fa215 100644
--- a/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs
+++ b/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs
@@ -33,6 +33,7 @@ import Distribution.Client.BuildReports.Types
import Distribution.Client.Dependency.Types
( PreSolver
)
+import Distribution.Client.HookAccept (HookAccept (..))
import Distribution.Client.Targets
( UserConstraint
)
@@ -227,6 +228,7 @@ data ProjectConfigShared = ProjectConfigShared
, projectConfigPreferOldest :: Flag PreferOldest
, projectConfigProgPathExtra :: NubList FilePath
, projectConfigMultiRepl :: Flag Bool
+ , projectConfigHookHashes :: Map FilePath HookAccept
-- More things that only make sense for manual mode, not --local mode
-- too much control!
-- projectConfigShadowPkgs :: Flag Bool,
diff --git a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs
index a14d43e4b99..9907193458d 100644
--- a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs
+++ b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs
@@ -176,6 +176,8 @@ import qualified Data.List.NonEmpty as NE
import qualified Data.Map as Map
import qualified Data.Set as Set
import Distribution.Client.Errors
+import Distribution.Client.HookAccept (loadHookHasheshMap)
+
import Distribution.Package
import Distribution.Simple.Command (commandShowOptions)
import Distribution.Simple.Compiler
@@ -363,6 +365,8 @@ withInstallPlan
, installedPackages
}
action = do
+ hookHashes <- loadHookHasheshMap (projectConfigConfigFile $ projectConfigShared projectConfig)
+
-- Take the project configuration and make a plan for how to build
-- everything in the project. This is independent of any specific targets
-- the user has asked for.
@@ -370,6 +374,7 @@ withInstallPlan
(elaboratedPlan, _, elaboratedShared, _, _) <-
rebuildInstallPlan
verbosity
+ hookHashes
distDirLayout
cabalDirLayout
projectConfig
@@ -392,6 +397,8 @@ runProjectPreBuildPhase
, installedPackages
}
selectPlanSubset = do
+ hookHashes <- loadHookHasheshMap (projectConfigConfigFile $ projectConfigShared projectConfig)
+
-- Take the project configuration and make a plan for how to build
-- everything in the project. This is independent of any specific targets
-- the user has asked for.
@@ -399,6 +406,7 @@ runProjectPreBuildPhase
(elaboratedPlan, _, elaboratedShared, _, _) <-
rebuildInstallPlan
verbosity
+ hookHashes
distDirLayout
cabalDirLayout
projectConfig
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index c04bca730d7..7e10677437c 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -117,6 +117,7 @@ import Distribution.Client.Dependency
import Distribution.Client.DistDirLayout
import Distribution.Client.FetchUtils
import Distribution.Client.HashValue
+import Distribution.Client.HookAccept (HookAccept)
import Distribution.Client.HttpUtils
import Distribution.Client.JobControl
import Distribution.Client.PackageHash
@@ -589,6 +590,7 @@ Binary ProgramDb instance.
--
rebuildInstallPlan
:: Verbosity
+ -> Map FilePath HookAccept
-> DistDirLayout
-> CabalDirLayout
-> ProjectConfig
@@ -604,6 +606,7 @@ rebuildInstallPlan
-- ^ @(improvedPlan, elaboratedPlan, _, _, _)@
rebuildInstallPlan
verbosity
+ hookHashes
distDirLayout@DistDirLayout
{ distProjectRootDirectory
, distProjectCacheFile
@@ -621,7 +624,7 @@ rebuildInstallPlan
fileMonitorImprovedPlan
-- react to changes in the project config,
-- the package .cabal files and the path
- (projectConfigMonitored, localPackages, progsearchpath)
+ (projectConfigMonitored, localPackages, progsearchpath, hookHashes)
$ do
-- And so is the elaborated plan that the improved plan based on
(elaboratedPlan, elaboratedShared, totalIndexState, activeRepos) <-
@@ -631,6 +634,7 @@ rebuildInstallPlan
( projectConfigMonitored
, localPackages
, progsearchpath
+ , hookHashes
)
$ do
compilerEtc <- phaseConfigureCompiler projectConfig
@@ -737,6 +741,7 @@ rebuildInstallPlan
, compiler
, platform
, programDbSignature progdb
+ , hookHashes
)
$ do
installedPkgIndex <-
@@ -865,6 +870,7 @@ rebuildInstallPlan
liftIO . runLogProgress verbosity $
elaborateInstallPlan
verbosity
+ hookHashes
platform
compiler
progdb
@@ -1585,6 +1591,7 @@ planPackages
-- matching that of the classic @cabal install --user@ or @--global@
elaborateInstallPlan
:: Verbosity
+ -> Map FilePath HookAccept
-> Platform
-> Compiler
-> ProgramDb
@@ -1602,6 +1609,7 @@ elaborateInstallPlan
-> LogProgress (ElaboratedInstallPlan, ElaboratedSharedConfig)
elaborateInstallPlan
verbosity
+ hookHashes
platform
compiler
compilerprogdb
@@ -1625,6 +1633,7 @@ elaborateInstallPlan
, pkgConfigCompiler = compiler
, pkgConfigCompilerProgs = compilerprogdb
, pkgConfigReplOptions = mempty
+ , pkgConfigHookHashes = hookHashes
}
preexistingInstantiatedPkgs :: Map UnitId FullUnitId
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs b/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs
index 7ee5cb52f41..484c4cad297 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs
@@ -84,6 +84,7 @@ import Distribution.Client.Types
import Distribution.Backpack
import Distribution.Backpack.ModuleShape
+import Distribution.Client.HookAccept (HookAccept (..))
import Distribution.Compat.Graph (IsNode (..))
import Distribution.InstalledPackageInfo (InstalledPackageInfo)
import Distribution.ModuleName (ModuleName)
@@ -190,6 +191,7 @@ data ElaboratedSharedConfig = ElaboratedSharedConfig
-- ghc & ghc-pkg). Once constructed, only the 'configuredPrograms' are
-- used.
, pkgConfigReplOptions :: ReplOptions
+ , pkgConfigHookHashes :: Map FilePath HookAccept
}
deriving (Show, Generic)
diff --git a/cabal-install/tests/IntegrationTests2.hs b/cabal-install/tests/IntegrationTests2.hs
index 8ee582db616..273be658906 100644
--- a/cabal-install/tests/IntegrationTests2.hs
+++ b/cabal-install/tests/IntegrationTests2.hs
@@ -2195,6 +2195,7 @@ planProject testdir cliConfig = do
(elaboratedPlan, _, elaboratedShared, _, _) <-
rebuildInstallPlan
verbosity
+ mempty
distDirLayout
cabalDirLayout
projectConfig
diff --git a/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs b/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs
index bf69b20ee04..371766fedb1 100644
--- a/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs
+++ b/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs
@@ -11,6 +11,7 @@
module UnitTests.Distribution.Client.ProjectConfig (tests) where
import Control.Monad
+import qualified Data.ByteString.Lazy.Char8 as LBS
import Data.Either (isRight)
import Data.Foldable (for_)
import Data.List (intercalate, isPrefixOf, (\\))
@@ -26,6 +27,8 @@ import System.IO.Unsafe (unsafePerformIO)
import Distribution.Deprecated.ParseUtils
import qualified Distribution.Deprecated.ReadP as Parse
+import Distribution.Client.HashValue (hashValue)
+import Distribution.Client.HookAccept (HookAccept (..))
import Distribution.Compiler
import Distribution.Package
import Distribution.PackageDescription
@@ -638,6 +641,7 @@ instance Arbitrary ProjectConfigShared where
projectConfigPreferOldest <- arbitrary
projectConfigProgPathExtra <- toNubList <$> listOf arbitraryShortToken
projectConfigMultiRepl <- arbitrary
+ projectConfigHookHashes <- arbitrary
return ProjectConfigShared{..}
where
arbitraryConstraints :: Gen [(UserConstraint, ConstraintSource)]
@@ -684,6 +688,7 @@ instance Arbitrary ProjectConfigShared where
<*> shrinker projectConfigPreferOldest
<*> shrinker projectConfigProgPathExtra
<*> shrinker projectConfigMultiRepl
+ <*> shrinker projectConfigHookHashes
where
preShrink_Constraints = map fst
postShrink_Constraints = map (\uc -> (uc, projectConfigConstraintSource))
@@ -691,6 +696,9 @@ instance Arbitrary ProjectConfigShared where
projectConfigConstraintSource :: ConstraintSource
projectConfigConstraintSource = ConstraintSourceProjectConfig nullProjectConfigPath
+instance Arbitrary HookAccept where
+ arbitrary = elements [AcceptAlways, AcceptHash (hashValue $ LBS.pack "hash")]
+
instance Arbitrary ProjectConfigProvenance where
arbitrary = elements [Implicit, Explicit (ProjectConfigPath $ "cabal.project" :| [])]
diff --git a/cabal-install/tests/UnitTests/Distribution/Client/TreeDiffInstances.hs b/cabal-install/tests/UnitTests/Distribution/Client/TreeDiffInstances.hs
index 179fef5688a..42c38a7bc82 100644
--- a/cabal-install/tests/UnitTests/Distribution/Client/TreeDiffInstances.hs
+++ b/cabal-install/tests/UnitTests/Distribution/Client/TreeDiffInstances.hs
@@ -13,6 +13,8 @@ import Distribution.Solver.Types.Settings
import Distribution.Client.BuildReports.Types
import Distribution.Client.CmdInstall.ClientInstallFlags
import Distribution.Client.Dependency.Types
+import Distribution.Client.HashValue (HashValue)
+import Distribution.Client.HookAccept (HookAccept (..))
import Distribution.Client.IndexUtils.ActiveRepos
import Distribution.Client.IndexUtils.IndexState
import Distribution.Client.IndexUtils.Timestamp
@@ -45,6 +47,8 @@ instance ToExpr ProjectConfigPath
instance ToExpr ConstraintSource
instance ToExpr CountConflicts
instance ToExpr FineGrainedConflicts
+instance ToExpr HashValue
+instance ToExpr HookAccept
instance ToExpr IndependentGoals
instance ToExpr InstallMethod
instance ToExpr InstallOutcome
diff --git a/changelog.d/pr-10799 b/changelog.d/pr-10799
new file mode 100644
index 00000000000..3f37124aebb
--- /dev/null
+++ b/changelog.d/pr-10799
@@ -0,0 +1,15 @@
+synopsis: Add pre and post build hooks
+packages: cabal-install
+prs: #10799
+issues: #9892
+significance: significant
+
+description: {
+
+- Run a program (named "preBuildHook") before doing a package build and another program
+ (named "postBuildHook") after the package is built.
+- These programs are project local and need to be in the `cabalHooks` directory which is
+ in the same directory as the `cabal.project` file.
+- The absence of these programs will be ignored.
+- How to check and run these hooks securely is specified in the documentation.
+}
diff --git a/doc/build-hooks.rst b/doc/build-hooks.rst
new file mode 100644
index 00000000000..82e53693dc4
--- /dev/null
+++ b/doc/build-hooks.rst
@@ -0,0 +1,83 @@
+Build Hooks
+===========
+
+Build hooks are programs that are run before (pre-build hook) and
+after (post-build hook) a package (including package dependencies)
+is built. The hooks are completely generic and can even be absent
+(their absence is ignored). Regardless of the return code of the
+pre-build hook, the normal build is executed. In the case where
+the pre-build hook provides a pre-built version of what the build
+step would provide, the build step is still run, but should be
+little more than a NOOP.
+
+Build hooks are project local rather than global to the user
+because a single user may want to use one set of hooks in one
+project and another set of hooks (or even none at all) for another
+project.
+
+Since the hook files are project local (and hence likely to be committed
+to revision control), a naive implementation of these hooks would be
+a potential security issue. A solution to this potential security
+issue has been implemented and described in the Hook Security section
+below.
+
+
+Possible Use Cases
+------------------
+
+Possible use cases include:
+
+* Fine grained benchmarking of individual package build times.
+* Build product caching.
+
+
+Location of Hook Files
+----------------------
+
+The two hook files are `cabalHooks/preBuildHook` and
+`cabalHooks/postBuildHook` where the `cabalHooks` directory is in
+the same directory as the `cabal.project` file. On UNIX style
+systems, these hooks need to be marked as user executable programs.
+
+
+Hook Parameters Exit Codes
+--------------------------
+
+The pre-build hook is passed three parameters; the unit id (from cabal),
+the source directory and the build directory. The post-build hook is
+passed the same three parameters, plus the exit code of the pre-build
+hook.
+
+The exit codes for the two hooks are ignored by cabal apart from cabal
+capturing the exit code for the pre-build hook and passing it to the
+post-build hook.
+
+
+Hook Security
+-------------
+These hook files are generic executable programs and are stored local to
+the project. To prevent the running of malicious hook files, the
+hook files are only run, it they are mentioned in the `hooks-security`
+file which is located in the users home `.cabal` directory, usually
+either `$HOME/.cabal/` or `$HOME/.config/cabal/`.
+
+The `hooks-security` file should contain one entry per line. Blank lines
+are ignored, as are Haskell style single line comments (starts with "--"
+and goes until the end of the line). Each entry should contain the full
+hook file path, at least one space and either "AcceptAlways" or
+"AcceptHash" followed by at least one space and the hexadecimal encoded
+hash of the file. The `hooks-security` file is read once when `cabal` is
+started and the entries inserted into a `Map`.
+
+When `cabal` detects a "preBuildHook" or "postBuildHook" it looks up
+the full file path in the `Map`. If the path is not found in the `Map`,
+`cabal` will die with an error message suggesting that the hook file
+be manually inspected and if deemed safe, added to the `hooks-security`
+file.
+
+If the hook file path is in the `Map` and it was specified as
+"AcceptAlways" the hook will be run. If the `Map` entry is "AcceptHash"
+with a hash, the hash of the hook file will be calculated and compared
+against the supplied hash. If the hashes match, the hook will be run.
+If there is a hash mismatch, `cabal` will abort with an error message
+about the hash mismatch.
diff --git a/doc/index.rst b/doc/index.rst
index 4bd13c65d7a..a721b77ed63 100644
--- a/doc/index.rst
+++ b/doc/index.rst
@@ -20,6 +20,7 @@ Welcome to the Cabal User Guide
how-to-run-in-windows
how-to-use-backpack
how-to-report-bugs
+ build-hooks
.. toctree::
:caption: Cabal Reference
From d4c0c0135dc37072e7f6cde03ee87bef49302c51 Mon Sep 17 00:00:00 2001
From: Andrea Bedini <andrea@andreabedini.com>
Date: Thu, 13 Mar 2025 13:18:55 +0800
Subject: [PATCH 07/82] feat: support generated cmm-sources
---
.../PackageDescription/FieldGrammar.hs | 22 ++++--
.../src/Distribution/Types/BuildInfo.hs | 14 ++--
.../src/Distribution/Types/BuildInfo/Lens.hs | 14 ++--
.../src/Distribution/Types/ExtraSource.hs | 77 +++++++++++++------
Cabal-syntax/src/Distribution/Utils/Path.hs | 4 +-
Cabal-tests/tests/NoThunks.hs | 5 +-
.../src/Data/TreeDiff/Instances/Cabal.hs | 5 +-
Cabal/src/Distribution/Simple/Build.hs | 20 ++---
.../Simple/GHC/Build/ExtraSources.hs | 31 +++++---
Cabal/src/Distribution/Simple/GHC/Internal.hs | 44 +++++++----
Cabal/src/Distribution/Simple/GHCJS.hs | 14 ++--
.../src/Distribution/Client/TargetSelector.hs | 2 +-
cabal-install/tests/IntegrationTests2.hs | 6 +-
13 files changed, 165 insertions(+), 93 deletions(-)
diff --git a/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs b/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs
index bb6f3f25eee..22912564e49 100644
--- a/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs
+++ b/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs
@@ -174,7 +174,8 @@ libraryFieldGrammar
, c (List CommaFSep (Identity PkgconfigDependency) PkgconfigDependency)
, c (List CommaVCat (Identity Dependency) Dependency)
, c (List CommaVCat (Identity Mixin) Mixin)
- , c (List VCat (Identity ExtraSource) ExtraSource)
+ , c (List VCat (Identity (ExtraSource Pkg)) (ExtraSource Pkg))
+ , c (List VCat (Identity (ExtraSource Build)) (ExtraSource Build))
, c (List CommaVCat (Identity ModuleReexport) ModuleReexport)
, c (List FSep (MQuoted Extension) Extension)
, c (List FSep (MQuoted Language) Language)
@@ -225,7 +226,8 @@ foreignLibFieldGrammar
, c (List CommaFSep (Identity PkgconfigDependency) PkgconfigDependency)
, c (List CommaVCat (Identity Dependency) Dependency)
, c (List CommaVCat (Identity Mixin) Mixin)
- , c (List VCat (Identity ExtraSource) ExtraSource)
+ , c (List VCat (Identity (ExtraSource Pkg)) (ExtraSource Pkg))
+ , c (List VCat (Identity (ExtraSource Build)) (ExtraSource Build))
, c (List FSep (Identity ForeignLibOption) ForeignLibOption)
, c (List FSep (MQuoted Extension) Extension)
, c (List FSep (MQuoted Language) Language)
@@ -265,7 +267,8 @@ executableFieldGrammar
, c (List CommaFSep (Identity PkgconfigDependency) PkgconfigDependency)
, c (List CommaVCat (Identity Dependency) Dependency)
, c (List CommaVCat (Identity Mixin) Mixin)
- , c (List VCat (Identity ExtraSource) ExtraSource)
+ , c (List VCat (Identity (ExtraSource Pkg)) (ExtraSource Pkg))
+ , c (List VCat (Identity (ExtraSource Build)) (ExtraSource Build))
, c (List FSep (MQuoted Extension) Extension)
, c (List FSep (MQuoted Language) Language)
, c (List FSep Token String)
@@ -342,7 +345,8 @@ testSuiteFieldGrammar
, c (List CommaFSep Token String)
, c (List CommaVCat (Identity Dependency) Dependency)
, c (List CommaVCat (Identity Mixin) Mixin)
- , c (List VCat (Identity ExtraSource) ExtraSource)
+ , c (List VCat (Identity (ExtraSource Pkg)) (ExtraSource Pkg))
+ , c (List VCat (Identity (ExtraSource Build)) (ExtraSource Build))
, c (List FSep (MQuoted Extension) Extension)
, c (List FSep (MQuoted Language) Language)
, c (List FSep Token String)
@@ -487,7 +491,8 @@ benchmarkFieldGrammar
, c (List CommaFSep (Identity PkgconfigDependency) PkgconfigDependency)
, c (List CommaVCat (Identity Dependency) Dependency)
, c (List CommaVCat (Identity Mixin) Mixin)
- , c (List VCat (Identity ExtraSource) ExtraSource)
+ , c (List VCat (Identity (ExtraSource Pkg)) (ExtraSource Pkg))
+ , c (List VCat (Identity (ExtraSource Build)) (ExtraSource Build))
, c (List FSep (MQuoted Extension) Extension)
, c (List FSep (MQuoted Language) Language)
, c (List FSep Token String)
@@ -590,7 +595,8 @@ buildInfoFieldGrammar
, c (List CommaFSep (Identity PkgconfigDependency) PkgconfigDependency)
, c (List CommaVCat (Identity Dependency) Dependency)
, c (List CommaVCat (Identity Mixin) Mixin)
- , c (List VCat (Identity ExtraSource) ExtraSource)
+ , c (List VCat (Identity (ExtraSource Pkg)) (ExtraSource Pkg))
+ , c (List VCat (Identity (ExtraSource Build)) (ExtraSource Build))
, c (List FSep (MQuoted Extension) Extension)
, c (List FSep (MQuoted Language) Language)
, c (List FSep Token String)
@@ -637,6 +643,8 @@ buildInfoFieldGrammar =
^^^ availableSince CabalSpecV3_0 []
<*> monoidalFieldAla "cmm-sources" formatExtraSources L.cmmSources
^^^ availableSince CabalSpecV3_0 []
+ <*> monoidalFieldAla "autogen-cmm-sources" formatExtraSources L.autogenCmmSources
+ -- FIXME ^^^ availableSince CabalSpecV3_0 []
<*> monoidalFieldAla "c-sources" formatExtraSources L.cSources
<*> monoidalFieldAla "cxx-sources" formatExtraSources L.cxxSources
^^^ availableSince CabalSpecV2_2 []
@@ -840,7 +848,7 @@ formatOtherExtensions = alaList' FSep MQuoted
formatOtherModules :: [ModuleName] -> List VCat (MQuoted ModuleName) ModuleName
formatOtherModules = alaList' VCat MQuoted
-formatExtraSources :: [ExtraSource] -> List VCat (Identity ExtraSource) ExtraSource
+formatExtraSources :: [ExtraSource pkg] -> List VCat (Identity (ExtraSource pkg)) (ExtraSource pkg)
formatExtraSources = alaList' VCat Identity
-------------------------------------------------------------------------------
diff --git a/Cabal-syntax/src/Distribution/Types/BuildInfo.hs b/Cabal-syntax/src/Distribution/Types/BuildInfo.hs
index a4a68546b92..1d7340e4de5 100644
--- a/Cabal-syntax/src/Distribution/Types/BuildInfo.hs
+++ b/Cabal-syntax/src/Distribution/Types/BuildInfo.hs
@@ -72,15 +72,17 @@ data BuildInfo = BuildInfo
-- ^ support frameworks for Mac OS X
, extraFrameworkDirs :: [SymbolicPath Pkg (Dir Framework)]
-- ^ extra locations to find frameworks
- , asmSources :: [ExtraSource]
+ , asmSources :: [ExtraSource Pkg]
-- ^ Assembly source files
- , cmmSources :: [ExtraSource]
+ , cmmSources :: [ExtraSource Pkg]
-- ^ C-- source files
- , cSources :: [ExtraSource]
+ , autogenCmmSources :: [ExtraSource Build]
+ -- ^ C-- generated source files
+ , cSources :: [ExtraSource Pkg]
-- ^ C source files
- , cxxSources :: [ExtraSource]
+ , cxxSources :: [ExtraSource Pkg]
-- ^ C++ source files
- , jsSources :: [ExtraSource]
+ , jsSources :: [ExtraSource Pkg]
-- ^ JavaScript source file
, hsSourceDirs :: [SymbolicPath Pkg (Dir Source)]
-- ^ where to look for the Haskell module hierarchy
@@ -172,6 +174,7 @@ instance Monoid BuildInfo where
, extraFrameworkDirs = []
, asmSources = []
, cmmSources = []
+ , autogenCmmSources = []
, cSources = []
, cxxSources = []
, jsSources = []
@@ -225,6 +228,7 @@ instance Semigroup BuildInfo where
, extraFrameworkDirs = combineNub extraFrameworkDirs
, asmSources = combineNub asmSources
, cmmSources = combineNub cmmSources
+ , autogenCmmSources = combineNub autogenCmmSources
, cSources = combineNub cSources
, cxxSources = combineNub cxxSources
, jsSources = combineNub jsSources
diff --git a/Cabal-syntax/src/Distribution/Types/BuildInfo/Lens.hs b/Cabal-syntax/src/Distribution/Types/BuildInfo/Lens.hs
index e50b41485a8..2d82a81a0bd 100644
--- a/Cabal-syntax/src/Distribution/Types/BuildInfo/Lens.hs
+++ b/Cabal-syntax/src/Distribution/Types/BuildInfo/Lens.hs
@@ -80,23 +80,27 @@ class HasBuildInfo a where
extraFrameworkDirs = buildInfo . extraFrameworkDirs
{-# INLINE extraFrameworkDirs #-}
- asmSources :: Lens' a [ExtraSource]
+ asmSources :: Lens' a [ExtraSource Pkg]
asmSources = buildInfo . asmSources
{-# INLINE asmSources #-}
- cmmSources :: Lens' a [ExtraSource]
+ autogenCmmSources :: Lens' a [ExtraSource Build]
+ autogenCmmSources = buildInfo . autogenCmmSources
+ {-# INLINE autogenCmmSources #-}
+
+ cmmSources :: Lens' a [ExtraSource Pkg]
cmmSources = buildInfo . cmmSources
{-# INLINE cmmSources #-}
- cSources :: Lens' a [ExtraSource]
+ cSources :: Lens' a [ExtraSource Pkg]
cSources = buildInfo . cSources
{-# INLINE cSources #-}
- cxxSources :: Lens' a [ExtraSource]
+ cxxSources :: Lens' a [ExtraSource Pkg]
cxxSources = buildInfo . cxxSources
{-# INLINE cxxSources #-}
- jsSources :: Lens' a [ExtraSource]
+ jsSources :: Lens' a [ExtraSource Pkg]
jsSources = buildInfo . jsSources
{-# INLINE jsSources #-}
diff --git a/Cabal-syntax/src/Distribution/Types/ExtraSource.hs b/Cabal-syntax/src/Distribution/Types/ExtraSource.hs
index f9ba481502c..4b888a0d28e 100644
--- a/Cabal-syntax/src/Distribution/Types/ExtraSource.hs
+++ b/Cabal-syntax/src/Distribution/Types/ExtraSource.hs
@@ -1,10 +1,12 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeFamilies #-}
module Distribution.Types.ExtraSource
( ExtraSource (..)
- , extraSourceFromPath
+ , ExtraSourceClass (..)
) where
import Distribution.Compat.Prelude
@@ -12,37 +14,66 @@ import Prelude ()
import Distribution.Parsec
import Distribution.Pretty
-import Distribution.Utils.Path (SymbolicPath, FileOrDir(..), Pkg)
+import Distribution.Utils.Path (Build, FileOrDir (..), Pkg, RelativePath, SymbolicPath, relativeSymbolicPath, unsafeCoerceSymbolicPath)
import qualified Distribution.Compat.CharParsing as P
import qualified Text.PrettyPrint as PP
-import Distribution.FieldGrammar.Newtypes (SymbolicPathNT(..))
-data ExtraSource = ExtraSource
- { extraSourceFile :: SymbolicPath Pkg File
- , extraSourceOpts :: [String]
- }
+data family ExtraSource pkg
+
+data instance ExtraSource Pkg = ExtraSourcePkg (SymbolicPath Pkg File) [String]
+ deriving (Generic, Show, Read, Eq, Ord, Typeable, Data)
+
+data instance ExtraSource Build = ExtraSourceBuild (RelativePath Build File) [String]
deriving (Generic, Show, Read, Eq, Ord, Typeable, Data)
-instance Binary ExtraSource
-instance Structured ExtraSource
-instance NFData ExtraSource where rnf = genericRnf
+class ExtraSourceClass e where
+ extraSourceOpts :: e -> [String]
+ extraSourceFile :: e -> SymbolicPath Pkg 'File
+
+instance ExtraSourceClass (ExtraSource Pkg) where
+ extraSourceOpts (ExtraSourcePkg _ opts) = opts
+ extraSourceFile (ExtraSourcePkg f _) = f
+
+instance ExtraSourceClass (ExtraSource Build) where
+ extraSourceOpts (ExtraSourceBuild _ opts) = opts
+
+ -- FIXME
+ extraSourceFile (ExtraSourceBuild f _) = unsafeCoerceSymbolicPath (relativeSymbolicPath f)
-instance Parsec ExtraSource where
+instance Binary (ExtraSource Pkg)
+instance Structured (ExtraSource Pkg)
+instance NFData (ExtraSource Pkg) where rnf = genericRnf
+
+instance Binary (ExtraSource Build)
+instance Structured (ExtraSource Build)
+instance NFData (ExtraSource Build) where rnf = genericRnf
+
+instance Parsec (ExtraSource Pkg) where
parsec = do
- SymbolicPathNT path <- parsec <* P.spaces
- opts <- P.optional (parensLax (P.sepBy p P.spaces))
- return (ExtraSource path (fromMaybe mempty opts))
+ path <- parsec <* P.spaces
+ opts <- P.optional (parensLax (P.sepBy p P.spaces))
+ return (ExtraSourcePkg path (fromMaybe mempty opts))
where
p :: P.CharParsing p => p String
- p = some $ P.satisfy (\c -> not (isSpace c) && not (c == ')'))
+ p = some $ P.satisfy (\c -> not (isSpace c) && (c /= ')'))
-parensLax :: (P.CharParsing m) => m a -> m a
-parensLax p = P.between (P.char '(' *> P.spaces) (P.char ')' *> P.spaces) p
+instance Parsec (ExtraSource Build) where
+ parsec = do
+ path <- parsec <* P.spaces
+ opts <- P.optional (parensLax (P.sepBy p P.spaces))
+ return (ExtraSourceBuild path (fromMaybe mempty opts))
+ where
+ p :: P.CharParsing p => p String
+ p = some $ P.satisfy (\c -> not (isSpace c) && (c /= ')'))
-instance Pretty ExtraSource where
- pretty (ExtraSource path opts) =
- pretty (SymbolicPathNT path) <<>> PP.parens (PP.hsep (map PP.text opts))
+instance Pretty (ExtraSource Pkg) where
+ pretty (ExtraSourcePkg path opts) =
+ pretty path <<>> PP.parens (PP.hsep (map PP.text opts))
-extraSourceFromPath :: SymbolicPath Pkg File -> ExtraSource
-extraSourceFromPath fp = ExtraSource fp mempty
+instance Pretty (ExtraSource Build) where
+ pretty (ExtraSourceBuild path opts) =
+ pretty path <<>> PP.parens (PP.hsep (map PP.text opts))
+
+parensLax :: P.CharParsing m => m a -> m a
+parensLax p = P.between (P.char '(' *> P.spaces) (P.char ')' *> P.spaces) p
diff --git a/Cabal-syntax/src/Distribution/Utils/Path.hs b/Cabal-syntax/src/Distribution/Utils/Path.hs
index a0f18a1dfdd..3d63703f501 100644
--- a/Cabal-syntax/src/Distribution/Utils/Path.hs
+++ b/Cabal-syntax/src/Distribution/Utils/Path.hs
@@ -460,7 +460,7 @@ data CWD
-- | Abstract directory: package directory (e.g. a directory containing the @.cabal@ file).
--
-- See Note [Symbolic paths] in Distribution.Utils.Path.
-data Pkg
+data Pkg deriving (Data)
-- | Abstract directory: dist directory (e.g. @dist-newstyle@).
--
@@ -490,7 +490,7 @@ data Framework
-- | Abstract directory: build directory.
--
-- See Note [Symbolic paths] in Distribution.Utils.Path.
-data Build
+data Build deriving (Data)
-- | Abstract directory: directory for build artifacts, such as documentation or @.hie@ files.
--
diff --git a/Cabal-tests/tests/NoThunks.hs b/Cabal-tests/tests/NoThunks.hs
index ffc4a4da0d9..63f6bcae070 100644
--- a/Cabal-tests/tests/NoThunks.hs
+++ b/Cabal-tests/tests/NoThunks.hs
@@ -25,7 +25,7 @@ import Distribution.ModuleName (ModuleName)
import Distribution.PackageDescription.Parsec (parseGenericPackageDescription)
import Distribution.SPDX (License, LicenseExceptionId, LicenseExpression, LicenseId, LicenseRef, SimpleLicenseExpression)
import Distribution.System (Arch, OS)
-import Distribution.Utils.Path (SymbolicPathX)
+import Distribution.Utils.Path (SymbolicPathX, Pkg, Build)
import Distribution.Utils.ShortText (ShortText)
import Distribution.Version (Version, VersionRange)
import Language.Haskell.Extension (Extension, KnownExtension, Language)
@@ -73,7 +73,8 @@ instance NoThunks ConfVar
instance NoThunks Dependency
instance NoThunks Executable
instance NoThunks ExecutableScope
-instance NoThunks ExtraSource
+instance NoThunks (ExtraSource Build)
+instance NoThunks (ExtraSource Pkg)
instance NoThunks FlagName
instance NoThunks ForeignLib
instance NoThunks ForeignLibOption
diff --git a/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs b/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs
index 42ab97cc4b0..fd7e4eea3c0 100644
--- a/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs
+++ b/Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs
@@ -29,7 +29,7 @@ import Distribution.Types.DumpBuildInfo (DumpBuildInfo)
import Distribution.Types.PackageVersionConstraint
import Distribution.Types.UnitId (DefUnitId, UnitId)
import Distribution.Utils.NubList (NubList)
-import Distribution.Utils.Path (SymbolicPathX)
+import Distribution.Utils.Path (SymbolicPathX, Build, Pkg)
import Distribution.Utils.ShortText (ShortText, fromShortText)
import Distribution.Verbosity
import Distribution.Verbosity.Internal
@@ -78,7 +78,8 @@ instance ToExpr ExeDependency
instance ToExpr Executable
instance ToExpr ExecutableScope
instance ToExpr ExposedModule
-instance ToExpr ExtraSource
+instance ToExpr (ExtraSource Build)
+instance ToExpr (ExtraSource Pkg)
instance ToExpr FlagAssignment
instance ToExpr FlagName
instance ToExpr ForeignLib
diff --git a/Cabal/src/Distribution/Simple/Build.hs b/Cabal/src/Distribution/Simple/Build.hs
index 410db8d3062..402f27467d2 100644
--- a/Cabal/src/Distribution/Simple/Build.hs
+++ b/Cabal/src/Distribution/Simple/Build.hs
@@ -642,35 +642,35 @@ generateCode codeGens nm pdesc bi lbi clbi verbosity = do
addExtraCSources :: BuildInfo -> [SymbolicPath Pkg File] -> BuildInfo
addExtraCSources bi extras = bi{cSources = new}
where
- new = ordNub (map extraSourceFromPath extras ++ cSources bi)
+ new = ordNub (map (flip ExtraSourcePkg []) extras ++ cSources bi)
-- | Add extra C++ sources generated by preprocessing to build
-- information.
addExtraCxxSources :: BuildInfo -> [SymbolicPath Pkg File] -> BuildInfo
addExtraCxxSources bi extras = bi{cxxSources = new}
where
- new = ordNub (map extraSourceFromPath extras ++ cxxSources bi)
+ new = ordNub (map (flip ExtraSourcePkg []) extras ++ cxxSources bi)
-- | Add extra C-- sources generated by preprocessing to build
-- information.
addExtraCmmSources :: BuildInfo -> [SymbolicPath Pkg File] -> BuildInfo
addExtraCmmSources bi extras = bi{cmmSources = new}
where
- new = ordNub (map extraSourceFromPath extras ++ cmmSources bi)
+ new = ordNub (map (flip ExtraSourcePkg []) extras ++ cmmSources bi)
-- | Add extra ASM sources generated by preprocessing to build
-- information.
addExtraAsmSources :: BuildInfo -> [SymbolicPath Pkg File] -> BuildInfo
addExtraAsmSources bi extras = bi{asmSources = new}
where
- new = ordNub (map extraSourceFromPath extras ++ asmSources bi)
+ new = ordNub (map (flip ExtraSourcePkg []) extras ++ asmSources bi)
-- | Add extra JS sources generated by preprocessing to build
-- information.
addExtraJsSources :: BuildInfo -> [SymbolicPath Pkg File] -> BuildInfo
addExtraJsSources bi extras = bi{jsSources = new}
where
- new = ordNub (map extraSourceFromPath extras ++ jsSources bi)
+ new = ordNub (map (flip ExtraSourcePkg []) extras ++ jsSources bi)
-- | Add extra HS modules generated by preprocessing to build
-- information.
@@ -716,7 +716,7 @@ replComponent
preprocessComponent pkg_descr comp lbi clbi False verbosity suffixHandlers
extras <- preprocessExtras verbosity comp lbi
let libbi = libBuildInfo lib
- lib' = lib{libBuildInfo = libbi{cSources = cSources libbi ++ map extraSourceFromPath extras}}
+ lib' = lib{libBuildInfo = libbi{cSources = cSources libbi ++ map (flip ExtraSourcePkg []) extras}}
replLib replFlags pkg lbi lib' libClbi
replComponent
replFlags
@@ -733,23 +733,23 @@ replComponent
case comp of
CLib lib -> do
let libbi = libBuildInfo lib
- lib' = lib{libBuildInfo = libbi{cSources = cSources libbi ++ map extraSourceFromPath extras}}
+ lib' = lib{libBuildInfo = libbi{cSources = cSources libbi ++ map (flip ExtraSourcePkg []) extras}}
replLib replFlags pkg_descr lbi lib' clbi
CFLib flib ->
replFLib replFlags pkg_descr lbi flib clbi
CExe exe -> do
let ebi = buildInfo exe
- exe' = exe{buildInfo = ebi{cSources = cSources ebi ++ map extraSourceFromPath extras}}
+ exe' = exe{buildInfo = ebi{cSources = cSources ebi ++ map (flip ExtraSourcePkg []) extras}}
replExe replFlags pkg_descr lbi exe' clbi
CTest test@TestSuite{testInterface = TestSuiteExeV10{}} -> do
let exe = testSuiteExeV10AsExe test
let ebi = buildInfo exe
- exe' = exe{buildInfo = ebi{cSources = cSources ebi ++ map extraSourceFromPath extras}}
+ exe' = exe{buildInfo = ebi{cSources = cSources ebi ++ map (flip ExtraSourcePkg []) extras}}
replExe replFlags pkg_descr lbi exe' clbi
CBench bm@Benchmark{benchmarkInterface = BenchmarkExeV10{}} -> do
let exe = benchmarkExeV10asExe bm
let ebi = buildInfo exe
- exe' = exe{buildInfo = ebi{cSources = cSources ebi ++ map extraSourceFromPath extras}}
+ exe' = exe{buildInfo = ebi{cSources = cSources ebi ++ map (flip ExtraSourcePkg []) extras}}
replExe replFlags pkg_descr lbi exe' clbi
#if __GLASGOW_HASKELL__ < 811
-- silence pattern-match warnings prior to GHC 9.0
diff --git a/Cabal/src/Distribution/Simple/GHC/Build/ExtraSources.hs b/Cabal/src/Distribution/Simple/GHC/Build/ExtraSources.hs
index 9304d3691ae..800059a9402 100644
--- a/Cabal/src/Distribution/Simple/GHC/Build/ExtraSources.hs
+++ b/Cabal/src/Distribution/Simple/GHC/Build/ExtraSources.hs
@@ -1,5 +1,7 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DisambiguateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
@@ -26,7 +28,7 @@ import Distribution.Simple.Program.Types
import Distribution.Simple.Setup.Common (commonSetupTempFileOptions)
import Distribution.System (Arch (JavaScript), Platform (..))
import Distribution.Types.ComponentLocalBuildInfo
-import Distribution.Types.ExtraSource (ExtraSource(..))
+import Distribution.Types.ExtraSource (ExtraSource (..))
import Distribution.Utils.Path
import Distribution.Verbosity (Verbosity)
@@ -52,9 +54,10 @@ buildAllExtraSources =
, buildJsSources
, buildAsmSources
, buildCmmSources
+ , buildAutogenCmmSources
]
-type ExtraSourceBuilder =
+type ExtraSourceBuilder =
Maybe (SymbolicPath Pkg File)
-- ^ An optional non-Haskell Main file
-> ConfiguredProgram
@@ -79,7 +82,7 @@ buildCSources mbMainFile =
CExe{}
| Just main <- mbMainFile
, isC $ getSymbolicPath main ->
- cFiles ++ [ExtraSource main mempty]
+ cFiles ++ [ExtraSourcePkg main mempty]
_otherwise -> cFiles
)
@@ -94,7 +97,7 @@ buildCxxSources mbMainFile =
CExe{}
| Just main <- mbMainFile
, isCxx $ getSymbolicPath main ->
- cxxFiles ++ [ExtraSource main mempty]
+ cxxFiles ++ [ExtraSourcePkg main mempty]
_otherwise -> cxxFiles
)
@@ -132,25 +135,34 @@ buildCmmSources _mbMainFile =
Internal.componentCmmGhcOptions
(cmmSources . componentBuildInfo)
+buildAutogenCmmSources :: ExtraSourceBuilder
+buildAutogenCmmSources _mbMainFile=
+ buildExtraSources
+ "C-- Generated Sources"
+ Internal.componentCmmGhcOptions
+ (autogenCmmSources . componentBuildInfo)
+
-- | Create 'PreBuildComponentRules' for a given type of extra build sources
-- which are compiled via a GHC invocation with the given options. Used to
-- define built-in extra sources, such as, C, Cxx, Js, Asm, and Cmm sources.
buildExtraSources
- :: String
+ :: forall from
+ . Internal.SourcePath (ExtraSource from)
+ => String
-- ^ String describing the extra sources being built, for printing.
-> ( Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> SymbolicPath Pkg (Dir Artifacts)
- -> ExtraSource
+ -> ExtraSource from
-> GhcOptions
)
-- ^ Function to determine the @'GhcOptions'@ for the
-- invocation of GHC when compiling these extra sources (e.g.
-- @'Internal.componentCxxGhcOptions'@,
-- @'Internal.componentCmmGhcOptions'@)
- -> (Component -> [ExtraSource])
+ -> (Component -> [ExtraSource from])
-- ^ View the extra sources of a component, typically from
-- the build info (e.g. @'asmSources'@, @'cSources'@).
-- @'Executable'@ components might additionally add the
@@ -196,7 +208,6 @@ buildExtraSources
platform
mbWorkDir
- buildAction :: ExtraSource -> IO ()
buildAction extraSource = do
let baseSrcOpts =
componentSourceGhcOptions
@@ -236,7 +247,7 @@ buildExtraSources
compileIfNeeded :: GhcOptions -> IO ()
compileIfNeeded opts' = do
- needsRecomp <- checkNeedsRecompilation mbWorkDir (extraSourceFile extraSource) opts'
+ needsRecomp <- checkNeedsRecompilation mbWorkDir (Internal.sourcePath lbi extraSource) opts'
when needsRecomp $ runGhcProg opts'
createDirectoryIfMissingVerbose verbosity True (i odir)
@@ -276,4 +287,4 @@ buildExtraSources
else do
info verbosity ("Building " ++ description ++ "...")
traverse_ buildAction sources
- return (toNubListR (map extraSourceFile sources))
+ return (toNubListR (map (Internal.sourcePath lbi) sources))
diff --git a/Cabal/src/Distribution/Simple/GHC/Internal.hs b/Cabal/src/Distribution/Simple/GHC/Internal.hs
index f4083859dea..dd046fcbece 100644
--- a/Cabal/src/Distribution/Simple/GHC/Internal.hs
+++ b/Cabal/src/Distribution/Simple/GHC/Internal.hs
@@ -1,5 +1,6 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}
-----------------------------------------------------------------------------
@@ -47,6 +48,9 @@ module Distribution.Simple.GHC.Internal
, ghcEnvironmentFileName
, renderGhcEnvironmentFile
, renderGhcEnvironmentFileEntry
+
+ -- * Paths
+ , SourcePath (..)
) where
import Distribution.Compat.Prelude
@@ -311,7 +315,6 @@ getExtensions verbosity implInfo ghcProg = do
then lines str
else -- Older GHCs only gave us either Foo or NoFoo,
-- so we have to work out the other one ourselves
-
[ extStr''
| extStr <- lines str
, let extStr' = case extStr of
@@ -331,7 +334,6 @@ getExtensions verbosity implInfo ghcProg = do
-- Since it was not a proper extension, it could
-- not be turned off, hence we omit a
-- DisableExtension entry here.
-
(EnableExtension NondecreasingIndentation, Nothing)
: extensions0
else extensions0
@@ -357,24 +359,23 @@ includePaths lbi bi clbi odir =
| dir <- mapMaybe (symbolicPathRelative_maybe . unsafeCoerceSymbolicPath) $ includeDirs bi
]
-type ExtraSourceGhcOptions =
+type ExtraSourceGhcOptions pkg =
Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> SymbolicPath Pkg (Dir Artifacts)
- -> ExtraSource
+ -> ExtraSource pkg
-> GhcOptions
-
-componentCcGhcOptions :: ExtraSourceGhcOptions
+componentCcGhcOptions :: SourcePath (ExtraSource pkg) => ExtraSourceGhcOptions pkg
componentCcGhcOptions verbosity lbi bi clbi odir extraSource =
mempty
{ -- Respect -v0, but don't crank up verbosity on GHC if
-- Cabal verbosity is requested. For that, use --ghc-option=-v instead!
ghcOptVerbosity = toFlag (min verbosity normal)
, ghcOptMode = toFlag GhcModeCompile
- , ghcOptInputFiles = toNubListR [extraSourceFile extraSource]
+ , ghcOptInputFiles = toNubListR [sourcePath lbi extraSource]
, ghcOptCppIncludePath = includePaths lbi bi clbi odir
, ghcOptHideAllPackages = toFlag True
, ghcOptPackageDBs = withPackageDB lbi
@@ -395,19 +396,19 @@ componentCcGhcOptions verbosity lbi bi clbi odir extraSource =
, ghcOptCcProgram =
maybeToFlag $
programPath
- <$> lookupProgram gccProgram (withPrograms lbi)
+ <$> lookupProgram gccProgram (withPrograms lbi)
, ghcOptObjDir = toFlag odir
, ghcOptExtra = hcOptions GHC bi
}
-componentCxxGhcOptions :: ExtraSourceGhcOptions
+componentCxxGhcOptions :: SourcePath (ExtraSource pkg) => ExtraSourceGhcOptions pkg
componentCxxGhcOptions verbosity lbi bi clbi odir extraSource =
mempty
{ -- Respect -v0, but don't crank up verbosity on GHC if
-- Cabal verbosity is requested. For that, use --ghc-option=-v instead!
ghcOptVerbosity = toFlag (min verbosity normal)
, ghcOptMode = toFlag GhcModeCompile
- , ghcOptInputFiles = toNubListR [extraSourceFile extraSource]
+ , ghcOptInputFiles = toNubListR [sourcePath lbi extraSource]
, ghcOptCppIncludePath = includePaths lbi bi clbi odir
, ghcOptHideAllPackages = toFlag True
, ghcOptPackageDBs = withPackageDB lbi
@@ -428,19 +429,19 @@ componentCxxGhcOptions verbosity lbi bi clbi odir extraSource =
, ghcOptCcProgram =
maybeToFlag $
programPath
- <$> lookupProgram gccProgram (withPrograms lbi)
+ <$> lookupProgram gccProgram (withPrograms lbi)
, ghcOptObjDir = toFlag odir
, ghcOptExtra = hcOptions GHC bi
}
-componentAsmGhcOptions :: ExtraSourceGhcOptions
+componentAsmGhcOptions :: SourcePath (ExtraSource pkg) => ExtraSourceGhcOptions pkg
componentAsmGhcOptions verbosity lbi bi clbi odir extraSource =
mempty
{ -- Respect -v0, but don't crank up verbosity on GHC if
-- Cabal verbosity is requested. For that, use --ghc-option=-v instead!
ghcOptVerbosity = toFlag (min verbosity normal)
, ghcOptMode = toFlag GhcModeCompile
- , ghcOptInputFiles = toNubListR [extraSourceFile extraSource]
+ , ghcOptInputFiles = toNubListR [sourcePath lbi extraSource]
, ghcOptCppIncludePath = includePaths lbi bi clbi odir
, ghcOptHideAllPackages = toFlag True
, ghcOptPackageDBs = withPackageDB lbi
@@ -460,14 +461,14 @@ componentAsmGhcOptions verbosity lbi bi clbi odir extraSource =
, ghcOptObjDir = toFlag odir
}
-componentJsGhcOptions :: ExtraSourceGhcOptions
+componentJsGhcOptions :: SourcePath (ExtraSource pkg) => ExtraSourceGhcOptions pkg
componentJsGhcOptions verbosity lbi bi clbi odir extraSource =
mempty
{ -- Respect -v0, but don't crank up verbosity on GHC if
-- Cabal verbosity is requested. For that, use --ghc-option=-v instead!
ghcOptVerbosity = toFlag (min verbosity normal)
, ghcOptMode = toFlag GhcModeCompile
- , ghcOptInputFiles = toNubListR [extraSourceFile extraSource]
+ , ghcOptInputFiles = toNubListR [sourcePath lbi extraSource]
, ghcOptCppIncludePath = includePaths lbi bi clbi odir
, ghcOptHideAllPackages = toFlag True
, ghcOptPackageDBs = withPackageDB lbi
@@ -561,14 +562,14 @@ toGhcOptimisation NoOptimisation = mempty -- TODO perhaps override?
toGhcOptimisation NormalOptimisation = toFlag GhcNormalOptimisation
toGhcOptimisation MaximumOptimisation = toFlag GhcMaximumOptimisation
-componentCmmGhcOptions :: ExtraSourceGhcOptions
+componentCmmGhcOptions :: SourcePath (ExtraSource pkg) => ExtraSourceGhcOptions pkg
componentCmmGhcOptions verbosity lbi bi clbi odir extraSource =
mempty
{ -- Respect -v0, but don't crank up verbosity on GHC if
-- Cabal verbosity is requested. For that, use --ghc-option=-v instead!
ghcOptVerbosity = toFlag (min verbosity normal)
, ghcOptMode = toFlag GhcModeCompile
- , ghcOptInputFiles = toNubListR [extraSourceFile extraSource]
+ , ghcOptInputFiles = toNubListR [sourcePath lbi extraSource]
, ghcOptCppIncludePath = includePaths lbi bi clbi odir
, ghcOptCppOptions = cppOptions bi
, ghcOptCppIncludes =
@@ -815,3 +816,12 @@ renderGhcEnvironmentFileEntry entry = case entry of
UserPackageDB -> "user-package-db"
SpecificPackageDB dbfile -> "package-db " ++ dbfile
GhcEnvFileClearPackageDbStack -> "clear-package-db"
+
+class ExtraSourceClass e => SourcePath e where
+ sourcePath :: LocalBuildInfo -> e -> SymbolicPath Pkg 'File
+
+instance SourcePath (ExtraSource Pkg) where
+ sourcePath _ (ExtraSourcePkg f _) = f
+
+instance SourcePath (ExtraSource Build) where
+ sourcePath lbi (ExtraSourceBuild f _) = buildDir lbi </> f
diff --git a/Cabal/src/Distribution/Simple/GHCJS.hs b/Cabal/src/Distribution/Simple/GHCJS.hs
index ddf65bf5f60..967981ee045 100644
--- a/Cabal/src/Distribution/Simple/GHCJS.hs
+++ b/Cabal/src/Distribution/Simple/GHCJS.hs
@@ -547,7 +547,7 @@ buildOrReplLib mReplFlags verbosity numJobs _pkg_descr lbi lib clbi = do
, "-js-lib-outputdir"
, getSymbolicPath libTargetDir
]
- ++ foldMap (\(ExtraSource file opts) -> getSymbolicPath file : opts) jsSrcs
+ ++ foldMap (\e -> getSymbolicPath (extraSourceFile e) : extraSourceOpts e) jsSrcs
}
vanillaOptsNoJsLib =
baseOpts
@@ -1114,8 +1114,8 @@ decodeMainIsArg arg
--
-- Used to correctly build and link sources.
data BuildSources = BuildSources
- { cSourcesFiles :: [ExtraSource]
- , cxxSourceFiles :: [ExtraSource]
+ { cSourcesFiles :: [ExtraSource Pkg]
+ , cxxSourceFiles :: [ExtraSource Pkg]
, inputSourceFiles :: [SymbolicPath Pkg File]
, inputSourceModules :: [ModuleName]
}
@@ -1161,8 +1161,8 @@ gbuildSources verbosity mbWorkDir pkgId specVer tmpDir bm =
-- have no excuse anymore to keep doing it wrong... ;-)
warn verbosity $
"Enabling workaround for Main module '"
- ++ prettyShow mainModName
- ++ "' listed in 'other-modules' illegally!"
+ ++ prettyShow mainModName
+ ++ "' listed in 'other-modules' illegally!"
return
BuildSources
@@ -1181,11 +1181,11 @@ gbuildSources verbosity mbWorkDir pkgId specVer tmpDir bm =
}
else
let (csf, cxxsf)
- | isCxx (getSymbolicPath main) = (cSources bnfo, extraSourceFromPath main : cxxSources bnfo)
+ | isCxx (getSymbolicPath main) = (cSources bnfo, ExtraSourcePkg main [] : cxxSources bnfo)
-- if main is not a Haskell source
-- and main is not a C++ source
-- then we assume that it is a C source
- | otherwise = (extraSourceFromPath main : cSources bnfo, cxxSources bnfo)
+ | otherwise = (ExtraSourcePkg main [] : cSources bnfo, cxxSources bnfo)
in return
BuildSources
{ cSourcesFiles = csf
diff --git a/cabal-install/src/Distribution/Client/TargetSelector.hs b/cabal-install/src/Distribution/Client/TargetSelector.hs
index 61ca11f087a..d74aff42e3e 100644
--- a/cabal-install/src/Distribution/Client/TargetSelector.hs
+++ b/cabal-install/src/Distribution/Client/TargetSelector.hs
@@ -72,7 +72,7 @@ import Distribution.PackageDescription
, BenchmarkInterface (..)
, BuildInfo (..)
, Executable (..)
- , ExtraSource (..)
+ , ExtraSourceClass (..)
, PackageDescription
, TestSuite (..)
, TestSuiteInterface (..)
diff --git a/cabal-install/tests/IntegrationTests2.hs b/cabal-install/tests/IntegrationTests2.hs
index 273be658906..dd54fea54d0 100644
--- a/cabal-install/tests/IntegrationTests2.hs
+++ b/cabal-install/tests/IntegrationTests2.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
@@ -70,7 +71,7 @@ import qualified Distribution.Simple.Flag as Flag
import Distribution.Simple.Setup (CommonSetupFlags (..), HaddockFlags (..), HaddockProjectFlags (..), defaultCommonSetupFlags, defaultHaddockFlags, defaultHaddockProjectFlags, toFlag)
import Distribution.System
import Distribution.Text
-import Distribution.Utils.Path (unsafeMakeSymbolicPath)
+import Distribution.Utils.Path (FileOrDir (File), Pkg, SymbolicPath, unsafeMakeSymbolicPath)
import Distribution.Version
import IntegrationTests2.CPP
@@ -660,7 +661,8 @@ testTargetSelectorAmbiguous reportSubCase = do
withCFiles exe files =
exe{buildInfo = (buildInfo exe){cSources = map (mkExtraSource . unsafeMakeSymbolicPath) files}}
- mkExtraSource x = ExtraSource x []
+ mkExtraSource :: SymbolicPath Pkg File -> ExtraSource Pkg
+ mkExtraSource x = ExtraSourcePkg x []
withHsSrcDirs :: Executable -> [FilePath] -> Executable
withHsSrcDirs exe srcDirs =
From c44c4a957c5e4fdedaa2c252bb0ecdbefac4de0d Mon Sep 17 00:00:00 2001
From: Andrea Bedini <andrea@andreabedini.com>
Date: Fri, 7 Mar 2025 13:02:21 +0800
Subject: [PATCH 08/82] refactor: jsem is irrelevant to fetching packages
This has to be cleaned up but it does not make sense to pass the compiler.
---
.../src/Distribution/Client/CmdInstall.hs | 1 -
.../src/Distribution/Client/ProjectConfig.hs | 21 ++++++-------------
.../Distribution/Client/ProjectPlanning.hs | 9 +++-----
3 files changed, 9 insertions(+), 22 deletions(-)
diff --git a/cabal-install/src/Distribution/Client/CmdInstall.hs b/cabal-install/src/Distribution/Client/CmdInstall.hs
index 63cf59169a3..07a72119b75 100644
--- a/cabal-install/src/Distribution/Client/CmdInstall.hs
+++ b/cabal-install/src/Distribution/Client/CmdInstall.hs
@@ -467,7 +467,6 @@ installAction flags@NixStyleFlags{extraFlags, configFlags, installFlags, project
fetchAndReadSourcePackages
verbosity
distDirLayout
- (Just compiler)
(projectConfigShared config)
(projectConfigBuildOnly config)
[ProjectPackageRemoteTarball uri | uri <- uris]
diff --git a/cabal-install/src/Distribution/Client/ProjectConfig.hs b/cabal-install/src/Distribution/Client/ProjectConfig.hs
index b9f2cfed6c6..e966ad29624 100644
--- a/cabal-install/src/Distribution/Client/ProjectConfig.hs
+++ b/cabal-install/src/Distribution/Client/ProjectConfig.hs
@@ -1261,7 +1261,6 @@ mplusMaybeT ma mb = do
fetchAndReadSourcePackages
:: Verbosity
-> DistDirLayout
- -> Maybe Compiler
-> ProjectConfigShared
-> ProjectConfigBuildOnly
-> [ProjectPackageLocation]
@@ -1269,7 +1268,6 @@ fetchAndReadSourcePackages
fetchAndReadSourcePackages
verbosity
distDirLayout
- compiler
projectConfigShared
projectConfigBuildOnly
pkgLocations = do
@@ -1306,9 +1304,7 @@ fetchAndReadSourcePackages
syncAndReadSourcePackagesRemoteRepos
verbosity
distDirLayout
- compiler
projectConfigShared
- projectConfigBuildOnly
(fromFlag (projectConfigOfflineMode projectConfigBuildOnly))
[repo | ProjectPackageRemoteRepo repo <- pkgLocations]
@@ -1425,23 +1421,16 @@ fetchAndReadSourcePackageRemoteTarball
syncAndReadSourcePackagesRemoteRepos
:: Verbosity
-> DistDirLayout
- -> Maybe Compiler
-> ProjectConfigShared
- -> ProjectConfigBuildOnly
-> Bool
-> [SourceRepoList]
-> Rebuild [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
syncAndReadSourcePackagesRemoteRepos
verbosity
DistDirLayout{distDownloadSrcDirectory}
- compiler
ProjectConfigShared
{ projectConfigProgPathExtra
}
- ProjectConfigBuildOnly
- { projectConfigUseSemaphore
- , projectConfigNumJobs
- }
offlineMode
repos = do
repos' <-
@@ -1462,14 +1451,15 @@ syncAndReadSourcePackagesRemoteRepos
]
let progPathExtra = fromNubList projectConfigProgPathExtra
+
getConfiguredVCS <- delayInitSharedResources $ \repoType ->
let vcs = Map.findWithDefault (error $ "Unknown VCS: " ++ prettyShow repoType) repoType knownVCSs
in configureVCS verbosity progPathExtra vcs
- concat
- <$> rerunConcurrentlyIfChanged
+ x <-
+ rerunConcurrentlyIfChanged
verbosity
- (newJobControlFromParStrat verbosity compiler parStrat (Just maxNumFetchJobs))
+ (newParallelJobControl maxNumFetchJobs)
[ ( monitor
, repoGroup'
, do
@@ -1487,8 +1477,9 @@ syncAndReadSourcePackagesRemoteRepos
[PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
monitor = newFileMonitor (pathStem <.> "cache")
]
+
+ return (concat x)
where
- parStrat = resolveNumJobsSetting projectConfigUseSemaphore projectConfigNumJobs
syncRepoGroupAndReadSourcePackages
:: VCS ConfiguredProgram
-> FilePath
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index 7e10677437c..37d0a4a3bdb 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -401,11 +401,11 @@ rebuildProjectConfig
(compiler, Platform arch os, _) <- configureCompiler verbosity distDirLayout (fst (PD.ignoreConditions projectConfigSkeleton) <> cliConfig)
pure (os, arch, compiler)
- (projectConfig, compiler) <- instantiateProjectConfigSkeletonFetchingCompiler fetchCompiler mempty projectConfigSkeleton
+ (projectConfig, _compiler) <- instantiateProjectConfigSkeletonFetchingCompiler fetchCompiler mempty projectConfigSkeleton
when (projectConfigDistDir (projectConfigShared $ projectConfig) /= NoFlag) $
liftIO $
warn verbosity "The builddir option is not supported in project and config files. It will be ignored."
- localPackages <- phaseReadLocalPackages compiler (projectConfig <> cliConfig)
+ localPackages <- phaseReadLocalPackages (projectConfig <> cliConfig)
return (projectConfig, localPackages)
let configfiles =
@@ -437,11 +437,9 @@ rebuildProjectConfig
-- NOTE: These are all packages mentioned in the project configuration.
-- Whether or not they will be considered local to the project will be decided by `shouldBeLocal`.
phaseReadLocalPackages
- :: Maybe Compiler
- -> ProjectConfig
+ :: ProjectConfig
-> Rebuild [PackageSpecifier UnresolvedSourcePackage]
phaseReadLocalPackages
- compiler
projectConfig@ProjectConfig
{ projectConfigShared
, projectConfigBuildOnly
@@ -456,7 +454,6 @@ rebuildProjectConfig
fetchAndReadSourcePackages
verbosity
distDirLayout
- compiler
projectConfigShared
projectConfigBuildOnly
pkgLocations
From 9b66d2cb6229e5864ef1d1c1ffee59bb2d8d9780 Mon Sep 17 00:00:00 2001
From: Andrea Bedini <andrea@andreabedini.com>
Date: Thu, 6 Mar 2025 12:17:18 +0800
Subject: [PATCH 09/82] refactor: introduce resolveProgramDb
---
.../src/Distribution/Client/ProjectConfig.hs | 11 +++++++++++
.../src/Distribution/Client/ProjectPlanning.hs | 8 +++-----
2 files changed, 14 insertions(+), 5 deletions(-)
diff --git a/cabal-install/src/Distribution/Client/ProjectConfig.hs b/cabal-install/src/Distribution/Client/ProjectConfig.hs
index e966ad29624..5bf2ab41e94 100644
--- a/cabal-install/src/Distribution/Client/ProjectConfig.hs
+++ b/cabal-install/src/Distribution/Client/ProjectConfig.hs
@@ -57,6 +57,7 @@ module Distribution.Client.ProjectConfig
, BuildTimeSettings (..)
, resolveBuildTimeSettings
, resolveNumJobsSetting
+ , resolveProgramDb
-- * Checking configuration
, checkBadPerPackageCompilerPaths
@@ -175,6 +176,9 @@ import Distribution.Simple.InstallDirs
)
import Distribution.Simple.Program
( ConfiguredProgram (..)
+ , ProgramDb
+ , defaultProgramDb
+ , userSpecifyPaths
)
import Distribution.Simple.Setup
( Flag (Flag)
@@ -245,6 +249,7 @@ import System.IO
)
import Distribution.Deprecated.ProjectParseUtils (ProjectParseError (..), ProjectParseWarning)
+import Distribution.Simple.Program.Db (prependProgramSearchPath)
import Distribution.Solver.Types.ProjectConfigPath
----------------------------------------
@@ -554,6 +559,12 @@ resolveNumJobsSetting projectConfigUseSemaphore projectConfigNumJobs =
1 -> Serial
n -> NumJobs (Just n)
+resolveProgramDb :: Verbosity -> PackageConfig -> IO ProgramDb
+resolveProgramDb verbosity pkgconf = do
+ let extraPath = fromNubList (packageConfigProgramPathExtra pkgconf)
+ progdb <- prependProgramSearchPath verbosity extraPath [] defaultProgramDb
+ return $ userSpecifyPaths (Map.toList (getMapLast (packageConfigProgramPaths pkgconf))) progdb
+
---------------------------------------------
-- Reading and writing project config files
--
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index 37d0a4a3bdb..84f5111e139 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -476,7 +476,7 @@ configureCompiler
, projectConfigHcPkg
}
, projectConfigLocalPackages =
- PackageConfig
+ projectConfigLocalPackages@PackageConfig
{ packageConfigProgramPaths
, packageConfigProgramPathExtra
}
@@ -497,16 +497,14 @@ configureCompiler
)
$ do
liftIO $ info verbosity "Compiler settings changed, reconfiguring..."
- let extraPath = fromNubList packageConfigProgramPathExtra
- progdb <- liftIO $ prependProgramSearchPath verbosity extraPath [] defaultProgramDb
- let progdb' = userSpecifyPaths (Map.toList (getMapLast packageConfigProgramPaths)) progdb
+ progdb <- liftIO $ resolveProgramDb verbosity projectConfigLocalPackages
result@(_, _, progdb'') <-
liftIO $
Cabal.configCompilerEx
hcFlavor
hcPath
hcPkg
- progdb'
+ progdb
verbosity
-- Note that we added the user-supplied program locations and args
From 0516edb55f418a4704b219065b201a86337fa124 Mon Sep 17 00:00:00 2001
From: Andrea Bedini <andrea@andreabedini.com>
Date: Wed, 5 Mar 2025 15:04:43 +0800
Subject: [PATCH 10/82] wip: introduce build and host toolchains
---
.../src/Distribution/Client/Config.hs | 3 ++
.../Client/ProjectConfig/Legacy.hs | 13 ++++----
.../Client/ProjectConfig/Types.hs | 3 ++
.../src/Distribution/Client/Setup.hs | 30 ++++++++++++++++++-
4 files changed, 43 insertions(+), 6 deletions(-)
diff --git a/cabal-install/src/Distribution/Client/Config.hs b/cabal-install/src/Distribution/Client/Config.hs
index 419d7d603ea..61384f495fb 100644
--- a/cabal-install/src/Distribution/Client/Config.hs
+++ b/cabal-install/src/Distribution/Client/Config.hs
@@ -573,6 +573,9 @@ instance Semigroup SavedConfig where
combineMonoid savedConfigureExFlags configAllowOlder
, configWriteGhcEnvironmentFilesPolicy =
combine configWriteGhcEnvironmentFilesPolicy
+ , configHostHcFlavor = combine configHostHcFlavor
+ , configHostHcPath = combine configHostHcPath
+ , configHostHcPkg = combine configHostHcPkg
}
where
combine = combine' savedConfigureExFlags
diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs
index 7d1bee02daa..f5030f58b5c 100644
--- a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs
+++ b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs
@@ -704,6 +704,13 @@ convertLegacyAllPackageFlags
convertLegacyAllPackageFlags globalFlags configFlags configExFlags installFlags projectFlags projectConfigMultiRepl =
ProjectConfigShared{..}
where
+ projectConfigHostHcFlavor = NoFlag
+ projectConfigHostHcPath = NoFlag
+ projectConfigHostHcPkg = NoFlag
+ projectConfigPackageDBs = (fmap . fmap) (interpretPackageDB Nothing) projectConfigPackageDBs_
+ projectConfigHookHashes = mempty -- :: Map FilePath HookAccept
+ projectConfigDistDir = fmap getSymbolicPath projectConfigAbsoluteDistDir
+
GlobalFlags
{ globalConfigFile = projectConfigConfigFile
, globalRemoteRepos = projectConfigRemoteRepos
@@ -713,8 +720,6 @@ convertLegacyAllPackageFlags globalFlags configFlags configExFlags installFlags
, globalStoreDir = projectConfigStoreDir
} = globalFlags
- projectConfigPackageDBs = (fmap . fmap) (interpretPackageDB Nothing) projectConfigPackageDBs_
- projectConfigHookHashes = mempty -- :: Map FilePath HookAccept
ConfigFlags
{ configCommonFlags = commonFlags
, configHcFlavor = projectConfigHcFlavor
@@ -730,8 +735,6 @@ convertLegacyAllPackageFlags globalFlags configFlags configExFlags installFlags
{ setupDistPref = projectConfigAbsoluteDistDir
} = commonFlags
- projectConfigDistDir = fmap getSymbolicPath projectConfigAbsoluteDistDir
-
ConfigExFlags
{ configCabalVersion = projectConfigCabalVersion
, configExConstraints = projectConfigConstraints
@@ -1010,7 +1013,7 @@ convertToLegacySharedConfig
}
configExFlags =
- ConfigExFlags
+ mempty
{ configCabalVersion = projectConfigCabalVersion
, configAppend = mempty
, configBackup = mempty
diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs
index 4f1558fa215..5657bb4b605 100644
--- a/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs
+++ b/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs
@@ -192,6 +192,9 @@ data ProjectConfigShared = ProjectConfigShared
, projectConfigHcFlavor :: Flag CompilerFlavor
, projectConfigHcPath :: Flag FilePath
, projectConfigHcPkg :: Flag FilePath
+ , projectConfigHostHcFlavor :: Flag CompilerFlavor
+ , projectConfigHostHcPath :: Flag FilePath
+ , projectConfigHostHcPkg :: Flag FilePath
, projectConfigHaddockIndex :: Flag PathTemplate
, -- Only makes sense for manual mode, not --local mode
-- too much control!
diff --git a/cabal-install/src/Distribution/Client/Setup.hs b/cabal-install/src/Distribution/Client/Setup.hs
index 78fcf7c2e1f..da399b604a7 100644
--- a/cabal-install/src/Distribution/Client/Setup.hs
+++ b/cabal-install/src/Distribution/Client/Setup.hs
@@ -162,7 +162,7 @@ import Distribution.ReadE
)
import Distribution.Simple.Command hiding (boolOpt, boolOpt')
import qualified Distribution.Simple.Command as Command
-import Distribution.Simple.Compiler (Compiler, PackageDB, PackageDBStack)
+import Distribution.Simple.Compiler (Compiler, CompilerFlavor (..), PackageDB, PackageDBStack)
import Distribution.Simple.Configure
( computeEffectiveProfiling
, configCompilerAuxEx
@@ -920,6 +920,9 @@ data ConfigExFlags = ConfigExFlags
, configAllowOlder :: Maybe AllowOlder
, configWriteGhcEnvironmentFilesPolicy
:: Flag WriteGhcEnvironmentFilesPolicy
+ , configHostHcFlavor :: Flag CompilerFlavor
+ , configHostHcPath :: Flag FilePath
+ , configHostHcPkg :: Flag FilePath
}
deriving (Eq, Show, Generic)
@@ -1047,6 +1050,31 @@ configureExOptions _showOrParseArgs src =
writeGhcEnvironmentFilesPolicyParser
writeGhcEnvironmentFilesPolicyPrinter
)
+ , option
+ []
+ ["host-compiler"]
+ "host compiler"
+ configHostHcFlavor
+ (\v flags -> flags{configHostHcFlavor = v})
+ ( choiceOpt
+ [ (Flag GHC, ("g", ["ghc"]), "compile with GHC")
+ , (Flag GHCJS, ([], ["ghcjs"]), "compile with GHCJS")
+ ]
+ )
+ , option
+ "W"
+ ["with-host-compiler", "with-host-hc"]
+ "give the path to the compiler for the host toolchain"
+ configHostHcPath
+ (\v flags -> flags{configHostHcPath = v})
+ (reqArgFlag "PATH")
+ , option
+ ""
+ ["with-host-hc-pkg"]
+ "give the path to the package tool for the host toolchain"
+ configHostHcPkg
+ (\v flags -> flags{configHostHcPkg = v})
+ (reqArgFlag "PATH")
]
writeGhcEnvironmentFilesPolicyParser :: ReadE (Flag WriteGhcEnvironmentFilesPolicy)
From 61f100feb82ecb08c6f798ceb0664a80b81cd155 Mon Sep 17 00:00:00 2001
From: Andrea Bedini <andrea@andreabedini.com>
Date: Thu, 6 Mar 2025 12:57:12 +0800
Subject: [PATCH 11/82] wip: thread toolchains everywhere
---
Cabal/src/Distribution/Simple/Program/Db.hs | 15 +
.../src/Distribution/Client/CmdExec.hs | 10 +-
.../src/Distribution/Client/CmdHaddock.hs | 47 ++--
.../Distribution/Client/CmdHaddockProject.hs | 61 ++--
.../src/Distribution/Client/CmdListBin.hs | 2 +-
.../src/Distribution/Client/CmdPath.hs | 11 +-
.../src/Distribution/Client/CmdRepl.hs | 12 +-
.../Distribution/Client/ProjectBuilding.hs | 3 +-
.../Client/ProjectBuilding/UnpackedPackage.hs | 30 +-
.../Client/ProjectOrchestration.hs | 10 +-
.../Distribution/Client/ProjectPlanOutput.hs | 53 ++--
.../Distribution/Client/ProjectPlanning.hs | 261 +++++++++---------
.../Client/ProjectPlanning/Types.hs | 47 +++-
.../src/Distribution/Client/ScriptUtils.hs | 15 +-
cabal-install/tests/IntegrationTests2.hs | 8 +-
.../Distribution/Client/ProjectConfig.hs | 6 +
16 files changed, 337 insertions(+), 254 deletions(-)
diff --git a/Cabal/src/Distribution/Simple/Program/Db.hs b/Cabal/src/Distribution/Simple/Program/Db.hs
index c76b38e9923..bc5d0714aa3 100644
--- a/Cabal/src/Distribution/Simple/Program/Db.hs
+++ b/Cabal/src/Distribution/Simple/Program/Db.hs
@@ -67,6 +67,7 @@ module Distribution.Simple.Program.Db
, ConfiguredProgs
, updateUnconfiguredProgs
, updateConfiguredProgs
+ , programDbSignature
) where
import Distribution.Compat.Prelude
@@ -564,3 +565,17 @@ requireProgramVersion verbosity prog range programDb =
join $
either (dieWithException verbosity) return
`fmap` lookupProgramVersion verbosity prog range programDb
+
+-- | Select the bits of a 'ProgramDb' to monitor for value changes.
+-- Use 'programsMonitorFiles' for the files to monitor.
+programDbSignature :: ProgramDb -> [ConfiguredProgram]
+programDbSignature progdb =
+ [ prog
+ { programMonitorFiles = []
+ , programOverrideEnv =
+ filter
+ ((/= "PATH") . fst)
+ (programOverrideEnv prog)
+ }
+ | prog <- configuredPrograms progdb
+ ]
diff --git a/cabal-install/src/Distribution/Client/CmdExec.hs b/cabal-install/src/Distribution/Client/CmdExec.hs
index caa680a3a3a..c0f565738fb 100644
--- a/cabal-install/src/Distribution/Client/CmdExec.hs
+++ b/cabal-install/src/Distribution/Client/CmdExec.hs
@@ -55,7 +55,9 @@ import Distribution.Client.ProjectPlanning
)
import qualified Distribution.Client.ProjectPlanning as Planning
import Distribution.Client.ProjectPlanning.Types
- ( dataDirsEnvironmentForPlan
+ ( Toolchain (..)
+ , Toolchains (..)
+ , dataDirsEnvironmentForPlan
)
import Distribution.Client.Setup
( ConfigFlags (configCommonFlags)
@@ -170,7 +172,7 @@ execAction flags@NixStyleFlags{..} extraArgs globalFlags = do
-- Some dependencies may have executables. Let's put those on the PATH.
let extraPaths = pathAdditions baseCtx buildCtx
- pkgProgs = pkgConfigCompilerProgs (elaboratedShared buildCtx)
+ pkgProgs = toolchainProgramDb $ buildToolchain $ pkgConfigToolchains (elaboratedShared buildCtx)
extraEnvVars =
dataDirsEnvironmentForPlan
(distDirLayout baseCtx)
@@ -185,7 +187,7 @@ execAction flags@NixStyleFlags{..} extraArgs globalFlags = do
-- point at the file.
-- In case ghc is too old to support environment files,
-- we pass the same info as arguments
- let compiler = pkgConfigCompiler $ elaboratedShared buildCtx
+ let compiler = toolchainCompiler $ buildToolchain $ pkgConfigToolchains $ elaboratedShared buildCtx
envFilesSupported = supportsPkgEnvFiles (getImplInfo compiler)
case extraArgs of
[] -> dieWithException verbosity SpecifyAnExecutable
@@ -243,7 +245,7 @@ matchCompilerPath elaboratedShared program =
programPath program
`elem` (programPath <$> configuredCompilers)
where
- configuredCompilers = configuredPrograms $ pkgConfigCompilerProgs elaboratedShared
+ configuredCompilers = configuredPrograms $ toolchainProgramDb $ buildToolchain $ pkgConfigToolchains elaboratedShared
-- | Execute an action with a temporary .ghc.environment file reflecting the
-- current environment. The action takes an environment containing the env
diff --git a/cabal-install/src/Distribution/Client/CmdHaddock.hs b/cabal-install/src/Distribution/Client/CmdHaddock.hs
index 677589e3e35..4b35b1f9f2e 100644
--- a/cabal-install/src/Distribution/Client/CmdHaddock.hs
+++ b/cabal-install/src/Distribution/Client/CmdHaddock.hs
@@ -27,9 +27,6 @@ import Distribution.Client.ProjectConfig.Types
, ProjectConfig (..)
)
import Distribution.Client.ProjectOrchestration
-import Distribution.Client.ProjectPlanning
- ( ElaboratedSharedConfig (..)
- )
import Distribution.Client.Setup
( CommonSetupFlags (..)
, ConfigFlags (..)
@@ -48,13 +45,6 @@ import Distribution.Simple.Command
, usageAlternatives
)
import Distribution.Simple.Flag (Flag (..))
-import Distribution.Simple.Program.Builtin
- ( haddockProgram
- )
-import Distribution.Simple.Program.Db
- ( addKnownProgram
- , reconfigurePrograms
- )
import Distribution.Simple.Setup
( HaddockFlags (..)
, fromFlagOrDefault
@@ -160,6 +150,7 @@ haddockAction relFlags targetStrings globalFlags = do
projCtx{buildSettings = (buildSettings projCtx){buildSettingHaddockOpen = True}}
| otherwise =
projCtx
+
absProjectConfig <- mkConfigAbsolute relProjectConfig
let baseCtx = relBaseCtx{projectConfig = absProjectConfig}
@@ -188,28 +179,32 @@ haddockAction relFlags targetStrings globalFlags = do
TargetActionHaddock
targets
elaboratedPlan
+
return (elaboratedPlan', targets)
printPlan verbosity baseCtx buildCtx
- progs <-
- reconfigurePrograms
- verbosity
- (haddockProgramPaths haddockFlags)
- (haddockProgramArgs haddockFlags)
- -- we need to insert 'haddockProgram' before we reconfigure it,
- -- otherwise 'set
- . addKnownProgram haddockProgram
- . pkgConfigCompilerProgs
- . elaboratedShared
- $ buildCtx
+ -- TODO
+ -- progs <-
+ -- reconfigurePrograms
+ -- verbosity
+ -- (haddockProgramPaths haddockFlags)
+ -- (haddockProgramArgs haddockFlags)
+ -- -- we need to insert 'haddockProgram' before we reconfigure it,
+ -- -- otherwise 'set
+ -- . addKnownProgram haddockProgram
+ -- . pkgConfigCompilerProgs
+ -- . elaboratedShared
+ -- $ buildCtx
+
+ -- TODO
let buildCtx' =
buildCtx
- { elaboratedShared =
- (elaboratedShared buildCtx)
- { pkgConfigCompilerProgs = progs
- }
- }
+ -- { elaboratedShared =
+ -- (elaboratedShared buildCtx)
+ -- { pkgConfigCompilerProgs = progs
+ -- }
+ -- }
buildOutcomes <- runProjectBuildPhase verbosity baseCtx buildCtx'
runProjectPostBuildPhase verbosity baseCtx buildCtx' buildOutcomes
diff --git a/cabal-install/src/Distribution/Client/CmdHaddockProject.hs b/cabal-install/src/Distribution/Client/CmdHaddockProject.hs
index 0635a77d68e..680e538513b 100644
--- a/cabal-install/src/Distribution/Client/CmdHaddockProject.hs
+++ b/cabal-install/src/Distribution/Client/CmdHaddockProject.hs
@@ -37,7 +37,9 @@ import Distribution.Client.ProjectPlanning
, TargetAction (..)
)
import Distribution.Client.ProjectPlanning.Types
- ( elabDistDirParams
+ ( Toolchain (..)
+ , Toolchains (..)
+ , elabDistDirParams
)
import Distribution.Client.ScriptUtils
( AcceptNoTargets (..)
@@ -72,14 +74,6 @@ import Distribution.Simple.Haddock (createHaddockIndex)
import Distribution.Simple.InstallDirs
( toPathTemplate
)
-import Distribution.Simple.Program.Builtin
- ( haddockProgram
- )
-import Distribution.Simple.Program.Db
- ( addKnownProgram
- , reconfigurePrograms
- , requireProgramVersion
- )
import Distribution.Simple.Setup
( HaddockFlags (..)
, HaddockProjectFlags (..)
@@ -100,8 +94,6 @@ import Distribution.Types.PackageDescription (PackageDescription (benchmarks, su
import Distribution.Types.PackageId (pkgName)
import Distribution.Types.PackageName (unPackageName)
import Distribution.Types.UnitId (unUnitId)
-import Distribution.Types.Version (mkVersion)
-import Distribution.Types.VersionRange (orLaterVersion)
import Distribution.Verbosity as Verbosity
( normal
)
@@ -166,24 +158,26 @@ haddockProjectAction flags _extraArgs globalFlags = do
pkgs :: [Either InstalledPackageInfo ElaboratedConfiguredPackage]
pkgs = matchingPackages elaboratedPlan
- progs <-
- reconfigurePrograms
- verbosity
- (haddockProjectProgramPaths flags)
- (haddockProjectProgramArgs flags)
- -- we need to insert 'haddockProgram' before we reconfigure it,
- -- otherwise 'set
- . addKnownProgram haddockProgram
- . pkgConfigCompilerProgs
- $ sharedConfig
- let sharedConfig' = sharedConfig{pkgConfigCompilerProgs = progs}
-
- _ <-
- requireProgramVersion
- verbosity
- haddockProgram
- (orLaterVersion (mkVersion [2, 26, 1]))
- progs
+ -- TODO
+ -- progs <-
+ -- reconfigurePrograms
+ -- verbosity
+ -- (haddockProjectProgramPaths flags)
+ -- (haddockProjectProgramArgs flags)
+ -- -- we need to insert 'haddockProgram' before we reconfigure it,
+ -- -- otherwise 'set
+ -- . addKnownProgram haddockProgram
+ -- . pkgConfigCompilerProgs
+ -- $ sharedConfig
+ -- let sharedConfig' = sharedConfig{pkgConfigCompilerProgs = progs}
+ let sharedConfig' = sharedConfig
+
+ -- _ <-
+ -- requireProgramVersion
+ -- verbosity
+ -- haddockProgram
+ -- (orLaterVersion (mkVersion [2, 26, 1]))
+ -- progs
--
-- Build project; we need to build dependencies.
@@ -301,7 +295,7 @@ haddockProjectAction flags _extraArgs globalFlags = do
packageDir =
storePackageDirectory
(cabalStoreDirLayout cabalLayout)
- (pkgConfigCompiler sharedConfig')
+ (toolchainCompiler $ buildToolchain $ pkgConfigToolchains sharedConfig')
(elabUnitId package)
-- TODO: use `InstallDirTemplates`
docDir = packageDir </> "share" </> "doc" </> "html"
@@ -344,11 +338,12 @@ haddockProjectAction flags _extraArgs globalFlags = do
]
, haddockProjectUseUnicode = NoFlag
}
+ -- NOTE: this lives in Cabal
createHaddockIndex
verbosity
- (pkgConfigCompilerProgs sharedConfig')
- (pkgConfigCompiler sharedConfig')
- (pkgConfigPlatform sharedConfig')
+ (toolchainProgramDb $ buildToolchain $ pkgConfigToolchains sharedConfig')
+ (toolchainCompiler $ buildToolchain $ pkgConfigToolchains sharedConfig')
+ (toolchainPlatform $ buildToolchain $ pkgConfigToolchains sharedConfig')
Nothing
flags'
where
diff --git a/cabal-install/src/Distribution/Client/CmdListBin.hs b/cabal-install/src/Distribution/Client/CmdListBin.hs
index df16b98e1a2..44b78b0347c 100644
--- a/cabal-install/src/Distribution/Client/CmdListBin.hs
+++ b/cabal-install/src/Distribution/Client/CmdListBin.hs
@@ -205,7 +205,7 @@ listbinAction flags@NixStyleFlags{..} args globalFlags = do
_ -> []
plat :: Platform
- plat = pkgConfigPlatform elaboratedSharedConfig
+ plat = toolchainPlatform $ buildToolchain $ pkgConfigToolchains elaboratedSharedConfig
-- here and in PlanOutput,
-- use binDirectoryFor?
diff --git a/cabal-install/src/Distribution/Client/CmdPath.hs b/cabal-install/src/Distribution/Client/CmdPath.hs
index d7587219665..ae70fbaf9ee 100644
--- a/cabal-install/src/Distribution/Client/CmdPath.hs
+++ b/cabal-install/src/Distribution/Client/CmdPath.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
-- |
@@ -40,6 +41,7 @@ import Distribution.Client.ProjectConfig.Types
)
import Distribution.Client.ProjectOrchestration
import Distribution.Client.ProjectPlanning
+import Distribution.Client.ProjectPlanning.Types (Toolchain (..), Toolchains (..))
import Distribution.Client.RebuildMonad (runRebuild)
import Distribution.Client.ScriptUtils
import Distribution.Client.Setup
@@ -242,10 +244,11 @@ pathAction flags@NixStyleFlags{extraFlags = pathFlags', ..} cliTargetStrings glo
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
+ let projectRoot = distProjectRootDirectory (distDirLayout baseCtx)
+ Toolchains{buildToolchain} <- runRebuild projectRoot $ configureCompiler verbosity (distDirLayout baseCtx) (projectConfig baseCtx)
+ compilerProg <- requireCompilerProg verbosity (toolchainCompiler buildToolchain)
+ (configuredCompilerProg, _) <- requireProgram verbosity compilerProg (toolchainProgramDb buildToolchain)
+ pure $ Just $ mkCompilerInfo configuredCompilerProg (toolchainCompiler buildToolchain)
paths <- for (fromFlagOrDefault [] $ pathDirectories pathFlags) $ \p -> do
t <- getPathLocation baseCtx p
diff --git a/cabal-install/src/Distribution/Client/CmdRepl.hs b/cabal-install/src/Distribution/Client/CmdRepl.hs
index a75524bbca6..7570e11aa84 100644
--- a/cabal-install/src/Distribution/Client/CmdRepl.hs
+++ b/cabal-install/src/Distribution/Client/CmdRepl.hs
@@ -55,7 +55,9 @@ import Distribution.Client.ProjectPlanning
, ElaboratedSharedConfig (..)
)
import Distribution.Client.ProjectPlanning.Types
- ( elabOrderExeDependencies
+ ( Toolchain (..)
+ , Toolchains (..)
+ , elabOrderExeDependencies
, showElaboratedInstallPlan
)
import Distribution.Client.ScriptUtils
@@ -344,7 +346,7 @@ replAction flags@NixStyleFlags{extraFlags = r@ReplFlags{..}, ..} targetStrings g
-- especially in the no-project case.
withInstallPlan (lessVerbose verbosity) baseCtx' $ \elaboratedPlan sharedConfig -> do
-- targets should be non-empty map, but there's no NonEmptyMap yet.
- targets <- validatedTargets (projectConfigShared (projectConfig ctx)) (pkgConfigCompiler sharedConfig) elaboratedPlan targetSelectors
+ targets <- validatedTargets (projectConfigShared (projectConfig ctx)) (toolchainCompiler $ buildToolchain $ pkgConfigToolchains sharedConfig) elaboratedPlan targetSelectors
let
(unitId, _) = fromMaybe (error "panic: targets should be non-empty") $ safeHead $ Map.toList targets
@@ -368,7 +370,7 @@ replAction flags@NixStyleFlags{extraFlags = r@ReplFlags{..}, ..} targetStrings g
let ProjectBaseContext{..} = baseCtx''
-- Recalculate with updated project.
- targets <- validatedTargets (projectConfigShared projectConfig) (pkgConfigCompiler elaboratedShared') elaboratedPlan targetSelectors
+ targets <- validatedTargets (projectConfigShared projectConfig) (toolchainCompiler $ buildToolchain $ pkgConfigToolchains elaboratedShared') elaboratedPlan targetSelectors
let
elaboratedPlan' =
@@ -400,7 +402,7 @@ replAction flags@NixStyleFlags{extraFlags = r@ReplFlags{..}, ..} targetStrings g
, targetsMap = targets
}
- ElaboratedSharedConfig{pkgConfigCompiler = compiler} = elaboratedShared'
+ ElaboratedSharedConfig{pkgConfigToolchains = Toolchains{hostToolchain = Toolchain{toolchainCompiler = compiler}}} = elaboratedShared'
repl_flags = case originalComponent of
Just oci -> generateReplFlags includeTransitive elaboratedPlan' oci
@@ -441,7 +443,7 @@ replAction flags@NixStyleFlags{extraFlags = r@ReplFlags{..}, ..} targetStrings g
-- HACK: Just combine together all env overrides, placing the most common things last
-- ghc program with overridden PATH
- (ghcProg, _) <- requireProgram verbosity ghcProgram (pkgConfigCompilerProgs (elaboratedShared buildCtx'))
+ (ghcProg, _) <- requireProgram verbosity ghcProgram (toolchainProgramDb $ buildToolchain $ pkgConfigToolchains (elaboratedShared buildCtx'))
let ghcProg' = ghcProg{programOverrideEnv = [("PATH", Just sp)]}
-- Find what the unit files are, and start a repl based on all the response
diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding.hs b/cabal-install/src/Distribution/Client/ProjectBuilding.hs
index 7bf6de869a5..93e9c93b918 100644
--- a/cabal-install/src/Distribution/Client/ProjectBuilding.hs
+++ b/cabal-install/src/Distribution/Client/ProjectBuilding.hs
@@ -343,8 +343,7 @@ rebuildTargets
storeDirLayout
installPlan
sharedPackageConfig@ElaboratedSharedConfig
- { pkgConfigCompiler = compiler
- , pkgConfigCompilerProgs = progdb
+ { pkgConfigToolchains = Toolchains{hostToolchain = Toolchain{toolchainCompiler = compiler, toolchainProgramDb = progdb}}
}
pkgsBuildStatus
buildSettings@BuildTimeSettings
diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs b/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs
index fe5c10662e6..3908a1d12d1 100644
--- a/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs
+++ b/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs
@@ -178,8 +178,14 @@ buildAndRegisterUnpackedPackage
registerLock
cacheLock
pkgshared@ElaboratedSharedConfig
- { pkgConfigCompiler = compiler
- , pkgConfigCompilerProgs = progdb
+ { pkgConfigToolchains =
+ Toolchains
+ { buildToolchain =
+ Toolchain
+ { toolchainCompiler = compiler
+ , toolchainProgramDb = progdb
+ }
+ }
}
plan
rpkg@(ReadyPackage pkg)
@@ -451,7 +457,15 @@ buildInplaceUnpackedPackage
buildSettings@BuildTimeSettings{buildSettingHaddockOpen}
registerLock
cacheLock
- pkgshared@ElaboratedSharedConfig{pkgConfigPlatform = Platform _ os}
+ pkgshared@ElaboratedSharedConfig
+ { pkgConfigToolchains =
+ Toolchains
+ { buildToolchain =
+ Toolchain
+ { toolchainPlatform = Platform _ os
+ }
+ }
+ }
plan
rpkg@(ReadyPackage pkg)
buildStatus
@@ -657,8 +671,14 @@ buildAndInstallUnpackedPackage
registerLock
cacheLock
pkgshared@ElaboratedSharedConfig
- { pkgConfigCompiler = compiler
- , pkgConfigPlatform = platform
+ { pkgConfigToolchains =
+ Toolchains
+ { buildToolchain =
+ Toolchain
+ { toolchainCompiler = compiler
+ , toolchainPlatform = platform
+ }
+ }
}
plan
rpkg@(ReadyPackage pkg)
diff --git a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs
index 9907193458d..5480e90537e 100644
--- a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs
+++ b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs
@@ -525,7 +525,7 @@ runProjectPostBuildPhase
AlwaysWriteGhcEnvironmentFiles -> True
NeverWriteGhcEnvironmentFiles -> False
WriteGhcEnvironmentFilesOnlyForGhc844AndNewer ->
- let compiler = pkgConfigCompiler elaboratedShared
+ let compiler = toolchainCompiler $ buildToolchain $ pkgConfigToolchains elaboratedShared
ghcCompatVersion = compilerCompatVersion GHC compiler
in maybe False (>= mkVersion [8, 4, 4]) ghcCompatVersion
@@ -1089,7 +1089,7 @@ printPlan
in -- Not necessary to "escape" it, it's just for user output
unwords . ("" :) $
commandShowOptions
- (Setup.configureCommand (pkgConfigCompilerProgs elaboratedShared))
+ (Setup.configureCommand (toolchainProgramDb $ buildToolchain $ pkgConfigToolchains elaboratedShared))
partialConfigureFlags
showBuildStatus :: BuildStatus -> String
@@ -1121,7 +1121,7 @@ printPlan
showBuildProfile =
"Build profile: "
++ unwords
- [ "-w " ++ (showCompilerId . pkgConfigCompiler) elaboratedShared
+ [ "-w " ++ (showCompilerId . toolchainCompiler . buildToolchain . pkgConfigToolchains) elaboratedShared
, "-O"
++ ( case globalOptimization <> localOptimization of -- if local is not set, read global
Setup.Flag NoOptimisation -> "0"
@@ -1134,8 +1134,8 @@ printPlan
writeBuildReports :: BuildTimeSettings -> ProjectBuildContext -> ElaboratedInstallPlan -> BuildOutcomes -> IO ()
writeBuildReports settings buildContext plan buildOutcomes = do
- let plat@(Platform arch os) = pkgConfigPlatform . elaboratedShared $ buildContext
- comp = pkgConfigCompiler . elaboratedShared $ buildContext
+ let plat@(Platform arch os) = toolchainPlatform . buildToolchain . pkgConfigToolchains . elaboratedShared $ buildContext
+ comp = toolchainCompiler . buildToolchain . pkgConfigToolchains . elaboratedShared $ buildContext
getRepo (RepoTarballPackage r _ _) = Just r
getRepo _ = Nothing
fromPlanPackage (InstallPlan.Configured pkg) (Just result) =
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanOutput.hs b/cabal-install/src/Distribution/Client/ProjectPlanOutput.hs
index b6b5dc8dd79..a38a792481e 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanOutput.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanOutput.hs
@@ -46,9 +46,7 @@ import Distribution.Simple.BuildPaths
)
import Distribution.Simple.Compiler
import Distribution.Simple.GHC
- ( GhcEnvironmentFileEntry (..)
- , GhcImplInfo (supportsPkgEnvFiles)
- , getImplInfo
+ ( GhcEnvironmentFileEntry (GhcEnvFileComment)
, simpleGhcEnvironmentFile
, writeGhcEnvironmentFile
)
@@ -57,9 +55,9 @@ import Distribution.System
import Distribution.Types.Version
( mkVersion
)
-import Distribution.Utils.Path hiding
- ( (<.>)
- , (</>)
+import Distribution.Utils.Path
+ ( getSymbolicPath
+ , makeSymbolicPath
)
import Distribution.Verbosity
@@ -107,7 +105,7 @@ encodePlanAsJson distDirLayout elaboratedInstallPlan elaboratedSharedConfig =
[ "cabal-version" J..= jdisplay cabalInstallVersion
, "cabal-lib-version" J..= jdisplay cabalVersion
, "compiler-id"
- J..= (J.String . showCompilerId . pkgConfigCompiler)
+ J..= (J.String . showCompilerId . toolchainCompiler . hostToolchain . pkgConfigToolchains)
elaboratedSharedConfig
, "os" J..= jdisplay os
, "arch" J..= jdisplay arch
@@ -115,7 +113,7 @@ encodePlanAsJson distDirLayout elaboratedInstallPlan elaboratedSharedConfig =
]
where
plat :: Platform
- plat@(Platform arch os) = pkgConfigPlatform elaboratedSharedConfig
+ plat@(Platform arch os) = toolchainPlatform . hostToolchain . pkgConfigToolchains $ elaboratedSharedConfig
installPlanToJ :: ElaboratedInstallPlan -> [J.Value]
installPlanToJ = map planPackageToJ . InstallPlan.toList
@@ -799,7 +797,7 @@ createPackageEnvironment
elaboratedPlan
elaboratedShared
buildStatus
- | compilerFlavor (pkgConfigCompiler elaboratedShared) == GHC =
+ | compilerFlavor (toolchainCompiler $ hostToolchain $ pkgConfigToolchains elaboratedShared) == GHC =
do
envFileM <-
writePlanGhcEnvironment
@@ -829,29 +827,30 @@ writePlanGhcEnvironment
writePlanGhcEnvironment
path
elaboratedInstallPlan
- ElaboratedSharedConfig
- { pkgConfigCompiler = compiler
- , pkgConfigPlatform = platform
- }
- postBuildStatus
- | compilerFlavor compiler == GHC
- , supportsPkgEnvFiles (getImplInfo compiler) =
- -- TODO: check ghcjs compat
- fmap Just $
- writeGhcEnvironmentFile
+ elaboratedSharedConfig
+ postBuildStatus =
+ -- \| compilerFlavor compiler == GHC
+ -- , supportsPkgEnvFiles (getImplInfo compiler) =
+
+ -- TODO: check ghcjs compat
+ fmap Just $
+ writeGhcEnvironmentFile
+ path
+ -- FIXME
+ (toolchainPlatform (hostToolchain (pkgConfigToolchains elaboratedSharedConfig)))
+ -- FIXME
+ (compilerVersion (toolchainCompiler (hostToolchain (pkgConfigToolchains elaboratedSharedConfig))))
+ ( renderGhcEnvironmentFile
path
- platform
- (compilerVersion compiler)
- ( renderGhcEnvironmentFile
- path
- elaboratedInstallPlan
- postBuildStatus
- )
+ elaboratedInstallPlan
+ postBuildStatus
+ )
+
-- TODO: [required eventually] support for writing user-wide package
-- environments, e.g. like a global project, but we would not put the
-- env file in the home dir, rather it lives under ~/.ghc/
-writePlanGhcEnvironment _ _ _ _ = return Nothing
+-- writePlanGhcEnvironment _ _ _ _ = return Nothing
renderGhcEnvironmentFile
:: FilePath
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index 84f5111e139..ab82ec14c62 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -95,6 +95,9 @@ module Distribution.Client.ProjectPlanning
, binDirectories
, storePackageInstallDirs
, storePackageInstallDirs'
+
+ -- * Re-exports for backward compatibility
+ , programDbSignature
) where
import Distribution.Client.Compat.Prelude
@@ -398,8 +401,8 @@ rebuildProjectConfig
let fetchCompiler = do
-- have to create the cache directory before configuring the compiler
liftIO $ createDirectoryIfMissingVerbose verbosity True distProjectCacheDirectory
- (compiler, Platform arch os, _) <- configureCompiler verbosity distDirLayout (fst (PD.ignoreConditions projectConfigSkeleton) <> cliConfig)
- pure (os, arch, compiler)
+ Toolchains{hostToolchain = Toolchain{toolchainCompiler = compiler, toolchainPlatform = Platform arch os}} <- configureCompiler verbosity distDirLayout (fst (PD.ignoreConditions projectConfigSkeleton) <> cliConfig)
+ return (os, arch, compiler)
(projectConfig, _compiler) <- instantiateProjectConfigSkeletonFetchingCompiler fetchCompiler mempty projectConfigSkeleton
when (projectConfigDistDir (projectConfigShared $ projectConfig) /= NoFlag) $
@@ -462,7 +465,7 @@ configureCompiler
:: Verbosity
-> DistDirLayout
-> ProjectConfig
- -> Rebuild (Compiler, Platform, ProgramDb)
+ -> Rebuild Toolchains
configureCompiler
verbosity
DistDirLayout
@@ -474,6 +477,9 @@ configureCompiler
{ projectConfigHcFlavor
, projectConfigHcPath
, projectConfigHcPkg
+ , projectConfigHostHcFlavor
+ , projectConfigHostHcPath
+ , projectConfigHostHcPkg
}
, projectConfigLocalPackages =
projectConfigLocalPackages@PackageConfig
@@ -497,35 +503,55 @@ configureCompiler
)
$ do
liftIO $ info verbosity "Compiler settings changed, reconfiguring..."
- progdb <- liftIO $ resolveProgramDb verbosity projectConfigLocalPackages
- result@(_, _, progdb'') <-
- liftIO $
- Cabal.configCompilerEx
- hcFlavor
- hcPath
- hcPkg
- progdb
- verbosity
- -- Note that we added the user-supplied program locations and args
- -- for /all/ programs, not just those for the compiler prog and
- -- compiler-related utils. In principle we don't know which programs
- -- the compiler will configure (and it does vary between compilers).
- -- We do know however that the compiler will only configure the
- -- programs it cares about, and those are the ones we monitor here.
- monitorFiles (programsMonitorFiles progdb'')
-
- -- Note: There is currently a bug here: we are dropping unconfigured
- -- programs from the 'ProgramDb' when we re-use the cache created by
- -- 'rerunIfChanged'.
- --
- -- See Note [Caching the result of configuring the compiler]
+ defdb <- liftIO $ resolveProgramDb verbosity projectConfigLocalPackages
+
+ buildToolchain <- do
+ (compiler, platform, progdb) <-
+ liftIO $
+ Cabal.configCompilerEx
+ hcFlavor
+ hcPath
+ hcPkg
+ defdb
+ verbosity
+
+ -- Note that we added the user-supplied program locations and args
+ -- for /all/ programs, not just those for the compiler prog and
+ -- compiler-related utils. In principle we don't know which programs
+ -- the compiler will configure (and it does vary between compilers).
+ -- We do know however that the compiler will only configure the
+ -- programs it cares about, and those are the ones we monitor here.
+ monitorFiles (programsMonitorFiles progdb)
+ return Toolchain{toolchainCompiler = compiler, toolchainPlatform = platform, toolchainProgramDb = progdb}
+
+ hostToolchain <- do
+ (compiler, platform, progdb) <-
+ liftIO $
+ Cabal.configCompilerEx
+ hostHcFlavor
+ hostHcPath
+ hostHcPkg
+ defdb
+ verbosity
- return result
+ -- Note that we added the user-supplied program locations and args
+ -- for /all/ programs, not just those for the compiler prog and
+ -- compiler-related utils. In principle we don't know which programs
+ -- the compiler will configure (and it does vary between compilers).
+ -- We do know however that the compiler will only configure the
+ -- programs it cares about, and those are the ones we monitor here.
+ monitorFiles (programsMonitorFiles progdb)
+ return Toolchain{toolchainCompiler = compiler, toolchainPlatform = platform, toolchainProgramDb = progdb}
+
+ return Toolchains{buildToolchain, hostToolchain}
where
hcFlavor = flagToMaybe projectConfigHcFlavor
hcPath = flagToMaybe projectConfigHcPath
hcPkg = flagToMaybe projectConfigHcPkg
+ hostHcFlavor = flagToMaybe projectConfigHostHcFlavor <|> flagToMaybe projectConfigHcFlavor
+ hostHcPath = flagToMaybe projectConfigHostHcPath <|> flagToMaybe projectConfigHcPath
+ hostHcPkg = flagToMaybe projectConfigHostHcPkg <|> flagToMaybe projectConfigHcPkg
{- Note [Caching the result of configuring the compiler]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -632,12 +658,16 @@ rebuildInstallPlan
, hookHashes
)
$ do
- compilerEtc <- phaseConfigureCompiler projectConfig
- _ <- phaseConfigurePrograms projectConfig compilerEtc
+ toolchains <- phaseConfigureToolchain projectConfig
+
+ liftIO $ print ("build compiler", compilerId $ toolchainCompiler $ buildToolchain toolchains)
+ liftIO $ print ("host compiler", compilerId $ toolchainCompiler $ buildToolchain toolchains)
+
+ -- _ <- phaseConfigurePrograms projectConfig compilerEtc
(solverPlan, pkgConfigDB, totalIndexState, activeRepos) <-
phaseRunSolver
projectConfig
- compilerEtc
+ toolchains
localPackages
(fromMaybe mempty mbInstalledPackages)
( elaboratedPlan
@@ -645,7 +675,7 @@ rebuildInstallPlan
) <-
phaseElaboratePlan
projectConfig
- compilerEtc
+ toolchains
pkgConfigDB
solverPlan
localPackages
@@ -673,10 +703,11 @@ rebuildInstallPlan
-- This is moderately expensive and doesn't change that often so we cache
-- it independently.
--
- phaseConfigureCompiler
+ phaseConfigureToolchain
:: ProjectConfig
- -> Rebuild (Compiler, Platform, ProgramDb)
- phaseConfigureCompiler = configureCompiler verbosity distDirLayout
+ -> Rebuild Toolchains
+ phaseConfigureToolchain = do
+ configureCompiler verbosity distDirLayout
-- Configuring other programs.
--
@@ -690,19 +721,19 @@ rebuildInstallPlan
-- all local packages, but that all the programs configured so far are the
-- compiler program or related util programs.
--
- phaseConfigurePrograms
- :: ProjectConfig
- -> (Compiler, Platform, ProgramDb)
- -> Rebuild ()
- phaseConfigurePrograms projectConfig (_, _, compilerprogdb) = do
- -- Users are allowed to specify program locations independently for
- -- each package (e.g. to use a particular version of a pre-processor
- -- for some packages). However they cannot do this for the compiler
- -- itself as that's just not going to work. So we check for this.
- liftIO $
- checkBadPerPackageCompilerPaths
- (configuredPrograms compilerprogdb)
- (getMapMappend (projectConfigSpecificPackage projectConfig))
+ -- phaseConfigurePrograms
+ -- :: ProjectConfig
+ -- -> (Compiler, Platform, ProgramDb)
+ -- -> Rebuild ()
+ -- phaseConfigurePrograms projectConfig (_, _, compilerprogdb) = do
+ -- -- Users are allowed to specify program locations independently for
+ -- -- each package (e.g. to use a particular version of a pre-processor
+ -- -- for some packages). However they cannot do this for the compiler
+ -- -- itself as that's just not going to work. So we check for this.
+ -- liftIO $
+ -- checkBadPerPackageCompilerPaths
+ -- (configuredPrograms compilerprogdb)
+ -- (getMapMappend (projectConfigSpecificPackage projectConfig))
-- TODO: [required eventually] find/configure other programs that the
-- user specifies.
@@ -715,7 +746,7 @@ rebuildInstallPlan
--
phaseRunSolver
:: ProjectConfig
- -> (Compiler, Platform, ProgramDb)
+ -> Toolchains
-> [PackageSpecifier UnresolvedSourcePackage]
-> InstalledPackageIndex
-> Rebuild (SolverInstallPlan, Maybe PkgConfigDb, IndexUtils.TotalIndexState, IndexUtils.ActiveRepos)
@@ -724,7 +755,7 @@ rebuildInstallPlan
{ projectConfigShared
, projectConfigBuildOnly
}
- (compiler, platform, progdb)
+ toolchains
localPackages
installedPackages =
rerunIfChanged
@@ -733,26 +764,24 @@ rebuildInstallPlan
( solverSettings
, localPackages
, localPackagesEnabledStanzas
- , compiler
- , platform
- , programDbSignature progdb
+ , toolchains
, hookHashes
)
$ do
installedPkgIndex <-
getInstalledPackages
verbosity
- compiler
- progdb
- platform
+ (buildToolchain toolchains)
corePackageDbs
+
(sourcePkgDb, tis, ar) <-
getSourcePackages
verbosity
withRepoCtx
(solverSettingIndexState solverSettings)
(solverSettingActiveRepos solverSettings)
- pkgConfigDB <- getPkgConfigDb verbosity progdb
+
+ pkgConfigDB <- getPkgConfigDb verbosity (toolchainProgramDb $ buildToolchain toolchains)
-- TODO: [code cleanup] it'd be better if the Compiler contained the
-- ConfiguredPrograms that it needs, rather than relying on the progdb
@@ -765,8 +794,7 @@ rebuildInstallPlan
foldProgress logMsg (pure . Left) (pure . Right) $
planPackages
verbosity
- compiler
- platform
+ (hostToolchain toolchains)
solverSettings
(installedPackages <> installedPkgIndex)
sourcePkgDb
@@ -775,7 +803,7 @@ rebuildInstallPlan
localPackagesEnabledStanzas
case planOrError of
Left msg -> do
- reportPlanningFailure projectConfig compiler platform localPackages
+ reportPlanningFailure projectConfig (hostToolchain toolchains) localPackages
dieWithException verbosity $ PhaseRunSolverErr msg
Right plan -> return (plan, pkgConfigDB, tis, ar)
where
@@ -830,7 +858,7 @@ rebuildInstallPlan
--
phaseElaboratePlan
:: ProjectConfig
- -> (Compiler, Platform, ProgramDb)
+ -> Toolchains
-> Maybe PkgConfigDb
-> SolverInstallPlan
-> [PackageSpecifier (SourcePackage (PackageLocation loc))]
@@ -846,7 +874,7 @@ rebuildInstallPlan
, projectConfigSpecificPackage
, projectConfigBuildOnly
}
- (compiler, platform, progdb)
+ toolchains
pkgConfigDB
solverPlan
localPackages = do
@@ -859,16 +887,14 @@ rebuildInstallPlan
(packageLocationsSignature solverPlan)
$ getPackageSourceHashes verbosity withRepoCtx solverPlan
- defaultInstallDirs <- liftIO $ userInstallDirTemplates compiler
+ defaultInstallDirs <- liftIO $ userInstallDirTemplates (toolchainCompiler (hostToolchain toolchains))
let installDirs = fmap Cabal.fromFlag $ (fmap Flag defaultInstallDirs) <> (projectConfigInstallDirs projectConfigShared)
(elaboratedPlan, elaboratedShared) <-
liftIO . runLogProgress verbosity $
elaborateInstallPlan
verbosity
hookHashes
- platform
- compiler
- progdb
+ toolchains
pkgConfigDB
distDirLayout
cabalStoreDirLayout
@@ -939,12 +965,12 @@ rebuildInstallPlan
-- matches up as expected, e.g. no dangling deps, files deleted.
return improvedPlan
where
- compiler = pkgConfigCompiler elaboratedShared
+ compiler = toolchainCompiler (hostToolchain (pkgConfigToolchains elaboratedShared))
-- | If a 'PackageSpecifier' refers to a single package, return Just that
-- package.
-reportPlanningFailure :: ProjectConfig -> Compiler -> Platform -> [PackageSpecifier UnresolvedSourcePackage] -> IO ()
-reportPlanningFailure projectConfig comp platform pkgSpecifiers =
+reportPlanningFailure :: ProjectConfig -> Toolchain -> [PackageSpecifier UnresolvedSourcePackage] -> IO ()
+reportPlanningFailure projectConfig Toolchain{toolchainCompiler = comp, toolchainPlatform = platform} pkgSpecifiers =
when reportFailure $
BuildReports.storeLocal
(compilerInfo comp)
@@ -992,44 +1018,28 @@ programsMonitorFiles progdb =
(programPath prog)
]
--- | Select the bits of a 'ProgramDb' to monitor for value changes.
--- Use 'programsMonitorFiles' for the files to monitor.
-programDbSignature :: ProgramDb -> [ConfiguredProgram]
-programDbSignature progdb =
- [ prog
- { programMonitorFiles = []
- , programOverrideEnv =
- filter
- ((/= "PATH") . fst)
- (programOverrideEnv prog)
- }
- | prog <- configuredPrograms progdb
- ]
-
getInstalledPackages
:: Verbosity
- -> Compiler
- -> ProgramDb
- -> Platform
+ -> Toolchain
-> PackageDBStackCWD
-> Rebuild InstalledPackageIndex
-getInstalledPackages verbosity compiler progdb platform packagedbs = do
+getInstalledPackages verbosity Toolchain{toolchainCompiler, toolchainPlatform, toolchainProgramDb} packagedbs = do
monitorFiles . map monitorFileOrDirectory
=<< liftIO
( IndexUtils.getInstalledPackagesMonitorFiles
verbosity
- compiler
+ toolchainCompiler
Nothing -- use ambient working directory
(coercePackageDBStack packagedbs)
- progdb
- platform
+ toolchainProgramDb
+ toolchainPlatform
)
liftIO $
IndexUtils.getInstalledPackages
verbosity
- compiler
+ toolchainCompiler
packagedbs
- progdb
+ toolchainProgramDb
{-
--TODO: [nice to have] use this but for sanity / consistency checking
@@ -1261,8 +1271,7 @@ getPackageSourceHashes verbosity withRepoCtx solverPlan = do
planPackages
:: Verbosity
- -> Compiler
- -> Platform
+ -> Toolchain
-> SolverSettings
-> InstalledPackageIndex
-> SourcePackageDb
@@ -1272,8 +1281,7 @@ planPackages
-> Progress String String SolverInstallPlan
planPackages
verbosity
- comp
- platform
+ Toolchain{toolchainCompiler = compiler, toolchainPlatform = platform}
SolverSettings{..}
installedPkgIndex
sourcePkgDb
@@ -1282,7 +1290,7 @@ planPackages
pkgStanzasEnable =
resolveDependencies
platform
- (compilerInfo comp)
+ (compilerInfo compiler)
pkgConfigDB
resolverParams
where
@@ -1325,7 +1333,7 @@ planPackages
. removeLowerBounds solverSettingAllowOlder
. removeUpperBounds solverSettingAllowNewer
. addDefaultSetupDependencies
- ( mkDefaultSetupDeps comp platform
+ ( mkDefaultSetupDeps compiler platform
. PD.packageDescription
. srcpkgDescription
)
@@ -1459,8 +1467,8 @@ planPackages
| otherwise = mkVersion [1, 20]
where
isGHC = compFlav `elem` [GHC, GHCJS]
- compFlav = compilerFlavor comp
- compVer = compilerVersion comp
+ compFlav = compilerFlavor compiler
+ compVer = compilerVersion compiler
-- As we can't predict the future, we also place a global upper
-- bound on the lib:Cabal version we know how to interact with:
@@ -1587,9 +1595,7 @@ planPackages
elaborateInstallPlan
:: Verbosity
-> Map FilePath HookAccept
- -> Platform
- -> Compiler
- -> ProgramDb
+ -> Toolchains
-> Maybe PkgConfigDb
-> DistDirLayout
-> StoreDirLayout
@@ -1605,9 +1611,18 @@ elaborateInstallPlan
elaborateInstallPlan
verbosity
hookHashes
- platform
- compiler
- compilerprogdb
+ toolchains@Toolchains
+ { buildToolchain =
+ Toolchain
+ { toolchainCompiler = compiler
+ , toolchainProgramDb = compilerprogdb
+ }
+ , hostToolchain =
+ Toolchain
+ { toolchainCompiler = hostCompiler
+ , toolchainPlatform = hostPlatform
+ }
+ }
pkgConfigDB
distDirLayout@DistDirLayout{..}
storeDirLayout@StoreDirLayout{storePackageDBStack}
@@ -1624,9 +1639,7 @@ elaborateInstallPlan
where
elaboratedSharedConfig =
ElaboratedSharedConfig
- { pkgConfigPlatform = platform
- , pkgConfigCompiler = compiler
- , pkgConfigCompilerProgs = compilerprogdb
+ { pkgConfigToolchains = toolchains
, pkgConfigReplOptions = mempty
, pkgConfigHookHashes = hookHashes
}
@@ -2190,8 +2203,8 @@ elaborateInstallPlan
flags
elabEnabledSpec
(const Satisfied)
- platform
- (compilerInfo compiler)
+ hostPlatform
+ (compilerInfo hostCompiler)
[]
gdesc of
Right (desc, _) -> desc
@@ -3851,8 +3864,9 @@ setupHsScriptOptions
-- - if we commit to a Cabal version, the logic in
Nothing
else Just elabSetupScriptCliVersion
- , useCompiler = Just pkgConfigCompiler
- , usePlatform = Just pkgConfigPlatform
+ , useCompiler = Just (toolchainCompiler $ buildToolchain $ pkgConfigToolchains)
+ , usePlatform = Just (toolchainPlatform $ buildToolchain $ pkgConfigToolchains)
+ , useProgramDb = toolchainProgramDb $ buildToolchain $ pkgConfigToolchains
, usePackageDB = elabSetupPackageDBStack
, usePackageIndex = Nothing
, useDependencies =
@@ -3862,7 +3876,6 @@ setupHsScriptOptions
]
, useDependenciesExclusive = True
, useVersionMacros = elabSetupScriptStyle == SetupCustomExplicitDeps
- , useProgramDb = pkgConfigCompilerProgs
, useDistPref = builddir
, useLoggingHandle = Nothing -- this gets set later
, useWorkingDir = Just srcdir
@@ -3947,9 +3960,9 @@ computeInstallDirs storeDirLayout defaultInstallDirs elaboratedShared elab
( InstallDirs.absoluteInstallDirs
(elabPkgSourceId elab)
(elabUnitId elab)
- (compilerInfo (pkgConfigCompiler elaboratedShared))
+ (compilerInfo (toolchainCompiler $ buildToolchain $ pkgConfigToolchains elaboratedShared))
InstallDirs.NoCopyDest
- (pkgConfigPlatform elaboratedShared)
+ (toolchainPlatform $ buildToolchain $ pkgConfigToolchains elaboratedShared)
defaultInstallDirs
)
{ -- absoluteInstallDirs sets these as 'undefined' but we have
@@ -3962,7 +3975,7 @@ computeInstallDirs storeDirLayout defaultInstallDirs elaboratedShared elab
-- use special simplified install dirs
storePackageInstallDirs'
storeDirLayout
- (pkgConfigCompiler elaboratedShared)
+ (toolchainCompiler $ buildToolchain $ pkgConfigToolchains elaboratedShared)
(elabUnitId elab)
-- TODO: [code cleanup] perhaps reorder this code
@@ -3983,7 +3996,7 @@ setupHsConfigureFlags
mkSymbolicPath
plan
(ReadyPackage elab@ElaboratedConfiguredPackage{..})
- sharedConfig@ElaboratedSharedConfig{..}
+ sharedConfig@ElaboratedSharedConfig{pkgConfigToolchains = Toolchains{buildToolchain}}
configCommonFlags = do
-- explicitly clear, then our package db stack
-- TODO: [required eventually] have to do this differently for older Cabal versions
@@ -4053,7 +4066,7 @@ setupHsConfigureFlags
["-hide-all-packages"]
elabProgramArgs
configProgramPathExtra = toNubList elabProgramPathExtra
- configHcFlavor = toFlag (compilerFlavor pkgConfigCompiler)
+ configHcFlavor = toFlag (compilerFlavor $ toolchainCompiler buildToolchain)
configHcPath = mempty -- we use configProgramPaths instead
configHcPkg = mempty -- we use configProgramPaths instead
configDumpBuildInfo = toFlag elabDumpBuildInfo
@@ -4111,7 +4124,7 @@ setupHsConfigureFlags
configUserInstall = mempty -- don't rely on defaults
configPrograms_ = mempty -- never use, shouldn't exist
configUseResponseFiles = mempty
- configAllowDependingOnPrivateLibs = Flag $ not $ libraryVisibilitySupported pkgConfigCompiler
+ configAllowDependingOnPrivateLibs = Flag $ not $ libraryVisibilitySupported (toolchainCompiler buildToolchain)
configIgnoreBuildTools = mempty
cidToGivenComponent :: ConfiguredId -> GivenComponent
@@ -4286,13 +4299,13 @@ setupHsHaddockFlags
-> Cabal.HaddockFlags
setupHsHaddockFlags
(ElaboratedConfiguredPackage{..})
- (ElaboratedSharedConfig{..})
+ (ElaboratedSharedConfig{pkgConfigToolchains = Toolchains{buildToolchain}})
_buildTimeSettings
common =
Cabal.HaddockFlags
{ haddockCommonFlags = common
, haddockProgramPaths =
- case lookupProgram haddockProgram pkgConfigCompilerProgs of
+ case lookupProgram haddockProgram (toolchainProgramDb buildToolchain) of
Nothing -> mempty
Just prg ->
[
@@ -4430,11 +4443,11 @@ packageHashConfigInputs
:: ElaboratedSharedConfig
-> ElaboratedConfiguredPackage
-> PackageHashConfigInputs
-packageHashConfigInputs shared@ElaboratedSharedConfig{..} pkg =
+packageHashConfigInputs shared@ElaboratedSharedConfig{pkgConfigToolchains = Toolchains{buildToolchain}} pkg =
PackageHashConfigInputs
- { pkgHashCompilerId = compilerId pkgConfigCompiler
- , pkgHashCompilerABI = compilerAbiTag pkgConfigCompiler
- , pkgHashPlatform = pkgConfigPlatform
+ { pkgHashCompilerId = compilerId (toolchainCompiler buildToolchain)
+ , pkgHashCompilerABI = compilerAbiTag (toolchainCompiler buildToolchain)
+ , pkgHashPlatform = toolchainPlatform buildToolchain
, pkgHashFlagAssignment = elabFlagAssignment
, pkgHashConfigureScriptArgs = elabConfigureScriptArgs
, pkgHashVanillaLib = withVanillaLib
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs b/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs
index 484c4cad297..8e52d778330 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs
@@ -58,6 +58,10 @@ module Distribution.Client.ProjectPlanning.Types
, isBenchComponentTarget
, componentOptionalStanza
+ -- * Toolchain
+ , Toolchain (..)
+ , Toolchains (..)
+
-- * Setup script
, SetupScriptStyle (..)
) where
@@ -100,6 +104,7 @@ import Distribution.Simple.LocalBuildInfo
, LibraryName (..)
)
import Distribution.Simple.Program
+import Distribution.Simple.Program.Db (configuredPrograms)
import Distribution.Simple.Setup
( DumpBuildInfo (..)
, HaddockTarget
@@ -184,9 +189,7 @@ showElaboratedInstallPlan = InstallPlan.showInstallPlan_gen showNode
-- even platform and compiler could be different if we're building things
-- like a server + client with ghc + ghcjs
data ElaboratedSharedConfig = ElaboratedSharedConfig
- { pkgConfigPlatform :: Platform
- , pkgConfigCompiler :: Compiler -- TODO: [code cleanup] replace with CompilerInfo
- , pkgConfigCompilerProgs :: ProgramDb
+ { pkgConfigToolchains :: Toolchains
-- ^ The programs that the compiler configured (e.g. for GHC, the progs
-- ghc & ghc-pkg). Once constructed, only the 'configuredPrograms' are
-- used.
@@ -344,10 +347,10 @@ normaliseConfiguredPackage
:: ElaboratedSharedConfig
-> ElaboratedConfiguredPackage
-> ElaboratedConfiguredPackage
-normaliseConfiguredPackage ElaboratedSharedConfig{pkgConfigCompilerProgs} pkg =
+normaliseConfiguredPackage ElaboratedSharedConfig{pkgConfigToolchains = Toolchains{buildToolchain}} pkg =
pkg{elabProgramArgs = Map.mapMaybeWithKey lookupFilter (elabProgramArgs pkg)}
where
- knownProgramDb = addKnownPrograms builtinPrograms pkgConfigCompilerProgs
+ knownProgramDb = addKnownPrograms builtinPrograms (toolchainProgramDb buildToolchain)
pkgDesc :: PackageDescription
pkgDesc = elabPkgDescription pkg
@@ -540,8 +543,8 @@ elabDistDirParams shared elab =
, distParamComponentName = case elabPkgOrComp elab of
ElabComponent comp -> compComponentName comp
ElabPackage _ -> Nothing
- , distParamCompilerId = compilerId (pkgConfigCompiler shared)
- , distParamPlatform = pkgConfigPlatform shared
+ , distParamCompilerId = compilerId $ toolchainCompiler $ hostToolchain $ pkgConfigToolchains shared
+ , distParamPlatform = toolchainPlatform $ hostToolchain $ pkgConfigToolchains shared
, distParamOptimization = LBC.withOptimization $ elabBuildOptions elab
}
@@ -909,6 +912,36 @@ componentOptionalStanza (CD.ComponentTest _) = Just TestStanzas
componentOptionalStanza (CD.ComponentBench _) = Just BenchStanzas
componentOptionalStanza _ = Nothing
+---------------------------
+-- Toolchain
+--
+
+data Toolchain = Toolchain
+ { toolchainPlatform :: Platform
+ , toolchainCompiler :: Compiler
+ , toolchainProgramDb :: ProgramDb
+ }
+ deriving (Show, Generic, Typeable)
+
+-- TODO: review this
+instance Eq Toolchain where
+ lhs == rhs =
+ (((==) `on` toolchainPlatform) lhs rhs)
+ && (((==) `on` toolchainCompiler) lhs rhs)
+ && ((((==)) `on` (configuredPrograms . toolchainProgramDb)) lhs rhs)
+
+instance Binary Toolchain
+instance Structured Toolchain
+
+data Toolchains = Toolchains
+ { buildToolchain :: Toolchain
+ , hostToolchain :: Toolchain
+ }
+ deriving (Eq, Show, Generic, Typeable)
+
+instance Binary Toolchains
+instance Structured Toolchains
+
---------------------------
-- Setup.hs script policy
--
diff --git a/cabal-install/src/Distribution/Client/ScriptUtils.hs b/cabal-install/src/Distribution/Client/ScriptUtils.hs
index 440de3c84ad..72950f36e0d 100644
--- a/cabal-install/src/Distribution/Client/ScriptUtils.hs
+++ b/cabal-install/src/Distribution/Client/ScriptUtils.hs
@@ -195,6 +195,7 @@ import qualified Data.ByteString.Char8 as BS
import Data.ByteString.Lazy ()
import qualified Data.Set as S
import Distribution.Client.Errors
+import Distribution.Client.ProjectPlanning.Types (Toolchain (..), Toolchains (..))
import Distribution.Utils.Path
( unsafeMakeSymbolicPath
)
@@ -361,9 +362,9 @@ withContextAndSelectors noTargets kind flags@NixStyleFlags{..} targetStrings glo
exists <- doesFileExist script
if exists
then do
- ctx <- withGlobalConfig verbosity globalConfigFlag (scriptBaseCtx script)
+ baseCtx <- withGlobalConfig verbosity globalConfigFlag (scriptBaseCtx script)
- let projectRoot = distProjectRootDirectory $ distDirLayout ctx
+ let projectRoot = distProjectRootDirectory $ distDirLayout baseCtx
writeFile (projectRoot </> "scriptlocation") =<< canonicalizePath script
scriptContents <- BS.readFile script
@@ -375,14 +376,14 @@ withContextAndSelectors noTargets kind flags@NixStyleFlags{..} targetStrings glo
(fromNubList . projectConfigProgPathExtra $ projectConfigShared cliConfig)
(flagToMaybe . projectConfigHttpTransport $ projectConfigBuildOnly cliConfig)
- projectCfgSkeleton <- readProjectBlockFromScript verbosity httpTransport (distDirLayout ctx) (takeFileName script) scriptContents
+ projectCfgSkeleton <- readProjectBlockFromScript verbosity httpTransport (distDirLayout baseCtx) (takeFileName script) scriptContents
- createDirectoryIfMissingVerbose verbosity True (distProjectCacheDirectory $ distDirLayout ctx)
- (compiler, platform@(Platform arch os), _) <- runRebuild projectRoot $ configureCompiler verbosity (distDirLayout ctx) (fst (ignoreConditions projectCfgSkeleton) <> projectConfig ctx)
+ createDirectoryIfMissingVerbose verbosity True (distProjectCacheDirectory $ distDirLayout baseCtx)
+ Toolchains{buildToolchain = Toolchain{toolchainPlatform = platform@(Platform arch os), toolchainCompiler = compiler}} <- runRebuild projectRoot $ configureCompiler verbosity (distDirLayout baseCtx) (fst (ignoreConditions projectCfgSkeleton) <> projectConfig baseCtx)
(projectCfg, _) <- instantiateProjectConfigSkeletonFetchingCompiler (pure (os, arch, compiler)) mempty projectCfgSkeleton
- let ctx' = ctx & lProjectConfig %~ (<> projectCfg)
+ let ctx' = baseCtx & lProjectConfig %~ (<> projectCfg)
build_dir = distBuildDirectory (distDirLayout ctx') $ (scriptDistDirParams script) ctx' compiler platform
exePath = build_dir </> "bin" </> scriptExeFileName script
@@ -588,7 +589,7 @@ fakeProjectSourcePackage projectRoot = sourcePackage
movedExePath :: UnqualComponentName -> DistDirLayout -> ElaboratedSharedConfig -> ElaboratedConfiguredPackage -> Maybe FilePath
movedExePath selectedComponent distDirLayout elabShared elabConfigured = do
exe <- find ((== selectedComponent) . exeName) . executables $ elabPkgDescription elabConfigured
- let CompilerId flavor _ = (compilerId . pkgConfigCompiler) elabShared
+ let CompilerId flavor _ = (compilerId . toolchainCompiler . buildToolchain . pkgConfigToolchains) elabShared
opts <- lookup flavor (perCompilerFlavorToList . options $ buildInfo exe)
let projectRoot = distProjectRootDirectory distDirLayout
fmap (projectRoot </>) . lookup "-o" $ reverse (zip opts (drop 1 opts))
diff --git a/cabal-install/tests/IntegrationTests2.hs b/cabal-install/tests/IntegrationTests2.hs
index dd54fea54d0..c6c33735900 100644
--- a/cabal-install/tests/IntegrationTests2.hs
+++ b/cabal-install/tests/IntegrationTests2.hs
@@ -1891,10 +1891,10 @@ testSetupScriptStyles config reportSubCase = do
let isOSX (Platform _ OSX) = True
isOSX _ = False
- compilerVer = compilerVersion (pkgConfigCompiler sharedConfig)
+ compilerVer = compilerVersion (toolchainCompiler $ buildToolchain $ pkgConfigToolchains sharedConfig)
-- Skip the Custom tests when the shipped Cabal library is buggy
unless
- ( (isOSX (pkgConfigPlatform sharedConfig) && (compilerVer < mkVersion [7, 10]))
+ ( (isOSX (toolchainPlatform $ buildToolchain $ pkgConfigToolchains sharedConfig) && (compilerVer < mkVersion [7, 10]))
-- 9.10 ships Cabal 3.12.0.0 affected by #9940
|| (mkVersion [9, 10] <= compilerVer && compilerVer < mkVersion [9, 11])
)
@@ -1908,7 +1908,7 @@ testSetupScriptStyles config reportSubCase = do
removeFile (basedir </> testdir1 </> "marker")
-- implicit deps implies 'Cabal < 2' which conflicts w/ GHC 8.2 or later
- when (compilerVersion (pkgConfigCompiler sharedConfig) < mkVersion [8, 2]) $ do
+ when (compilerVersion (toolchainCompiler $ buildToolchain $ pkgConfigToolchains sharedConfig) < mkVersion [8, 2]) $ do
reportSubCase (show SetupCustomImplicitDeps)
(plan2, res2) <- executePlan =<< planProject testdir2 config
pkg2 <- expectPackageInstalled plan2 res2 pkgidA
@@ -2784,7 +2784,7 @@ testHaddockProjectDependencies config = do
(_, _, sharedConfig) <- planProject testdir config
-- `haddock-project` is only supported by `haddock-2.26.1` and above which is
-- shipped with `ghc-9.4`
- when (compilerVersion (pkgConfigCompiler sharedConfig) > mkVersion [9, 4]) $ do
+ when (compilerVersion (toolchainCompiler $ buildToolchain $ pkgConfigToolchains sharedConfig) > mkVersion [9, 4]) $ do
let dir = basedir </> testdir
cleanHaddockProject testdir
withCurrentDirectory dir $ do
diff --git a/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs b/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs
index 371766fedb1..a77415fec49 100644
--- a/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs
+++ b/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs
@@ -613,6 +613,9 @@ instance Arbitrary ProjectConfigShared where
projectConfigHcFlavor <- arbitrary
projectConfigHcPath <- arbitraryFlag arbitraryShortToken
projectConfigHcPkg <- arbitraryFlag arbitraryShortToken
+ projectConfigHostHcFlavor <- arbitrary
+ projectConfigHostHcPath <- arbitraryFlag arbitraryShortToken
+ projectConfigHostHcPkg <- arbitraryFlag arbitraryShortToken
projectConfigHaddockIndex <- arbitrary
projectConfigInstallDirs <- fixInstallDirs <$> arbitrary
projectConfigPackageDBs <- shortListOf 2 arbitrary
@@ -660,6 +663,9 @@ instance Arbitrary ProjectConfigShared where
<*> shrinker projectConfigHcFlavor
<*> shrinkerAla (fmap NonEmpty) projectConfigHcPath
<*> shrinkerAla (fmap NonEmpty) projectConfigHcPkg
+ <*> shrinker projectConfigHostHcFlavor
+ <*> shrinkerAla (fmap NonEmpty) projectConfigHostHcPath
+ <*> shrinkerAla (fmap NonEmpty) projectConfigHostHcPkg
<*> shrinker projectConfigHaddockIndex
<*> shrinker projectConfigInstallDirs
<*> shrinker projectConfigPackageDBs
From bb80d2a3f04a0380b5060fc72308798fcad3b11f Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Thu, 6 Mar 2025 20:29:25 +0900
Subject: [PATCH 12/82] wip: Thread HostHc into the proper places.
---
.../src/Distribution/Client/ProjectConfig/Legacy.hs | 6 +++---
cabal-install/src/Distribution/Client/ProjectPlanning.hs | 9 +++++----
2 files changed, 8 insertions(+), 7 deletions(-)
diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs
index f5030f58b5c..b29b3cf47f9 100644
--- a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs
+++ b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs
@@ -704,9 +704,6 @@ convertLegacyAllPackageFlags
convertLegacyAllPackageFlags globalFlags configFlags configExFlags installFlags projectFlags projectConfigMultiRepl =
ProjectConfigShared{..}
where
- projectConfigHostHcFlavor = NoFlag
- projectConfigHostHcPath = NoFlag
- projectConfigHostHcPkg = NoFlag
projectConfigPackageDBs = (fmap . fmap) (interpretPackageDB Nothing) projectConfigPackageDBs_
projectConfigHookHashes = mempty -- :: Map FilePath HookAccept
projectConfigDistDir = fmap getSymbolicPath projectConfigAbsoluteDistDir
@@ -744,6 +741,9 @@ convertLegacyAllPackageFlags globalFlags configFlags configExFlags installFlags
, configAllowNewer = projectConfigAllowNewer
, configWriteGhcEnvironmentFilesPolicy =
projectConfigWriteGhcEnvironmentFilesPolicy
+ , configHostHcFlavor = projectConfigHostHcFlavor
+ , configHostHcPath = projectConfigHostHcPath
+ , configHostHcPkg = projectConfigHostHcPkg
} = configExFlags
InstallFlags
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index ab82ec14c62..f429819daba 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -661,7 +661,7 @@ rebuildInstallPlan
toolchains <- phaseConfigureToolchain projectConfig
liftIO $ print ("build compiler", compilerId $ toolchainCompiler $ buildToolchain toolchains)
- liftIO $ print ("host compiler", compilerId $ toolchainCompiler $ buildToolchain toolchains)
+ liftIO $ print ("host compiler", compilerId $ toolchainCompiler $ hostToolchain toolchains)
-- _ <- phaseConfigurePrograms projectConfig compilerEtc
(solverPlan, pkgConfigDB, totalIndexState, activeRepos) <-
@@ -3864,9 +3864,10 @@ setupHsScriptOptions
-- - if we commit to a Cabal version, the logic in
Nothing
else Just elabSetupScriptCliVersion
- , useCompiler = Just (toolchainCompiler $ buildToolchain $ pkgConfigToolchains)
- , usePlatform = Just (toolchainPlatform $ buildToolchain $ pkgConfigToolchains)
- , useProgramDb = toolchainProgramDb $ buildToolchain $ pkgConfigToolchains
+ , -- for Setup.hs, we _always_ want to use the HOST toolchain.
+ useCompiler = Just (toolchainCompiler $ hostToolchain $ pkgConfigToolchains)
+ , usePlatform = Just (toolchainPlatform $ hostToolchain $ pkgConfigToolchains)
+ , useProgramDb = toolchainProgramDb $ hostToolchain $ pkgConfigToolchains
, usePackageDB = elabSetupPackageDBStack
, usePackageIndex = Nothing
, useDependencies =
From b1a44bdaba5bed7bb54c7629d609228d1cc209e7 Mon Sep 17 00:00:00 2001
From: Andrea Bedini <andrea@andreabedini.com>
Date: Fri, 7 Mar 2025 15:20:07 +0800
Subject: [PATCH 13/82] wip: log more details from the SolverInstallPlan
---
.../src/Distribution/Solver/Modular.hs | 32 ++++++++++++++++---
.../Distribution/Client/ProjectPlanning.hs | 2 +-
2 files changed, 28 insertions(+), 6 deletions(-)
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular.hs b/cabal-install-solver/src/Distribution/Solver/Modular.hs
index 9111b2d78d0..2c0883d2fba 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular.hs
@@ -34,7 +34,7 @@ import Distribution.Solver.Modular.IndexConversion
import Distribution.Solver.Modular.Log
( SolverFailure(..), displayLogMessages )
import Distribution.Solver.Modular.Package
- ( PN )
+ ( PN, showPI )
import Distribution.Solver.Modular.RetryLog
import Distribution.Solver.Modular.Solver
( SolverConfig(..), PruneAfterFirstSuccess(..), solve )
@@ -54,15 +54,37 @@ import Distribution.Simple.Setup
import Distribution.Simple.Utils
( ordNubBy )
import Distribution.Verbosity
+import Distribution.Solver.Modular.Configured (CP (..))
+import qualified Distribution.Solver.Types.ComponentDeps as ComponentDeps
+import Distribution.Pretty (Pretty (..))
+import Text.PrettyPrint (text, vcat, Doc, nest, ($+$))
+import Distribution.Solver.Types.OptionalStanza (showStanzas, optStanzaSetNull)
+import Distribution.Types.Flag (nullFlagAssignment)
+showCP :: CP QPN -> Doc
+showCP (CP qpi fa es ds) =
+ text "package:" <+> text (showPI qpi) $+$ nest 2 (
+ vcat
+ [ if nullFlagAssignment fa then mempty else text "flags:" <+> pretty fa
+ , if optStanzaSetNull es then mempty else text "stanzas:" <+> text (showStanzas es)
+ , vcat
+ [ text "component" <+> pretty c $+$
+ nest 2 (text "dependencies" $+$
+ nest 2 (vcat [ text (showPI dep) | dep <- deps]))
+ | (c, deps) <- ComponentDeps.toList ds
+ ]
+ ])
+
-- | Ties the two worlds together: classic cabal-install vs. the modular
-- solver. Performs the necessary translations before and after.
modularResolver :: SolverConfig -> DependencyResolver loc
-modularResolver sc (Platform arch os) cinfo iidx sidx pkgConfigDB pprefs pcs pns =
- uncurry postprocess <$> -- convert install plan
- solve' sc cinfo idx pkgConfigDB pprefs gcs pns
- where
+modularResolver sc (Platform arch os) cinfo iidx sidx pkgConfigDB pprefs pcs pns = do
+ (assignment, revdepmap) <- solve' sc cinfo idx pkgConfigDB pprefs gcs pns
+ let cp = toCPs assignment revdepmap
+ Step (show (vcat (map showCP cp))) $
+ return $ postprocess assignment revdepmap
+ where
-- Indices have to be converted into solver-specific uniform index.
idx = convPIs os arch cinfo gcs (shadowPkgs sc) (strongFlags sc) (solveExecutables sc) iidx sidx
-- Constraints have to be converted into a finite map indexed by PN.
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index f429819daba..11021bb70b1 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -819,7 +819,7 @@ rebuildInstallPlan
projectConfigBuildOnly
solverSettings = resolveSolverSettings projectConfig
- logMsg message rest = debugNoWrap verbosity message >> rest
+ logMsg message rest = infoNoWrap verbosity message >> rest
localPackagesEnabledStanzas =
Map.fromList
From c13273e0f7da838e515b87b4ca2d79708b28a460 Mon Sep 17 00:00:00 2001
From: Andrea Bedini <andrea@andreabedini.com>
Date: Fri, 7 Mar 2025 15:59:14 +0800
Subject: [PATCH 14/82] wip: pass qualified package name into the
SolverInstallPlan
---
.../Solver/Modular/ConfiguredConversion.hs | 32 +++++++++----------
.../Solver/Types/InstSolverPackage.hs | 2 ++
.../Distribution/Solver/Types/PackagePath.hs | 22 ++++++++++---
.../Solver/Types/SolverPackage.hs | 2 ++
.../src/Distribution/Client/Dependency.hs | 2 +-
.../Distribution/Client/ProjectPlanning.hs | 4 ++-
6 files changed, 42 insertions(+), 22 deletions(-)
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs b/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs
index 0e2e8ad5baa..89b57e2c783 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs
@@ -6,8 +6,6 @@ import Data.Maybe
import Prelude hiding (pi)
import Data.Either (partitionEithers)
-import Distribution.Package (UnitId, packageId)
-
import qualified Distribution.Simple.PackageIndex as SI
import Distribution.Solver.Modular.Configured
@@ -29,36 +27,38 @@ convCP :: SI.InstalledPackageIndex ->
CI.PackageIndex (SourcePackage loc) ->
CP QPN -> ResolverPackage loc
convCP iidx sidx (CP qpi fa es ds) =
- case convPI qpi of
- Left pi -> PreExisting $
+ case qpi of
+ -- Installed
+ (PI qpn (I _ (Inst pi))) ->
+ PreExisting $
InstSolverPackage {
- instSolverPkgIPI = fromJust $ SI.lookupUnitId iidx pi,
+ instSolverQPN = qpn,
+ instSolverPkgIPI = fromMaybe (error "convCP: lookupUnitId failed") $ SI.lookupUnitId iidx pi,
instSolverPkgLibDeps = fmap fst ds',
instSolverPkgExeDeps = fmap snd ds'
}
- Right pi -> Configured $
+ -- "In repo" i.e. a source package
+ (PI qpn@(Q _path pn) (I v InRepo)) ->
+ let pi = PackageIdentifier pn v in
+ Configured $
SolverPackage {
- solverPkgSource = srcpkg,
+ solverPkgQPN = qpn,
+ solverPkgSource = fromMaybe (error "convCP: lookupPackageId failed") $ CI.lookupPackageId sidx pi,
solverPkgFlags = fa,
solverPkgStanzas = es,
solverPkgLibDeps = fmap fst ds',
solverPkgExeDeps = fmap snd ds'
}
- where
- srcpkg = fromMaybe (error "convCP: lookupPackageId failed") $ CI.lookupPackageId sidx pi
where
ds' :: ComponentDeps ([SolverId] {- lib -}, [SolverId] {- exe -})
ds' = fmap (partitionEithers . map convConfId) ds
-convPI :: PI QPN -> Either UnitId PackageId
-convPI (PI _ (I _ (Inst pi))) = Left pi
-convPI pi = Right (packageId (either id id (convConfId pi)))
-
convConfId :: PI QPN -> Either SolverId {- is lib -} SolverId {- is exe -}
convConfId (PI (Q (PackagePath _ q) pn) (I v loc)) =
case loc of
- Inst pi -> Left (PreExistingId sourceId pi)
- _otherwise
+ Inst pi ->
+ Left (PreExistingId sourceId pi)
+ InRepo
| QualExe _ pn' <- q
-- NB: the dependencies of the executable are also
-- qualified. So the way to tell if this is an executable
@@ -67,6 +67,6 @@ convConfId (PI (Q (PackagePath _ q) pn) (I v loc)) =
-- silly and didn't allow arbitrarily nested build-tools
-- dependencies, so a shallow check works.
, pn == pn' -> Right (PlannedId sourceId)
- | otherwise -> Left (PlannedId sourceId)
+ | otherwise -> Left (PlannedId sourceId)
where
sourceId = PackageIdentifier pn v
diff --git a/cabal-install-solver/src/Distribution/Solver/Types/InstSolverPackage.hs b/cabal-install-solver/src/Distribution/Solver/Types/InstSolverPackage.hs
index 871a0dd15a9..15fb9d510ec 100644
--- a/cabal-install-solver/src/Distribution/Solver/Types/InstSolverPackage.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Types/InstSolverPackage.hs
@@ -8,6 +8,7 @@ import Prelude ()
import Distribution.Package ( Package(..), HasMungedPackageId(..), HasUnitId(..) )
import Distribution.Solver.Types.ComponentDeps ( ComponentDeps )
+import Distribution.Solver.Types.PackagePath (QPN)
import Distribution.Solver.Types.SolverId
import Distribution.Types.MungedPackageId
import Distribution.Types.PackageId
@@ -17,6 +18,7 @@ import Distribution.InstalledPackageInfo (InstalledPackageInfo)
-- | An 'InstSolverPackage' is a pre-existing installed package
-- specified by the dependency solver.
data InstSolverPackage = InstSolverPackage {
+ instSolverQPN :: QPN,
instSolverPkgIPI :: InstalledPackageInfo,
instSolverPkgLibDeps :: ComponentDeps [SolverId],
instSolverPkgExeDeps :: ComponentDeps [SolverId]
diff --git a/cabal-install-solver/src/Distribution/Solver/Types/PackagePath.hs b/cabal-install-solver/src/Distribution/Solver/Types/PackagePath.hs
index 4fc4df25f97..05727ffe8c9 100644
--- a/cabal-install-solver/src/Distribution/Solver/Types/PackagePath.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Types/PackagePath.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE DeriveGeneric #-}
module Distribution.Solver.Types.PackagePath
( PackagePath(..)
, Namespace(..)
@@ -18,7 +20,10 @@ import qualified Text.PrettyPrint as Disp
-- | A package path consists of a namespace and a package path inside that
-- namespace.
data PackagePath = PackagePath Namespace Qualifier
- deriving (Eq, Ord, Show)
+ deriving (Eq, Ord, Show, Generic)
+
+instance Binary PackagePath
+instance Structured PackagePath
-- | Top-level namespace
--
@@ -30,7 +35,10 @@ data Namespace =
-- | A namespace for a specific build target
| Independent PackageName
- deriving (Eq, Ord, Show)
+ deriving (Eq, Ord, Show, Generic)
+
+instance Binary Namespace
+instance Structured Namespace
-- | Pretty-prints a namespace. The result is either empty or
-- ends in a period, so it can be prepended onto a qualifier.
@@ -68,7 +76,10 @@ data Qualifier =
-- tracked only @pn2@, that would require us to pick only one
-- version of an executable over the entire install plan.)
| QualExe PackageName PackageName
- deriving (Eq, Ord, Show)
+ deriving (Eq, Ord, Show, Generic)
+
+instance Binary Qualifier
+instance Structured Qualifier
-- | Pretty-prints a qualifier. The result is either empty or
-- ends in a period, so it can be prepended onto a package name.
@@ -87,11 +98,14 @@ dispQualifier (QualBase pn) = pretty pn <<>> Disp.text "."
-- | A qualified entity. Pairs a package path with the entity.
data Qualified a = Q PackagePath a
- deriving (Eq, Ord, Show)
+ deriving (Eq, Ord, Show, Generic)
-- | Qualified package name.
type QPN = Qualified PackageName
+instance Binary (Qualified PackageName)
+instance Structured (Qualified PackageName)
+
-- | Pretty-prints a qualified package name.
dispQPN :: QPN -> Disp.Doc
dispQPN (Q (PackagePath ns qual) pn) =
diff --git a/cabal-install-solver/src/Distribution/Solver/Types/SolverPackage.hs b/cabal-install-solver/src/Distribution/Solver/Types/SolverPackage.hs
index 186f140aefe..b3748254ebb 100644
--- a/cabal-install-solver/src/Distribution/Solver/Types/SolverPackage.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Types/SolverPackage.hs
@@ -10,6 +10,7 @@ import Distribution.Package ( Package(..) )
import Distribution.PackageDescription ( FlagAssignment )
import Distribution.Solver.Types.ComponentDeps ( ComponentDeps )
import Distribution.Solver.Types.OptionalStanza
+import Distribution.Solver.Types.PackagePath (QPN)
import Distribution.Solver.Types.SolverId
import Distribution.Solver.Types.SourcePackage
@@ -21,6 +22,7 @@ import Distribution.Solver.Types.SourcePackage
-- but for symmetry we have the parameter. (Maybe it can be removed.)
--
data SolverPackage loc = SolverPackage {
+ solverPkgQPN :: QPN,
solverPkgSource :: SourcePackage loc,
solverPkgFlags :: FlagAssignment,
solverPkgStanzas :: OptionalStanzaSet,
diff --git a/cabal-install/src/Distribution/Client/Dependency.hs b/cabal-install/src/Distribution/Client/Dependency.hs
index d59bc611c44..af759a2fedf 100644
--- a/cabal-install/src/Distribution/Client/Dependency.hs
+++ b/cabal-install/src/Distribution/Client/Dependency.hs
@@ -1023,7 +1023,7 @@ configuredPackageProblems
configuredPackageProblems
platform
cinfo
- (SolverPackage pkg specifiedFlags stanzas specifiedDeps0 _specifiedExeDeps') =
+ (SolverPackage _qpn pkg specifiedFlags stanzas specifiedDeps0 _specifiedExeDeps') =
[ DuplicateFlag flag
| flag <- PD.findDuplicateFlagAssignments specifiedFlags
]
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index 11021bb70b1..f30e11ad23e 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -1685,7 +1685,7 @@ elaborateInstallPlan
:: (SolverId -> [ElaboratedPlanPackage])
-> SolverPackage UnresolvedPkgLoc
-> LogProgress [ElaboratedConfiguredPackage]
- elaborateSolverToComponents mapDep spkg@(SolverPackage _ _ _ deps0 exe_deps0) =
+ elaborateSolverToComponents mapDep spkg@(SolverPackage qpn _ _ _ deps0 exe_deps0) =
case mkComponentsGraph (elabEnabledSpec elab0) pd of
Right g -> do
let src_comps = componentsGraphToList g
@@ -2075,6 +2075,7 @@ elaborateInstallPlan
elaborateSolverToPackage
pkgWhyNotPerComponent
pkg@( SolverPackage
+ qpn
(SourcePackage pkgid _gpd _srcloc _descOverride)
_flags
_stanzas
@@ -2178,6 +2179,7 @@ elaborateInstallPlan
-> (ElaboratedConfiguredPackage, LogProgress ())
elaborateSolverToCommon
pkg@( SolverPackage
+ qpn
(SourcePackage pkgid gdesc srcloc descOverride)
flags
stanzas
From 8b90158f841f3105d4c134bc026922924415881e Mon Sep 17 00:00:00 2001
From: Andrea Bedini <andrea@andreabedini.com>
Date: Fri, 14 Mar 2025 11:57:51 +0800
Subject: [PATCH 15/82] refactor(cabal-install-solver)!: remove QualifyOptions
Remove QualifyOptions by setting qoSetupIndependent to be always true (the
current default) and qoBaseShim false (this must have been just a hack of some
sort).
---
.../Distribution/Solver/Modular/Builder.hs | 6 +-
.../Distribution/Solver/Modular/Dependency.hs | 198 ++++++++----------
.../Distribution/Solver/Modular/Explore.hs | 2 +-
.../src/Distribution/Solver/Modular/Index.hs | 16 --
.../Distribution/Solver/Modular/Linking.hs | 8 +-
.../Distribution/Solver/Modular/Validate.hs | 8 +-
6 files changed, 100 insertions(+), 138 deletions(-)
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Builder.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Builder.hs
index 5d196f4fd9f..9de9ea16ee2 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/Builder.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/Builder.hs
@@ -50,8 +50,7 @@ data BuildState = BS {
index :: Index, -- ^ information about packages and their dependencies
rdeps :: RevDepMap, -- ^ set of all package goals, completed and open, with reverse dependencies
open :: [OpenGoal], -- ^ set of still open goals (flag and package goals)
- next :: BuildType, -- ^ kind of node to generate next
- qualifyOptions :: QualifyOptions -- ^ qualification options
+ next :: BuildType -- ^ kind of node to generate next
}
-- | Map of available linking targets.
@@ -105,7 +104,7 @@ scopedExtendOpen :: QPN -> FlaggedDeps PN -> FlagInfo ->
scopedExtendOpen qpn fdeps fdefs s = extendOpen qpn gs s
where
-- Qualify all package names
- qfdeps = qualifyDeps (qualifyOptions s) qpn fdeps
+ qfdeps = qualifyDeps qpn fdeps
-- Introduce all package flags
qfdefs = L.map (\ (fn, b) -> Flagged (FN qpn fn) b [] []) $ M.toList fdefs
-- Combine new package and flag goals
@@ -255,7 +254,6 @@ buildTree idx (IndependentGoals ind) igs =
, rdeps = M.fromList (L.map (\ qpn -> (qpn, [])) qpns)
, open = L.map topLevelGoal qpns
, next = Goals
- , qualifyOptions = defaultQualifyOptions idx
}
, linkingState = M.empty
}
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Dependency.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Dependency.hs
index 27debc9c6f0..78ac86c89f2 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/Dependency.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/Dependency.hs
@@ -1,34 +1,38 @@
{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE RecordWildCards #-}
-module Distribution.Solver.Modular.Dependency (
- -- * Variables
- Var(..)
+
+module Distribution.Solver.Modular.Dependency
+ ( -- * Variables
+ Var (..)
, showVar
, varPN
+
-- * Conflict sets
, ConflictSet
, ConflictMap
, CS.showConflictSet
+
-- * Constrained instances
- , CI(..)
+ , CI (..)
+
-- * Flagged dependencies
, FlaggedDeps
- , FlaggedDep(..)
- , LDep(..)
- , Dep(..)
- , PkgComponent(..)
- , ExposedComponent(..)
- , DependencyReason(..)
+ , FlaggedDep (..)
+ , LDep (..)
+ , Dep (..)
+ , PkgComponent (..)
+ , ExposedComponent (..)
+ , DependencyReason (..)
, showDependencyReason
, flattenFlaggedDeps
- , QualifyOptions(..)
, qualifyDeps
, unqualifyDeps
+
-- * Reverse dependency map
, RevDepMap
+
-- * Goals
- , Goal(..)
- , GoalReason(..)
+ , Goal (..)
+ , GoalReason (..)
, QGoalReason
, goalToVar
, varToConflictSet
@@ -39,21 +43,21 @@ module Distribution.Solver.Modular.Dependency (
, dependencyReasonToConflictSetWithVersionConflict
) where
-import Prelude ()
import qualified Data.Map as M
import qualified Data.Set as S
import Distribution.Solver.Compat.Prelude hiding (pi)
+import Prelude ()
-import Language.Haskell.Extension (Extension(..), Language(..))
+import Language.Haskell.Extension (Extension (..), Language (..))
-import Distribution.Solver.Modular.ConflictSet (ConflictSet, ConflictMap)
+import Distribution.Solver.Modular.ConflictSet (ConflictMap, ConflictSet)
+import qualified Distribution.Solver.Modular.ConflictSet as CS
import Distribution.Solver.Modular.Flag
import Distribution.Solver.Modular.Package
import Distribution.Solver.Modular.Var
import Distribution.Solver.Modular.Version
-import qualified Distribution.Solver.Modular.ConflictSet as CS
-import Distribution.Solver.Types.ComponentDeps (Component(..))
+import Distribution.Solver.Types.ComponentDeps (Component (..))
import Distribution.Solver.Types.PackagePath
import Distribution.Types.LibraryName
import Distribution.Types.PkgconfigVersionRange
@@ -85,14 +89,14 @@ type FlaggedDeps qpn = [FlaggedDep qpn]
-- | Flagged dependencies can either be plain dependency constraints,
-- or flag-dependent dependency trees.
-data FlaggedDep qpn =
- -- | Dependencies which are conditional on a flag choice.
+data FlaggedDep qpn
+ = -- | Dependencies which are conditional on a flag choice.
Flagged (FN qpn) FInfo (TrueFlaggedDeps qpn) (FalseFlaggedDeps qpn)
- -- | Dependencies which are conditional on whether or not a stanza
+ | -- | Dependencies which are conditional on whether or not a stanza
-- (e.g., a test suite or benchmark) is enabled.
- | Stanza (SN qpn) (TrueFlaggedDeps qpn)
- -- | Dependencies which are always enabled, for the component 'comp'.
- | Simple (LDep qpn) Component
+ Stanza (SN qpn) (TrueFlaggedDeps qpn)
+ | -- | Dependencies which are always enabled, for the component 'comp'.
+ Simple (LDep qpn) Component
-- | Conservatively flatten out flagged dependencies
--
@@ -102,10 +106,10 @@ flattenFlaggedDeps = concatMap aux
where
aux :: FlaggedDep qpn -> [(LDep qpn, Component)]
aux (Flagged _ _ t f) = flattenFlaggedDeps t ++ flattenFlaggedDeps f
- aux (Stanza _ t) = flattenFlaggedDeps t
- aux (Simple d c) = [(d, c)]
+ aux (Stanza _ t) = flattenFlaggedDeps t
+ aux (Simple d c) = [(d, c)]
-type TrueFlaggedDeps qpn = FlaggedDeps qpn
+type TrueFlaggedDeps qpn = FlaggedDeps qpn
type FalseFlaggedDeps qpn = FlaggedDeps qpn
-- | A 'Dep' labeled with the reason it was introduced.
@@ -119,11 +123,16 @@ data LDep qpn = LDep (DependencyReason qpn) (Dep qpn)
-- | A dependency (constraint) associates a package name with a constrained
-- instance. It can also represent other types of dependencies, such as
-- dependencies on language extensions.
-data Dep qpn = Dep (PkgComponent qpn) CI -- ^ dependency on a package component
- | Ext Extension -- ^ dependency on a language extension
- | Lang Language -- ^ dependency on a language version
- | Pkg PkgconfigName PkgconfigVersionRange -- ^ dependency on a pkg-config package
- deriving Functor
+data Dep qpn
+ = -- | dependency on a package component
+ Dep (PkgComponent qpn) CI
+ | -- | dependency on a language extension
+ Ext Extension
+ | -- | dependency on a language version
+ Lang Language
+ | -- | dependency on a pkg-config package
+ Pkg PkgconfigName PkgconfigVersionRange
+ deriving (Functor)
-- | An exposed component within a package. This type is used to represent
-- build-depends and build-tool-depends dependencies.
@@ -132,8 +141,8 @@ data PkgComponent qpn = PkgComponent qpn ExposedComponent
-- | A component that can be depended upon by another package, i.e., a library
-- or an executable.
-data ExposedComponent =
- ExposedLib LibraryName
+data ExposedComponent
+ = ExposedLib LibraryName
| ExposedExe UnqualComponentName
deriving (Eq, Ord, Show)
@@ -147,43 +156,25 @@ data DependencyReason qpn = DependencyReason qpn (Map Flag FlagValue) (S.Set Sta
-- | Print the reason that a dependency was introduced.
showDependencyReason :: DependencyReason QPN -> String
showDependencyReason (DependencyReason qpn flags stanzas) =
- intercalate " " $
- showQPN qpn
+ intercalate " " $
+ showQPN qpn
: map (uncurry showFlagValue) (M.toList flags)
- ++ map (\s -> showSBool s True) (S.toList stanzas)
-
--- | Options for goal qualification (used in 'qualifyDeps')
---
--- See also 'defaultQualifyOptions'
-data QualifyOptions = QO {
- -- | Do we have a version of base relying on another version of base?
- qoBaseShim :: Bool
-
- -- Should dependencies of the setup script be treated as independent?
- , qoSetupIndependent :: Bool
- }
- deriving Show
+ ++ map (\s -> showSBool s True) (S.toList stanzas)
-- | Apply built-in rules for package qualifiers
--
--- Although the behaviour of 'qualifyDeps' depends on the 'QualifyOptions',
--- it is important that these 'QualifyOptions' are _static_. Qualification
--- does NOT depend on flag assignment; in other words, it behaves the same no
--- matter which choices the solver makes (modulo the global 'QualifyOptions');
--- we rely on this in 'linkDeps' (see comment there).
---
-- NOTE: It's the _dependencies_ of a package that may or may not be independent
-- from the package itself. Package flag choices must of course be consistent.
-qualifyDeps :: QualifyOptions -> QPN -> FlaggedDeps PN -> FlaggedDeps QPN
-qualifyDeps QO{..} (Q pp@(PackagePath ns q) pn) = go
+qualifyDeps :: QPN -> FlaggedDeps PN -> FlaggedDeps QPN
+qualifyDeps (Q pp@(PackagePath ns q) pn) = go
where
go :: FlaggedDeps PN -> FlaggedDeps QPN
go = map go1
go1 :: FlaggedDep PN -> FlaggedDep QPN
go1 (Flagged fn nfo t f) = Flagged (fmap (Q pp) fn) nfo (go t) (go f)
- go1 (Stanza sn t) = Stanza (fmap (Q pp) sn) (go t)
- go1 (Simple dep comp) = Simple (goLDep dep comp) comp
+ go1 (Stanza sn t) = Stanza (fmap (Q pp) sn) (go t)
+ go1 (Simple dep comp) = Simple (goLDep dep comp) comp
-- Suppose package B has a setup dependency on package A.
-- This will be recorded as something like
@@ -197,15 +188,14 @@ qualifyDeps QO{..} (Q pp@(PackagePath ns q) pn) = go
goLDep (LDep dr dep) comp = LDep (fmap (Q pp) dr) (goD dep comp)
goD :: Dep PN -> Component -> Dep QPN
- goD (Ext ext) _ = Ext ext
- goD (Lang lang) _ = Lang lang
- goD (Pkg pkn vr) _ = Pkg pkn vr
+ goD (Ext ext) _ = Ext ext
+ goD (Lang lang) _ = Lang lang
+ goD (Pkg pkn vr) _ = Pkg pkn vr
goD (Dep dep@(PkgComponent qpn (ExposedExe _)) ci) _ =
- Dep (Q (PackagePath ns (QualExe pn qpn)) <$> dep) ci
- goD (Dep dep@(PkgComponent qpn (ExposedLib _)) ci) comp
- | qBase qpn = Dep (Q (PackagePath ns (QualBase pn)) <$> dep) ci
- | qSetup comp = Dep (Q (PackagePath ns (QualSetup pn)) <$> dep) ci
- | otherwise = Dep (Q (PackagePath ns inheritedQ ) <$> dep) ci
+ Dep (Q (PackagePath ns (QualExe pn qpn)) <$> dep) ci
+ goD (Dep dep@(PkgComponent _qpn (ExposedLib _)) ci) comp
+ | comp == ComponentSetup = Dep (Q (PackagePath ns (QualSetup pn)) <$> dep) ci
+ | otherwise = Dep (Q (PackagePath ns inheritedQ) <$> dep) ci
-- If P has a setup dependency on Q, and Q has a regular dependency on R, then
-- we say that the 'Setup' qualifier is inherited: P has an (indirect) setup
@@ -216,18 +206,10 @@ qualifyDeps QO{..} (Q pp@(PackagePath ns q) pn) = go
-- a detailed discussion.
inheritedQ :: Qualifier
inheritedQ = case q of
- QualSetup _ -> q
- QualExe _ _ -> q
- QualToplevel -> q
- QualBase _ -> QualToplevel
-
- -- Should we qualify this goal with the 'Base' package path?
- qBase :: PN -> Bool
- qBase dep = qoBaseShim && unPackageName dep == "base"
-
- -- Should we qualify this goal with the 'Setup' package path?
- qSetup :: Component -> Bool
- qSetup comp = qoSetupIndependent && comp == ComponentSetup
+ QualSetup _ -> q
+ QualExe _ _ -> q
+ QualToplevel -> q
+ QualBase _ -> QualToplevel
-- | Remove qualifiers from set of dependencies
--
@@ -244,8 +226,8 @@ unqualifyDeps = go
go1 :: FlaggedDep QPN -> FlaggedDep PN
go1 (Flagged fn nfo t f) = Flagged (fmap unq fn) nfo (go t) (go f)
- go1 (Stanza sn t) = Stanza (fmap unq sn) (go t)
- go1 (Simple dep comp) = Simple (goLDep dep) comp
+ go1 (Stanza sn t) = Stanza (fmap unq sn) (go t)
+ go1 (Simple dep comp) = Simple (goLDep dep) comp
goLDep :: LDep QPN -> LDep PN
goLDep (LDep dr dep) = LDep (fmap unq dr) (fmap unq dep)
@@ -271,8 +253,8 @@ data Goal qpn = Goal (Var qpn) (GoalReason qpn)
deriving (Eq, Show, Functor)
-- | Reason why a goal is being added to a goal set.
-data GoalReason qpn =
- UserGoal -- introduced by a build target
+data GoalReason qpn
+ = UserGoal -- introduced by a build target
| DependencyGoal (DependencyReason qpn) -- introduced by a package
deriving (Eq, Show, Functor)
@@ -288,7 +270,7 @@ varToConflictSet = CS.singleton
-- | Convert a 'GoalReason' to a 'ConflictSet' that can be used when the goal
-- leads to a conflict.
goalReasonToConflictSet :: GoalReason QPN -> ConflictSet
-goalReasonToConflictSet UserGoal = CS.empty
+goalReasonToConflictSet UserGoal = CS.empty
goalReasonToConflictSet (DependencyGoal dr) = dependencyReasonToConflictSet dr
-- | Convert a 'GoalReason' to a 'ConflictSet' containing the reason that the
@@ -302,14 +284,14 @@ goalReasonToConflictSetWithConflict :: QPN -> GoalReason QPN -> ConflictSet
goalReasonToConflictSetWithConflict goal (DependencyGoal (DependencyReason qpn flags stanzas))
| M.null flags && S.null stanzas =
CS.singletonWithConflict (P qpn) $ CS.GoalConflict goal
-goalReasonToConflictSetWithConflict _ gr = goalReasonToConflictSet gr
+goalReasonToConflictSetWithConflict _ gr = goalReasonToConflictSet gr
-- | This function returns the solver variables responsible for the dependency.
-- It drops the values chosen for flag and stanza variables, which are only
-- needed for log messages.
dependencyReasonToConflictSet :: DependencyReason QPN -> ConflictSet
dependencyReasonToConflictSet (DependencyReason qpn flags stanzas) =
- CS.fromList $ P qpn : flagVars ++ map stanzaToVar (S.toList stanzas)
+ CS.fromList $ P qpn : flagVars ++ map stanzaToVar (S.toList stanzas)
where
-- Filter out any flags that introduced the dependency with both values.
-- They don't need to be included in the conflict set, because changing the
@@ -327,16 +309,19 @@ dependencyReasonToConflictSet (DependencyReason qpn flags stanzas) =
-- This function currently only specifies the reason for the conflict in the
-- simple case where the 'DependencyReason' does not involve any flags or
-- stanzas. Otherwise, it falls back to calling 'dependencyReasonToConflictSet'.
-dependencyReasonToConflictSetWithVersionConstraintConflict :: QPN
- -> Ver
- -> DependencyReason QPN
- -> ConflictSet
dependencyReasonToConflictSetWithVersionConstraintConflict
- dependency excludedVersion dr@(DependencyReason qpn flags stanzas)
- | M.null flags && S.null stanzas =
- CS.singletonWithConflict (P qpn) $
- CS.VersionConstraintConflict dependency excludedVersion
- | otherwise = dependencyReasonToConflictSet dr
+ :: QPN
+ -> Ver
+ -> DependencyReason QPN
+ -> ConflictSet
+dependencyReasonToConflictSetWithVersionConstraintConflict
+ dependency
+ excludedVersion
+ dr@(DependencyReason qpn flags stanzas)
+ | M.null flags && S.null stanzas =
+ CS.singletonWithConflict (P qpn) $
+ CS.VersionConstraintConflict dependency excludedVersion
+ | otherwise = dependencyReasonToConflictSet dr
-- | Convert a 'DependencyReason' to a 'ConflictSet' specifying that the
-- conflict occurred because the conflict set variables introduced a version of
@@ -346,13 +331,16 @@ dependencyReasonToConflictSetWithVersionConstraintConflict
-- This function currently only specifies the reason for the conflict in the
-- simple case where the 'DependencyReason' does not involve any flags or
-- stanzas. Otherwise, it falls back to calling 'dependencyReasonToConflictSet'.
-dependencyReasonToConflictSetWithVersionConflict :: QPN
- -> CS.OrderedVersionRange
- -> DependencyReason QPN
- -> ConflictSet
dependencyReasonToConflictSetWithVersionConflict
- pkgWithVersionConstraint constraint dr@(DependencyReason qpn flags stanzas)
- | M.null flags && S.null stanzas =
- CS.singletonWithConflict (P qpn) $
- CS.VersionConflict pkgWithVersionConstraint constraint
- | otherwise = dependencyReasonToConflictSet dr
+ :: QPN
+ -> CS.OrderedVersionRange
+ -> DependencyReason QPN
+ -> ConflictSet
+dependencyReasonToConflictSetWithVersionConflict
+ pkgWithVersionConstraint
+ constraint
+ dr@(DependencyReason qpn flags stanzas)
+ | M.null flags && S.null stanzas =
+ CS.singletonWithConflict (P qpn) $
+ CS.VersionConflict pkgWithVersionConstraint constraint
+ | otherwise = dependencyReasonToConflictSet dr
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Explore.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Explore.hs
index 90038a28f5c..d047ecda38e 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/Explore.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/Explore.hs
@@ -270,7 +270,7 @@ exploreLog mbj enableBj fineGrainedConflicts (CountConflicts countConflicts) idx
couldResolveConflicts :: QPN -> POption -> S.Set CS.Conflict -> Maybe ConflictSet
couldResolveConflicts currentQPN@(Q _ pn) (POption i@(I v _) _) conflicts =
let (PInfo deps _ _ _) = idx M.! pn M.! i
- qdeps = qualifyDeps (defaultQualifyOptions idx) currentQPN deps
+ qdeps = qualifyDeps currentQPN deps
couldBeResolved :: CS.Conflict -> Maybe ConflictSet
couldBeResolved CS.OtherConflict = Nothing
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Index.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Index.hs
index 2f28d12de85..28ed5c9cd2d 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/Index.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/Index.hs
@@ -4,7 +4,6 @@ module Distribution.Solver.Modular.Index
, ComponentInfo(..)
, IsVisible(..)
, IsBuildable(..)
- , defaultQualifyOptions
, mkIndex
) where
@@ -57,18 +56,3 @@ mkIndex xs = M.map M.fromList (groupMap (L.map (\ (pn, i, pi) -> (pn, (i, pi)))
groupMap :: Ord a => [(a, b)] -> Map a [b]
groupMap xs = M.fromListWith (flip (++)) (L.map (\ (x, y) -> (x, [y])) xs)
-
-defaultQualifyOptions :: Index -> QualifyOptions
-defaultQualifyOptions idx = QO {
- qoBaseShim = or [ dep == base
- | -- Find all versions of base ..
- Just is <- [M.lookup base idx]
- -- .. which are installed ..
- , (I _ver (Inst _), PInfo deps _comps _flagNfo _fr) <- M.toList is
- -- .. and flatten all their dependencies ..
- , (LDep _ (Dep (PkgComponent dep _) _ci), _comp) <- flattenFlaggedDeps deps
- ]
- , qoSetupIndependent = True
- }
- where
- base = mkPackageName "base"
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Linking.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Linking.hs
index 15514472c80..ead3e10c6d4 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/Linking.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/Linking.hs
@@ -61,8 +61,6 @@ data ValidateState = VS {
, vsLinks :: Map QPN LinkGroup
, vsFlags :: FAssignment
, vsStanzas :: SAssignment
- , vsQualifyOptions :: QualifyOptions
-
-- Saved qualified dependencies. Every time 'validateLinking' makes a
-- package choice, it qualifies the package's dependencies and saves them in
-- this map. Then the qualified dependencies are available for subsequent
@@ -101,7 +99,7 @@ validateLinking index = (`runReader` initVS) . go
goP qpn@(Q _pp pn) opt@(POption i _) r = do
vs <- ask
let PInfo deps _ _ _ = vsIndex vs ! pn ! i
- qdeps = qualifyDeps (vsQualifyOptions vs) qpn deps
+ qdeps = qualifyDeps qpn deps
newSaved = M.insert qpn qdeps (vsSaved vs)
case execUpdateState (pickPOption qpn opt qdeps) vs of
Left (cs, err) -> return $ Fail cs (DependenciesNotLinked err)
@@ -129,7 +127,6 @@ validateLinking index = (`runReader` initVS) . go
, vsLinks = M.empty
, vsFlags = M.empty
, vsStanzas = M.empty
- , vsQualifyOptions = defaultQualifyOptions index
, vsSaved = M.empty
}
@@ -275,8 +272,7 @@ linkDeps target = \deps -> do
requalify :: FlaggedDeps QPN -> UpdateState (FlaggedDeps QPN)
requalify deps = do
- vs <- get
- return $ qualifyDeps (vsQualifyOptions vs) target (unqualifyDeps deps)
+ return $ qualifyDeps target (unqualifyDeps deps)
pickFlag :: QFN -> Bool -> UpdateState ()
pickFlag qfn b = do
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs
index 4af149b31cf..d6de20cc1de 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs
@@ -108,9 +108,7 @@ data ValidateState = VS {
-- Map from package name to the components that are required from that
-- package.
- requiredComponents :: Map QPN ComponentDependencyReasons,
-
- qualifyOptions :: QualifyOptions
+ requiredComponents :: Map QPN ComponentDependencyReasons
}
newtype Validate a = Validate (Reader ValidateState a)
@@ -200,11 +198,10 @@ validate = go
svd <- asks saved -- obtain saved dependencies
aComps <- asks availableComponents
rComps <- asks requiredComponents
- qo <- asks qualifyOptions
-- obtain dependencies and index-dictated exclusions introduced by the choice
let (PInfo deps comps _ mfr) = idx ! pn ! i
-- qualify the deps in the current scope
- let qdeps = qualifyDeps qo qpn deps
+ let qdeps = qualifyDeps qpn deps
-- the new active constraints are given by the instance we have chosen,
-- plus the dependency information we have for that instance
let newactives = extractAllDeps pfa psa qdeps
@@ -577,5 +574,4 @@ validateTree cinfo idx pkgConfigDb t = runValidate (validate t) VS {
, pa = PA M.empty M.empty M.empty
, availableComponents = M.empty
, requiredComponents = M.empty
- , qualifyOptions = defaultQualifyOptions idx
}
From a696671da00fe58d65218fae006efddc95cb351f Mon Sep 17 00:00:00 2001
From: Andrea Bedini <andrea@andreabedini.com>
Date: Fri, 14 Mar 2025 12:16:18 +0800
Subject: [PATCH 16/82] refactor(cabal-install-solver)!: remove deadcode
principalPP and setupPP seem to have gone unused since
8194fab5671a86fc2446a39ec27fcbd1e19c7418
---
.../Distribution/Solver/Modular/Package.hs | 25 -------------------
1 file changed, 25 deletions(-)
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Package.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Package.hs
index ccd0e4d4a70..6b35808902a 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/Package.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/Package.hs
@@ -11,8 +11,6 @@ module Distribution.Solver.Modular.Package
, QPV
, instI
, makeIndependent
- , primaryPP
- , setupPP
, showI
, showPI
, unPN
@@ -77,29 +75,6 @@ instI :: I -> Bool
instI (I _ (Inst _)) = True
instI _ = False
--- | Is the package in the primary group of packages. This is used to
--- determine (1) if we should try to establish stanza preferences
--- for this goal, and (2) whether or not a user specified @--constraint@
--- should apply to this dependency (grep 'primaryPP' to see the
--- use sites). In particular this does not include packages pulled in
--- as setup deps.
---
-primaryPP :: PackagePath -> Bool
-primaryPP (PackagePath _ns q) = go q
- where
- go QualToplevel = True
- go (QualBase _) = True
- go (QualSetup _) = False
- go (QualExe _ _) = False
-
--- | Is the package a dependency of a setup script. This is used to
--- establish whether or not certain constraints should apply to this
--- dependency (grep 'setupPP' to see the use sites).
---
-setupPP :: PackagePath -> Bool
-setupPP (PackagePath _ns (QualSetup _)) = True
-setupPP (PackagePath _ns _) = False
-
-- | Qualify a target package with its own name so that its dependencies are not
-- required to be consistent with other targets.
makeIndependent :: PN -> QPN
From d908ca3875b5eba904fa18e5a9e8232ce8ca27d2 Mon Sep 17 00:00:00 2001
From: Andrea Bedini <andrea@andreabedini.com>
Date: Fri, 14 Mar 2025 12:35:12 +0800
Subject: [PATCH 17/82] wip move Toolchain into cabal-install-solver
---
.../cabal-install-solver.cabal | 1 +
.../Client/ProjectPlanning/Types.hs | 20 +------------------
2 files changed, 2 insertions(+), 19 deletions(-)
diff --git a/cabal-install-solver/cabal-install-solver.cabal b/cabal-install-solver/cabal-install-solver.cabal
index 3f3b84644cf..4a20a369fee 100644
--- a/cabal-install-solver/cabal-install-solver.cabal
+++ b/cabal-install-solver/cabal-install-solver.cabal
@@ -95,6 +95,7 @@ library
Distribution.Solver.Types.SolverId
Distribution.Solver.Types.SolverPackage
Distribution.Solver.Types.SourcePackage
+ Distribution.Solver.Types.System
Distribution.Solver.Types.Variable
build-depends:
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs b/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs
index 8e52d778330..7432e1897ae 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs
@@ -104,7 +104,6 @@ import Distribution.Simple.LocalBuildInfo
, LibraryName (..)
)
import Distribution.Simple.Program
-import Distribution.Simple.Program.Db (configuredPrograms)
import Distribution.Simple.Setup
( DumpBuildInfo (..)
, HaddockTarget
@@ -113,9 +112,9 @@ import Distribution.Simple.Setup
)
import Distribution.Simple.Utils (ordNub)
import Distribution.Solver.Types.ComponentDeps (ComponentDeps)
+import Distribution.Solver.Types.System
import qualified Distribution.Solver.Types.ComponentDeps as CD
import Distribution.Solver.Types.OptionalStanza
-import Distribution.System
import Distribution.Types.ComponentRequestedSpec
import qualified Distribution.Types.LocalBuildConfig as LBC
import Distribution.Types.PackageDescription (PackageDescription (..))
@@ -916,23 +915,6 @@ componentOptionalStanza _ = Nothing
-- Toolchain
--
-data Toolchain = Toolchain
- { toolchainPlatform :: Platform
- , toolchainCompiler :: Compiler
- , toolchainProgramDb :: ProgramDb
- }
- deriving (Show, Generic, Typeable)
-
--- TODO: review this
-instance Eq Toolchain where
- lhs == rhs =
- (((==) `on` toolchainPlatform) lhs rhs)
- && (((==) `on` toolchainCompiler) lhs rhs)
- && ((((==)) `on` (configuredPrograms . toolchainProgramDb)) lhs rhs)
-
-instance Binary Toolchain
-instance Structured Toolchain
-
data Toolchains = Toolchains
{ buildToolchain :: Toolchain
, hostToolchain :: Toolchain
From 9a4f854e3da0a0113f6bfbd0e46c7118962de32f Mon Sep 17 00:00:00 2001
From: Andrea Bedini <andrea@andreabedini.com>
Date: Fri, 14 Mar 2025 17:30:03 +0800
Subject: [PATCH 18/82] wip
---
.../cabal-install-solver.cabal | 3 +-
.../src/Distribution/Solver/Types/Stage.hs | 18 ++
.../Distribution/Solver/Types/Toolchain.hs | 49 ++++++
.../Distribution/Client/ProjectPlanning.hs | 154 +++++++++---------
.../Client/ProjectPlanning/Types.hs | 20 +--
5 files changed, 151 insertions(+), 93 deletions(-)
create mode 100644 cabal-install-solver/src/Distribution/Solver/Types/Stage.hs
create mode 100644 cabal-install-solver/src/Distribution/Solver/Types/Toolchain.hs
diff --git a/cabal-install-solver/cabal-install-solver.cabal b/cabal-install-solver/cabal-install-solver.cabal
index 4a20a369fee..c1145254b6c 100644
--- a/cabal-install-solver/cabal-install-solver.cabal
+++ b/cabal-install-solver/cabal-install-solver.cabal
@@ -95,7 +95,8 @@ library
Distribution.Solver.Types.SolverId
Distribution.Solver.Types.SolverPackage
Distribution.Solver.Types.SourcePackage
- Distribution.Solver.Types.System
+ Distribution.Solver.Types.Stage
+ Distribution.Solver.Types.Toolchain
Distribution.Solver.Types.Variable
build-depends:
diff --git a/cabal-install-solver/src/Distribution/Solver/Types/Stage.hs b/cabal-install-solver/src/Distribution/Solver/Types/Stage.hs
new file mode 100644
index 00000000000..0365ef515c1
--- /dev/null
+++ b/cabal-install-solver/src/Distribution/Solver/Types/Stage.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module Distribution.Solver.Types.Stage
+ ( Stage (..)
+ ) where
+
+import Distribution.Compat.Prelude
+import Prelude ()
+
+data Stage
+ = -- | -- The system where the build is running
+ Build
+ | -- | -- The system where the built artifacts will run
+ Host
+ deriving (Eq, Read, Show, Generic, Typeable)
+
+instance Binary Stage
+instance Structured Stage
diff --git a/cabal-install-solver/src/Distribution/Solver/Types/Toolchain.hs b/cabal-install-solver/src/Distribution/Solver/Types/Toolchain.hs
new file mode 100644
index 00000000000..182101b8899
--- /dev/null
+++ b/cabal-install-solver/src/Distribution/Solver/Types/Toolchain.hs
@@ -0,0 +1,49 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module Distribution.Solver.Types.Toolchain
+ ( Toolchain (..)
+ , Toolchains (..)
+ , toolchainFor
+ ) where
+
+import Distribution.Compat.Prelude
+import Prelude ()
+
+import Distribution.Simple.Compiler
+import Distribution.Simple.Program.Db
+import Distribution.Solver.Types.Stage (Stage (..))
+import Distribution.System
+
+---------------------------
+-- Toolchain
+--
+
+data Toolchain = Toolchain
+ { toolchainPlatform :: Platform
+ , toolchainCompiler :: Compiler
+ , toolchainProgramDb :: ProgramDb
+ }
+ deriving (Show, Generic, Typeable)
+
+-- TODO: review this
+instance Eq Toolchain where
+ lhs == rhs =
+ (((==) `on` toolchainPlatform) lhs rhs)
+ && (((==) `on` toolchainCompiler) lhs rhs)
+ && ((((==)) `on` (configuredPrograms . toolchainProgramDb)) lhs rhs)
+
+instance Binary Toolchain
+instance Structured Toolchain
+
+data Toolchains = Toolchains
+ { buildToolchain :: Toolchain
+ , hostToolchain :: Toolchain
+ }
+ deriving (Eq, Show, Generic, Typeable)
+
+toolchainFor :: Stage -> Toolchains -> Toolchain
+toolchainFor Build = buildToolchain
+toolchainFor Host = hostToolchain
+
+instance Binary Toolchains
+instance Structured Toolchains
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index f30e11ad23e..1990ad8a415 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -221,6 +221,8 @@ import qualified Distribution.Simple.InstallDirs as InstallDirs
import qualified Distribution.Simple.LocalBuildInfo as Cabal
import qualified Distribution.Simple.Setup as Cabal
import qualified Distribution.Solver.Types.ComponentDeps as CD
+import Distribution.Solver.Types.Stage
+import Distribution.Solver.Types.Toolchain
import qualified Distribution.Compat.Graph as Graph
@@ -1611,18 +1613,7 @@ elaborateInstallPlan
elaborateInstallPlan
verbosity
hookHashes
- toolchains@Toolchains
- { buildToolchain =
- Toolchain
- { toolchainCompiler = compiler
- , toolchainProgramDb = compilerprogdb
- }
- , hostToolchain =
- Toolchain
- { toolchainCompiler = hostCompiler
- , toolchainPlatform = hostPlatform
- }
- }
+ toolchains
pkgConfigDB
distDirLayout@DistDirLayout{..}
storeDirLayout@StoreDirLayout{storePackageDBStack}
@@ -2201,12 +2192,19 @@ elaborateInstallPlan
elabIsCanonical = True
elabPkgSourceId = pkgid
+
+ -- TODO: temporarily set everything to build on build
+ elabStage = Build
+ elabCompiler = toolchainCompiler (toolchainFor elabStage toolchains)
+ elabPlatform = toolchainPlatform (toolchainFor elabStage toolchains)
+ elabProgramDb = toolchainProgramDb (toolchainFor elabStage toolchains)
+
elabPkgDescription = case PD.finalizePD
flags
elabEnabledSpec
(const Satisfied)
- hostPlatform
- (compilerInfo hostCompiler)
+ elabPlatform
+ (compilerInfo elabCompiler)
[]
gdesc of
Right (desc, _) -> desc
@@ -2281,6 +2279,10 @@ elaborateInstallPlan
deps0
elabSetupPackageDBStack = buildAndRegisterDbs
+ inplacePackageDbs = corePackageDbs ++ [distPackageDB (compilerId elabCompiler)]
+
+ corePackageDbs = storePackageDBStack elabCompiler (projectConfigPackageDBs sharedPackageConfig)
+
elabInplaceBuildPackageDBStack = inplacePackageDbs
elabInplaceRegisterPackageDBStack = inplacePackageDbs
elabInplaceSetupPackageDBStack = inplacePackageDbs
@@ -2291,17 +2293,21 @@ elaborateInstallPlan
elabPkgDescriptionOverride = descOverride
+ pkgsUseSharedLibrary :: Set PackageId
+ pkgsUseSharedLibrary =
+ packagesWithLibDepsDownwardClosedProperty (needsSharedLib elabCompiler)
+
elabBuildOptions =
LBC.BuildOptions
{ withVanillaLib = perPkgOptionFlag pkgid True packageConfigVanillaLib -- TODO: [required feature]: also needs to be handled recursively
- , withSharedLib = canBuildSharedLibs && pkgid `Set.member` pkgsUseSharedLibrary
+ , withSharedLib = canBuildSharedLibs elabCompiler && pkgid `Set.member` pkgsUseSharedLibrary
, withStaticLib = perPkgOptionFlag pkgid False packageConfigStaticLib
, withDynExe = perPkgOptionFlag pkgid False packageConfigDynExe
, withFullyStaticExe = perPkgOptionFlag pkgid False packageConfigFullyStaticExe
, withGHCiLib = perPkgOptionFlag pkgid False packageConfigGHCiLib -- TODO: [required feature] needs to default to enabled on windows still
, withProfExe = perPkgOptionFlag pkgid False packageConfigProf
- , withProfLib = canBuildProfilingLibs && pkgid `Set.member` pkgsUseProfilingLibrary
- , withProfLibShared = canBuildProfilingSharedLibs && pkgid `Set.member` pkgsUseProfilingLibraryShared
+ , withProfLib = canBuildProfilingLibs elabCompiler && pkgid `Set.member` pkgsUseProfilingLibrary
+ , withProfLibShared = canBuildProfilingSharedLibs elabCompiler && pkgid `Set.member` pkgsUseProfilingLibraryShared
, exeCoverage = perPkgOptionFlag pkgid False packageConfigCoverage
, libCoverage = perPkgOptionFlag pkgid False packageConfigCoverage
, withOptimization = perPkgOptionFlag pkgid NormalOptimisation packageConfigOptimization
@@ -2334,13 +2340,13 @@ elaborateInstallPlan
elabProgramPaths =
Map.fromList
[ (programId prog, programPath prog)
- | prog <- configuredPrograms compilerprogdb
+ | prog <- configuredPrograms elabProgramDb
]
<> perPkgOptionMapLast pkgid packageConfigProgramPaths
elabProgramArgs =
Map.fromList
[ (programId prog, args)
- | prog <- configuredPrograms compilerprogdb
+ | prog <- configuredPrograms elabProgramDb
, let args = programOverrideArgs $ addHaddockIfDocumentationEnabled prog
, not (null args)
]
@@ -2422,12 +2428,6 @@ elaborateInstallPlan
mempty
perpkg = maybe mempty f (Map.lookup (packageName pkg) perPackageConfig)
- inplacePackageDbs =
- corePackageDbs
- ++ [distPackageDB (compilerId compiler)]
-
- corePackageDbs = storePackageDBStack compiler (projectConfigPackageDBs sharedPackageConfig)
-
-- For this local build policy, every package that lives in a local source
-- dir (as opposed to a tarball), or depends on such a package, will be
-- built inplace into a shared dist dir. Tarball packages that depend on
@@ -2458,13 +2458,13 @@ elaborateInstallPlan
-- TODO: localPackages is a misnomer, it's all project packages
-- here is where we decide which ones will be local!
- pkgsUseSharedLibrary :: Set PackageId
- pkgsUseSharedLibrary =
- packagesWithLibDepsDownwardClosedProperty needsSharedLib
+ pkgsUseProfilingLibrary :: Set PackageId
+ pkgsUseProfilingLibrary =
+ packagesWithLibDepsDownwardClosedProperty needsProfilingLib
- needsSharedLib pkgid =
+ needsSharedLib compiler pkgid =
fromMaybe
- compilerShouldUseSharedLibByDefault
+ (compilerShouldUseSharedLibByDefault compiler)
-- Case 1: --enable-shared or --disable-shared is passed explicitly, honour that.
( case pkgSharedLib of
Just v -> Just v
@@ -2475,7 +2475,7 @@ elaborateInstallPlan
-- Case 3: If --enable-profiling is passed, then we are going to
-- build profiled dynamic, so no need for shared libraries.
case pkgProf of
- Just True -> if canBuildProfilingSharedLibs then Nothing else Just True
+ Just True -> if canBuildProfilingSharedLibs compiler then Nothing else Just True
_ -> Just True
-- But don't necessarily turn off shared library generation if
-- --disable-executable-dynamic is passed. The shared objects might
@@ -2487,52 +2487,7 @@ elaborateInstallPlan
pkgDynExe = perPkgOptionMaybe pkgid packageConfigDynExe
pkgProf = perPkgOptionMaybe pkgid packageConfigProf
- -- TODO: [code cleanup] move this into the Cabal lib. It's currently open
- -- coded in Distribution.Simple.Configure, but should be made a proper
- -- function of the Compiler or CompilerInfo.
- compilerShouldUseSharedLibByDefault =
- case compilerFlavor compiler of
- GHC -> GHC.compilerBuildWay compiler == DynWay && canBuildSharedLibs
- GHCJS -> GHCJS.isDynamic compiler
- _ -> False
-
- compilerShouldUseProfilingLibByDefault =
- case compilerFlavor compiler of
- GHC -> GHC.compilerBuildWay compiler == ProfWay && canBuildProfilingLibs
- _ -> False
-
- compilerShouldUseProfilingSharedLibByDefault =
- case compilerFlavor compiler of
- GHC -> GHC.compilerBuildWay compiler == ProfDynWay && canBuildProfilingSharedLibs
- _ -> False
-
- -- Returns False if we definitely can't build shared libs
- canBuildWayLibs predicate = case predicate compiler of
- Just can_build -> can_build
- -- If we don't know for certain, just assume we can
- -- which matches behaviour in previous cabal releases
- Nothing -> True
-
- canBuildSharedLibs = canBuildWayLibs dynamicSupported
- canBuildProfilingLibs = canBuildWayLibs profilingVanillaSupported
- canBuildProfilingSharedLibs = canBuildWayLibs profilingDynamicSupported
-
- wayWarnings pkg = do
- when
- (needsProfilingLib pkg && not canBuildProfilingLibs)
- (warnProgress (text "Compiler does not support building p libraries, profiling is disabled"))
- when
- (needsSharedLib pkg && not canBuildSharedLibs)
- (warnProgress (text "Compiler does not support building dyn libraries, dynamic libraries are disabled"))
- when
- (needsProfilingLibShared pkg && not canBuildProfilingSharedLibs)
- (warnProgress (text "Compiler does not support building p_dyn libraries, profiling dynamic libraries are disabled."))
-
- pkgsUseProfilingLibrary :: Set PackageId
- pkgsUseProfilingLibrary =
- packagesWithLibDepsDownwardClosedProperty needsProfilingLib
-
- needsProfilingLib pkg =
+ needsProfilingLib compiler pkg =
fromFlagOrDefault compilerShouldUseProfilingLibByDefault (profBothFlag <> profLibFlag)
where
pkgid = packageId pkg
@@ -2590,6 +2545,51 @@ elaborateInstallPlan
-- package config validation/resolution pass.
]
+-- TODO: [code cleanup] move this into the Cabal lib. It's currently open
+-- coded in Distribution.Simple.Configure, but should be made a proper
+-- function of the Compiler or CompilerInfo.
+compilerShouldUseSharedLibByDefault :: Compiler -> Bool
+compilerShouldUseSharedLibByDefault compiler =
+ case compilerFlavor compiler of
+ GHC -> GHC.compilerBuildWay compiler == DynWay && canBuildSharedLibs compiler
+ GHCJS -> GHCJS.isDynamic compiler
+ _ -> False
+
+-- TODO: [code cleanup] move this into the Cabal lib.
+compilerShouldUseProfilingLibByDefault :: Compiler -> Bool
+compilerShouldUseProfilingLibByDefault compiler =
+ case compilerFlavor compiler of
+ GHC -> GHC.compilerBuildWay compiler == ProfWay && canBuildProfilingLibs compiler
+ _ -> False
+
+-- TODO: [code cleanup] move this into the Cabal lib.
+compilerShouldUseProfilingSharedLibByDefault :: Compiler -> Bool
+compilerShouldUseProfilingSharedLibByDefault compiler =
+ case compilerFlavor compiler of
+ GHC -> GHC.compilerBuildWay compiler == ProfDynWay && canBuildProfilingSharedLibs compiler
+ _ -> False
+
+-- Returns False if we definitely can't build shared libs
+-- TODO: [code cleanup] move this into the Cabal lib.
+canBuildWayLibs :: (t -> Maybe Bool) -> t -> Bool
+canBuildWayLibs predicate compiler = case predicate compiler of
+ Just can_build -> can_build
+ -- If we don't know for certain, just assume we can
+ -- which matches behaviour in previous cabal releases
+ Nothing -> True
+
+-- TODO: [code cleanup] move this into the Cabal lib.
+canBuildSharedLibs :: Compiler -> Bool
+canBuildSharedLibs = canBuildWayLibs dynamicSupported
+
+-- TODO: [code cleanup] move this into the Cabal lib.
+canBuildProfilingLibs :: Compiler -> Bool
+canBuildProfilingLibs = canBuildWayLibs profilingVanillaSupported
+
+-- TODO: [code cleanup] move this into the Cabal lib.
+canBuildProfilingSharedLibs :: Compiler -> Bool
+canBuildProfilingSharedLibs = canBuildWayLibs profilingDynamicSupported
+
-- TODO: [nice to have] config consistency checking:
-- + profiling libs & exes, exe needs lib, recursive
-- + shared libs & exes, exe needs lib, recursive
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs b/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs
index 7432e1897ae..16b791105ef 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs
@@ -112,7 +112,8 @@ import Distribution.Simple.Setup
)
import Distribution.Simple.Utils (ordNub)
import Distribution.Solver.Types.ComponentDeps (ComponentDeps)
-import Distribution.Solver.Types.System
+import Distribution.Solver.Types.Stage
+import Distribution.Solver.Types.Toolchain
import qualified Distribution.Solver.Types.ComponentDeps as CD
import Distribution.Solver.Types.OptionalStanza
import Distribution.Types.ComponentRequestedSpec
@@ -250,7 +251,9 @@ data ElaboratedConfiguredPackage = ElaboratedConfiguredPackage
-- to disable. This tells us which ones we build by default, and
-- helps with error messages when the user asks to build something
-- they explicitly disabled.
- --
+
+ , elabStage :: Stage
+
-- TODO: The 'Bool' here should be refined into an ADT with three
-- cases: NotRequested, ExplicitlyRequested and
-- ImplicitlyRequested. A stanza is explicitly requested if
@@ -911,19 +914,6 @@ componentOptionalStanza (CD.ComponentTest _) = Just TestStanzas
componentOptionalStanza (CD.ComponentBench _) = Just BenchStanzas
componentOptionalStanza _ = Nothing
----------------------------
--- Toolchain
---
-
-data Toolchains = Toolchains
- { buildToolchain :: Toolchain
- , hostToolchain :: Toolchain
- }
- deriving (Eq, Show, Generic, Typeable)
-
-instance Binary Toolchains
-instance Structured Toolchains
-
---------------------------
-- Setup.hs script policy
--
From 27a5f68b95c6853b5ca12a794985ab6d9849072d Mon Sep 17 00:00:00 2001
From: Andrea Bedini <andrea@andreabedini.com>
Date: Mon, 17 Mar 2025 11:49:51 +0800
Subject: [PATCH 19/82] drop elaborationWarnings
---
.../Distribution/Client/ProjectPlanning.hs | 31 +++++++++----------
1 file changed, 15 insertions(+), 16 deletions(-)
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index 1990ad8a415..7630d0050bf 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -1693,7 +1693,6 @@ elaborateInstallPlan
let whyNotPerComp = why_not_per_component src_comps
case NE.nonEmpty whyNotPerComp of
Nothing -> do
- elaborationWarnings
return comps
Just notPerCompReasons -> do
checkPerPackageOk comps notPerCompReasons
@@ -1766,7 +1765,7 @@ elaborateInstallPlan
<+> fsep (punctuate comma $ map (text . whyNotPerComponent) $ toList reasons)
-- TODO: Maybe exclude Backpack too
- (elab0, elaborationWarnings) = elaborateSolverToCommon spkg
+ elab0 = elaborateSolverToCommon spkg
pkgid = elabPkgSourceId elab0
pd = elabPkgDescription elab0
@@ -2078,11 +2077,17 @@ elaborateInstallPlan
-- Knot tying: the final elab includes the
-- pkgInstalledId, which is calculated by hashing many
-- of the other fields of the elaboratedPackage.
- elaborationWarnings
return elab
where
- (elab0@ElaboratedConfiguredPackage{..}, elaborationWarnings) =
- elaborateSolverToCommon pkg
+ elab =
+ elab1
+ { elabInstallDirs =
+ computeInstallDirs
+ storeDirLayout
+ defaultInstallDirs
+ elaboratedSharedConfig
+ elab1
+ }
elab1 =
elab0
@@ -2093,15 +2098,9 @@ elaborateInstallPlan
, elabModuleShape = modShape
}
- elab =
- elab1
- { elabInstallDirs =
- computeInstallDirs
- storeDirLayout
- defaultInstallDirs
- elaboratedSharedConfig
- elab1
- }
+ elab0@ElaboratedConfiguredPackage{..} =
+ elaborateSolverToCommon pkg
+
modShape = case find (matchElabPkg (== (CLibName LMainLibName))) comps of
Nothing -> emptyModuleShape
@@ -2167,7 +2166,7 @@ elaborateInstallPlan
elaborateSolverToCommon
:: SolverPackage UnresolvedPkgLoc
- -> (ElaboratedConfiguredPackage, LogProgress ())
+ -> ElaboratedConfiguredPackage
elaborateSolverToCommon
pkg@( SolverPackage
qpn
@@ -2177,7 +2176,7 @@ elaborateInstallPlan
deps0
_exe_deps0
) =
- (elaboratedPackage, wayWarnings pkgid)
+ elaboratedPackage
where
elaboratedPackage = ElaboratedConfiguredPackage{..}
From bf465c1f4c7f8210f617f7d7316a611666d542c5 Mon Sep 17 00:00:00 2001
From: Andrea Bedini <andrea@andreabedini.com>
Date: Mon, 17 Mar 2025 11:52:39 +0800
Subject: [PATCH 20/82] needsProfilingLib cannot per per compiler just yet
I would need to rework packagesWithLibDepsDownwardClosedProperty. It has
to be done but not now.
---
.../Distribution/Client/ProjectPlanning.hs | 67 ++++++++++---------
1 file changed, 35 insertions(+), 32 deletions(-)
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index 7630d0050bf..af9c8b8a895 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -2486,9 +2486,10 @@ elaborateInstallPlan
pkgDynExe = perPkgOptionMaybe pkgid packageConfigDynExe
pkgProf = perPkgOptionMaybe pkgid packageConfigProf
- needsProfilingLib compiler pkg =
- fromFlagOrDefault compilerShouldUseProfilingLibByDefault (profBothFlag <> profLibFlag)
+ needsProfilingLib pkg = fromFlagOrDefault False (profBothFlag <> profLibFlag)
where
+ -- fromFlagOrDefault compilerShouldUseProfilingLibByDefault (profBothFlag <> profLibFlag)
+
pkgid = packageId pkg
profBothFlag = lookupPerPkgOption pkgid packageConfigProf
profLibFlag = lookupPerPkgOption pkgid packageConfigProfLib
@@ -2497,24 +2498,26 @@ elaborateInstallPlan
pkgsUseProfilingLibraryShared =
packagesWithLibDepsDownwardClosedProperty needsProfilingLibShared
+ -- TODO: review this logic
needsProfilingLibShared pkg =
- fromMaybe
- compilerShouldUseProfilingSharedLibByDefault
- -- case 1: If --enable-profiling-shared is passed explicitly, honour that
- ( case profLibSharedFlag of
- Just v -> Just v
- Nothing -> case pkgDynExe of
- Just True ->
- case pkgProf of
- -- case 2: --enable-executable-dynamic + --enable-profiling
- -- turn on shared profiling libraries
- Just True -> if canBuildProfilingSharedLibs then Just True else Nothing
- _ -> Nothing
- -- But don't necessarily turn off shared library generation is
- -- --disable-executable-dynamic is passed. The shared objects might
- -- be needed for something different.
- _ -> Nothing
- )
+ -- fromMaybe
+ -- compilerShouldUseProfilingSharedLibByDefault
+ -- -- case 1: If --enable-profiling-shared is passed explicitly, honour that
+ case profLibSharedFlag of
+ Just v -> v
+ Nothing -> case pkgDynExe of
+ Just True ->
+ case pkgProf of
+ -- case 2: --enable-executable-dynamic + --enable-profiling
+ -- turn on shared profiling libraries
+ -- Just True -> if canBuildProfilingSharedLibs then Just True else Nothing
+ Just True -> True
+ _ -> False
+ -- But don't necessarily turn off shared library generation is
+ -- --disable-executable-dynamic is passed. The shared objects might
+ -- be needed for something different.
+ -- _ -> Nothing
+ _ -> False
where
pkgid = packageId pkg
profLibSharedFlag = perPkgOptionMaybe pkgid packageConfigProfShared
@@ -2554,19 +2557,19 @@ compilerShouldUseSharedLibByDefault compiler =
GHCJS -> GHCJS.isDynamic compiler
_ -> False
--- TODO: [code cleanup] move this into the Cabal lib.
-compilerShouldUseProfilingLibByDefault :: Compiler -> Bool
-compilerShouldUseProfilingLibByDefault compiler =
- case compilerFlavor compiler of
- GHC -> GHC.compilerBuildWay compiler == ProfWay && canBuildProfilingLibs compiler
- _ -> False
-
--- TODO: [code cleanup] move this into the Cabal lib.
-compilerShouldUseProfilingSharedLibByDefault :: Compiler -> Bool
-compilerShouldUseProfilingSharedLibByDefault compiler =
- case compilerFlavor compiler of
- GHC -> GHC.compilerBuildWay compiler == ProfDynWay && canBuildProfilingSharedLibs compiler
- _ -> False
+-- -- TODO: [code cleanup] move this into the Cabal lib.
+-- compilerShouldUseProfilingLibByDefault :: Compiler -> Bool
+-- compilerShouldUseProfilingLibByDefault compiler =
+-- case compilerFlavor compiler of
+-- GHC -> GHC.compilerBuildWay compiler == ProfWay && canBuildProfilingLibs compiler
+-- _ -> False
+
+-- -- TODO: [code cleanup] move this into the Cabal lib.
+-- compilerShouldUseProfilingSharedLibByDefault :: Bool
+-- compilerShouldUseProfilingSharedLibByDefault =
+-- case compilerFlavor compiler of
+-- GHC -> GHC.compilerBuildWay compiler == ProfDynWay && canBuildProfilingSharedLibs compiler
+-- _ -> False
-- Returns False if we definitely can't build shared libs
-- TODO: [code cleanup] move this into the Cabal lib.
From da1abc650c7fe6a6e0d5b286b3ef20cdbdba4a26 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Sat, 15 Mar 2025 20:44:18 +0900
Subject: [PATCH 21/82] Add CompilerId to IPI
---
Cabal-syntax/src/Distribution/Compiler.hs | 11 ++++++++++-
.../src/Distribution/Types/InstalledPackageInfo.hs | 2 ++
.../Types/InstalledPackageInfo/FieldGrammar.hs | 3 +++
.../Distribution/Types/InstalledPackageInfo/Lens.hs | 5 +++++
Cabal/src/Distribution/Simple/GHC.hs | 1 +
5 files changed, 21 insertions(+), 1 deletion(-)
diff --git a/Cabal-syntax/src/Distribution/Compiler.hs b/Cabal-syntax/src/Distribution/Compiler.hs
index 40148776ee1..879547234ae 100644
--- a/Cabal-syntax/src/Distribution/Compiler.hs
+++ b/Cabal-syntax/src/Distribution/Compiler.hs
@@ -184,12 +184,18 @@ instance Pretty CompilerId where
| v == nullVersion = pretty f
| otherwise = pretty f <<>> Disp.char '-' <<>> pretty v
+instance Pretty (Maybe CompilerId) where
+ pretty = maybe Disp.empty pretty
+
instance Parsec CompilerId where
parsec = do
flavour <- parsec
version <- (P.char '-' >> parsec) <|> return nullVersion
return (CompilerId flavour version)
+instance Parsec (Maybe CompilerId) where
+ parsec = Just <$> parsec <|> return Nothing
+
lowercase :: String -> String
lowercase = map toLower
@@ -216,9 +222,11 @@ data CompilerInfo = CompilerInfo
, compilerInfoExtensions :: Maybe [Extension]
-- ^ Supported extensions, if known.
}
- deriving (Generic, Show, Read)
+ deriving (Generic, Show, Read, Eq)
instance Binary CompilerInfo
+instance Structured CompilerInfo
+instance NFData CompilerInfo where rnf = genericRnf
data AbiTag
= NoAbiTag
@@ -227,6 +235,7 @@ data AbiTag
instance Binary AbiTag
instance Structured AbiTag
+instance NFData AbiTag where rnf = genericRnf
instance Pretty AbiTag where
pretty NoAbiTag = Disp.empty
diff --git a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs
index f57457d2e5b..03c0b9cae3c 100644
--- a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs
+++ b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs
@@ -16,6 +16,7 @@ import Prelude ()
import Distribution.Backpack
import Distribution.Compat.Graph (IsNode (..))
+import Distribution.Compiler (CompilerId)
import Distribution.License
import Distribution.ModuleName
import Distribution.Package hiding (installedUnitId)
@@ -93,6 +94,7 @@ data InstalledPackageInfo = InstalledPackageInfo
, haddockInterfaces :: [FilePath]
, haddockHTMLs :: [FilePath]
, pkgRoot :: Maybe FilePath
+ , pkgCompiler :: Maybe CompilerId
}
deriving (Eq, Generic, Read, Show)
diff --git a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs
index 7578907b590..c2e77292c07 100644
--- a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs
+++ b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs
@@ -15,6 +15,7 @@ import Distribution.Backpack
import Distribution.CabalSpecVersion
import Distribution.Compat.Lens (Lens', (&), (.~))
import Distribution.Compat.Newtype
+import Distribution.Compiler (CompilerId(..))
import Distribution.FieldGrammar
import Distribution.FieldGrammar.FieldDescrs
import Distribution.License
@@ -73,6 +74,7 @@ ipiFieldGrammar
, c ExposedModules
, c InstWith
, c SpecLicenseLenient
+ , c (Identity (Maybe CompilerId))
)
=> g InstalledPackageInfo InstalledPackageInfo
ipiFieldGrammar =
@@ -125,6 +127,7 @@ ipiFieldGrammar =
<@> monoidalFieldAla "haddock-interfaces" (alaList' FSep FilePathNT) L.haddockInterfaces
<@> monoidalFieldAla "haddock-html" (alaList' FSep FilePathNT) L.haddockHTMLs
<@> optionalFieldAla "pkgroot" FilePathNT L.pkgRoot
+ <@> optionalFieldDef "compiler" L.pkgCompiler Nothing
where
mkInstalledPackageInfo _ Basic{..} =
InstalledPackageInfo
diff --git a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/Lens.hs b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/Lens.hs
index 47fa1c96f40..9e7798e443d 100644
--- a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/Lens.hs
+++ b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/Lens.hs
@@ -7,6 +7,7 @@ import Distribution.Compat.Lens
import Distribution.Compat.Prelude
import Prelude ()
+import Distribution.Compiler (CompilerId)
import Distribution.Backpack (OpenModule)
import Distribution.License (License)
import Distribution.ModuleName (ModuleName)
@@ -194,3 +195,7 @@ pkgRoot f s = fmap (\x -> s{T.pkgRoot = x}) (f (T.pkgRoot s))
libVisibility :: Lens' InstalledPackageInfo LibraryVisibility
libVisibility f s = fmap (\x -> s{T.libVisibility = x}) (f (T.libVisibility s))
{-# INLINE libVisibility #-}
+
+pkgCompiler :: Lens' InstalledPackageInfo (Maybe CompilerId)
+pkgCompiler f s = fmap (\x -> s{T.pkgCompiler = x}) (f (T.pkgCompiler s))
+{-# INLINE pkgCompiler #-}
diff --git a/Cabal/src/Distribution/Simple/GHC.hs b/Cabal/src/Distribution/Simple/GHC.hs
index 45fbee0fed1..9d02cac5fac 100644
--- a/Cabal/src/Distribution/Simple/GHC.hs
+++ b/Cabal/src/Distribution/Simple/GHC.hs
@@ -418,6 +418,7 @@ getInstalledPackages
-> ProgramDb
-> IO InstalledPackageIndex
getInstalledPackages verbosity comp mbWorkDir packagedbs progdb = do
+ print $ ("getInstalledPackages", (compilerId comp), packagedbs)
checkPackageDbEnvVar verbosity
checkPackageDbStack verbosity comp packagedbs
pkgss <- getInstalledPackages' verbosity mbWorkDir packagedbs progdb
From b3ae65d5459ffe02f88a5a5f0d93fa03346a09cd Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Sat, 15 Mar 2025 21:10:34 +0900
Subject: [PATCH 22/82] Cleanup and Add the compilerId to the
installedPackageIndex
---
Cabal-syntax/src/Distribution/Compiler.hs | 1 +
Cabal/src/Distribution/Simple/GHC.hs | 7 +++++--
Cabal/src/Distribution/Simple/Register.hs | 1 +
3 files changed, 7 insertions(+), 2 deletions(-)
diff --git a/Cabal-syntax/src/Distribution/Compiler.hs b/Cabal-syntax/src/Distribution/Compiler.hs
index 879547234ae..cef915a25d3 100644
--- a/Cabal-syntax/src/Distribution/Compiler.hs
+++ b/Cabal-syntax/src/Distribution/Compiler.hs
@@ -1,6 +1,7 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE FlexibleInstances #-}
-----------------------------------------------------------------------------
diff --git a/Cabal/src/Distribution/Simple/GHC.hs b/Cabal/src/Distribution/Simple/GHC.hs
index 9d02cac5fac..a41c6d4a5d9 100644
--- a/Cabal/src/Distribution/Simple/GHC.hs
+++ b/Cabal/src/Distribution/Simple/GHC.hs
@@ -88,7 +88,7 @@ import Control.Monad (forM_)
import Data.List (stripPrefix)
import qualified Data.Map as Map
import Distribution.CabalSpecVersion
-import Distribution.InstalledPackageInfo (InstalledPackageInfo)
+import Distribution.InstalledPackageInfo (InstalledPackageInfo(pkgCompiler))
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
import Distribution.Package
import Distribution.PackageDescription as PD
@@ -422,7 +422,10 @@ getInstalledPackages verbosity comp mbWorkDir packagedbs progdb = do
checkPackageDbEnvVar verbosity
checkPackageDbStack verbosity comp packagedbs
pkgss <- getInstalledPackages' verbosity mbWorkDir packagedbs progdb
- index <- toPackageIndex verbosity pkgss progdb
+ let pkgss' = [ (packagedb, (\pkg -> pkg{pkgCompiler = Just (compilerId comp)}) <$> pkgs)
+ | (packagedb, pkgs) <- pkgss
+ ]
+ index <- toPackageIndex verbosity pkgss' progdb
return $! hackRtsPackage index
where
hackRtsPackage index =
diff --git a/Cabal/src/Distribution/Simple/Register.hs b/Cabal/src/Distribution/Simple/Register.hs
index 0bd7312cbc4..f5078f69f3d 100644
--- a/Cabal/src/Distribution/Simple/Register.hs
+++ b/Cabal/src/Distribution/Simple/Register.hs
@@ -553,6 +553,7 @@ generalInstalledPackageInfo adjustRelIncDirs pkg abi_hash lib lbi clbi installDi
, IPI.haddockHTMLs = [htmldir installDirs | hasModules]
, IPI.pkgRoot = Nothing
, IPI.libVisibility = libVisibility lib
+ , IPI.pkgCompiler = Nothing
}
where
ghc84 = case compilerId $ compiler lbi of
From cca7205a2641710274cbc1acf2a67b2290591f9d Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Mon, 17 Mar 2025 10:09:20 +0900
Subject: [PATCH 23/82] Ensure dependency unit-ids are updated correctly.
---
Cabal/src/Distribution/Simple/GHC.hs | 7 +++++--
1 file changed, 5 insertions(+), 2 deletions(-)
diff --git a/Cabal/src/Distribution/Simple/GHC.hs b/Cabal/src/Distribution/Simple/GHC.hs
index a41c6d4a5d9..04280e5e0eb 100644
--- a/Cabal/src/Distribution/Simple/GHC.hs
+++ b/Cabal/src/Distribution/Simple/GHC.hs
@@ -88,7 +88,7 @@ import Control.Monad (forM_)
import Data.List (stripPrefix)
import qualified Data.Map as Map
import Distribution.CabalSpecVersion
-import Distribution.InstalledPackageInfo (InstalledPackageInfo(pkgCompiler))
+import Distribution.InstalledPackageInfo (InstalledPackageInfo)
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
import Distribution.Package
import Distribution.PackageDescription as PD
@@ -422,7 +422,10 @@ getInstalledPackages verbosity comp mbWorkDir packagedbs progdb = do
checkPackageDbEnvVar verbosity
checkPackageDbStack verbosity comp packagedbs
pkgss <- getInstalledPackages' verbosity mbWorkDir packagedbs progdb
- let pkgss' = [ (packagedb, (\pkg -> pkg{pkgCompiler = Just (compilerId comp)}) <$> pkgs)
+ let pkgss' = [ (packagedb, (\pkg -> pkg{ InstalledPackageInfo.pkgCompiler = Just (compilerId comp)
+ ,InstalledPackageInfo.installedUnitId = ((\x -> mkUnitId $ prettyShow (compilerId comp) ++ ":" ++ (unUnitId x)) . InstalledPackageInfo.installedUnitId) pkg
+ ,InstalledPackageInfo.depends = (map (\x -> mkUnitId $ prettyShow (compilerId comp) ++ ":" ++ (unUnitId x)) . InstalledPackageInfo.depends) pkg })
+ <$> pkgs)
| (packagedb, pkgs) <- pkgss
]
index <- toPackageIndex verbosity pkgss' progdb
From a68d450acd0586a5f20827680739f05de08daecd Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Mon, 17 Mar 2025 13:16:41 +0900
Subject: [PATCH 24/82] Plan with build _and_ host package indices.
---
.../src/Distribution/Client/ProjectPlanning.hs | 11 ++++++++---
1 file changed, 8 insertions(+), 3 deletions(-)
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index af9c8b8a895..73b9d02c0a5 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -770,7 +770,12 @@ rebuildInstallPlan
, hookHashes
)
$ do
- installedPkgIndex <-
+ hinstalledPkgIndex <-
+ getInstalledPackages
+ verbosity
+ (hostToolchain toolchains)
+ corePackageDbs
+ binstalledPkgIndex <-
getInstalledPackages
verbosity
(buildToolchain toolchains)
@@ -796,9 +801,9 @@ rebuildInstallPlan
foldProgress logMsg (pure . Left) (pure . Right) $
planPackages
verbosity
- (hostToolchain toolchains)
+ (hostToolchain toolchains) -- FIXME: this should be `toolchains`.
solverSettings
- (installedPackages <> installedPkgIndex)
+ (installedPackages <> hinstalledPkgIndex <> binstalledPkgIndex)
sourcePkgDb
pkgConfigDB
localPackages
From ddbdd71929a4d5d6b53af2eca47235ced2074aaa Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Fri, 14 Mar 2025 14:01:43 +0900
Subject: [PATCH 25/82] Add Stage = Host | Build
---
.../Solver/Modular/ConfiguredConversion.hs | 6 +++---
.../Distribution/Solver/Modular/Explore.hs | 2 +-
.../src/Distribution/Solver/Modular/Index.hs | 15 +++++++++++++++
.../Solver/Modular/IndexConversion.hs | 4 ++--
.../Distribution/Solver/Modular/Package.hs | 19 ++++++++++++++-----
.../Distribution/Solver/Modular/Preference.hs | 12 ++++++------
.../Distribution/Solver/Modular/Validate.hs | 4 ++--
7 files changed, 43 insertions(+), 19 deletions(-)
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs b/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs
index 89b57e2c783..670850a9439 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs
@@ -29,7 +29,7 @@ convCP :: SI.InstalledPackageIndex ->
convCP iidx sidx (CP qpi fa es ds) =
case qpi of
-- Installed
- (PI qpn (I _ (Inst pi))) ->
+ (PI qpn (I {- FIXME -} Host _ (Inst pi))) ->
PreExisting $
InstSolverPackage {
instSolverQPN = qpn,
@@ -38,7 +38,7 @@ convCP iidx sidx (CP qpi fa es ds) =
instSolverPkgExeDeps = fmap snd ds'
}
-- "In repo" i.e. a source package
- (PI qpn@(Q _path pn) (I v InRepo)) ->
+ (PI qpn@(Q _path pn) (I {- FIXME -} Host v InRepo)) ->
let pi = PackageIdentifier pn v in
Configured $
SolverPackage {
@@ -54,7 +54,7 @@ convCP iidx sidx (CP qpi fa es ds) =
ds' = fmap (partitionEithers . map convConfId) ds
convConfId :: PI QPN -> Either SolverId {- is lib -} SolverId {- is exe -}
-convConfId (PI (Q (PackagePath _ q) pn) (I v loc)) =
+convConfId (PI (Q (PackagePath _ q) pn) (I _stage v loc)) =
case loc of
Inst pi ->
Left (PreExistingId sourceId pi)
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Explore.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Explore.hs
index d047ecda38e..8dfa9c88bf3 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/Explore.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/Explore.hs
@@ -268,7 +268,7 @@ exploreLog mbj enableBj fineGrainedConflicts (CountConflicts countConflicts) idx
-- Skipping it is an optimization. If false, it returns a new conflict set
-- to be merged with the previous one.
couldResolveConflicts :: QPN -> POption -> S.Set CS.Conflict -> Maybe ConflictSet
- couldResolveConflicts currentQPN@(Q _ pn) (POption i@(I v _) _) conflicts =
+ couldResolveConflicts currentQPN@(Q _ pn) (POption i@(I _stage v _) _) conflicts =
let (PInfo deps _ _ _) = idx M.! pn M.! i
qdeps = qualifyDeps currentQPN deps
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Index.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Index.hs
index 28ed5c9cd2d..85e158a3182 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/Index.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/Index.hs
@@ -56,3 +56,18 @@ mkIndex xs = M.map M.fromList (groupMap (L.map (\ (pn, i, pi) -> (pn, (i, pi)))
groupMap :: Ord a => [(a, b)] -> Map a [b]
groupMap xs = M.fromListWith (flip (++)) (L.map (\ (x, y) -> (x, [y])) xs)
+
+defaultQualifyOptions :: Index -> QualifyOptions
+defaultQualifyOptions idx = QO {
+ qoBaseShim = or [ dep == base
+ | -- Find all versions of base ..
+ Just is <- [M.lookup base idx]
+ -- .. which are installed ..
+ , (I _ver _stage (Inst _), PInfo deps _comps _flagNfo _fr) <- M.toList is
+ -- .. and flatten all their dependencies ..
+ , (LDep _ (Dep (PkgComponent dep _) _ci), _comp) <- flattenFlaggedDeps deps
+ ]
+ , qoSetupIndependent = True
+ }
+ where
+ base = mkPackageName "base"
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs b/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs
index 72d0b8193e3..b8ad3e4949a 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs
@@ -81,7 +81,7 @@ convIPI' (ShadowPkgs sip) idx =
-- | Extract/recover the package ID from an installed package info, and convert it to a solver's I.
convId :: IPI.InstalledPackageInfo -> (PN, I)
-convId ipi = (pn, I ver $ Inst $ IPI.installedUnitId ipi)
+convId ipi = (pn, I {- FIXME -} Host ver $ Inst $ IPI.installedUnitId ipi)
where MungedPackageId mpn ver = mungedId ipi
-- HACK. See Note [Index conversion with internal libraries]
pn = encodeCompatPackageName mpn
@@ -163,7 +163,7 @@ convSPI' os arch cinfo constraints strfl solveExes =
convSP :: OS -> Arch -> CompilerInfo -> Map PN [LabeledPackageConstraint]
-> StrongFlags -> SolveExecutables -> SourcePackage loc -> (PN, I, PInfo)
convSP os arch cinfo constraints strfl solveExes (SourcePackage (PackageIdentifier pn pv) gpd _ _pl) =
- let i = I pv InRepo
+ let i = I {- FIXME -} Host pv InRepo
pkgConstraints = fromMaybe [] $ M.lookup pn constraints
in (pn, i, convGPD os arch cinfo pkgConstraints strfl solveExes pn gpd)
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Package.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Package.hs
index 6b35808902a..2b4a423adcc 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/Package.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/Package.hs
@@ -1,6 +1,7 @@
{-# LANGUAGE DeriveFunctor #-}
module Distribution.Solver.Modular.Package
( I(..)
+ , Stage(..)
, Loc(..)
, PackageId
, PackageIdentifier(..)
@@ -49,14 +50,22 @@ type PId = UnitId
data Loc = Inst PId | InRepo
deriving (Eq, Ord, Show)
+-- | Stage. A stage in the build process.
+data Stage = Build | Host
+ deriving (Eq, Ord, Show)
+
+showStage :: Stage -> String
+showStage Build = "[build]"
+showStage Host = "[host ]"
+
-- | Instance. A version number and a location.
-data I = I Ver Loc
+data I = I Stage Ver Loc
deriving (Eq, Ord, Show)
-- | String representation of an instance.
showI :: I -> String
-showI (I v InRepo) = showVer v
-showI (I v (Inst uid)) = showVer v ++ "/installed" ++ extractPackageAbiHash uid
+showI (I s v InRepo) = showStage s ++ showVer v
+showI (I s v (Inst uid)) = showStage s ++ showVer v ++ "/installed" ++ extractPackageAbiHash uid
where
extractPackageAbiHash xs =
case first reverse $ break (=='-') $ reverse (prettyShow xs) of
@@ -72,8 +81,8 @@ showPI :: PI QPN -> String
showPI (PI qpn i) = showQPN qpn ++ "-" ++ showI i
instI :: I -> Bool
-instI (I _ (Inst _)) = True
-instI _ = False
+instI (I _ _ (Inst _)) = True
+instI _ = False
-- | Qualify a target package with its own name so that its dependencies are not
-- required to be consistent with other targets.
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Preference.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Preference.hs
index 9e0d5fb4d22..c8bf9209528 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/Preference.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/Preference.hs
@@ -72,7 +72,7 @@ addWeight :: (PN -> [Ver] -> POption -> Weight) -> EndoTreeTrav d c
addWeight f = addWeights [f]
version :: POption -> Ver
-version (POption (I v _) _) = v
+version (POption (I _ v _) _) = v
-- | Prefer to link packages whenever possible.
preferLinked :: EndoTreeTrav d c
@@ -139,8 +139,8 @@ preferPackagePreferences pcs =
-- Prefer installed packages over non-installed packages.
installed :: POption -> Weight
- installed (POption (I _ (Inst _)) _) = 0
- installed _ = 1
+ installed (POption (I _ _ (Inst _)) _) = 0
+ installed _ = 1
-- | Traversal that tries to establish package stanza enable\/disable
-- preferences. Works by reordering the branches of stanza choices.
@@ -184,7 +184,7 @@ processPackageConstraintP qpn c i (LabeledPackageConstraint (PackageConstraint s
else r
where
go :: I -> PackageProperty -> Tree d c
- go (I v _) (PackagePropertyVersion vr)
+ go (I _stage v _) (PackagePropertyVersion vr)
| checkVR vr v = r
| otherwise = Fail c (GlobalConstraintVersion vr src)
go _ PackagePropertyInstalled
@@ -338,10 +338,10 @@ avoidReinstalls p = go
| otherwise = PChoiceF qpn rdm gr cs
where
disableReinstalls =
- let installed = [ v | (_, POption (I v (Inst _)) _, _) <- W.toList cs ]
+ let installed = [ v | (_, POption (I _stage v (Inst _)) _, _) <- W.toList cs ]
in W.mapWithKey (notReinstall installed) cs
- notReinstall vs (POption (I v InRepo) _) _ | v `elem` vs =
+ notReinstall vs (POption (I _stage v InRepo) _) _ | v `elem` vs =
Fail (varToConflictSet (P qpn)) CannotReinstall
notReinstall _ _ x =
x
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs
index d6de20cc1de..e0ad47e32b8 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs
@@ -449,14 +449,14 @@ merge (MergedDepFixed comp1 vs1 i1) (PkgDep vs2 (PkgComponent p comp2) ci@(Fixed
, ( ConflictingDep vs1 (PkgComponent p comp1) (Fixed i1)
, ConflictingDep vs2 (PkgComponent p comp2) ci ) )
-merge (MergedDepFixed comp1 vs1 i@(I v _)) (PkgDep vs2 (PkgComponent p comp2) ci@(Constrained vr))
+merge (MergedDepFixed comp1 vs1 i@(I _stage v _)) (PkgDep vs2 (PkgComponent p comp2) ci@(Constrained vr))
| checkVR vr v = Right $ MergedDepFixed comp1 vs1 i
| otherwise =
Left ( createConflictSetForVersionConflict p v vs1 vr vs2
, ( ConflictingDep vs1 (PkgComponent p comp1) (Fixed i)
, ConflictingDep vs2 (PkgComponent p comp2) ci ) )
-merge (MergedDepConstrained vrOrigins) (PkgDep vs2 (PkgComponent p comp2) ci@(Fixed i@(I v _))) =
+merge (MergedDepConstrained vrOrigins) (PkgDep vs2 (PkgComponent p comp2) ci@(Fixed i@(I _stage v _))) =
go vrOrigins -- I tried "reverse vrOrigins" here, but it seems to slow things down ...
where
go :: [VROrigin] -> Either (ConflictSet, (ConflictingDep, ConflictingDep)) MergedPkgDep
From 08db0c17403522d3c51cbf983f44e0e37bf8ada3 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Tue, 18 Mar 2025 10:05:29 +0900
Subject: [PATCH 26/82] Fixup pkgCompiler
---
Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs | 1 +
1 file changed, 1 insertion(+)
diff --git a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs
index 03c0b9cae3c..defb1922607 100644
--- a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs
+++ b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs
@@ -176,4 +176,5 @@ emptyInstalledPackageInfo =
, haddockHTMLs = []
, pkgRoot = Nothing
, libVisibility = LibraryVisibilityPrivate
+ , pkgCompiler = Nothing
}
From c83ed1caf1a47d5f486655dd71489792629f2ee1 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Tue, 18 Mar 2025 10:05:38 +0900
Subject: [PATCH 27/82] Fixup cherry-pick
---
.../src/Distribution/Solver/Modular/Index.hs | 14 --------------
1 file changed, 14 deletions(-)
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Index.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Index.hs
index 85e158a3182..1f84e0ba161 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/Index.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/Index.hs
@@ -57,17 +57,3 @@ mkIndex xs = M.map M.fromList (groupMap (L.map (\ (pn, i, pi) -> (pn, (i, pi)))
groupMap :: Ord a => [(a, b)] -> Map a [b]
groupMap xs = M.fromListWith (flip (++)) (L.map (\ (x, y) -> (x, [y])) xs)
-defaultQualifyOptions :: Index -> QualifyOptions
-defaultQualifyOptions idx = QO {
- qoBaseShim = or [ dep == base
- | -- Find all versions of base ..
- Just is <- [M.lookup base idx]
- -- .. which are installed ..
- , (I _ver _stage (Inst _), PInfo deps _comps _flagNfo _fr) <- M.toList is
- -- .. and flatten all their dependencies ..
- , (LDep _ (Dep (PkgComponent dep _) _ci), _comp) <- flattenFlaggedDeps deps
- ]
- , qoSetupIndependent = True
- }
- where
- base = mkPackageName "base"
From 5f7fbb8d188596bf4927796b8eae8b4fd802cffb Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Tue, 18 Mar 2025 10:51:30 +0900
Subject: [PATCH 28/82] Thread toolchains everywhere.
---
.../src/Distribution/Solver/Modular.hs | 17 +++++----
.../Solver/Modular/IndexConversion.hs | 32 +++++++++-------
.../src/Distribution/Solver/Modular/Solver.hs | 8 ++--
.../Solver/Types/DependencyResolver.hs | 4 +-
.../Distribution/Solver/Types/Toolchain.hs | 8 ++++
.../src/Distribution/Client/Configure.hs | 3 +-
.../src/Distribution/Client/Dependency.hs | 37 +++++++++----------
.../src/Distribution/Client/Fetch.hs | 4 +-
.../src/Distribution/Client/Freeze.hs | 4 +-
.../src/Distribution/Client/Install.hs | 4 +-
.../Distribution/Client/ProjectPlanning.hs | 16 ++++----
11 files changed, 76 insertions(+), 61 deletions(-)
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular.hs b/cabal-install-solver/src/Distribution/Solver/Modular.hs
index 2c0883d2fba..733cdc87aa0 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular.hs
@@ -57,8 +57,9 @@ import Distribution.Verbosity
import Distribution.Solver.Modular.Configured (CP (..))
import qualified Distribution.Solver.Types.ComponentDeps as ComponentDeps
import Distribution.Pretty (Pretty (..))
-import Text.PrettyPrint (text, vcat, Doc, nest, ($+$))
+import Text.PrettyPrint (text, vcat, Doc, nest, ($+$))
import Distribution.Solver.Types.OptionalStanza (showStanzas, optStanzaSetNull)
+import Distribution.Solver.Types.Toolchain ( Toolchains )
import Distribution.Types.Flag (nullFlagAssignment)
@@ -75,18 +76,18 @@ showCP (CP qpi fa es ds) =
| (c, deps) <- ComponentDeps.toList ds
]
])
-
+
-- | Ties the two worlds together: classic cabal-install vs. the modular
-- solver. Performs the necessary translations before and after.
modularResolver :: SolverConfig -> DependencyResolver loc
-modularResolver sc (Platform arch os) cinfo iidx sidx pkgConfigDB pprefs pcs pns = do
- (assignment, revdepmap) <- solve' sc cinfo idx pkgConfigDB pprefs gcs pns
+modularResolver sc toolchains iidx sidx pkgConfigDB pprefs pcs pns = do
+ (assignment, revdepmap) <- solve' sc toolchains idx pkgConfigDB pprefs gcs pns
let cp = toCPs assignment revdepmap
Step (show (vcat (map showCP cp))) $
return $ postprocess assignment revdepmap
where
-- Indices have to be converted into solver-specific uniform index.
- idx = convPIs os arch cinfo gcs (shadowPkgs sc) (strongFlags sc) (solveExecutables sc) iidx sidx
+ idx = convPIs toolchains gcs (shadowPkgs sc) (strongFlags sc) (solveExecutables sc) iidx sidx
-- Constraints have to be converted into a finite map indexed by PN.
gcs = M.fromListWith (++) (map pair pcs)
where
@@ -136,21 +137,21 @@ modularResolver sc (Platform arch os) cinfo iidx sidx pkgConfigDB pprefs pcs pns
-- complete, i.e., it shows the whole chain of dependencies from the user
-- targets to the conflicting packages.
solve' :: SolverConfig
- -> CompilerInfo
+ -> Toolchains
-> Index
-> Maybe PkgConfigDb
-> (PN -> PackagePreferences)
-> Map PN [LabeledPackageConstraint]
-> Set PN
-> Progress String String (Assignment, RevDepMap)
-solve' sc cinfo idx pkgConfigDB pprefs gcs pns =
+solve' sc toolchains idx pkgConfigDB pprefs gcs pns =
toProgress $ retry (runSolver printFullLog sc) createErrorMsg
where
runSolver :: Bool -> SolverConfig
-> RetryLog String SolverFailure (Assignment, RevDepMap)
runSolver keepLog sc' =
displayLogMessages keepLog $
- solve sc' cinfo idx pkgConfigDB pprefs gcs pns
+ solve sc' toolchains idx pkgConfigDB pprefs gcs pns
createErrorMsg :: SolverFailure
-> RetryLog String String (Assignment, RevDepMap)
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs b/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs
index b8ad3e4949a..44fa7b9ca8a 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs
@@ -14,6 +14,7 @@ import qualified Distribution.InstalledPackageInfo as IPI
import Distribution.Compiler
import Distribution.Package -- from Cabal
import Distribution.Simple.BuildToolDepends -- from Cabal
+import Distribution.Simple.Compiler (compilerInfo)
import Distribution.Types.ExeDependency -- from Cabal
import Distribution.Types.PkgconfigDependency -- from Cabal
import Distribution.Types.ComponentName -- from Cabal
@@ -34,6 +35,7 @@ import Distribution.Solver.Types.PackageConstraint
import qualified Distribution.Solver.Types.PackageIndex as CI
import Distribution.Solver.Types.Settings
import Distribution.Solver.Types.SourcePackage
+import Distribution.Solver.Types.Toolchain ( Toolchains(..), Toolchain(..) )
import Distribution.Solver.Modular.Dependency as D
import Distribution.Solver.Modular.Flag as F
@@ -53,13 +55,13 @@ import Distribution.Solver.Modular.Version
-- resolving these situations. However, the right thing to do is to
-- fix the problem there, so for now, shadowing is only activated if
-- explicitly requested.
-convPIs :: OS -> Arch -> CompilerInfo -> Map PN [LabeledPackageConstraint]
+convPIs :: Toolchains -> Map PN [LabeledPackageConstraint]
-> ShadowPkgs -> StrongFlags -> SolveExecutables
-> SI.InstalledPackageIndex -> CI.PackageIndex (SourcePackage loc)
-> Index
-convPIs os arch comp constraints sip strfl solveExes iidx sidx =
+convPIs toolchains constraints sip strfl solveExes iidx sidx =
mkIndex $
- convIPI' sip iidx ++ convSPI' os arch comp constraints strfl solveExes sidx
+ convIPI' sip iidx ++ convSPI' toolchains constraints strfl solveExes sidx
-- | Convert a Cabal installed package index to the simpler,
-- more uniform index format of the solver.
@@ -153,31 +155,33 @@ convIPId dr comp idx ipid =
-- | Convert a cabal-install source package index to the simpler,
-- more uniform index format of the solver.
-convSPI' :: OS -> Arch -> CompilerInfo -> Map PN [LabeledPackageConstraint]
+convSPI' :: Toolchains -> Map PN [LabeledPackageConstraint]
-> StrongFlags -> SolveExecutables
-> CI.PackageIndex (SourcePackage loc) -> [(PN, I, PInfo)]
-convSPI' os arch cinfo constraints strfl solveExes =
- L.map (convSP os arch cinfo constraints strfl solveExes) . CI.allPackages
+convSPI' toolchains constraints strfl solveExes =
+ L.concatMap (convSP toolchains constraints strfl solveExes) . CI.allPackages
-- | Convert a single source package into the solver-specific format.
-convSP :: OS -> Arch -> CompilerInfo -> Map PN [LabeledPackageConstraint]
- -> StrongFlags -> SolveExecutables -> SourcePackage loc -> (PN, I, PInfo)
-convSP os arch cinfo constraints strfl solveExes (SourcePackage (PackageIdentifier pn pv) gpd _ _pl) =
- let i = I {- FIXME -} Host pv InRepo
- pkgConstraints = fromMaybe [] $ M.lookup pn constraints
- in (pn, i, convGPD os arch cinfo pkgConstraints strfl solveExes pn gpd)
+convSP :: Toolchains -> Map PN [LabeledPackageConstraint]
+ -> StrongFlags -> SolveExecutables -> SourcePackage loc -> [(PN, I, PInfo)]
+convSP toolchains constraints strfl solveExes (SourcePackage (PackageIdentifier pn pv) gpd _ _pl) =
+ let pkgConstraints = fromMaybe [] $ M.lookup pn constraints
+ in [(pn, I Host pv InRepo, convGPD (hostToolchain toolchains) pkgConstraints strfl solveExes pn gpd)
+ ,(pn, I Build pv InRepo, convGPD (buildToolchain toolchains) pkgConstraints strfl solveExes pn gpd)]
-- We do not use 'flattenPackageDescription' or 'finalizePD'
-- from 'Distribution.PackageDescription.Configuration' here, because we
-- want to keep the condition tree, but simplify much of the test.
-- | Convert a generic package description to a solver-specific 'PInfo'.
-convGPD :: OS -> Arch -> CompilerInfo -> [LabeledPackageConstraint]
+convGPD :: Toolchain -> [LabeledPackageConstraint]
-> StrongFlags -> SolveExecutables -> PN -> GenericPackageDescription
-> PInfo
-convGPD os arch cinfo constraints strfl solveExes pn
+convGPD toolchain constraints strfl solveExes pn
(GenericPackageDescription pkg scannedVersion flags mlib sub_libs flibs exes tests benchs) =
let
+ cinfo = compilerInfo (toolchainCompiler toolchain)
+ (Platform arch os) = toolchainPlatform toolchain
fds = flagInfo strfl flags
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs
index b2c89fc1537..58de7c9740d 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs
@@ -24,6 +24,7 @@ import Distribution.Solver.Types.PackagePreferences
import Distribution.Solver.Types.PkgConfigDb (PkgConfigDb)
import Distribution.Solver.Types.LabeledPackageConstraint
import Distribution.Solver.Types.Settings
+import Distribution.Solver.Types.Toolchain ( Toolchains(..), Toolchain(..) )
import Distribution.Solver.Types.Variable
import Distribution.Solver.Modular.Assignment
@@ -44,6 +45,7 @@ import Distribution.Solver.Modular.Tree
import qualified Distribution.Solver.Modular.PSQ as PSQ
import Distribution.Simple.Setup (BooleanFlag(..))
+import Distribution.Simple.Compiler (compilerInfo)
#ifdef DEBUG_TRACETREE
import qualified Distribution.Solver.Modular.ConflictSet as CS
@@ -89,14 +91,14 @@ newtype PruneAfterFirstSuccess = PruneAfterFirstSuccess Bool
-- before exploration.
--
solve :: SolverConfig -- ^ solver parameters
- -> CompilerInfo
+ -> Toolchains
-> Index -- ^ all available packages as an index
-> Maybe PkgConfigDb -- ^ available pkg-config pkgs
-> (PN -> PackagePreferences) -- ^ preferences
-> M.Map PN [LabeledPackageConstraint] -- ^ global constraints
-> S.Set PN -- ^ global goals
-> RetryLog Message SolverFailure (Assignment, RevDepMap)
-solve sc cinfo idx pkgConfigDB userPrefs userConstraints userGoals =
+solve sc toolchains idx pkgConfigDB userPrefs userConstraints userGoals =
explorePhase .
traceTree "cycles.json" id .
detectCycles .
@@ -137,7 +139,7 @@ solve sc cinfo idx pkgConfigDB userPrefs userConstraints userGoals =
P.enforceManualFlags userConstraints
validationCata = P.enforceSingleInstanceRestriction .
validateLinking idx .
- validateTree cinfo idx pkgConfigDB
+ validateTree (compilerInfo (toolchainCompiler (hostToolchain toolchains))) idx pkgConfigDB
prunePhase = (if asBool (avoidReinstalls sc) then P.avoidReinstalls (const True) else id) .
(case onlyConstrained sc of
OnlyConstrainedAll ->
diff --git a/cabal-install-solver/src/Distribution/Solver/Types/DependencyResolver.hs b/cabal-install-solver/src/Distribution/Solver/Types/DependencyResolver.hs
index 139a6d2b33d..d4e9c2ea707 100644
--- a/cabal-install-solver/src/Distribution/Solver/Types/DependencyResolver.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Types/DependencyResolver.hs
@@ -16,6 +16,7 @@ import Distribution.Solver.Types.SourcePackage
import Distribution.Simple.PackageIndex ( InstalledPackageIndex )
import Distribution.Package ( PackageName )
import Distribution.Compiler ( CompilerInfo )
+import Distribution.Solver.Types.Toolchain ( Toolchains )
import Distribution.System ( Platform )
-- | A dependency resolver is a function that works out an installation plan
@@ -26,8 +27,7 @@ import Distribution.System ( Platform )
-- solving the package dependency problem and we want to make it easy to swap
-- in alternatives.
--
-type DependencyResolver loc = Platform
- -> CompilerInfo
+type DependencyResolver loc = Toolchains
-> InstalledPackageIndex
-> PackageIndex (SourcePackage loc)
-> Maybe PkgConfigDb
diff --git a/cabal-install-solver/src/Distribution/Solver/Types/Toolchain.hs b/cabal-install-solver/src/Distribution/Solver/Types/Toolchain.hs
index 182101b8899..3126a4abfbd 100644
--- a/cabal-install-solver/src/Distribution/Solver/Types/Toolchain.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Types/Toolchain.hs
@@ -4,6 +4,7 @@ module Distribution.Solver.Types.Toolchain
( Toolchain (..)
, Toolchains (..)
, toolchainFor
+ , mkToolchainsWithHost
) where
import Distribution.Compat.Prelude
@@ -47,3 +48,10 @@ toolchainFor Host = hostToolchain
instance Binary Toolchains
instance Structured Toolchains
+
+mkToolchainsWithHost :: Platform -> Compiler -> Toolchains
+mkToolchainsWithHost platform compiler =
+ Toolchains
+ { buildToolchain = Toolchain platform compiler (error "build program db missing")
+ , hostToolchain = Toolchain platform compiler (error "host program db missing")
+ }
diff --git a/cabal-install/src/Distribution/Client/Configure.hs b/cabal-install/src/Distribution/Client/Configure.hs
index 048a7db963e..f62ee83e61c 100644
--- a/cabal-install/src/Distribution/Client/Configure.hs
+++ b/cabal-install/src/Distribution/Client/Configure.hs
@@ -67,6 +67,7 @@ import Distribution.Solver.Types.PkgConfigDb
)
import Distribution.Solver.Types.Settings
import Distribution.Solver.Types.SourcePackage
+import Distribution.Solver.Types.Toolchain (mkToolchainsWithHost)
import Distribution.Client.SavedFlags (readCommandFlags, writeCommandFlags)
import Distribution.Package
@@ -470,7 +471,7 @@ planLocalPackage
(SourcePackageDb mempty packagePrefs)
[SpecificSourcePackage localPkg]
- return (resolveDependencies platform (compilerInfo comp) pkgConfigDb resolverParams)
+ return (resolveDependencies (mkToolchainsWithHost platform comp) pkgConfigDb resolverParams)
-- | Call an installer for an 'SourcePackage' but override the configure
-- flags with the ones given by the 'ReadyPackage'. In particular the
diff --git a/cabal-install/src/Distribution/Client/Dependency.hs b/cabal-install/src/Distribution/Client/Dependency.hs
index af759a2fedf..4b5422d145a 100644
--- a/cabal-install/src/Distribution/Client/Dependency.hs
+++ b/cabal-install/src/Distribution/Client/Dependency.hs
@@ -115,6 +115,7 @@ import Distribution.PackageDescription.Configuration
import qualified Distribution.PackageDescription.Configuration as PD
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import qualified Distribution.Simple.PackageIndex as InstalledPackageIndex
+import Distribution.Simple.Compiler (compilerInfo)
import Distribution.Simple.Setup
( asBool
)
@@ -153,6 +154,7 @@ import Distribution.Solver.Types.Settings
import Distribution.Solver.Types.SolverId
import Distribution.Solver.Types.SolverPackage
import Distribution.Solver.Types.SourcePackage
+import Distribution.Solver.Types.Toolchain
import Distribution.Solver.Types.Variable
import Control.Exception
@@ -782,14 +784,13 @@ runSolver = modularResolver
-- a 'Progress' structure that can be unfolded to provide progress information,
-- logging messages and the final result or an error.
resolveDependencies
- :: Platform
- -> CompilerInfo
+ :: Toolchains
-> Maybe PkgConfigDb
-> DepResolverParams
-> Progress String String SolverInstallPlan
-resolveDependencies platform comp pkgConfigDB params =
+resolveDependencies toolchains pkgConfigDB params =
Step (showDepResolverParams finalparams) $
- fmap (validateSolverResult platform comp indGoals) $
+ fmap (validateSolverResult toolchains indGoals) $
runSolver
( SolverConfig
reordGoals
@@ -808,8 +809,7 @@ resolveDependencies platform comp pkgConfigDB params =
verbosity
(PruneAfterFirstSuccess False)
)
- platform
- comp
+ toolchains
installedPkgIndex
sourcePkgIndex
pkgConfigDB
@@ -909,13 +909,12 @@ interpretPackagesPreference selected defaultPref prefs =
-- | Make an install plan from the output of the dep resolver.
-- It checks that the plan is valid, or it's an error in the dep resolver.
validateSolverResult
- :: Platform
- -> CompilerInfo
+ :: Toolchains
-> IndependentGoals
-> [ResolverPackage UnresolvedPkgLoc]
-> SolverInstallPlan
-validateSolverResult platform comp indepGoals pkgs =
- case planPackagesProblems platform comp pkgs of
+validateSolverResult toolchains indepGoals pkgs =
+ case planPackagesProblems toolchains pkgs of
[] -> case SolverInstallPlan.new indepGoals graph of
Right plan -> plan
Left problems -> error (formatPlanProblems problems)
@@ -960,14 +959,13 @@ showPlanPackageProblem (DuplicatePackageSolverId pid dups) =
++ " duplicate instances."
planPackagesProblems
- :: Platform
- -> CompilerInfo
+ :: Toolchains
-> [ResolverPackage UnresolvedPkgLoc]
-> [PlanPackageProblem]
-planPackagesProblems platform cinfo pkgs =
+planPackagesProblems toolchains pkgs =
[ InvalidConfiguredPackage pkg packageProblems
| Configured pkg <- pkgs
- , let packageProblems = configuredPackageProblems platform cinfo pkg
+ , let packageProblems = configuredPackageProblems toolchains pkg
, not (null packageProblems)
]
++ [ DuplicatePackageSolverId (Graph.nodeKey aDup) dups
@@ -1016,13 +1014,11 @@ showPackageProblem (InvalidDep dep pkgid) =
-- in the configuration given by the flag assignment, all the package
-- dependencies are satisfied by the specified packages.
configuredPackageProblems
- :: Platform
- -> CompilerInfo
+ :: Toolchains
-> SolverPackage UnresolvedPkgLoc
-> [PackageProblem]
configuredPackageProblems
- platform
- cinfo
+ toolchains
(SolverPackage _qpn pkg specifiedFlags stanzas specifiedDeps0 _specifiedExeDeps') =
[ DuplicateFlag flag
| flag <- PD.findDuplicateFlagAssignments specifiedFlags
@@ -1096,8 +1092,9 @@ configuredPackageProblems
specifiedFlags
compSpec
(const Satisfied)
- platform
- cinfo
+ -- FIXME: HARDCODED HOST TOOLCHAIN here.
+ (toolchainPlatform (hostToolchain toolchains))
+ (compilerInfo (toolchainCompiler (hostToolchain toolchains)))
[]
(srcpkgDescription pkg) of
Right (resolvedPkg, _) ->
diff --git a/cabal-install/src/Distribution/Client/Fetch.hs b/cabal-install/src/Distribution/Client/Fetch.hs
index 033d3a01e14..abe6d181a7f 100644
--- a/cabal-install/src/Distribution/Client/Fetch.hs
+++ b/cabal-install/src/Distribution/Client/Fetch.hs
@@ -38,6 +38,7 @@ import Distribution.Solver.Types.OptionalStanza
import Distribution.Solver.Types.PkgConfigDb (PkgConfigDb, readPkgConfigDb)
import Distribution.Solver.Types.SolverPackage
import Distribution.Solver.Types.SourcePackage
+import Distribution.Solver.Types.Toolchain (mkToolchainsWithHost)
import Distribution.Client.Errors
import Distribution.Package
@@ -174,8 +175,7 @@ planPackages
installPlan <-
foldProgress logMsg (dieWithException verbosity . PlanPackages . show) return $
resolveDependencies
- platform
- (compilerInfo comp)
+ (mkToolchainsWithHost platform comp)
pkgConfigDb
resolverParams
diff --git a/cabal-install/src/Distribution/Client/Freeze.hs b/cabal-install/src/Distribution/Client/Freeze.hs
index a03b45b6a2d..abcc69797f9 100644
--- a/cabal-install/src/Distribution/Client/Freeze.hs
+++ b/cabal-install/src/Distribution/Client/Freeze.hs
@@ -52,6 +52,7 @@ import Distribution.Solver.Types.LabeledPackageConstraint
import Distribution.Solver.Types.OptionalStanza
import Distribution.Solver.Types.PkgConfigDb
import Distribution.Solver.Types.SolverId
+import Distribution.Solver.Types.Toolchain (mkToolchainsWithHost)
import Distribution.Client.Errors
import Distribution.Package
@@ -212,8 +213,7 @@ planPackages
installPlan <-
foldProgress logMsg (dieWithException verbosity . FreezeException) return $
resolveDependencies
- platform
- (compilerInfo comp)
+ (mkToolchainsWithHost platform comp)
pkgConfigDb
resolverParams
diff --git a/cabal-install/src/Distribution/Client/Install.hs b/cabal-install/src/Distribution/Client/Install.hs
index 635cd7e1689..6c9a605c553 100644
--- a/cabal-install/src/Distribution/Client/Install.hs
+++ b/cabal-install/src/Distribution/Client/Install.hs
@@ -141,6 +141,7 @@ import Distribution.Solver.Types.PkgConfigDb
)
import Distribution.Solver.Types.Settings
import Distribution.Solver.Types.SourcePackage as SourcePackage
+import Distribution.Solver.Types.Toolchain (mkToolchainsWithHost)
import Distribution.Client.ProjectConfig
import Distribution.Client.Utils
@@ -585,8 +586,7 @@ planPackages
pkgConfigDb
pkgSpecifiers =
resolveDependencies
- platform
- (compilerInfo comp)
+ (mkToolchainsWithHost platform comp)
pkgConfigDb
resolverParams
>>= if onlyDeps then pruneInstallPlan pkgSpecifiers else return
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index 73b9d02c0a5..16639d54270 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -1278,7 +1278,7 @@ getPackageSourceHashes verbosity withRepoCtx solverPlan = do
planPackages
:: Verbosity
- -> Toolchain
+ -> Toolchains
-> SolverSettings
-> InstalledPackageIndex
-> SourcePackageDb
@@ -1288,7 +1288,7 @@ planPackages
-> Progress String String SolverInstallPlan
planPackages
verbosity
- Toolchain{toolchainCompiler = compiler, toolchainPlatform = platform}
+ toolchains
SolverSettings{..}
installedPkgIndex
sourcePkgDb
@@ -1296,8 +1296,7 @@ planPackages
localPackages
pkgStanzasEnable =
resolveDependencies
- platform
- (compilerInfo compiler)
+ toolchains
pkgConfigDB
resolverParams
where
@@ -1340,7 +1339,9 @@ planPackages
. removeLowerBounds solverSettingAllowOlder
. removeUpperBounds solverSettingAllowNewer
. addDefaultSetupDependencies
- ( mkDefaultSetupDeps compiler platform
+ ( mkDefaultSetupDeps
+ (toolchainCompiler (buildToolchain toolchains))
+ (toolchainPlatform (buildToolchain toolchains))
. PD.packageDescription
. srcpkgDescription
)
@@ -1474,8 +1475,9 @@ planPackages
| otherwise = mkVersion [1, 20]
where
isGHC = compFlav `elem` [GHC, GHCJS]
- compFlav = compilerFlavor compiler
- compVer = compilerVersion compiler
+ -- FIXME: We assume HOST here.
+ compFlav = compilerFlavor (toolchainCompiler (hostToolchain toolchains))
+ compVer = compilerVersion (toolchainCompiler (hostToolchain toolchains))
-- As we can't predict the future, we also place a global upper
-- bound on the lib:Cabal version we know how to interact with:
From 20068b0e7eb6c4d99099b87f3a3cc65a0a87746a Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Tue, 18 Mar 2025 11:27:46 +0900
Subject: [PATCH 29/82] s/Host/Build/g
---
.../src/Distribution/Client/Config.hs | 6 ++---
.../Client/ProjectConfig/Legacy.hs | 6 ++---
.../Client/ProjectConfig/Types.hs | 6 ++---
.../Distribution/Client/ProjectPlanning.hs | 24 +++++++++----------
.../src/Distribution/Client/Setup.hs | 18 +++++++-------
5 files changed, 30 insertions(+), 30 deletions(-)
diff --git a/cabal-install/src/Distribution/Client/Config.hs b/cabal-install/src/Distribution/Client/Config.hs
index 61384f495fb..d27fd14f9e6 100644
--- a/cabal-install/src/Distribution/Client/Config.hs
+++ b/cabal-install/src/Distribution/Client/Config.hs
@@ -573,9 +573,9 @@ instance Semigroup SavedConfig where
combineMonoid savedConfigureExFlags configAllowOlder
, configWriteGhcEnvironmentFilesPolicy =
combine configWriteGhcEnvironmentFilesPolicy
- , configHostHcFlavor = combine configHostHcFlavor
- , configHostHcPath = combine configHostHcPath
- , configHostHcPkg = combine configHostHcPkg
+ , configBuildHcFlavor = combine configBuildHcFlavor
+ , configBuildHcPath = combine configBuildHcPath
+ , configBuildHcPkg = combine configBuildHcPkg
}
where
combine = combine' savedConfigureExFlags
diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs
index b29b3cf47f9..9be3a34ae6e 100644
--- a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs
+++ b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs
@@ -741,9 +741,9 @@ convertLegacyAllPackageFlags globalFlags configFlags configExFlags installFlags
, configAllowNewer = projectConfigAllowNewer
, configWriteGhcEnvironmentFilesPolicy =
projectConfigWriteGhcEnvironmentFilesPolicy
- , configHostHcFlavor = projectConfigHostHcFlavor
- , configHostHcPath = projectConfigHostHcPath
- , configHostHcPkg = projectConfigHostHcPkg
+ , configBuildHcFlavor = projectConfigBuildHcFlavor
+ , configBuildHcPath = projectConfigBuildHcPath
+ , configBuildHcPkg = projectConfigBuildHcPkg
} = configExFlags
InstallFlags
diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs
index 5657bb4b605..8a0a74ac9ed 100644
--- a/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs
+++ b/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs
@@ -192,9 +192,9 @@ data ProjectConfigShared = ProjectConfigShared
, projectConfigHcFlavor :: Flag CompilerFlavor
, projectConfigHcPath :: Flag FilePath
, projectConfigHcPkg :: Flag FilePath
- , projectConfigHostHcFlavor :: Flag CompilerFlavor
- , projectConfigHostHcPath :: Flag FilePath
- , projectConfigHostHcPkg :: Flag FilePath
+ , projectConfigBuildHcFlavor :: Flag CompilerFlavor
+ , projectConfigBuildHcPath :: Flag FilePath
+ , projectConfigBuildHcPkg :: Flag FilePath
, projectConfigHaddockIndex :: Flag PathTemplate
, -- Only makes sense for manual mode, not --local mode
-- too much control!
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index 16639d54270..fe0a6e7b03c 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -479,9 +479,9 @@ configureCompiler
{ projectConfigHcFlavor
, projectConfigHcPath
, projectConfigHcPkg
- , projectConfigHostHcFlavor
- , projectConfigHostHcPath
- , projectConfigHostHcPkg
+ , projectConfigBuildHcFlavor
+ , projectConfigBuildHcPath
+ , projectConfigBuildHcPkg
}
, projectConfigLocalPackages =
projectConfigLocalPackages@PackageConfig
@@ -512,9 +512,9 @@ configureCompiler
(compiler, platform, progdb) <-
liftIO $
Cabal.configCompilerEx
- hcFlavor
- hcPath
- hcPkg
+ buildHcFlavor
+ buildHcPath
+ buildHcPkg
defdb
verbosity
@@ -531,9 +531,9 @@ configureCompiler
(compiler, platform, progdb) <-
liftIO $
Cabal.configCompilerEx
- hostHcFlavor
- hostHcPath
- hostHcPkg
+ hcFlavor
+ hcPath
+ hcPkg
defdb
verbosity
@@ -551,9 +551,9 @@ configureCompiler
hcFlavor = flagToMaybe projectConfigHcFlavor
hcPath = flagToMaybe projectConfigHcPath
hcPkg = flagToMaybe projectConfigHcPkg
- hostHcFlavor = flagToMaybe projectConfigHostHcFlavor <|> flagToMaybe projectConfigHcFlavor
- hostHcPath = flagToMaybe projectConfigHostHcPath <|> flagToMaybe projectConfigHcPath
- hostHcPkg = flagToMaybe projectConfigHostHcPkg <|> flagToMaybe projectConfigHcPkg
+ buildHcFlavor = flagToMaybe projectConfigBuildHcFlavor <|> flagToMaybe projectConfigHcFlavor
+ buildHcPath = flagToMaybe projectConfigBuildHcPath <|> flagToMaybe projectConfigHcPath
+ buildHcPkg = flagToMaybe projectConfigBuildHcPkg <|> flagToMaybe projectConfigHcPkg
{- Note [Caching the result of configuring the compiler]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/cabal-install/src/Distribution/Client/Setup.hs b/cabal-install/src/Distribution/Client/Setup.hs
index da399b604a7..b10ee9dee49 100644
--- a/cabal-install/src/Distribution/Client/Setup.hs
+++ b/cabal-install/src/Distribution/Client/Setup.hs
@@ -920,9 +920,9 @@ data ConfigExFlags = ConfigExFlags
, configAllowOlder :: Maybe AllowOlder
, configWriteGhcEnvironmentFilesPolicy
:: Flag WriteGhcEnvironmentFilesPolicy
- , configHostHcFlavor :: Flag CompilerFlavor
- , configHostHcPath :: Flag FilePath
- , configHostHcPkg :: Flag FilePath
+ , configBuildHcFlavor :: Flag CompilerFlavor
+ , configBuildHcPath :: Flag FilePath
+ , configBuildHcPkg :: Flag FilePath
}
deriving (Eq, Show, Generic)
@@ -1054,8 +1054,8 @@ configureExOptions _showOrParseArgs src =
[]
["host-compiler"]
"host compiler"
- configHostHcFlavor
- (\v flags -> flags{configHostHcFlavor = v})
+ configBuildHcFlavor
+ (\v flags -> flags{configBuildHcFlavor = v})
( choiceOpt
[ (Flag GHC, ("g", ["ghc"]), "compile with GHC")
, (Flag GHCJS, ([], ["ghcjs"]), "compile with GHCJS")
@@ -1065,15 +1065,15 @@ configureExOptions _showOrParseArgs src =
"W"
["with-host-compiler", "with-host-hc"]
"give the path to the compiler for the host toolchain"
- configHostHcPath
- (\v flags -> flags{configHostHcPath = v})
+ configBuildHcPath
+ (\v flags -> flags{configBuildHcPath = v})
(reqArgFlag "PATH")
, option
""
["with-host-hc-pkg"]
"give the path to the package tool for the host toolchain"
- configHostHcPkg
- (\v flags -> flags{configHostHcPkg = v})
+ configBuildHcPkg
+ (\v flags -> flags{configBuildHcPkg = v})
(reqArgFlag "PATH")
]
From 672e511b4fad8f1e60e784d1cddc7191a5a8cb47 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Tue, 18 Mar 2025 11:27:57 +0900
Subject: [PATCH 30/82] Add WeightedPSQ.filterKey
---
.../src/Distribution/Solver/Modular/WeightedPSQ.hs | 5 +++++
1 file changed, 5 insertions(+)
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/WeightedPSQ.hs b/cabal-install-solver/src/Distribution/Solver/Modular/WeightedPSQ.hs
index 94def7be196..747017148d7 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/WeightedPSQ.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/WeightedPSQ.hs
@@ -9,6 +9,7 @@ module Distribution.Solver.Modular.WeightedPSQ (
, weights
, isZeroOrOne
, filter
+ , filterKey
, lookup
, mapWithKey
, mapWeightsWithKey
@@ -34,6 +35,10 @@ newtype WeightedPSQ w k v = WeightedPSQ [(w, k, v)]
filter :: (v -> Bool) -> WeightedPSQ k w v -> WeightedPSQ k w v
filter p (WeightedPSQ xs) = WeightedPSQ (L.filter (p . triple_3) xs)
+-- | /O(N)/.
+filterKey :: (k -> Bool) -> WeightedPSQ w k v -> WeightedPSQ w k v
+filterKey p (WeightedPSQ xs) = WeightedPSQ (L.filter (p . triple_2) xs)
+
-- | /O(1)/. Return @True@ if the @WeightedPSQ@ contains zero or one elements.
isZeroOrOne :: WeightedPSQ w k v -> Bool
isZeroOrOne (WeightedPSQ []) = True
From 075b2a6a18507cd9bebfe4b13e367b1734b3ee08 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Tue, 18 Mar 2025 11:28:47 +0900
Subject: [PATCH 31/82] More toolchain threading
---
.../Solver/Modular/IndexConversion.hs | 31 +++++++++++--------
.../Distribution/Client/ProjectPlanning.hs | 2 +-
2 files changed, 19 insertions(+), 14 deletions(-)
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs b/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs
index 44fa7b9ca8a..9ab501e904a 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs
@@ -24,6 +24,7 @@ import Distribution.Types.MungedPackageName -- from Cabal
import Distribution.PackageDescription -- from Cabal
import Distribution.PackageDescription.Configuration
import qualified Distribution.Simple.PackageIndex as SI
+import Distribution.Simple.Compiler (compilerId)
import Distribution.System
import Distribution.Solver.Types.ComponentDeps
@@ -61,15 +62,15 @@ convPIs :: Toolchains -> Map PN [LabeledPackageConstraint]
-> Index
convPIs toolchains constraints sip strfl solveExes iidx sidx =
mkIndex $
- convIPI' sip iidx ++ convSPI' toolchains constraints strfl solveExes sidx
+ convIPI' toolchains sip iidx ++ convSPI' toolchains constraints strfl solveExes sidx
-- | Convert a Cabal installed package index to the simpler,
-- more uniform index format of the solver.
-convIPI' :: ShadowPkgs -> SI.InstalledPackageIndex -> [(PN, I, PInfo)]
-convIPI' (ShadowPkgs sip) idx =
+convIPI' :: Toolchains -> ShadowPkgs -> SI.InstalledPackageIndex -> [(PN, I, PInfo)]
+convIPI' toolchains (ShadowPkgs sip) idx =
-- apply shadowing whenever there are multiple installed packages with
-- the same version
- [ maybeShadow (convIP idx pkg)
+ [ maybeShadow (convIP toolchains idx pkg)
-- IMPORTANT to get internal libraries. See
-- Note [Index conversion with internal libraries]
| (_, pkgs) <- SI.allPackagesBySourcePackageIdAndLibName idx
@@ -82,16 +83,20 @@ convIPI' (ShadowPkgs sip) idx =
shadow x = x
-- | Extract/recover the package ID from an installed package info, and convert it to a solver's I.
-convId :: IPI.InstalledPackageInfo -> (PN, I)
-convId ipi = (pn, I {- FIXME -} Host ver $ Inst $ IPI.installedUnitId ipi)
+convId :: Toolchains -> IPI.InstalledPackageInfo -> (PN, I)
+convId toolchains ipi = (pn, I stage ver $ Inst $ IPI.installedUnitId ipi)
where MungedPackageId mpn ver = mungedId ipi
-- HACK. See Note [Index conversion with internal libraries]
pn = encodeCompatPackageName mpn
+ stage = case IPI.pkgCompiler ipi of
+ Just c | c == compilerId (toolchainCompiler (buildToolchain toolchains)) -> Build
+ Just c | c == compilerId (toolchainCompiler (hostToolchain toolchains)) -> Host
+ _ -> error "convId: unhandled compiler"
-- | Convert a single installed package into the solver-specific format.
-convIP :: SI.InstalledPackageIndex -> IPI.InstalledPackageInfo -> (PN, I, PInfo)
-convIP idx ipi =
- case traverse (convIPId (DependencyReason pn M.empty S.empty) comp idx) (IPI.depends ipi) of
+convIP :: Toolchains -> SI.InstalledPackageIndex -> IPI.InstalledPackageInfo -> (PN, I, PInfo)
+convIP toolchains idx ipi =
+ case traverse (convIPId toolchains (DependencyReason pn M.empty S.empty) comp idx) (IPI.depends ipi) of
Left u -> (pn, i, PInfo [] M.empty M.empty (Just (Broken u)))
Right fds -> (pn, i, PInfo fds components M.empty Nothing)
where
@@ -103,7 +108,7 @@ convIP idx ipi =
, compIsBuildable = IsBuildable True
}
- (pn, i) = convId ipi
+ (pn, i) = convId toolchains ipi
-- 'sourceLibName' is unreliable, but for now we only really use this for
-- primary libs anyways
@@ -143,11 +148,11 @@ convIP idx ipi =
-- May return Nothing if the package can't be found in the index. That
-- indicates that the original package having this dependency is broken
-- and should be ignored.
-convIPId :: DependencyReason PN -> Component -> SI.InstalledPackageIndex -> UnitId -> Either UnitId (FlaggedDep PN)
-convIPId dr comp idx ipid =
+convIPId :: Toolchains -> DependencyReason PN -> Component -> SI.InstalledPackageIndex -> UnitId -> Either UnitId (FlaggedDep PN)
+convIPId toolchains dr comp idx ipid =
case SI.lookupUnitId idx ipid of
Nothing -> Left ipid
- Just ipi -> let (pn, i) = convId ipi
+ Just ipi -> let (pn, i) = convId toolchains ipi
name = ExposedLib LMainLibName -- TODO: Handle sub-libraries.
in Right (D.Simple (LDep dr (Dep (PkgComponent pn name) (Fixed i))) comp)
-- NB: something we pick up from the
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index fe0a6e7b03c..fd999487dd0 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -801,7 +801,7 @@ rebuildInstallPlan
foldProgress logMsg (pure . Left) (pure . Right) $
planPackages
verbosity
- (hostToolchain toolchains) -- FIXME: this should be `toolchains`.
+ toolchains
solverSettings
(installedPackages <> hinstalledPkgIndex <> binstalledPkgIndex)
sourcePkgDb
From 9698a71c5cdea660032dd5dacce322ab3a512db9 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Tue, 18 Mar 2025 14:42:44 +0900
Subject: [PATCH 32/82] Stop `Stage`, which now lives in D.S.T.Stage
---
.../src/Distribution/Solver/Modular/Package.hs | 5 +----
1 file changed, 1 insertion(+), 4 deletions(-)
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Package.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Package.hs
index 2b4a423adcc..3d2b3026c92 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/Package.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/Package.hs
@@ -25,6 +25,7 @@ import Distribution.Pretty (prettyShow)
import Distribution.Solver.Modular.Version
import Distribution.Solver.Types.PackagePath
+import Distribution.Solver.Types.Stage (Stage (..))
-- | A package name.
type PN = PackageName
@@ -50,10 +51,6 @@ type PId = UnitId
data Loc = Inst PId | InRepo
deriving (Eq, Ord, Show)
--- | Stage. A stage in the build process.
-data Stage = Build | Host
- deriving (Eq, Ord, Show)
-
showStage :: Stage -> String
showStage Build = "[build]"
showStage Host = "[host ]"
From 7b27c1a5b49a203dc2b177e73b0bab8e49d1e9a5 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Tue, 18 Mar 2025 14:42:53 +0900
Subject: [PATCH 33/82] Add Ord Stage
---
cabal-install-solver/src/Distribution/Solver/Types/Stage.hs | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/cabal-install-solver/src/Distribution/Solver/Types/Stage.hs b/cabal-install-solver/src/Distribution/Solver/Types/Stage.hs
index 0365ef515c1..b2595a33089 100644
--- a/cabal-install-solver/src/Distribution/Solver/Types/Stage.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Types/Stage.hs
@@ -12,7 +12,7 @@ data Stage
Build
| -- | -- The system where the built artifacts will run
Host
- deriving (Eq, Read, Show, Generic, Typeable)
+ deriving (Eq, Ord, Read, Show, Generic, Typeable)
instance Binary Stage
instance Structured Stage
From 0b47c0629697d5dd7a172f017c9a333f41aed4a2 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Tue, 18 Mar 2025 14:44:26 +0900
Subject: [PATCH 34/82] Add stage to SolverPackage, and use stage from
elabStage
---
.../Solver/Modular/ConfiguredConversion.hs | 5 +-
.../Solver/Types/SolverPackage.hs | 2 +
.../src/Distribution/Client/Dependency.hs | 2 +-
.../Client/ProjectBuilding/UnpackedPackage.hs | 50 +++++++++----------
.../Client/ProjectOrchestration.hs | 1 +
.../Distribution/Client/ProjectPlanning.hs | 10 ++--
6 files changed, 37 insertions(+), 33 deletions(-)
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs b/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs
index 670850a9439..d391345d0eb 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs
@@ -29,7 +29,7 @@ convCP :: SI.InstalledPackageIndex ->
convCP iidx sidx (CP qpi fa es ds) =
case qpi of
-- Installed
- (PI qpn (I {- FIXME -} Host _ (Inst pi))) ->
+ (PI qpn (I _stage _ (Inst pi))) ->
PreExisting $
InstSolverPackage {
instSolverQPN = qpn,
@@ -38,11 +38,12 @@ convCP iidx sidx (CP qpi fa es ds) =
instSolverPkgExeDeps = fmap snd ds'
}
-- "In repo" i.e. a source package
- (PI qpn@(Q _path pn) (I {- FIXME -} Host v InRepo)) ->
+ (PI qpn@(Q _path pn) (I stage v InRepo)) ->
let pi = PackageIdentifier pn v in
Configured $
SolverPackage {
solverPkgQPN = qpn,
+ solverPkgStage = stage,
solverPkgSource = fromMaybe (error "convCP: lookupPackageId failed") $ CI.lookupPackageId sidx pi,
solverPkgFlags = fa,
solverPkgStanzas = es,
diff --git a/cabal-install-solver/src/Distribution/Solver/Types/SolverPackage.hs b/cabal-install-solver/src/Distribution/Solver/Types/SolverPackage.hs
index b3748254ebb..956bc5dff6e 100644
--- a/cabal-install-solver/src/Distribution/Solver/Types/SolverPackage.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Types/SolverPackage.hs
@@ -13,6 +13,7 @@ import Distribution.Solver.Types.OptionalStanza
import Distribution.Solver.Types.PackagePath (QPN)
import Distribution.Solver.Types.SolverId
import Distribution.Solver.Types.SourcePackage
+import Distribution.Solver.Types.Stage (Stage (..))
-- | A 'SolverPackage' is a package specified by the dependency solver.
-- It will get elaborated into a 'ConfiguredPackage' or even an
@@ -23,6 +24,7 @@ import Distribution.Solver.Types.SourcePackage
--
data SolverPackage loc = SolverPackage {
solverPkgQPN :: QPN,
+ solverPkgStage :: Stage,
solverPkgSource :: SourcePackage loc,
solverPkgFlags :: FlagAssignment,
solverPkgStanzas :: OptionalStanzaSet,
diff --git a/cabal-install/src/Distribution/Client/Dependency.hs b/cabal-install/src/Distribution/Client/Dependency.hs
index 4b5422d145a..65f8a06ac97 100644
--- a/cabal-install/src/Distribution/Client/Dependency.hs
+++ b/cabal-install/src/Distribution/Client/Dependency.hs
@@ -1019,7 +1019,7 @@ configuredPackageProblems
-> [PackageProblem]
configuredPackageProblems
toolchains
- (SolverPackage _qpn pkg specifiedFlags stanzas specifiedDeps0 _specifiedExeDeps') =
+ (SolverPackage _qpn _stage pkg specifiedFlags stanzas specifiedDeps0 _specifiedExeDeps') =
[ DuplicateFlag flag
| flag <- PD.findDuplicateFlagAssignments specifiedFlags
]
diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs b/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs
index 3908a1d12d1..3ca93d62fd5 100644
--- a/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs
+++ b/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs
@@ -80,7 +80,9 @@ import Distribution.Simple.Command (CommandUI)
import Distribution.Simple.Compiler
( PackageDBStackCWD
, coercePackageDBStack
+ , showCompilerId
)
+import Distribution.Solver.Types.Stage
import qualified Distribution.Simple.InstallDirs as InstallDirs
import Distribution.Simple.LocalBuildInfo
( ComponentName (..)
@@ -178,15 +180,7 @@ buildAndRegisterUnpackedPackage
registerLock
cacheLock
pkgshared@ElaboratedSharedConfig
- { pkgConfigToolchains =
- Toolchains
- { buildToolchain =
- Toolchain
- { toolchainCompiler = compiler
- , toolchainProgramDb = progdb
- }
- }
- }
+ { pkgConfigToolchains = toolchains }
plan
rpkg@(ReadyPackage pkg)
srcdir
@@ -260,6 +254,10 @@ buildAndRegisterUnpackedPackage
return ()
where
+ (compiler, progdb) = case elabStage pkg of
+ Host -> (toolchainCompiler (hostToolchain toolchains), toolchainProgramDb (hostToolchain toolchains))
+ Build -> (toolchainCompiler (buildToolchain toolchains), toolchainProgramDb (buildToolchain toolchains))
+
uid = installedUnitId rpkg
comp_par_strat = case maybe_semaphore of
@@ -458,14 +456,7 @@ buildInplaceUnpackedPackage
registerLock
cacheLock
pkgshared@ElaboratedSharedConfig
- { pkgConfigToolchains =
- Toolchains
- { buildToolchain =
- Toolchain
- { toolchainPlatform = Platform _ os
- }
- }
- }
+ { pkgConfigToolchains = toolchains }
plan
rpkg@(ReadyPackage pkg)
buildStatus
@@ -610,6 +601,10 @@ buildInplaceUnpackedPackage
, buildResultLogFile = Nothing
}
where
+ Platform _ os = case elabStage pkg of
+ Host -> toolchainPlatform (hostToolchain toolchains)
+ Build -> toolchainPlatform (buildToolchain toolchains)
+
dparams = elabDistDirParams pkgshared pkg
packageFileMonitor = newPackageFileMonitor pkgshared distDirLayout dparams
@@ -671,15 +666,7 @@ buildAndInstallUnpackedPackage
registerLock
cacheLock
pkgshared@ElaboratedSharedConfig
- { pkgConfigToolchains =
- Toolchains
- { buildToolchain =
- Toolchain
- { toolchainCompiler = compiler
- , toolchainPlatform = platform
- }
- }
- }
+ { pkgConfigToolchains = toolchains }
plan
rpkg@(ReadyPackage pkg)
srcdir
@@ -826,6 +813,10 @@ buildAndInstallUnpackedPackage
, buildResultLogFile = mlogFile
}
where
+ (compiler, platform) = case elabStage pkg of
+ Host -> (toolchainCompiler (hostToolchain toolchains), toolchainPlatform (hostToolchain toolchains))
+ Build -> (toolchainCompiler (buildToolchain toolchains), toolchainPlatform (buildToolchain toolchains))
+
uid = installedUnitId rpkg
pkgid = packageId rpkg
@@ -836,13 +827,20 @@ buildAndInstallUnpackedPackage
prettyShow pkgid
++ " (all, legacy fallback: "
++ unwords (map whyNotPerComponent $ NE.toList pkgWhyNotPerComponent)
+ ++ ", "
+ ++ dispcompiler (elabStage pkg)
++ ")"
-- Packages built per component
ElabComponent comp ->
prettyShow pkgid
++ " ("
++ maybe "custom" prettyShow (compComponentName comp)
+ ++ ", "
+ ++ dispcompiler (elabStage pkg)
++ ")"
+ dispcompiler :: Stage -> String
+ dispcompiler Host = showCompilerId (toolchainCompiler (hostToolchain toolchains))
+ dispcompiler Build = showCompilerId (toolchainCompiler (buildToolchain toolchains))
noticeProgress :: ProgressPhase -> IO ()
noticeProgress phase =
diff --git a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs
index 5480e90537e..d7600d59ede 100644
--- a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs
+++ b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs
@@ -1002,6 +1002,7 @@ printPlan
unwords $
filter (not . null) $
[ " -"
+ , show (elabStage elab)
, if verbosity >= deafening
then prettyShow (installedUnitId elab)
else prettyShow (packageId elab)
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index fd999487dd0..9adb49631d8 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -1683,7 +1683,7 @@ elaborateInstallPlan
:: (SolverId -> [ElaboratedPlanPackage])
-> SolverPackage UnresolvedPkgLoc
-> LogProgress [ElaboratedConfiguredPackage]
- elaborateSolverToComponents mapDep spkg@(SolverPackage qpn _ _ _ deps0 exe_deps0) =
+ elaborateSolverToComponents mapDep spkg@(SolverPackage _qpn _stage _ _ _ deps0 exe_deps0) =
case mkComponentsGraph (elabEnabledSpec elab0) pd of
Right g -> do
let src_comps = componentsGraphToList g
@@ -2072,7 +2072,8 @@ elaborateInstallPlan
elaborateSolverToPackage
pkgWhyNotPerComponent
pkg@( SolverPackage
- qpn
+ _qpn
+ _stage
(SourcePackage pkgid _gpd _srcloc _descOverride)
_flags
_stanzas
@@ -2176,7 +2177,8 @@ elaborateInstallPlan
-> ElaboratedConfiguredPackage
elaborateSolverToCommon
pkg@( SolverPackage
- qpn
+ _qpn
+ stage
(SourcePackage pkgid gdesc srcloc descOverride)
flags
stanzas
@@ -2200,7 +2202,7 @@ elaborateInstallPlan
elabPkgSourceId = pkgid
-- TODO: temporarily set everything to build on build
- elabStage = Build
+ elabStage = stage
elabCompiler = toolchainCompiler (toolchainFor elabStage toolchains)
elabPlatform = toolchainPlatform (toolchainFor elabStage toolchains)
elabProgramDb = toolchainProgramDb (toolchainFor elabStage toolchains)
From 17102ac520162951cb82d22cfeedadcf3d5b3e5a Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Tue, 18 Mar 2025 16:16:23 +0900
Subject: [PATCH 35/82] Make it work [somewhat]
---
Cabal/src/Distribution/Simple/GHC.hs | 5 +-
.../Distribution/Solver/Modular/Preference.hs | 15 ++++
.../src/Distribution/Solver/Modular/Solver.hs | 22 ++++++
.../Distribution/Client/ProjectBuilding.hs | 2 +-
.../Client/ProjectOrchestration.hs | 7 +-
.../Distribution/Client/ProjectPlanning.hs | 69 ++++++++++++++-----
6 files changed, 97 insertions(+), 23 deletions(-)
diff --git a/Cabal/src/Distribution/Simple/GHC.hs b/Cabal/src/Distribution/Simple/GHC.hs
index 04280e5e0eb..8a7bad44b38 100644
--- a/Cabal/src/Distribution/Simple/GHC.hs
+++ b/Cabal/src/Distribution/Simple/GHC.hs
@@ -418,13 +418,10 @@ getInstalledPackages
-> ProgramDb
-> IO InstalledPackageIndex
getInstalledPackages verbosity comp mbWorkDir packagedbs progdb = do
- print $ ("getInstalledPackages", (compilerId comp), packagedbs)
checkPackageDbEnvVar verbosity
checkPackageDbStack verbosity comp packagedbs
pkgss <- getInstalledPackages' verbosity mbWorkDir packagedbs progdb
- let pkgss' = [ (packagedb, (\pkg -> pkg{ InstalledPackageInfo.pkgCompiler = Just (compilerId comp)
- ,InstalledPackageInfo.installedUnitId = ((\x -> mkUnitId $ prettyShow (compilerId comp) ++ ":" ++ (unUnitId x)) . InstalledPackageInfo.installedUnitId) pkg
- ,InstalledPackageInfo.depends = (map (\x -> mkUnitId $ prettyShow (compilerId comp) ++ ":" ++ (unUnitId x)) . InstalledPackageInfo.depends) pkg })
+ let pkgss' = [ (packagedb, (\pkg -> pkg{ InstalledPackageInfo.pkgCompiler = Just (compilerId comp) })
<$> pkgs)
| (packagedb, pkgs) <- pkgss
]
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Preference.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Preference.hs
index c8bf9209528..9cd16d703db 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/Preference.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/Preference.hs
@@ -15,6 +15,7 @@ module Distribution.Solver.Modular.Preference
, onlyConstrained
, sortGoals
, pruneAfterFirstSuccess
+ , pruneHostFromSetup
) where
import Prelude ()
@@ -347,6 +348,20 @@ avoidReinstalls p = go
x
go x = x
+-- | Ensure that Setup (Build time) dependencies only have Build dependencies
+-- available and that Host dependencies only have Host dependencies available.
+pruneHostFromSetup :: EndoTreeTrav d c
+pruneHostFromSetup = go
+ where
+ go (PChoiceF qpn rdm gr cs) | (Q (PackagePath _ (QualSetup _)) _) <- qpn =
+ PChoiceF qpn rdm gr (W.filterKey (not . isHost) cs)
+ go (PChoiceF qpn rdm gr cs) | (Q (PackagePath _ _) _) <- qpn =
+ PChoiceF qpn rdm gr (W.filterKey isHost cs)
+ go x = x
+
+ isHost :: POption -> Bool
+ isHost (POption (I s _ _) _) = s == Host
+
-- | Require all packages to be mentioned in a constraint or as a goal.
onlyConstrained :: (PN -> Bool) -> EndoTreeTrav d QGoalReason
onlyConstrained p = go
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs
index 58de7c9740d..fa6fae2e667 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs
@@ -47,6 +47,8 @@ import qualified Distribution.Solver.Modular.PSQ as PSQ
import Distribution.Simple.Setup (BooleanFlag(..))
import Distribution.Simple.Compiler (compilerInfo)
+import qualified Distribution.Solver.Modular.WeightedPSQ as W
+
#ifdef DEBUG_TRACETREE
import qualified Distribution.Solver.Modular.ConflictSet as CS
import qualified Distribution.Solver.Modular.WeightedPSQ as W
@@ -100,6 +102,7 @@ solve :: SolverConfig -- ^ solver parameters
-> RetryLog Message SolverFailure (Assignment, RevDepMap)
solve sc toolchains idx pkgConfigDB userPrefs userConstraints userGoals =
explorePhase .
+ stageBuildDeps "B" .
traceTree "cycles.json" id .
detectCycles .
traceTree "heuristics.json" id .
@@ -112,6 +115,9 @@ solve sc toolchains idx pkgConfigDB userPrefs userConstraints userGoals =
validationCata .
traceTree "pruned.json" id .
trav prunePhase .
+ -- stageBuildDeps "A'" .
+ trav P.pruneHostFromSetup .
+ stageBuildDeps "A" .
traceTree "build.json" id $
buildPhase
where
@@ -148,6 +154,22 @@ solve sc toolchains idx pkgConfigDB userPrefs userConstraints userGoals =
id)
buildPhase = buildTree idx (independentGoals sc) (S.toList userGoals)
+ stageBuildDeps prefix = go
+ where go :: Tree d c -> Tree d c
+ go (PChoice qpn rdm gr cs) | (Q (PackagePath _ (QualSetup _)) _) <- qpn =
+ (PChoice qpn rdm gr (trace (prefix ++ show qpn ++ '\n':unlines (map (" - " ++) candidates)) (go <$> cs)))
+ where candidates = map show . filter (\(I _s _v l) -> l /= InRepo) . map (\(_w, (POption i _), _v) -> i) $ W.toList cs
+ go (PChoice qpn rdm gr cs) =
+ (PChoice qpn rdm gr (go <$> cs))
+ go (FChoice qfn rdm gr t b d cs) =
+ FChoice qfn rdm gr t b d (go <$> cs)
+ go (SChoice qsn rdm gr t cs) =
+ SChoice qsn rdm gr t (go <$> cs)
+ go (GoalChoice rdm cs) =
+ GoalChoice rdm (go <$> cs)
+ go x@(Fail _ _) = x
+ go x@(Done _ _) = x
+
allExplicit = M.keysSet userConstraints `S.union` userGoals
pkgIsExplicit :: PN -> Bool
diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding.hs b/cabal-install/src/Distribution/Client/ProjectBuilding.hs
index 93e9c93b918..a2aa390e8a7 100644
--- a/cabal-install/src/Distribution/Client/ProjectBuilding.hs
+++ b/cabal-install/src/Distribution/Client/ProjectBuilding.hs
@@ -214,7 +214,7 @@ rebuildTargetsDryRun distDirLayout@DistDirLayout{..} shared =
BuildInplaceOnly{} -> do
-- TODO: [nice to have] use a proper file monitor rather
-- than this dir exists test
- exists <- doesDirectoryExist srcdir
+ exists <- doesDirectoryExist (traceShowId srcdir)
if exists
then dryRunLocalPkg pkg depsBuildStatus srcdir
else return (BuildStatusUnpack tarball)
diff --git a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs
index d7600d59ede..348eb031093 100644
--- a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs
+++ b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs
@@ -1001,8 +1001,9 @@ printPlan
showPkgAndReason (ReadyPackage elab) =
unwords $
filter (not . null) $
+ -- FIXME: ideally we'd like to display the compiler in there as well.
+ -- we do have access to elabStage, but the toolchain isn't around.
[ " -"
- , show (elabStage elab)
, if verbosity >= deafening
then prettyShow (installedUnitId elab)
else prettyShow (packageId elab)
@@ -1122,7 +1123,9 @@ printPlan
showBuildProfile =
"Build profile: "
++ unwords
- [ "-w " ++ (showCompilerId . toolchainCompiler . buildToolchain . pkgConfigToolchains) elaboratedShared
+ [ "-w " ++ (showCompilerId . toolchainCompiler . hostToolchain . pkgConfigToolchains) elaboratedShared
+ -- FIXME: this should only be shown if hostToolchain /= buildToolchain
+ , "-W " ++ (showCompilerId . toolchainCompiler . buildToolchain . pkgConfigToolchains) elaboratedShared
, "-O"
++ ( case globalOptimization <> localOptimization of -- if local is not set, read global
Setup.Flag NoOptimisation -> "0"
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index 9adb49631d8..a4922769bc2 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -167,6 +167,7 @@ import Distribution.Solver.Types.Settings
import Distribution.Solver.Types.SolverId
import Distribution.Solver.Types.SolverPackage
import Distribution.Solver.Types.SourcePackage
+import Distribution.Solver.Types.Stage
import Distribution.ModuleName
import Distribution.Package
@@ -219,9 +220,10 @@ import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.GHCJS as GHCJS
import qualified Distribution.Simple.InstallDirs as InstallDirs
import qualified Distribution.Simple.LocalBuildInfo as Cabal
+import qualified Distribution.Simple.PackageIndex as PI
import qualified Distribution.Simple.Setup as Cabal
import qualified Distribution.Solver.Types.ComponentDeps as CD
-import Distribution.Solver.Types.Stage
+-- import Distribution.Solver.Types.Stage
import Distribution.Solver.Types.Toolchain
import qualified Distribution.Compat.Graph as Graph
@@ -770,11 +772,38 @@ rebuildInstallPlan
, hookHashes
)
$ do
+ -- InstalledPackageIndex
+ -- type InstalledPackageIndex = PackageIndex IPI.InstalledPackageInfo
+ -- data PackageIndex a = PackageIndex
+ -- { -- The primary index. Each InstalledPackageInfo record is uniquely identified
+ -- -- by its UnitId.
+ -- --
+ -- unitIdIndex :: !(Map UnitId a)
+ -- , -- This auxiliary index maps package names (case-sensitively) to all the
+ -- -- versions and instances of that package. This allows us to find all
+ -- -- versions satisfying a dependency.
+ -- --
+ -- -- It is a three-level index. The first level is the package name,
+ -- -- the second is the package version and the final level is instances
+ -- -- of the same package version. These are unique by UnitId
+ -- -- and are kept in preference order.
+ -- --
+ -- -- FIXME: Clarify what "preference order" means. Check that this invariant is
+ -- -- preserved. See #1463 for discussion.
+ -- packageIdIndex :: !(Map (PackageName, LibraryName) (Map Version [a]))
+ -- }
+ -- deriving (Eq, Generic, Show, Read)
+ --
+ -- can probably use fromList $ Map.elems $ on it.
hinstalledPkgIndex <-
getInstalledPackages
verbosity
(hostToolchain toolchains)
corePackageDbs
+ -- this is an aweful hack, however `getInstalledPackages` is
+ -- terribly invovled everywhere so we'll have to do with this
+ -- for now. FIXME!
+ -- let hinstalledPkgIndex' = PI.fromList $ PI.allPackages hinstalledPkgIndex
binstalledPkgIndex <-
getInstalledPackages
verbosity
@@ -797,6 +826,8 @@ rebuildInstallPlan
liftIO $ do
notice verbosity "Resolving dependencies..."
+ liftIO $ print ("build compiler", compilerId $ toolchainCompiler $ buildToolchain toolchains)
+ liftIO $ print ("host compiler", compilerId $ toolchainCompiler $ hostToolchain toolchains)
planOrError <-
foldProgress logMsg (pure . Left) (pure . Right) $
planPackages
@@ -2275,8 +2306,8 @@ elaborateInstallPlan
then BuildInplaceOnly OnDisk
else BuildAndInstall
elabPackageDbs = projectConfigPackageDBs sharedPackageConfig
- elabBuildPackageDBStack = buildAndRegisterDbs
- elabRegisterPackageDBStack = buildAndRegisterDbs
+ elabBuildPackageDBStack = buildAndRegisterDbs stage
+ elabRegisterPackageDBStack = buildAndRegisterDbs stage
elabSetupScriptStyle = packageSetupScriptStyle elabPkgDescription
elabSetupScriptCliVersion =
@@ -2285,19 +2316,25 @@ elaborateInstallPlan
elabPkgDescription
libDepGraph
deps0
- elabSetupPackageDBStack = buildAndRegisterDbs
- inplacePackageDbs = corePackageDbs ++ [distPackageDB (compilerId elabCompiler)]
+ -- This code is ... a bit nuts. We need to parameterise the DB stack
+ -- over the stage. (which is also assigned to elabStage). And now
+ -- we have inplace, core, ... other DBStacks, for the Setup however,
+ -- we _must_ force it to use the Build stage stack. As that's where
+ -- the setup dependencies will be found.
+ elabSetupPackageDBStack = buildAndRegisterDbs Build
+
+ inplacePackageDbs stage = corePackageDbs stage ++ [distPackageDB (compilerId (toolchainCompiler (toolchainFor stage toolchains)))]
- corePackageDbs = storePackageDBStack elabCompiler (projectConfigPackageDBs sharedPackageConfig)
+ corePackageDbs stage = storePackageDBStack (toolchainCompiler (toolchainFor stage toolchains)) (projectConfigPackageDBs sharedPackageConfig)
- elabInplaceBuildPackageDBStack = inplacePackageDbs
- elabInplaceRegisterPackageDBStack = inplacePackageDbs
- elabInplaceSetupPackageDBStack = inplacePackageDbs
+ elabInplaceBuildPackageDBStack = inplacePackageDbs stage
+ elabInplaceRegisterPackageDBStack = inplacePackageDbs stage
+ elabInplaceSetupPackageDBStack = inplacePackageDbs stage
- buildAndRegisterDbs
- | shouldBuildInplaceOnly pkg = inplacePackageDbs
- | otherwise = corePackageDbs
+ buildAndRegisterDbs stage
+ | shouldBuildInplaceOnly pkg = inplacePackageDbs stage
+ | otherwise = corePackageDbs stage
elabPkgDescriptionOverride = descOverride
@@ -3877,10 +3914,10 @@ setupHsScriptOptions
-- - if we commit to a Cabal version, the logic in
Nothing
else Just elabSetupScriptCliVersion
- , -- for Setup.hs, we _always_ want to use the HOST toolchain.
- useCompiler = Just (toolchainCompiler $ hostToolchain $ pkgConfigToolchains)
- , usePlatform = Just (toolchainPlatform $ hostToolchain $ pkgConfigToolchains)
- , useProgramDb = toolchainProgramDb $ hostToolchain $ pkgConfigToolchains
+ , -- for Setup.hs, we _always_ want to use the BUILD toolchain.
+ useCompiler = Just (toolchainCompiler $ buildToolchain $ pkgConfigToolchains)
+ , usePlatform = Just (toolchainPlatform $ buildToolchain $ pkgConfigToolchains)
+ , useProgramDb = toolchainProgramDb $ buildToolchain $ pkgConfigToolchains
, usePackageDB = elabSetupPackageDBStack
, usePackageIndex = Nothing
, useDependencies =
From 1677003e122a5495da8fb45b95e4485d867dbb1d Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Tue, 18 Mar 2025 17:57:42 +0900
Subject: [PATCH 36/82] Make sure we are aware of BOTH build and host
compilers.
---
.../src/Distribution/Client/ProjectPlanning.hs | 10 +++++-----
1 file changed, 5 insertions(+), 5 deletions(-)
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index a4922769bc2..aac4708e6b3 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -826,8 +826,6 @@ rebuildInstallPlan
liftIO $ do
notice verbosity "Resolving dependencies..."
- liftIO $ print ("build compiler", compilerId $ toolchainCompiler $ buildToolchain toolchains)
- liftIO $ print ("host compiler", compilerId $ toolchainCompiler $ hostToolchain toolchains)
planOrError <-
foldProgress logMsg (pure . Left) (pure . Right) $
planPackages
@@ -991,10 +989,11 @@ rebuildInstallPlan
-> Rebuild ElaboratedInstallPlan
phaseImprovePlan elaboratedPlan elaboratedShared = do
liftIO $ debug verbosity "Improving the install plan..."
- storePkgIdSet <- getStoreEntries cabalStoreDirLayout compiler
+ hstorePkgIdSet <- getStoreEntries cabalStoreDirLayout hcompiler
+ bstorePkgIdSet <- getStoreEntries cabalStoreDirLayout bcompiler
let improvedPlan =
improveInstallPlanWithInstalledPackages
- storePkgIdSet
+ (hstorePkgIdSet `Set.union` bstorePkgIdSet)
elaboratedPlan
liftIO $ debugNoWrap verbosity (showElaboratedInstallPlan improvedPlan)
-- TODO: [nice to have] having checked which packages from the store
@@ -1003,7 +1002,8 @@ rebuildInstallPlan
-- matches up as expected, e.g. no dangling deps, files deleted.
return improvedPlan
where
- compiler = toolchainCompiler (hostToolchain (pkgConfigToolchains elaboratedShared))
+ hcompiler = toolchainCompiler (hostToolchain (pkgConfigToolchains elaboratedShared))
+ bcompiler = toolchainCompiler (buildToolchain (pkgConfigToolchains elaboratedShared))
-- | If a 'PackageSpecifier' refers to a single package, return Just that
-- package.
From d449b914b58e4c8c06729d3c86a97e2de08ae950 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Tue, 18 Mar 2025 17:58:39 +0900
Subject: [PATCH 37/82] Drop debugging
---
cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs | 3 ---
1 file changed, 3 deletions(-)
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs
index fa6fae2e667..887c1fce563 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs
@@ -102,7 +102,6 @@ solve :: SolverConfig -- ^ solver parameters
-> RetryLog Message SolverFailure (Assignment, RevDepMap)
solve sc toolchains idx pkgConfigDB userPrefs userConstraints userGoals =
explorePhase .
- stageBuildDeps "B" .
traceTree "cycles.json" id .
detectCycles .
traceTree "heuristics.json" id .
@@ -115,9 +114,7 @@ solve sc toolchains idx pkgConfigDB userPrefs userConstraints userGoals =
validationCata .
traceTree "pruned.json" id .
trav prunePhase .
- -- stageBuildDeps "A'" .
trav P.pruneHostFromSetup .
- stageBuildDeps "A" .
traceTree "build.json" id $
buildPhase
where
From a2144ecc7431bec60ef652a27d0d11fa5d35a915 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Tue, 18 Mar 2025 18:00:39 +0900
Subject: [PATCH 38/82] Drop more debugging
---
cabal-install/src/Distribution/Client/ProjectPlanning.hs | 3 ---
1 file changed, 3 deletions(-)
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index aac4708e6b3..3b790a56d7e 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -664,9 +664,6 @@ rebuildInstallPlan
$ do
toolchains <- phaseConfigureToolchain projectConfig
- liftIO $ print ("build compiler", compilerId $ toolchainCompiler $ buildToolchain toolchains)
- liftIO $ print ("host compiler", compilerId $ toolchainCompiler $ hostToolchain toolchains)
-
-- _ <- phaseConfigurePrograms projectConfig compilerEtc
(solverPlan, pkgConfigDB, totalIndexState, activeRepos) <-
phaseRunSolver
From d183c9b10eb049571d3be2897f74ca3e3531f6f1 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Tue, 18 Mar 2025 20:59:17 +0900
Subject: [PATCH 39/82] Fix build-depends also.
---
.../src/Distribution/Solver/Modular/Preference.hs | 5 +++++
.../src/Distribution/Solver/Modular/Solver.hs | 7 +++++++
2 files changed, 12 insertions(+)
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Preference.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Preference.hs
index 9cd16d703db..9adaa8cf410 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/Preference.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/Preference.hs
@@ -353,8 +353,13 @@ avoidReinstalls p = go
pruneHostFromSetup :: EndoTreeTrav d c
pruneHostFromSetup = go
where
+ -- for Setup(.hs) and build-depends, we want to force Build packages.
go (PChoiceF qpn rdm gr cs) | (Q (PackagePath _ (QualSetup _)) _) <- qpn =
PChoiceF qpn rdm gr (W.filterKey (not . isHost) cs)
+ -- QualExe are build-depends. Structure is QualExe (comp) (build-depend).
+ go (PChoiceF qpn rdm gr cs) | (Q (PackagePath _ (QualExe _ _)) _) <- qpn =
+ PChoiceF qpn rdm gr (W.filterKey (not . isHost) cs)
+ -- everything else use Host packages.
go (PChoiceF qpn rdm gr cs) | (Q (PackagePath _ _) _) <- qpn =
PChoiceF qpn rdm gr (W.filterKey isHost cs)
go x = x
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs
index 887c1fce563..2efd0610dcd 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs
@@ -115,6 +115,7 @@ solve sc toolchains idx pkgConfigDB userPrefs userConstraints userGoals =
traceTree "pruned.json" id .
trav prunePhase .
trav P.pruneHostFromSetup .
+ -- stageBuildDeps "build: " .
traceTree "build.json" id $
buildPhase
where
@@ -153,9 +154,15 @@ solve sc toolchains idx pkgConfigDB userPrefs userConstraints userGoals =
stageBuildDeps prefix = go
where go :: Tree d c -> Tree d c
+ -- For Setup we must use the build compiler, as the host compiler
+ -- may not be able to produce code that runs on the build machine.
go (PChoice qpn rdm gr cs) | (Q (PackagePath _ (QualSetup _)) _) <- qpn =
(PChoice qpn rdm gr (trace (prefix ++ show qpn ++ '\n':unlines (map (" - " ++) candidates)) (go <$> cs)))
where candidates = map show . filter (\(I _s _v l) -> l /= InRepo) . map (\(_w, (POption i _), _v) -> i) $ W.toList cs
+ -- Same for build-depends. These show up as QualExe (component) (build-depends).
+ go (PChoice qpn rdm gr cs) | (Q (PackagePath _ (QualExe _ _)) _) <- qpn =
+ (PChoice qpn rdm gr (trace (prefix ++ show qpn ++ '\n':unlines (map (" - " ++) candidates)) (go <$> cs)))
+ where candidates = map show . filter (\(I _s _v l) -> l /= InRepo) . map (\(_w, (POption i _), _v) -> i) $ W.toList cs
go (PChoice qpn rdm gr cs) =
(PChoice qpn rdm gr (go <$> cs))
go (FChoice qfn rdm gr t b d cs) =
From 184755d76ffc133174ba83b1ca6467ca9c3260a4 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Wed, 19 Mar 2025 09:38:19 +0900
Subject: [PATCH 40/82] it's build-compiler, not host-compiler for -W
---
cabal-install/src/Distribution/Client/Setup.hs | 12 ++++++------
1 file changed, 6 insertions(+), 6 deletions(-)
diff --git a/cabal-install/src/Distribution/Client/Setup.hs b/cabal-install/src/Distribution/Client/Setup.hs
index b10ee9dee49..a429836dc90 100644
--- a/cabal-install/src/Distribution/Client/Setup.hs
+++ b/cabal-install/src/Distribution/Client/Setup.hs
@@ -1052,8 +1052,8 @@ configureExOptions _showOrParseArgs src =
)
, option
[]
- ["host-compiler"]
- "host compiler"
+ ["build-compiler"]
+ "build compiler"
configBuildHcFlavor
(\v flags -> flags{configBuildHcFlavor = v})
( choiceOpt
@@ -1063,15 +1063,15 @@ configureExOptions _showOrParseArgs src =
)
, option
"W"
- ["with-host-compiler", "with-host-hc"]
- "give the path to the compiler for the host toolchain"
+ ["with-build-compiler", "with-build-hc"]
+ "give the path to the compiler for the build toolchain"
configBuildHcPath
(\v flags -> flags{configBuildHcPath = v})
(reqArgFlag "PATH")
, option
""
- ["with-host-hc-pkg"]
- "give the path to the package tool for the host toolchain"
+ ["with-build-hc-pkg"]
+ "give the path to the package tool for the build toolchain"
configBuildHcPkg
(\v flags -> flags{configBuildHcPkg = v})
(reqArgFlag "PATH")
From 57fca266863a7980878a856b1da953df0cb6a021 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Wed, 19 Mar 2025 10:27:17 +0900
Subject: [PATCH 41/82] Don't prune if buildIsHost
---
.../src/Distribution/Solver/Modular/Solver.hs | 4 ++--
.../src/Distribution/Solver/Types/Toolchain.hs | 6 ++++++
2 files changed, 8 insertions(+), 2 deletions(-)
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs
index 2efd0610dcd..8604fa35c47 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs
@@ -24,7 +24,7 @@ import Distribution.Solver.Types.PackagePreferences
import Distribution.Solver.Types.PkgConfigDb (PkgConfigDb)
import Distribution.Solver.Types.LabeledPackageConstraint
import Distribution.Solver.Types.Settings
-import Distribution.Solver.Types.Toolchain ( Toolchains(..), Toolchain(..) )
+import Distribution.Solver.Types.Toolchain ( Toolchains(..), Toolchain(..), buildIsHost )
import Distribution.Solver.Types.Variable
import Distribution.Solver.Modular.Assignment
@@ -114,7 +114,7 @@ solve sc toolchains idx pkgConfigDB userPrefs userConstraints userGoals =
validationCata .
traceTree "pruned.json" id .
trav prunePhase .
- trav P.pruneHostFromSetup .
+ (if buildIsHost toolchains then id else trav P.pruneHostFromSetup) .
-- stageBuildDeps "build: " .
traceTree "build.json" id $
buildPhase
diff --git a/cabal-install-solver/src/Distribution/Solver/Types/Toolchain.hs b/cabal-install-solver/src/Distribution/Solver/Types/Toolchain.hs
index 3126a4abfbd..d7b9312520b 100644
--- a/cabal-install-solver/src/Distribution/Solver/Types/Toolchain.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Types/Toolchain.hs
@@ -1,10 +1,12 @@
{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE NamedFieldPuns #-}
module Distribution.Solver.Types.Toolchain
( Toolchain (..)
, Toolchains (..)
, toolchainFor
, mkToolchainsWithHost
+ , buildIsHost
) where
import Distribution.Compat.Prelude
@@ -55,3 +57,7 @@ mkToolchainsWithHost platform compiler =
{ buildToolchain = Toolchain platform compiler (error "build program db missing")
, hostToolchain = Toolchain platform compiler (error "host program db missing")
}
+
+buildIsHost :: Toolchains -> Bool
+buildIsHost Toolchains {buildToolchain, hostToolchain} =
+ buildToolchain == hostToolchain
From 8b3bd3412188adc99d799ad8d3212933ed0edb5d Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Wed, 19 Mar 2025 12:47:47 +0900
Subject: [PATCH 42/82] prune inRepo from build deps
---
.../src/Distribution/Solver/Modular/Preference.hs | 12 +++++++++---
.../src/Distribution/Solver/Modular/Solver.hs | 10 +++++++---
2 files changed, 16 insertions(+), 6 deletions(-)
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Preference.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Preference.hs
index 9adaa8cf410..6976bbccff2 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/Preference.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/Preference.hs
@@ -350,22 +350,28 @@ avoidReinstalls p = go
-- | Ensure that Setup (Build time) dependencies only have Build dependencies
-- available and that Host dependencies only have Host dependencies available.
+-- We also do not want to use InRepo dependencies for setup/build-depends. This
+-- easily leads to cycles.
pruneHostFromSetup :: EndoTreeTrav d c
pruneHostFromSetup = go
where
-- for Setup(.hs) and build-depends, we want to force Build packages.
go (PChoiceF qpn rdm gr cs) | (Q (PackagePath _ (QualSetup _)) _) <- qpn =
- PChoiceF qpn rdm gr (W.filterKey (not . isHost) cs)
+ PChoiceF qpn rdm gr (W.filterKey (not . isHostOrRepo) cs)
-- QualExe are build-depends. Structure is QualExe (comp) (build-depend).
go (PChoiceF qpn rdm gr cs) | (Q (PackagePath _ (QualExe _ _)) _) <- qpn =
- PChoiceF qpn rdm gr (W.filterKey (not . isHost) cs)
+ PChoiceF qpn rdm gr (W.filterKey (not . isHostOrRepo) cs)
-- everything else use Host packages.
go (PChoiceF qpn rdm gr cs) | (Q (PackagePath _ _) _) <- qpn =
PChoiceF qpn rdm gr (W.filterKey isHost cs)
go x = x
isHost :: POption -> Bool
- isHost (POption (I s _ _) _) = s == Host
+ isHost (POption (I s _v _l) _) = s == Host
+ isInRepo :: POption -> Bool
+ isInRepo (POption (I _s _v l) _) = l == InRepo
+ isHostOrRepo :: POption -> Bool
+ isHostOrRepo (POption (I s _v l) _) = s == Host || l == InRepo
-- | Require all packages to be mentioned in a constraint or as a goal.
onlyConstrained :: (PN -> Bool) -> EndoTreeTrav d QGoalReason
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs
index 8604fa35c47..91d19badc25 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs
@@ -114,8 +114,8 @@ solve sc toolchains idx pkgConfigDB userPrefs userConstraints userGoals =
validationCata .
traceTree "pruned.json" id .
trav prunePhase .
+ stageBuildDeps "build: " .
(if buildIsHost toolchains then id else trav P.pruneHostFromSetup) .
- -- stageBuildDeps "build: " .
traceTree "build.json" id $
buildPhase
where
@@ -158,11 +158,15 @@ solve sc toolchains idx pkgConfigDB userPrefs userConstraints userGoals =
-- may not be able to produce code that runs on the build machine.
go (PChoice qpn rdm gr cs) | (Q (PackagePath _ (QualSetup _)) _) <- qpn =
(PChoice qpn rdm gr (trace (prefix ++ show qpn ++ '\n':unlines (map (" - " ++) candidates)) (go <$> cs)))
- where candidates = map show . filter (\(I _s _v l) -> l /= InRepo) . map (\(_w, (POption i _), _v) -> i) $ W.toList cs
+ where candidates = map show
+ -- . filter (\(I _s _v l) -> l /= InRepo)
+ . map (\(_w, (POption i _), _v) -> i) $ W.toList cs
-- Same for build-depends. These show up as QualExe (component) (build-depends).
go (PChoice qpn rdm gr cs) | (Q (PackagePath _ (QualExe _ _)) _) <- qpn =
(PChoice qpn rdm gr (trace (prefix ++ show qpn ++ '\n':unlines (map (" - " ++) candidates)) (go <$> cs)))
- where candidates = map show . filter (\(I _s _v l) -> l /= InRepo) . map (\(_w, (POption i _), _v) -> i) $ W.toList cs
+ where candidates = map show
+ -- . filter (\(I _s _v l) -> l /= InRepo)
+ . map (\(_w, (POption i _), _v) -> i) $ W.toList cs
go (PChoice qpn rdm gr cs) =
(PChoice qpn rdm gr (go <$> cs))
go (FChoice qfn rdm gr t b d cs) =
From 1c536a3d9f8c35b155470b79f23ac3e74b3cbb14 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Thu, 20 Mar 2025 15:30:59 +0900
Subject: [PATCH 43/82] Add `--build-package-db`.
---
.../src/Distribution/Client/Config.hs | 1 +
.../Client/ProjectConfig/Legacy.hs | 2 ++
.../Client/ProjectConfig/Types.hs | 1 +
.../Distribution/Client/ProjectPlanning.hs | 19 +++++++++++++------
.../src/Distribution/Client/Setup.hs | 14 ++++++++++++++
5 files changed, 31 insertions(+), 6 deletions(-)
diff --git a/cabal-install/src/Distribution/Client/Config.hs b/cabal-install/src/Distribution/Client/Config.hs
index d27fd14f9e6..71888779578 100644
--- a/cabal-install/src/Distribution/Client/Config.hs
+++ b/cabal-install/src/Distribution/Client/Config.hs
@@ -576,6 +576,7 @@ instance Semigroup SavedConfig where
, configBuildHcFlavor = combine configBuildHcFlavor
, configBuildHcPath = combine configBuildHcPath
, configBuildHcPkg = combine configBuildHcPkg
+ , configBuildPackageDBs = lastNonEmpty configBuildPackageDBs
}
where
combine = combine' savedConfigureExFlags
diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs
index 9be3a34ae6e..7c357c70a8a 100644
--- a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs
+++ b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs
@@ -705,6 +705,7 @@ convertLegacyAllPackageFlags globalFlags configFlags configExFlags installFlags
ProjectConfigShared{..}
where
projectConfigPackageDBs = (fmap . fmap) (interpretPackageDB Nothing) projectConfigPackageDBs_
+ projectConfigBuildPackageDBs = (fmap . fmap) (interpretPackageDB Nothing) projectConfigBuildPackageDBs_
projectConfigHookHashes = mempty -- :: Map FilePath HookAccept
projectConfigDistDir = fmap getSymbolicPath projectConfigAbsoluteDistDir
@@ -744,6 +745,7 @@ convertLegacyAllPackageFlags globalFlags configFlags configExFlags installFlags
, configBuildHcFlavor = projectConfigBuildHcFlavor
, configBuildHcPath = projectConfigBuildHcPath
, configBuildHcPkg = projectConfigBuildHcPkg
+ , configBuildPackageDBs = projectConfigBuildPackageDBs_
} = configExFlags
InstallFlags
diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs
index 8a0a74ac9ed..0ae0bcd6d6a 100644
--- a/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs
+++ b/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs
@@ -202,6 +202,7 @@ data ProjectConfigShared = ProjectConfigShared
projectConfigInstallDirs :: InstallDirs (Flag PathTemplate)
, projectConfigPackageDBs :: [Maybe PackageDBCWD]
+ , projectConfigBuildPackageDBs :: [Maybe PackageDBCWD]
, -- configuration used both by the solver and other phases
projectConfigRemoteRepos :: NubList RemoteRepo
-- ^ Available Hackage servers.
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index 3b790a56d7e..081e1bf3e49 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -796,7 +796,7 @@ rebuildInstallPlan
getInstalledPackages
verbosity
(hostToolchain toolchains)
- corePackageDbs
+ (corePackageDbs Host)
-- this is an aweful hack, however `getInstalledPackages` is
-- terribly invovled everywhere so we'll have to do with this
-- for now. FIXME!
@@ -805,7 +805,7 @@ rebuildInstallPlan
getInstalledPackages
verbosity
(buildToolchain toolchains)
- corePackageDbs
+ (corePackageDbs Build)
(sourcePkgDb, tis, ar) <-
getSourcePackages
@@ -840,9 +840,13 @@ rebuildInstallPlan
dieWithException verbosity $ PhaseRunSolverErr msg
Right plan -> return (plan, pkgConfigDB, tis, ar)
where
- corePackageDbs :: PackageDBStackCWD
- corePackageDbs =
- Cabal.interpretPackageDbFlags False (projectConfigPackageDBs projectConfigShared)
+ corePackageDbs :: Stage -> PackageDBStackCWD
+ corePackageDbs stage =
+ Cabal.interpretPackageDbFlags False (packageDBs stage)
+
+ packageDBs Host = projectConfigPackageDBs projectConfigShared
+ packageDBs Build = projectConfigBuildPackageDBs projectConfigShared
+
withRepoCtx :: (RepoContext -> IO a) -> IO a
withRepoCtx =
@@ -2323,7 +2327,10 @@ elaborateInstallPlan
inplacePackageDbs stage = corePackageDbs stage ++ [distPackageDB (compilerId (toolchainCompiler (toolchainFor stage toolchains)))]
- corePackageDbs stage = storePackageDBStack (toolchainCompiler (toolchainFor stage toolchains)) (projectConfigPackageDBs sharedPackageConfig)
+ corePackageDbs stage = storePackageDBStack (toolchainCompiler (toolchainFor stage toolchains)) (packageDBs stage)
+
+ packageDBs Host = projectConfigPackageDBs sharedPackageConfig
+ packageDBs Build = projectConfigBuildPackageDBs sharedPackageConfig
elabInplaceBuildPackageDBStack = inplacePackageDbs stage
elabInplaceRegisterPackageDBStack = inplacePackageDbs stage
diff --git a/cabal-install/src/Distribution/Client/Setup.hs b/cabal-install/src/Distribution/Client/Setup.hs
index a429836dc90..05e94256e64 100644
--- a/cabal-install/src/Distribution/Client/Setup.hs
+++ b/cabal-install/src/Distribution/Client/Setup.hs
@@ -923,6 +923,7 @@ data ConfigExFlags = ConfigExFlags
, configBuildHcFlavor :: Flag CompilerFlavor
, configBuildHcPath :: Flag FilePath
, configBuildHcPkg :: Flag FilePath
+ , configBuildPackageDBs :: [Maybe PackageDB]
}
deriving (Eq, Show, Generic)
@@ -1075,6 +1076,19 @@ configureExOptions _showOrParseArgs src =
configBuildHcPkg
(\v flags -> flags{configBuildHcPkg = v})
(reqArgFlag "PATH")
+ , option
+ ""
+ ["build-package-db"]
+ ( "Append the given package database to the list of package"
+ ++ " databases used (to satisfy dependencies and register into)."
+ ++ " May be a specific file, 'global' or 'user'. The initial list"
+ ++ " is ['global'], ['global', 'user'], or ['global', $sandbox],"
+ ++ " depending on context. Use 'clear' to reset the list to empty."
+ ++ " See the user guide for details."
+ )
+ configBuildPackageDBs
+ (\v flags -> flags{configBuildPackageDBs = v})
+ (reqArg' "DB" readPackageDbList showPackageDbList)
]
writeGhcEnvironmentFilesPolicyParser :: ReadE (Flag WriteGhcEnvironmentFilesPolicy)
From 675f0865ec9afae9590a97b84fa8c1d85bafff02 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Thu, 20 Mar 2025 15:31:43 +0900
Subject: [PATCH 44/82] Fixup: Really only filter HOST, not InRepo.
---
.../src/Distribution/Solver/Modular/Preference.hs | 8 ++------
1 file changed, 2 insertions(+), 6 deletions(-)
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Preference.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Preference.hs
index 6976bbccff2..e17287324f5 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/Preference.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/Preference.hs
@@ -357,10 +357,10 @@ pruneHostFromSetup = go
where
-- for Setup(.hs) and build-depends, we want to force Build packages.
go (PChoiceF qpn rdm gr cs) | (Q (PackagePath _ (QualSetup _)) _) <- qpn =
- PChoiceF qpn rdm gr (W.filterKey (not . isHostOrRepo) cs)
+ PChoiceF qpn rdm gr (W.filterKey (not . isHost) cs)
-- QualExe are build-depends. Structure is QualExe (comp) (build-depend).
go (PChoiceF qpn rdm gr cs) | (Q (PackagePath _ (QualExe _ _)) _) <- qpn =
- PChoiceF qpn rdm gr (W.filterKey (not . isHostOrRepo) cs)
+ PChoiceF qpn rdm gr (W.filterKey (not . isHost) cs)
-- everything else use Host packages.
go (PChoiceF qpn rdm gr cs) | (Q (PackagePath _ _) _) <- qpn =
PChoiceF qpn rdm gr (W.filterKey isHost cs)
@@ -368,10 +368,6 @@ pruneHostFromSetup = go
isHost :: POption -> Bool
isHost (POption (I s _v _l) _) = s == Host
- isInRepo :: POption -> Bool
- isInRepo (POption (I _s _v l) _) = l == InRepo
- isHostOrRepo :: POption -> Bool
- isHostOrRepo (POption (I s _v l) _) = s == Host || l == InRepo
-- | Require all packages to be mentioned in a constraint or as a goal.
onlyConstrained :: (PN -> Bool) -> EndoTreeTrav d QGoalReason
From 6bfb13b92317e899d36c509d6e972faaabf92b77 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Thu, 20 Mar 2025 20:24:10 +0900
Subject: [PATCH 45/82] Fixup host/build package-db
---
.../src/Distribution/Client/ProjectPlanning.hs | 10 +++++++---
1 file changed, 7 insertions(+), 3 deletions(-)
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index 081e1bf3e49..389685e379c 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -845,7 +845,9 @@ rebuildInstallPlan
Cabal.interpretPackageDbFlags False (packageDBs stage)
packageDBs Host = projectConfigPackageDBs projectConfigShared
- packageDBs Build = projectConfigBuildPackageDBs projectConfigShared
+ packageDBs Build
+ | buildIsHost toolchains, null (projectConfigBuildPackageDBs projectConfigShared) = projectConfigPackageDBs projectConfigShared
+ | otherwise = projectConfigBuildPackageDBs projectConfigShared
withRepoCtx :: (RepoContext -> IO a) -> IO a
@@ -2330,7 +2332,9 @@ elaborateInstallPlan
corePackageDbs stage = storePackageDBStack (toolchainCompiler (toolchainFor stage toolchains)) (packageDBs stage)
packageDBs Host = projectConfigPackageDBs sharedPackageConfig
- packageDBs Build = projectConfigBuildPackageDBs sharedPackageConfig
+ packageDBs Build
+ | buildIsHost toolchains, null (projectConfigBuildPackageDBs sharedPackageConfig) = projectConfigPackageDBs sharedPackageConfig
+ | otherwise = projectConfigBuildPackageDBs sharedPackageConfig
elabInplaceBuildPackageDBStack = inplacePackageDbs stage
elabInplaceRegisterPackageDBStack = inplacePackageDbs stage
@@ -4030,7 +4034,7 @@ computeInstallDirs storeDirLayout defaultInstallDirs elaboratedShared elab
-- use special simplified install dirs
storePackageInstallDirs'
storeDirLayout
- (toolchainCompiler $ buildToolchain $ pkgConfigToolchains elaboratedShared)
+ (toolchainCompiler $ hostToolchain $ pkgConfigToolchains elaboratedShared)
(elabUnitId elab)
-- TODO: [code cleanup] perhaps reorder this code
From 6ca784e4beddd567f2de77d547edcd4337a68f96 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Thu, 20 Mar 2025 20:24:30 +0900
Subject: [PATCH 46/82] Cleaup
---
.../src/Distribution/Solver/Modular/Solver.hs | 3 ++-
.../src/Distribution/Client/ProjectPlanning.hs | 12 ++++++++++--
2 files changed, 12 insertions(+), 3 deletions(-)
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs
index 91d19badc25..89c7daa0223 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs
@@ -114,8 +114,9 @@ solve sc toolchains idx pkgConfigDB userPrefs userConstraints userGoals =
validationCata .
traceTree "pruned.json" id .
trav prunePhase .
- stageBuildDeps "build: " .
+ -- stageBuildDeps "post-prune: " .
(if buildIsHost toolchains then id else trav P.pruneHostFromSetup) .
+ -- stageBuildDeps "build: " .
traceTree "build.json" id $
buildPhase
where
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index 389685e379c..fc3cfa90280 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -181,7 +181,7 @@ import Distribution.Simple.LocalBuildInfo
)
import Distribution.Simple.BuildWay
-import Distribution.Simple.PackageIndex (InstalledPackageIndex)
+import Distribution.Simple.PackageIndex (InstalledPackageIndex, allPackages)
import Distribution.Simple.Program
import Distribution.Simple.Program.Db
import Distribution.Simple.Program.Find
@@ -805,7 +805,9 @@ rebuildInstallPlan
getInstalledPackages
verbosity
(buildToolchain toolchains)
- (corePackageDbs Build)
+ -- FIXME: HACK
+ -- if host and build compiler are the same, we want to get -package-db in here.
+ (corePackageDbs $ if buildIsHost toolchains then Host else Build)
(sourcePkgDb, tis, ar) <-
getSourcePackages
@@ -823,6 +825,12 @@ rebuildInstallPlan
liftIO $ do
notice verbosity "Resolving dependencies..."
+ -- putStrLn "== installedPackages"
+ -- putStrLn $ unlines $ map (prettyShow . IPI.sourcePackageId) $ PI.allPackages installedPackages
+ -- putStrLn "== binstalledPackages"
+ -- putStrLn $ unlines $ map (prettyShow . IPI.sourcePackageId) $ PI.allPackages binstalledPkgIndex
+ -- putStrLn "== hinstalledPackages"
+ -- putStrLn $ unlines $ map (prettyShow . IPI.sourcePackageId) $ PI.allPackages hinstalledPkgIndex
planOrError <-
foldProgress logMsg (pure . Left) (pure . Right) $
planPackages
From 418e8c54cc22f8aefa0adce283c579cd8db13f2d Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Sat, 22 Mar 2025 20:13:19 +0900
Subject: [PATCH 47/82] Fix assert
---
.../Distribution/Client/ProjectBuilding/UnpackedPackage.hs | 5 ++++-
cabal-install/src/Distribution/Client/ProjectPlanning.hs | 1 +
.../src/Distribution/Client/ProjectPlanning/Types.hs | 3 ++-
3 files changed, 7 insertions(+), 2 deletions(-)
diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs b/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs
index 3ca93d62fd5..1a1e286596b 100644
--- a/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs
+++ b/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs
@@ -761,7 +761,10 @@ buildAndInstallUnpackedPackage
| otherwise = do
assert
( elabRegisterPackageDBStack pkg
- == storePackageDBStack compiler (elabPackageDbs pkg)
+ == storePackageDBStack compiler (case elabStage pkg of
+ Host -> elabPackageDbs pkg
+ Build -> elabBuildPackageDbs pkg
+ )
)
(return ())
_ <-
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index fc3cfa90280..bb90d600c50 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -2317,6 +2317,7 @@ elaborateInstallPlan
then BuildInplaceOnly OnDisk
else BuildAndInstall
elabPackageDbs = projectConfigPackageDBs sharedPackageConfig
+ elabBuildPackageDbs = projectConfigBuildPackageDBs sharedPackageConfig
elabBuildPackageDBStack = buildAndRegisterDbs stage
elabRegisterPackageDBStack = buildAndRegisterDbs stage
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs b/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs
index 16b791105ef..a4f22a25f2b 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs
@@ -253,7 +253,7 @@ data ElaboratedConfiguredPackage = ElaboratedConfiguredPackage
-- they explicitly disabled.
, elabStage :: Stage
-
+
-- TODO: The 'Bool' here should be refined into an ADT with three
-- cases: NotRequested, ExplicitlyRequested and
-- ImplicitlyRequested. A stanza is explicitly requested if
@@ -268,6 +268,7 @@ data ElaboratedConfiguredPackage = ElaboratedConfiguredPackage
-- just happen not to have any tests. (But perhaps we should
-- warn if ALL local packages don't have any tests.)
, elabPackageDbs :: [Maybe PackageDBCWD]
+ , elabBuildPackageDbs :: [Maybe PackageDBCWD]
, elabSetupPackageDBStack :: PackageDBStackCWD
, elabBuildPackageDBStack :: PackageDBStackCWD
, elabRegisterPackageDBStack :: PackageDBStackCWD
From bb65785bd7dc018bc3779ba250c1c564cb9d773a Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Mon, 24 Mar 2025 08:21:29 +0900
Subject: [PATCH 48/82] fixup! Fixup host/build package-db
---
cabal-install/src/Distribution/Client/ProjectPlanning.hs | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index bb90d600c50..a55f6bee2da 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -4028,7 +4028,7 @@ computeInstallDirs storeDirLayout defaultInstallDirs elaboratedShared elab
( InstallDirs.absoluteInstallDirs
(elabPkgSourceId elab)
(elabUnitId elab)
- (compilerInfo (toolchainCompiler $ buildToolchain $ pkgConfigToolchains elaboratedShared))
+ (compilerInfo (toolchainCompiler $ toolchainFor (elabStage elab) $ pkgConfigToolchains elaboratedShared))
InstallDirs.NoCopyDest
(toolchainPlatform $ buildToolchain $ pkgConfigToolchains elaboratedShared)
defaultInstallDirs
@@ -4043,7 +4043,7 @@ computeInstallDirs storeDirLayout defaultInstallDirs elaboratedShared elab
-- use special simplified install dirs
storePackageInstallDirs'
storeDirLayout
- (toolchainCompiler $ hostToolchain $ pkgConfigToolchains elaboratedShared)
+ (toolchainCompiler $ toolchainFor (elabStage elab) $ pkgConfigToolchains elaboratedShared)
(elabUnitId elab)
-- TODO: [code cleanup] perhaps reorder this code
From 674f2b200ac8af30d60cdead452ebd7ca0485961 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Mon, 24 Mar 2025 08:22:17 +0900
Subject: [PATCH 49/82] Add cabal.project: build-packages
---
.../src/Distribution/Client/ProjectConfig.hs | 5 ++++-
.../src/Distribution/Client/ProjectConfig/Legacy.hs | 11 +++++++++++
.../src/Distribution/Client/ProjectConfig/Types.hs | 5 +++++
3 files changed, 20 insertions(+), 1 deletion(-)
diff --git a/cabal-install/src/Distribution/Client/ProjectConfig.hs b/cabal-install/src/Distribution/Client/ProjectConfig.hs
index 5bf2ab41e94..fd96eb4d2f3 100644
--- a/cabal-install/src/Distribution/Client/ProjectConfig.hs
+++ b/cabal-install/src/Distribution/Client/ProjectConfig.hs
@@ -798,6 +798,8 @@ defaultImplicitProjectConfig =
mempty
{ -- We expect a package in the current directory.
projectPackages = ["./*.cabal"]
+ -- By default we do not assume any special build packages.
+ , projectBuildPackages = []
, projectConfigProvenance = Set.singleton Implicit
}
@@ -1084,11 +1086,12 @@ findProjectPackages
DistDirLayout{distProjectRootDirectory}
ProjectConfig{..} = do
requiredPkgs <- findPackageLocations True projectPackages
+ buildPkgs <- findPackageLocations True projectBuildPackages
optionalPkgs <- findPackageLocations False projectPackagesOptional
let repoPkgs = map ProjectPackageRemoteRepo projectPackagesRepo
namedPkgs = map ProjectPackageNamed projectPackagesNamed
- return (concat [requiredPkgs, optionalPkgs, repoPkgs, namedPkgs])
+ return (concat [requiredPkgs, buildPkgs, optionalPkgs, repoPkgs, namedPkgs])
where
findPackageLocations :: Bool -> [String] -> Rebuild [ProjectPackageLocation]
findPackageLocations required pkglocstr = do
diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs
index 7c357c70a8a..bc8268d1506 100644
--- a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs
+++ b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs
@@ -408,6 +408,7 @@ parseProjectSkeleton cacheDir httpTransport verbosity projectDir source (Project
-- can redefine the parsers directly for the new types.
data LegacyProjectConfig = LegacyProjectConfig
{ legacyPackages :: [String]
+ , legacyBuildPackages :: [String]
, legacyPackagesOptional :: [String]
, legacyPackagesRepo :: [SourceRepoList]
, legacyPackagesNamed :: [PackageVersionConstraint]
@@ -613,6 +614,7 @@ convertLegacyProjectConfig :: LegacyProjectConfig -> ProjectConfig
convertLegacyProjectConfig
LegacyProjectConfig
{ legacyPackages
+ , legacyBuildPackages
, legacyPackagesOptional
, legacyPackagesRepo
, legacyPackagesNamed
@@ -637,6 +639,7 @@ convertLegacyProjectConfig
} =
ProjectConfig
{ projectPackages = legacyPackages
+ , projectBuildPackages = legacyBuildPackages
, projectPackagesOptional = legacyPackagesOptional
, projectPackagesRepo = legacyPackagesRepo
, projectPackagesNamed = legacyPackagesNamed
@@ -936,6 +939,7 @@ convertToLegacyProjectConfig :: ProjectConfig -> LegacyProjectConfig
convertToLegacyProjectConfig
projectConfig@ProjectConfig
{ projectPackages
+ , projectBuildPackages
, projectPackagesOptional
, projectPackagesRepo
, projectPackagesNamed
@@ -945,6 +949,7 @@ convertToLegacyProjectConfig
} =
LegacyProjectConfig
{ legacyPackages = projectPackages
+ , legacyBuildPackages = projectBuildPackages
, legacyPackagesOptional = projectPackagesOptional
, legacyPackagesRepo = projectPackagesRepo
, legacyPackagesNamed = projectPackagesNamed
@@ -1316,6 +1321,12 @@ legacyProjectConfigFieldDescrs constraintSrc =
parsePackageLocationTokenQ
legacyPackages
(\v flags -> flags{legacyPackages = v})
+ , newLineListField
+ "build-packages"
+ (Disp.text . renderPackageLocationToken)
+ parsePackageLocationTokenQ
+ legacyBuildPackages
+ (\v flags -> flags{legacyBuildPackages = v})
, newLineListField
"optional-packages"
(Disp.text . renderPackageLocationToken)
diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs
index 0ae0bcd6d6a..0f82fbcc12f 100644
--- a/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs
+++ b/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs
@@ -129,6 +129,11 @@ data ProjectConfig = ProjectConfig
-- ^ Packages in this project, including local dirs, local .cabal files
-- local and remote tarballs. When these are file globs, they must
-- match at least one package.
+ , projectBuildPackages :: [String]
+ -- ^ Packages in this project, including local dirs, local .cabal files
+ -- local and remote tarballs considered only for build-time dependencies
+ -- (build-type: Custom orHooks; build-depends, ...). When these are file
+ -- globs, they must match at least one package.
, projectPackagesOptional :: [String]
-- ^ Like 'projectConfigPackageGlobs' but /optional/ in the sense that
-- file globs are allowed to match nothing. The primary use case for
From 79b31e10d39ee54e68e2055587728b4f92c49145 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Mon, 24 Mar 2025 12:52:30 +0900
Subject: [PATCH 50/82] Add compiler to PackageId
---
Cabal-syntax/src/Distribution/Compiler.hs | 2 +-
.../PackageDescription/FieldGrammar.hs | 4 +++-
.../Distribution/Types/InstalledPackageInfo.hs | 10 +++++-----
.../Types/InstalledPackageInfo/FieldGrammar.hs | 13 ++++++++-----
.../src/Distribution/Types/MungedPackageId.hs | 17 ++++++++++-------
.../Distribution/Types/PackageDescription.hs | 1 +
.../src/Distribution/Types/PackageId.hs | 12 ++++++++----
.../src/Distribution/Types/PackageId/Lens.hs | 6 ++++++
.../Types/PackageVersionConstraint.hs | 4 ++--
.../Backpack/PreExistingComponent.hs | 4 ++--
.../src/Distribution/Backpack/ReadyComponent.hs | 1 +
.../Distribution/PackageDescription/Check.hs | 2 +-
Cabal/src/Distribution/Simple/Build.hs | 2 +-
Cabal/src/Distribution/Simple/Build/Macros.hs | 6 +++---
Cabal/src/Distribution/Simple/Configure.hs | 5 +++--
Cabal/src/Distribution/Simple/PackageIndex.hs | 13 +++++++++----
.../src/Distribution/Types/PackageName/Magic.hs | 2 +-
.../Solver/Modular/ConfiguredConversion.hs | 4 ++--
.../Solver/Types/InstSolverPackage.hs | 4 ++--
.../Client/BuildReports/Anonymous.hs | 2 +-
.../src/Distribution/Client/Dependency.hs | 2 +-
.../src/Distribution/Client/IndexUtils.hs | 8 ++++----
.../src/Distribution/Client/Install.hs | 2 +-
.../src/Distribution/Client/PackageHash.hs | 4 ++--
.../src/Distribution/Client/SetupWrapper.hs | 6 +++---
.../Distribution/Client/SolverInstallPlan.hs | 2 +-
.../src/Distribution/Client/Types/AllowNewer.hs | 2 +-
27 files changed, 83 insertions(+), 57 deletions(-)
diff --git a/Cabal-syntax/src/Distribution/Compiler.hs b/Cabal-syntax/src/Distribution/Compiler.hs
index cef915a25d3..a4ac948570f 100644
--- a/Cabal-syntax/src/Distribution/Compiler.hs
+++ b/Cabal-syntax/src/Distribution/Compiler.hs
@@ -174,7 +174,7 @@ instance (Semigroup a, Monoid a) => Monoid (PerCompilerFlavor a) where
-- ------------------------------------------------------------
data CompilerId = CompilerId CompilerFlavor Version
- deriving (Eq, Generic, Ord, Read, Show)
+ deriving (Eq, Generic, Ord, Read, Show, Data)
instance Binary CompilerId
instance Structured CompilerId
diff --git a/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs b/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs
index 22912564e49..27e98ee0a82 100644
--- a/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs
+++ b/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs
@@ -74,7 +74,7 @@ import Prelude ()
import Distribution.CabalSpecVersion
import Distribution.Compat.Newtype (Newtype, pack', unpack')
-import Distribution.Compiler (CompilerFlavor (..), PerCompilerFlavor (..))
+import Distribution.Compiler (CompilerFlavor (..), PerCompilerFlavor (..), CompilerId)
import Distribution.FieldGrammar
import Distribution.Fields
import Distribution.ModuleName (ModuleName)
@@ -101,6 +101,7 @@ packageDescriptionFieldGrammar
, c (Identity BuildType)
, c (Identity PackageName)
, c (Identity Version)
+ , c (Identity CompilerId)
, forall from to. c (List FSep (RelativePathNT from to) (RelativePath from to))
, forall from to. c (List VCat (RelativePathNT from to) (RelativePath from to))
, c (List FSep TestedWith (CompilerFlavor, VersionRange))
@@ -150,6 +151,7 @@ packageDescriptionFieldGrammar =
PackageIdentifier
<$> uniqueField "name" L.pkgName
<*> uniqueField "version" L.pkgVersion
+ <*> optionalField "compiler" L.pkgCompiler
licenseFilesGrammar =
(++)
diff --git a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs
index defb1922607..ee1dfca5888 100644
--- a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs
+++ b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs
@@ -16,10 +16,10 @@ import Prelude ()
import Distribution.Backpack
import Distribution.Compat.Graph (IsNode (..))
-import Distribution.Compiler (CompilerId)
+import Distribution.Compiler (CompilerId, buildCompilerId)
import Distribution.License
import Distribution.ModuleName
-import Distribution.Package hiding (installedUnitId)
+import Distribution.Package hiding (installedUnitId, pkgCompiler)
import Distribution.Types.AbiDependency
import Distribution.Types.ExposedModule
import Distribution.Types.LibraryName
@@ -121,8 +121,8 @@ instance IsNode InstalledPackageInfo where
nodeNeighbors = depends
mungedPackageId :: InstalledPackageInfo -> MungedPackageId
-mungedPackageId ipi =
- MungedPackageId (mungedPackageName ipi) (packageVersion ipi)
+mungedPackageId ipi@InstalledPackageInfo{pkgCompiler = comp} =
+ MungedPackageId (mungedPackageName ipi) (packageVersion ipi) comp
-- | Returns the munged package name, which we write into @name@ for
-- compatibility with old versions of GHC.
@@ -132,7 +132,7 @@ mungedPackageName ipi = MungedPackageName (packageName ipi) (sourceLibName ipi)
emptyInstalledPackageInfo :: InstalledPackageInfo
emptyInstalledPackageInfo =
InstalledPackageInfo
- { sourcePackageId = PackageIdentifier (mkPackageName "") nullVersion
+ { sourcePackageId = PackageIdentifier (mkPackageName "") nullVersion Nothing
, sourceLibName = LMainLibName
, installedComponentId_ = mkComponentId ""
, installedUnitId = mkUnitId ""
diff --git a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs
index c2e77292c07..151aaf4b119 100644
--- a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs
+++ b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs
@@ -20,7 +20,7 @@ import Distribution.FieldGrammar
import Distribution.FieldGrammar.FieldDescrs
import Distribution.License
import Distribution.ModuleName
-import Distribution.Package
+import Distribution.Package hiding (pkgCompiler)
import Distribution.Parsec
import Distribution.Pretty
import Distribution.Types.LibraryName
@@ -38,7 +38,7 @@ import qualified Text.PrettyPrint as Disp
import Distribution.Types.InstalledPackageInfo
import qualified Distribution.Types.InstalledPackageInfo.Lens as L
-import qualified Distribution.Types.PackageId.Lens as L
+import qualified Distribution.Types.PackageId.Lens as L hiding (pkgCompiler)
-- Note: GHC goes nuts and inlines everything,
-- One can see e.g. in -ddump-simpl-stats:
@@ -133,7 +133,7 @@ ipiFieldGrammar =
InstalledPackageInfo
-- _basicPkgName is not used
-- setMaybePackageId says it can be no-op.
- (PackageIdentifier pn _basicVersion)
+ (PackageIdentifier pn _basicVersion _basicCompilerId)
(combineLibraryName ln _basicLibName)
(mkComponentId "") -- installedComponentId_, not in use
_basicLibVisibility
@@ -256,6 +256,7 @@ data Basic = Basic
, _basicPkgName :: Maybe PackageName
, _basicLibName :: LibraryName
, _basicLibVisibility :: LibraryVisibility
+ , _basicCompilerId :: Maybe CompilerId
}
basic :: Lens' InstalledPackageInfo Basic
@@ -268,14 +269,16 @@ basic f ipi = g <$> f b
(maybePackageName ipi)
(sourceLibName ipi)
(libVisibility ipi)
+ (pkgCompiler ipi)
- g (Basic n v pn ln lv) =
+ g (Basic n v pn ln lv compid) =
ipi
& setMungedPackageName n
& L.sourcePackageId . L.pkgVersion .~ v
& setMaybePackageName pn
& L.sourceLibName .~ ln
& L.libVisibility .~ lv
+ & L.pkgCompiler .~ compid
basicName :: Lens' Basic MungedPackageName
basicName f b = (\x -> b{_basicName = x}) <$> f (_basicName b)
@@ -319,7 +322,7 @@ basicFieldGrammar =
<*> optionalField "lib-name" basicLibName
<*> optionalFieldDef "visibility" basicLibVisibility LibraryVisibilityPrivate
where
- mkBasic n v pn ln lv = Basic n v pn ln' lv'
+ mkBasic n v pn ln lv = Basic n v pn ln' lv' Nothing
where
ln' = maybe LMainLibName LSubLibName ln
-- Older GHCs (<8.8) always report installed libraries as private
diff --git a/Cabal-syntax/src/Distribution/Types/MungedPackageId.hs b/Cabal-syntax/src/Distribution/Types/MungedPackageId.hs
index 8e879620478..b0edcd99bf5 100644
--- a/Cabal-syntax/src/Distribution/Types/MungedPackageId.hs
+++ b/Cabal-syntax/src/Distribution/Types/MungedPackageId.hs
@@ -15,6 +15,7 @@ import Distribution.Types.LibraryName
import Distribution.Types.MungedPackageName
import Distribution.Types.PackageId
import Distribution.Version (Version, nullVersion)
+import Distribution.Compiler (CompilerId)
import qualified Text.PrettyPrint as Disp
@@ -27,6 +28,7 @@ data MungedPackageId = MungedPackageId
-- 'MungedPackageName'.
, mungedVersion :: Version
-- ^ The version of this package / component, eg 1.2
+ , mingledCompilerId :: Maybe CompilerId
}
deriving (Generic, Read, Show, Eq, Ord, Data)
@@ -41,8 +43,9 @@ instance Structured MungedPackageId
-- >>> prettyShow $ MungedPackageId (MungedPackageName "servant" (LSubLibName "lackey")) (mkVersion [0,1,2])
-- "z-servant-z-lackey-0.1.2"
instance Pretty MungedPackageId where
- pretty (MungedPackageId n v)
- | v == nullVersion = pretty n -- if no version, don't show version.
+ pretty (MungedPackageId n v c)
+ | v == nullVersion = pretty c <<>> Disp.char '-' <<>> pretty n -- if no version, don't show version.
+ | Just c' <- c = pretty c' <<>> Disp.char '-' <<>> pretty n <<>> Disp.char '-' <<>> pretty v
| otherwise = pretty n <<>> Disp.char '-' <<>> pretty v
-- |
@@ -66,15 +69,15 @@ instance Pretty MungedPackageId where
-- Nothing
instance Parsec MungedPackageId where
parsec = do
- PackageIdentifier pn v <- parsec
- return $ MungedPackageId (decodeCompatPackageName pn) v
+ PackageIdentifier pn v comp <- parsec
+ return $ MungedPackageId (decodeCompatPackageName pn) v comp
instance NFData MungedPackageId where
- rnf (MungedPackageId name version) = rnf name `seq` rnf version
+ rnf (MungedPackageId name version compiler) = rnf name `seq` rnf version `seq` rnf compiler
computeCompatPackageId :: PackageId -> LibraryName -> MungedPackageId
-computeCompatPackageId (PackageIdentifier pn vr) ln =
- MungedPackageId (MungedPackageName pn ln) vr
+computeCompatPackageId (PackageIdentifier pn vr comp) ln =
+ MungedPackageId (MungedPackageName pn ln) vr comp
-- $setup
-- >>> :seti -XOverloadedStrings
diff --git a/Cabal-syntax/src/Distribution/Types/PackageDescription.hs b/Cabal-syntax/src/Distribution/Types/PackageDescription.hs
index 4b00a8ef526..17f72e54c95 100644
--- a/Cabal-syntax/src/Distribution/Types/PackageDescription.hs
+++ b/Cabal-syntax/src/Distribution/Types/PackageDescription.hs
@@ -207,6 +207,7 @@ emptyPackageDescription =
PackageIdentifier
(mkPackageName "")
nullVersion
+ Nothing
, licenseRaw = Right UnspecifiedLicense -- TODO:
, licenseFiles = []
, specVersion = CabalSpecV1_0
diff --git a/Cabal-syntax/src/Distribution/Types/PackageId.hs b/Cabal-syntax/src/Distribution/Types/PackageId.hs
index 9cd88a2f810..ca9bfbfc967 100644
--- a/Cabal-syntax/src/Distribution/Types/PackageId.hs
+++ b/Cabal-syntax/src/Distribution/Types/PackageId.hs
@@ -13,6 +13,7 @@ import Distribution.Parsec (Parsec (..), simpleParsec)
import Distribution.Pretty
import Distribution.Types.PackageName
import Distribution.Version (Version, nullVersion)
+import Distribution.Compiler (CompilerId)
import qualified Data.List.NonEmpty as NE
import qualified Distribution.Compat.CharParsing as P
@@ -27,6 +28,7 @@ data PackageIdentifier = PackageIdentifier
-- ^ The name of this package, eg. foo
, pkgVersion :: Version
-- ^ the version of this package, eg 1.2
+ , pkgCompiler :: Maybe CompilerId
}
deriving (Generic, Read, Show, Eq, Ord, Data)
@@ -34,8 +36,9 @@ instance Binary PackageIdentifier
instance Structured PackageIdentifier
instance Pretty PackageIdentifier where
- pretty (PackageIdentifier n v)
- | v == nullVersion = pretty n -- if no version, don't show version.
+ pretty (PackageIdentifier n v c)
+ | v == nullVersion = pretty c <<>> Disp.char '-' <<>> pretty n -- if no version, don't show version.
+ | Just c' <- c = pretty c' <<>> Disp.char '-' <<>> pretty n <<>> Disp.char '-' <<>> pretty v
| otherwise = pretty n <<>> Disp.char '-' <<>> pretty v
-- |
@@ -61,15 +64,16 @@ instance Pretty PackageIdentifier where
-- Nothing
instance Parsec PackageIdentifier where
parsec = do
+ comp <- parsec <* P.char '-'
xs' <- P.sepByNonEmpty component (P.char '-')
(v, xs) <- case simpleParsec (NE.last xs') of
Nothing -> return (nullVersion, toList xs') -- all components are version
Just v -> return (v, NE.init xs')
if not (null xs) && all (\c -> all (/= '.') c && not (all isDigit c)) xs
- then return $ PackageIdentifier (mkPackageName (intercalate "-" xs)) v
+ then return $ PackageIdentifier (mkPackageName (intercalate "-" xs)) v comp
else fail "all digits or a dot in a portion of package name"
where
component = P.munch1 (\c -> isAlphaNum c || c == '.')
instance NFData PackageIdentifier where
- rnf (PackageIdentifier name version) = rnf name `seq` rnf version
+ rnf (PackageIdentifier name version compiler) = rnf name `seq` rnf version `seq` rnf compiler
diff --git a/Cabal-syntax/src/Distribution/Types/PackageId/Lens.hs b/Cabal-syntax/src/Distribution/Types/PackageId/Lens.hs
index 08305234fbd..5a4682c7ed3 100644
--- a/Cabal-syntax/src/Distribution/Types/PackageId/Lens.hs
+++ b/Cabal-syntax/src/Distribution/Types/PackageId/Lens.hs
@@ -10,6 +10,7 @@ import Prelude ()
import Distribution.Types.PackageId (PackageIdentifier)
import Distribution.Types.PackageName (PackageName)
import Distribution.Version (Version)
+import Distribution.Compiler (CompilerId)
import qualified Distribution.Types.PackageId as T
@@ -20,3 +21,8 @@ pkgName f s = fmap (\x -> s{T.pkgName = x}) (f (T.pkgName s))
pkgVersion :: Lens' PackageIdentifier Version
pkgVersion f s = fmap (\x -> s{T.pkgVersion = x}) (f (T.pkgVersion s))
{-# INLINE pkgVersion #-}
+
+pkgCompiler :: Lens' PackageIdentifier (Maybe CompilerId)
+pkgCompiler f s = fmap (\x -> s{T.pkgCompiler = x}) (f (T.pkgCompiler s))
+{-# INLINE pkgCompiler #-}
+
diff --git a/Cabal-syntax/src/Distribution/Types/PackageVersionConstraint.hs b/Cabal-syntax/src/Distribution/Types/PackageVersionConstraint.hs
index 013226ca2d5..5c2b8d9b0b1 100644
--- a/Cabal-syntax/src/Distribution/Types/PackageVersionConstraint.hs
+++ b/Cabal-syntax/src/Distribution/Types/PackageVersionConstraint.hs
@@ -53,7 +53,7 @@ instance Pretty PackageVersionConstraint where
-- Just (PackageVersionConstraint (PackageName "foo") (ThisVersion (mkVersion [2,0])))
instance Parsec PackageVersionConstraint where
parsec = do
- PackageIdentifier name ver <- parsec
+ PackageIdentifier name ver comp <- parsec
if ver == nullVersion
then do
P.spaces
@@ -64,7 +64,7 @@ instance Parsec PackageVersionConstraint where
-- | @since 3.4.0.0
thisPackageVersionConstraint :: PackageIdentifier -> PackageVersionConstraint
-thisPackageVersionConstraint (PackageIdentifier pn vr) =
+thisPackageVersionConstraint (PackageIdentifier pn vr comp) =
PackageVersionConstraint pn (thisVersion vr)
-- | @since 3.4.0.0
diff --git a/Cabal/src/Distribution/Backpack/PreExistingComponent.hs b/Cabal/src/Distribution/Backpack/PreExistingComponent.hs
index 0fba79bcb87..a72fe20f07f 100644
--- a/Cabal/src/Distribution/Backpack/PreExistingComponent.hs
+++ b/Cabal/src/Distribution/Backpack/PreExistingComponent.hs
@@ -71,9 +71,9 @@ instance HasMungedPackageId PreExistingComponent where
mungedId = pc_munged_id
instance Package PreExistingComponent where
- packageId pec = PackageIdentifier (pc_pkgname pec) v
+ packageId pec = PackageIdentifier (pc_pkgname pec) v compid
where
- MungedPackageId _ v = pc_munged_id pec
+ MungedPackageId _ v compid = pc_munged_id pec
instance HasUnitId PreExistingComponent where
installedUnitId = pc_uid
diff --git a/Cabal/src/Distribution/Backpack/ReadyComponent.hs b/Cabal/src/Distribution/Backpack/ReadyComponent.hs
index 7a3523d5eab..b871ebff59f 100644
--- a/Cabal/src/Distribution/Backpack/ReadyComponent.hs
+++ b/Cabal/src/Distribution/Backpack/ReadyComponent.hs
@@ -300,6 +300,7 @@ toReadyComponents pid_map subst0 comps =
MungedPackageId
(MungedPackageName nonExistentPackageThisIsCabalBug LMainLibName)
(mkVersion [0])
+ Nothing
instc =
InstantiatedComponent
{ instc_insts = Map.toList insts
diff --git a/Cabal/src/Distribution/PackageDescription/Check.hs b/Cabal/src/Distribution/PackageDescription/Check.hs
index 925bc69d6e1..799e677af17 100644
--- a/Cabal/src/Distribution/PackageDescription/Check.hs
+++ b/Cabal/src/Distribution/PackageDescription/Check.hs
@@ -582,7 +582,7 @@ checkSetupBuildInfo (Just (SetupBuildInfo ds _)) = do
checkPVPs (checkDependencyVersionRange hasGTLowerBound) gtlck ds
checkPackageId :: Monad m => PackageIdentifier -> CheckM m ()
-checkPackageId (PackageIdentifier pkgName_ _pkgVersion_) = do
+checkPackageId (PackageIdentifier pkgName_ _pkgVersion_ _compid) = do
checkP
(not . FilePath.Windows.isValid . prettyShow $ pkgName_)
(PackageDistInexcusable $ InvalidNameWin pkgName_)
diff --git a/Cabal/src/Distribution/Simple/Build.hs b/Cabal/src/Distribution/Simple/Build.hs
index 402f27467d2..008a270848f 100644
--- a/Cabal/src/Distribution/Simple/Build.hs
+++ b/Cabal/src/Distribution/Simple/Build.hs
@@ -821,7 +821,7 @@ testSuiteLibV09AsLibAndExe
}
-- This is, like, the one place where we use a CTestName for a library.
-- Should NOT use library name, since that could conflict!
- PackageIdentifier pkg_name pkg_ver = package pkg_descr
+ PackageIdentifier pkg_name pkg_ver _pkg_compid = package pkg_descr
-- Note: we do make internal library from the test!
compat_name = MungedPackageName pkg_name (LSubLibName (testName test))
compat_key = computeCompatPackageKey (compiler lbi) compat_name pkg_ver (componentUnitId clbi)
diff --git a/Cabal/src/Distribution/Simple/Build/Macros.hs b/Cabal/src/Distribution/Simple/Build/Macros.hs
index f3c51d71c96..e71d5a4a644 100644
--- a/Cabal/src/Distribution/Simple/Build/Macros.hs
+++ b/Cabal/src/Distribution/Simple/Build/Macros.hs
@@ -67,11 +67,11 @@ generateCabalMacrosHeader pkg_descr lbi clbi =
, Z.zMangleStr = map fixchar
}
where
- getPid (_, MungedPackageId (MungedPackageName pn _) v) =
+ getPid (_, MungedPackageId (MungedPackageName pn _) v compid) =
-- NB: Drop the library name! We're just reporting package versions.
-- This would have to be revisited if you are allowed to depend
-- on different versions of the same package
- PackageIdentifier pn v
+ PackageIdentifier pn v compid
-- | Helper function that generates just the @VERSION_pkg@ and @MIN_VERSION_pkg@
-- macros for a list of package ids (usually used with the specific deps of
@@ -91,7 +91,7 @@ generatePackageVersionMacros ver pkgids =
}
mkZPackage :: PackageId -> Z.ZPackage
-mkZPackage (PackageIdentifier name ver) =
+mkZPackage (PackageIdentifier name ver compid) =
Z.ZPackage
{ Z.zpkgName = name
, Z.zpkgVersion = ver
diff --git a/Cabal/src/Distribution/Simple/Configure.hs b/Cabal/src/Distribution/Simple/Configure.hs
index 7c96efb33fc..a76b4359bc9 100644
--- a/Cabal/src/Distribution/Simple/Configure.hs
+++ b/Cabal/src/Distribution/Simple/Configure.hs
@@ -335,7 +335,7 @@ writePersistBuildConfig mbWorkDir distPref lbi = do
-- | Identifier of the current Cabal package.
currentCabalId :: PackageIdentifier
-currentCabalId = PackageIdentifier (mkPackageName "Cabal") cabalVersion
+currentCabalId = PackageIdentifier (mkPackageName "Cabal") cabalVersion Nothing
-- | Identifier of the current compiler package.
currentCompilerId :: PackageIdentifier
@@ -343,6 +343,7 @@ currentCompilerId =
PackageIdentifier
(mkPackageName System.Info.compilerName)
(mkVersion' System.Info.compilerVersion)
+ Nothing
-- | Parse the @setup-config@ file header, returning the package identifiers
-- for Cabal and the compiler.
@@ -1987,7 +1988,7 @@ selectDependency
-- It's an internal library, and we're not per-component build
do_internal lib
| Set.member lib internalIndex =
- Right $ InternalDependency $ PackageIdentifier dep_pkgname $ packageVersion pkgid
+ Right $ InternalDependency $ PackageIdentifier dep_pkgname (packageVersion pkgid) (pkgCompiler pkgid)
| otherwise =
Left $ DependencyMissingInternal dep_pkgname lib
diff --git a/Cabal/src/Distribution/Simple/PackageIndex.hs b/Cabal/src/Distribution/Simple/PackageIndex.hs
index a7d23962b72..6e115ca65a5 100644
--- a/Cabal/src/Distribution/Simple/PackageIndex.hs
+++ b/Cabal/src/Distribution/Simple/PackageIndex.hs
@@ -169,7 +169,7 @@ instance Semigroup (PackageIndex IPI.InstalledPackageInfo) where
{-# NOINLINE invariant #-}
invariant :: WithCallStack (InstalledPackageIndex -> Bool)
invariant (PackageIndex pids pnames) =
- -- trace (show pids' ++ "\n" ++ show pnames') $
+ trace (show pids' ++ "\n" ++ show pnames') $
pids' == pnames'
where
pids' = map installedUnitId (Map.elems pids)
@@ -335,16 +335,21 @@ deleteSourcePackageId pkgid original@(PackageIndex pids pnames) =
Just pvers -> case Map.lookup (packageVersion pkgid) pvers of
Nothing -> original
Just pkgs ->
- mkPackageIndex
- (foldl' (flip (Map.delete . installedUnitId)) pids pkgs)
+ traceShow (pkgid, pkgs) $ mkPackageIndex
+ (Map.update deletePkgInstance (installedUnitId pkgid) pids)
(deletePkgName pnames)
where
deletePkgName =
Map.update deletePkgVersion (packageName pkgid, LMainLibName)
+ deletePkgVersion :: Map Version [IPI.InstalledPackageInfo] -> Maybe (Map Version [IPI.InstalledPackageInfo])
deletePkgVersion =
(\m -> if Map.null m then Nothing else Just m)
- . Map.delete (packageVersion pkgid)
+ . Map.update deletePkgInstance (packageVersion pkgid)
+
+ deletePkgInstance :: [IPI.InstalledPackageInfo] -> Maybe [IPI.InstalledPackageInfo]
+ deletePkgInstance xs = if null xs' then Nothing else Just xs'
+ where xs' = [x | x <- xs, pkgCompiler pkgid /= pkgCompiler (IPI.sourcePackageId x)]
-- | Removes all packages with this (case-sensitive) name from the index.
--
diff --git a/Cabal/src/Distribution/Types/PackageName/Magic.hs b/Cabal/src/Distribution/Types/PackageName/Magic.hs
index 022a62468b1..908e82bea6f 100644
--- a/Cabal/src/Distribution/Types/PackageName/Magic.hs
+++ b/Cabal/src/Distribution/Types/PackageName/Magic.hs
@@ -21,4 +21,4 @@ fakePackageCabalFileName = "fake-package.cabal"
-- | 'fakePackageName' with 'version0'.
fakePackageId :: PackageId
-fakePackageId = PackageIdentifier fakePackageName version0
+fakePackageId = PackageIdentifier fakePackageName version0 Nothing
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs b/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs
index d391345d0eb..6ae45e569fc 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs
@@ -39,7 +39,7 @@ convCP iidx sidx (CP qpi fa es ds) =
}
-- "In repo" i.e. a source package
(PI qpn@(Q _path pn) (I stage v InRepo)) ->
- let pi = PackageIdentifier pn v in
+ let pi = PackageIdentifier pn v Nothing {-# FIXME: should be COMPILERID #-} in
Configured $
SolverPackage {
solverPkgQPN = qpn,
@@ -70,4 +70,4 @@ convConfId (PI (Q (PackagePath _ q) pn) (I _stage v loc)) =
, pn == pn' -> Right (PlannedId sourceId)
| otherwise -> Left (PlannedId sourceId)
where
- sourceId = PackageIdentifier pn v
+ sourceId = PackageIdentifier pn v Nothing -- FIXME: this should be the compiler id!
diff --git a/cabal-install-solver/src/Distribution/Solver/Types/InstSolverPackage.hs b/cabal-install-solver/src/Distribution/Solver/Types/InstSolverPackage.hs
index 15fb9d510ec..868d1d9dfe2 100644
--- a/cabal-install-solver/src/Distribution/Solver/Types/InstSolverPackage.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Types/InstSolverPackage.hs
@@ -31,8 +31,8 @@ instance Structured InstSolverPackage
instance Package InstSolverPackage where
packageId i =
-- HACK! See Note [Index conversion with internal libraries]
- let MungedPackageId mpn v = mungedId i
- in PackageIdentifier (encodeCompatPackageName mpn) v
+ let MungedPackageId mpn v compid = mungedId i
+ in PackageIdentifier (encodeCompatPackageName mpn) v compid
instance HasMungedPackageId InstSolverPackage where
mungedId = mungedId . instSolverPkgIPI
diff --git a/cabal-install/src/Distribution/Client/BuildReports/Anonymous.hs b/cabal-install/src/Distribution/Client/BuildReports/Anonymous.hs
index ce1d1665327..a6febfcca50 100644
--- a/cabal-install/src/Distribution/Client/BuildReports/Anonymous.hs
+++ b/cabal-install/src/Distribution/Client/BuildReports/Anonymous.hs
@@ -103,7 +103,7 @@ newBuildReport os' arch' comp pkgid flags deps result =
cabalInstallID :: PackageIdentifier
cabalInstallID =
- PackageIdentifier (mkPackageName "cabal-install") cabalInstallVersion
+ PackageIdentifier (mkPackageName "cabal-install") cabalInstallVersion Nothing
-------------------------------------------------------------------------------
-- FieldGrammar
diff --git a/cabal-install/src/Distribution/Client/Dependency.hs b/cabal-install/src/Distribution/Client/Dependency.hs
index 65f8a06ac97..7f3812d69b4 100644
--- a/cabal-install/src/Distribution/Client/Dependency.hs
+++ b/cabal-install/src/Distribution/Client/Dependency.hs
@@ -1057,7 +1057,7 @@ configuredPackageProblems
(sort $ map fst (PD.unFlagAssignment specifiedFlags)) -- TODO
packageSatisfiesDependency :: PackageIdentifier -> Dependency -> Bool
packageSatisfiesDependency
- (PackageIdentifier name version)
+ (PackageIdentifier name version _compid)
(Dependency name' versionRange _) =
assert (name == name') $
version `withinRange` versionRange
diff --git a/cabal-install/src/Distribution/Client/IndexUtils.hs b/cabal-install/src/Distribution/Client/IndexUtils.hs
index 6027f5e53f3..0cd842d663e 100644
--- a/cabal-install/src/Distribution/Client/IndexUtils.hs
+++ b/cabal-install/src/Distribution/Client/IndexUtils.hs
@@ -617,7 +617,7 @@ extractPkg verbosity entry blockNo = case Tar.entryContent entry of
[pkgname, vers, _] -> case simpleParsec vers of
Just ver -> Just . return $ Just (NormalPackage pkgid descr content blockNo)
where
- pkgid = PackageIdentifier (mkPackageName pkgname) ver
+ pkgid = PackageIdentifier (mkPackageName pkgname) ver Nothing
parsed = parseGenericPackageDescriptionMaybe (BS.toStrict content)
descr = case parsed of
Just d -> d
@@ -1269,10 +1269,10 @@ hashConsCache cache0 =
go !pns !pvs (CachePackageId pid bno ts : rest) =
CachePackageId pid' bno ts : go pns' pvs' rest
where
- !pid' = PackageIdentifier pn' pv'
+ !pid' = PackageIdentifier pn' pv' compid
(!pn', !pns') = mapIntern pn pns
(!pv', !pvs') = mapIntern pv pvs
- PackageIdentifier pn pv = pid
+ PackageIdentifier pn pv compid = pid
go pns pvs (x : xs) = x : go pns pvs xs
mapIntern :: Ord k => k -> Map.Map k k -> (k, Map.Map k k)
@@ -1395,7 +1395,7 @@ read00IndexCacheEntry = \line ->
(Just pkgname, Just pkgver, Just blockno) ->
Just
( CachePackageId
- (PackageIdentifier pkgname pkgver)
+ (PackageIdentifier pkgname pkgver Nothing)
blockno
NoTimestamp
)
diff --git a/cabal-install/src/Distribution/Client/Install.hs b/cabal-install/src/Distribution/Client/Install.hs
index 6c9a605c553..7f32d51ac3d 100644
--- a/cabal-install/src/Distribution/Client/Install.hs
+++ b/cabal-install/src/Distribution/Client/Install.hs
@@ -1101,7 +1101,7 @@ theSpecifiedPackage :: Package pkg => PackageSpecifier pkg -> Maybe PackageId
theSpecifiedPackage pkgSpec =
case pkgSpec of
NamedPackage name [PackagePropertyVersion version] ->
- PackageIdentifier name <$> trivialRange version
+ PackageIdentifier name <$> trivialRange version <*> Nothing
NamedPackage _ _ -> Nothing
SpecificSourcePackage pkg -> Just $ packageId pkg
where
diff --git a/cabal-install/src/Distribution/Client/PackageHash.hs b/cabal-install/src/Distribution/Client/PackageHash.hs
index 38240c3888a..d99fc9ad250 100644
--- a/cabal-install/src/Distribution/Client/PackageHash.hs
+++ b/cabal-install/src/Distribution/Client/PackageHash.hs
@@ -133,7 +133,7 @@ hashedInstalledPackageIdShort pkghashinputs@PackageHashInputs{pkgHashPkgId} =
, showHashValue (truncateHash 20 (hashPackageHashInputs pkghashinputs))
]
where
- PackageIdentifier name version = pkgHashPkgId
+ PackageIdentifier name version _compid = pkgHashPkgId
-- Truncate a string, with a visual indication that it is truncated.
truncateStr n s
@@ -172,7 +172,7 @@ hashedInstalledPackageIdVeryShort pkghashinputs@PackageHashInputs{pkgHashPkgId}
, showHashValue (truncateHash 4 (hashPackageHashInputs pkghashinputs))
]
where
- PackageIdentifier name version = pkgHashPkgId
+ PackageIdentifier name version _compid = pkgHashPkgId
-- | All the information that contributes to a package's hash, and thus its
-- 'InstalledPackageId'.
diff --git a/cabal-install/src/Distribution/Client/SetupWrapper.hs b/cabal-install/src/Distribution/Client/SetupWrapper.hs
index 55042e212cd..d46045c849a 100644
--- a/cabal-install/src/Distribution/Client/SetupWrapper.hs
+++ b/cabal-install/src/Distribution/Client/SetupWrapper.hs
@@ -1068,7 +1068,7 @@ getExternalSetupMethod verbosity options pkg bt = do
debug verbosity "Setup executable needs to be updated, compiling..."
(compiler, progdb, options'') <- configureCompiler options'
pkgDbs <- traverse (traverse (makeRelativeToDirS mbWorkDir)) (coercePackageDBStack (usePackageDB options''))
- let cabalPkgid = PackageIdentifier (mkPackageName "Cabal") cabalLibVersion
+ let cabalPkgid = PackageIdentifier (mkPackageName "Cabal") cabalLibVersion Nothing
(program, extraOpts) =
case compilerFlavor compiler of
GHCJS -> (ghcjsProgram, ["-build-runner"])
@@ -1155,5 +1155,5 @@ getExternalSetupMethod verbosity options pkg bt = do
return $ i setupProgFile
isCabalPkgId, isBasePkgId :: PackageIdentifier -> Bool
-isCabalPkgId (PackageIdentifier pname _) = pname == mkPackageName "Cabal"
-isBasePkgId (PackageIdentifier pname _) = pname == mkPackageName "base"
+isCabalPkgId (PackageIdentifier pname _ _compid) = pname == mkPackageName "Cabal"
+isBasePkgId (PackageIdentifier pname _ _compid) = pname == mkPackageName "base"
diff --git a/cabal-install/src/Distribution/Client/SolverInstallPlan.hs b/cabal-install/src/Distribution/Client/SolverInstallPlan.hs
index 17dcf6d9398..631dbde5afe 100644
--- a/cabal-install/src/Distribution/Client/SolverInstallPlan.hs
+++ b/cabal-install/src/Distribution/Client/SolverInstallPlan.hs
@@ -218,7 +218,7 @@ showPlanProblem (PackageInconsistency name inconsistencies) =
[ " package "
++ prettyShow pkg
++ " requires "
- ++ prettyShow (PackageIdentifier name ver)
+ ++ prettyShow (PackageIdentifier name ver Nothing)
| (pkg, ver) <- inconsistencies
]
showPlanProblem (PackageStateInvalid pkg pkg') =
diff --git a/cabal-install/src/Distribution/Client/Types/AllowNewer.hs b/cabal-install/src/Distribution/Client/Types/AllowNewer.hs
index 0a5700174b8..6a6503aaf4c 100644
--- a/cabal-install/src/Distribution/Client/Types/AllowNewer.hs
+++ b/cabal-install/src/Distribution/Client/Types/AllowNewer.hs
@@ -109,7 +109,7 @@ relaxedDepStarP =
-- continuation after package identifier
relaxedDepPkgidP :: CabalParsing m => PackageIdentifier -> m RelaxedDep
-relaxedDepPkgidP pid@(PackageIdentifier pn v)
+relaxedDepPkgidP pid@(PackageIdentifier pn v _compid)
| pn == mkPackageName "all"
, v == nullVersion =
RelaxedDep RelaxDepScopeAll <$ P.char ':' <*> modP <*> parsec
From 328713ab2214d9098b97240f8d87cba807fc2f5c Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Mon, 24 Mar 2025 12:52:36 +0900
Subject: [PATCH 51/82] Revert "Add compiler to PackageId"
This reverts commit 79b31e10d39ee54e68e2055587728b4f92c49145.
---
Cabal-syntax/src/Distribution/Compiler.hs | 2 +-
.../PackageDescription/FieldGrammar.hs | 4 +---
.../Distribution/Types/InstalledPackageInfo.hs | 10 +++++-----
.../Types/InstalledPackageInfo/FieldGrammar.hs | 13 +++++--------
.../src/Distribution/Types/MungedPackageId.hs | 17 +++++++----------
.../Distribution/Types/PackageDescription.hs | 1 -
.../src/Distribution/Types/PackageId.hs | 12 ++++--------
.../src/Distribution/Types/PackageId/Lens.hs | 6 ------
.../Types/PackageVersionConstraint.hs | 4 ++--
.../Backpack/PreExistingComponent.hs | 4 ++--
.../src/Distribution/Backpack/ReadyComponent.hs | 1 -
.../Distribution/PackageDescription/Check.hs | 2 +-
Cabal/src/Distribution/Simple/Build.hs | 2 +-
Cabal/src/Distribution/Simple/Build/Macros.hs | 6 +++---
Cabal/src/Distribution/Simple/Configure.hs | 5 ++---
Cabal/src/Distribution/Simple/PackageIndex.hs | 13 ++++---------
.../src/Distribution/Types/PackageName/Magic.hs | 2 +-
.../Solver/Modular/ConfiguredConversion.hs | 4 ++--
.../Solver/Types/InstSolverPackage.hs | 4 ++--
.../Client/BuildReports/Anonymous.hs | 2 +-
.../src/Distribution/Client/Dependency.hs | 2 +-
.../src/Distribution/Client/IndexUtils.hs | 8 ++++----
.../src/Distribution/Client/Install.hs | 2 +-
.../src/Distribution/Client/PackageHash.hs | 4 ++--
.../src/Distribution/Client/SetupWrapper.hs | 6 +++---
.../Distribution/Client/SolverInstallPlan.hs | 2 +-
.../src/Distribution/Client/Types/AllowNewer.hs | 2 +-
27 files changed, 57 insertions(+), 83 deletions(-)
diff --git a/Cabal-syntax/src/Distribution/Compiler.hs b/Cabal-syntax/src/Distribution/Compiler.hs
index a4ac948570f..cef915a25d3 100644
--- a/Cabal-syntax/src/Distribution/Compiler.hs
+++ b/Cabal-syntax/src/Distribution/Compiler.hs
@@ -174,7 +174,7 @@ instance (Semigroup a, Monoid a) => Monoid (PerCompilerFlavor a) where
-- ------------------------------------------------------------
data CompilerId = CompilerId CompilerFlavor Version
- deriving (Eq, Generic, Ord, Read, Show, Data)
+ deriving (Eq, Generic, Ord, Read, Show)
instance Binary CompilerId
instance Structured CompilerId
diff --git a/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs b/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs
index 27e98ee0a82..22912564e49 100644
--- a/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs
+++ b/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs
@@ -74,7 +74,7 @@ import Prelude ()
import Distribution.CabalSpecVersion
import Distribution.Compat.Newtype (Newtype, pack', unpack')
-import Distribution.Compiler (CompilerFlavor (..), PerCompilerFlavor (..), CompilerId)
+import Distribution.Compiler (CompilerFlavor (..), PerCompilerFlavor (..))
import Distribution.FieldGrammar
import Distribution.Fields
import Distribution.ModuleName (ModuleName)
@@ -101,7 +101,6 @@ packageDescriptionFieldGrammar
, c (Identity BuildType)
, c (Identity PackageName)
, c (Identity Version)
- , c (Identity CompilerId)
, forall from to. c (List FSep (RelativePathNT from to) (RelativePath from to))
, forall from to. c (List VCat (RelativePathNT from to) (RelativePath from to))
, c (List FSep TestedWith (CompilerFlavor, VersionRange))
@@ -151,7 +150,6 @@ packageDescriptionFieldGrammar =
PackageIdentifier
<$> uniqueField "name" L.pkgName
<*> uniqueField "version" L.pkgVersion
- <*> optionalField "compiler" L.pkgCompiler
licenseFilesGrammar =
(++)
diff --git a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs
index ee1dfca5888..defb1922607 100644
--- a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs
+++ b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs
@@ -16,10 +16,10 @@ import Prelude ()
import Distribution.Backpack
import Distribution.Compat.Graph (IsNode (..))
-import Distribution.Compiler (CompilerId, buildCompilerId)
+import Distribution.Compiler (CompilerId)
import Distribution.License
import Distribution.ModuleName
-import Distribution.Package hiding (installedUnitId, pkgCompiler)
+import Distribution.Package hiding (installedUnitId)
import Distribution.Types.AbiDependency
import Distribution.Types.ExposedModule
import Distribution.Types.LibraryName
@@ -121,8 +121,8 @@ instance IsNode InstalledPackageInfo where
nodeNeighbors = depends
mungedPackageId :: InstalledPackageInfo -> MungedPackageId
-mungedPackageId ipi@InstalledPackageInfo{pkgCompiler = comp} =
- MungedPackageId (mungedPackageName ipi) (packageVersion ipi) comp
+mungedPackageId ipi =
+ MungedPackageId (mungedPackageName ipi) (packageVersion ipi)
-- | Returns the munged package name, which we write into @name@ for
-- compatibility with old versions of GHC.
@@ -132,7 +132,7 @@ mungedPackageName ipi = MungedPackageName (packageName ipi) (sourceLibName ipi)
emptyInstalledPackageInfo :: InstalledPackageInfo
emptyInstalledPackageInfo =
InstalledPackageInfo
- { sourcePackageId = PackageIdentifier (mkPackageName "") nullVersion Nothing
+ { sourcePackageId = PackageIdentifier (mkPackageName "") nullVersion
, sourceLibName = LMainLibName
, installedComponentId_ = mkComponentId ""
, installedUnitId = mkUnitId ""
diff --git a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs
index 151aaf4b119..c2e77292c07 100644
--- a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs
+++ b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs
@@ -20,7 +20,7 @@ import Distribution.FieldGrammar
import Distribution.FieldGrammar.FieldDescrs
import Distribution.License
import Distribution.ModuleName
-import Distribution.Package hiding (pkgCompiler)
+import Distribution.Package
import Distribution.Parsec
import Distribution.Pretty
import Distribution.Types.LibraryName
@@ -38,7 +38,7 @@ import qualified Text.PrettyPrint as Disp
import Distribution.Types.InstalledPackageInfo
import qualified Distribution.Types.InstalledPackageInfo.Lens as L
-import qualified Distribution.Types.PackageId.Lens as L hiding (pkgCompiler)
+import qualified Distribution.Types.PackageId.Lens as L
-- Note: GHC goes nuts and inlines everything,
-- One can see e.g. in -ddump-simpl-stats:
@@ -133,7 +133,7 @@ ipiFieldGrammar =
InstalledPackageInfo
-- _basicPkgName is not used
-- setMaybePackageId says it can be no-op.
- (PackageIdentifier pn _basicVersion _basicCompilerId)
+ (PackageIdentifier pn _basicVersion)
(combineLibraryName ln _basicLibName)
(mkComponentId "") -- installedComponentId_, not in use
_basicLibVisibility
@@ -256,7 +256,6 @@ data Basic = Basic
, _basicPkgName :: Maybe PackageName
, _basicLibName :: LibraryName
, _basicLibVisibility :: LibraryVisibility
- , _basicCompilerId :: Maybe CompilerId
}
basic :: Lens' InstalledPackageInfo Basic
@@ -269,16 +268,14 @@ basic f ipi = g <$> f b
(maybePackageName ipi)
(sourceLibName ipi)
(libVisibility ipi)
- (pkgCompiler ipi)
- g (Basic n v pn ln lv compid) =
+ g (Basic n v pn ln lv) =
ipi
& setMungedPackageName n
& L.sourcePackageId . L.pkgVersion .~ v
& setMaybePackageName pn
& L.sourceLibName .~ ln
& L.libVisibility .~ lv
- & L.pkgCompiler .~ compid
basicName :: Lens' Basic MungedPackageName
basicName f b = (\x -> b{_basicName = x}) <$> f (_basicName b)
@@ -322,7 +319,7 @@ basicFieldGrammar =
<*> optionalField "lib-name" basicLibName
<*> optionalFieldDef "visibility" basicLibVisibility LibraryVisibilityPrivate
where
- mkBasic n v pn ln lv = Basic n v pn ln' lv' Nothing
+ mkBasic n v pn ln lv = Basic n v pn ln' lv'
where
ln' = maybe LMainLibName LSubLibName ln
-- Older GHCs (<8.8) always report installed libraries as private
diff --git a/Cabal-syntax/src/Distribution/Types/MungedPackageId.hs b/Cabal-syntax/src/Distribution/Types/MungedPackageId.hs
index b0edcd99bf5..8e879620478 100644
--- a/Cabal-syntax/src/Distribution/Types/MungedPackageId.hs
+++ b/Cabal-syntax/src/Distribution/Types/MungedPackageId.hs
@@ -15,7 +15,6 @@ import Distribution.Types.LibraryName
import Distribution.Types.MungedPackageName
import Distribution.Types.PackageId
import Distribution.Version (Version, nullVersion)
-import Distribution.Compiler (CompilerId)
import qualified Text.PrettyPrint as Disp
@@ -28,7 +27,6 @@ data MungedPackageId = MungedPackageId
-- 'MungedPackageName'.
, mungedVersion :: Version
-- ^ The version of this package / component, eg 1.2
- , mingledCompilerId :: Maybe CompilerId
}
deriving (Generic, Read, Show, Eq, Ord, Data)
@@ -43,9 +41,8 @@ instance Structured MungedPackageId
-- >>> prettyShow $ MungedPackageId (MungedPackageName "servant" (LSubLibName "lackey")) (mkVersion [0,1,2])
-- "z-servant-z-lackey-0.1.2"
instance Pretty MungedPackageId where
- pretty (MungedPackageId n v c)
- | v == nullVersion = pretty c <<>> Disp.char '-' <<>> pretty n -- if no version, don't show version.
- | Just c' <- c = pretty c' <<>> Disp.char '-' <<>> pretty n <<>> Disp.char '-' <<>> pretty v
+ pretty (MungedPackageId n v)
+ | v == nullVersion = pretty n -- if no version, don't show version.
| otherwise = pretty n <<>> Disp.char '-' <<>> pretty v
-- |
@@ -69,15 +66,15 @@ instance Pretty MungedPackageId where
-- Nothing
instance Parsec MungedPackageId where
parsec = do
- PackageIdentifier pn v comp <- parsec
- return $ MungedPackageId (decodeCompatPackageName pn) v comp
+ PackageIdentifier pn v <- parsec
+ return $ MungedPackageId (decodeCompatPackageName pn) v
instance NFData MungedPackageId where
- rnf (MungedPackageId name version compiler) = rnf name `seq` rnf version `seq` rnf compiler
+ rnf (MungedPackageId name version) = rnf name `seq` rnf version
computeCompatPackageId :: PackageId -> LibraryName -> MungedPackageId
-computeCompatPackageId (PackageIdentifier pn vr comp) ln =
- MungedPackageId (MungedPackageName pn ln) vr comp
+computeCompatPackageId (PackageIdentifier pn vr) ln =
+ MungedPackageId (MungedPackageName pn ln) vr
-- $setup
-- >>> :seti -XOverloadedStrings
diff --git a/Cabal-syntax/src/Distribution/Types/PackageDescription.hs b/Cabal-syntax/src/Distribution/Types/PackageDescription.hs
index 17f72e54c95..4b00a8ef526 100644
--- a/Cabal-syntax/src/Distribution/Types/PackageDescription.hs
+++ b/Cabal-syntax/src/Distribution/Types/PackageDescription.hs
@@ -207,7 +207,6 @@ emptyPackageDescription =
PackageIdentifier
(mkPackageName "")
nullVersion
- Nothing
, licenseRaw = Right UnspecifiedLicense -- TODO:
, licenseFiles = []
, specVersion = CabalSpecV1_0
diff --git a/Cabal-syntax/src/Distribution/Types/PackageId.hs b/Cabal-syntax/src/Distribution/Types/PackageId.hs
index ca9bfbfc967..9cd88a2f810 100644
--- a/Cabal-syntax/src/Distribution/Types/PackageId.hs
+++ b/Cabal-syntax/src/Distribution/Types/PackageId.hs
@@ -13,7 +13,6 @@ import Distribution.Parsec (Parsec (..), simpleParsec)
import Distribution.Pretty
import Distribution.Types.PackageName
import Distribution.Version (Version, nullVersion)
-import Distribution.Compiler (CompilerId)
import qualified Data.List.NonEmpty as NE
import qualified Distribution.Compat.CharParsing as P
@@ -28,7 +27,6 @@ data PackageIdentifier = PackageIdentifier
-- ^ The name of this package, eg. foo
, pkgVersion :: Version
-- ^ the version of this package, eg 1.2
- , pkgCompiler :: Maybe CompilerId
}
deriving (Generic, Read, Show, Eq, Ord, Data)
@@ -36,9 +34,8 @@ instance Binary PackageIdentifier
instance Structured PackageIdentifier
instance Pretty PackageIdentifier where
- pretty (PackageIdentifier n v c)
- | v == nullVersion = pretty c <<>> Disp.char '-' <<>> pretty n -- if no version, don't show version.
- | Just c' <- c = pretty c' <<>> Disp.char '-' <<>> pretty n <<>> Disp.char '-' <<>> pretty v
+ pretty (PackageIdentifier n v)
+ | v == nullVersion = pretty n -- if no version, don't show version.
| otherwise = pretty n <<>> Disp.char '-' <<>> pretty v
-- |
@@ -64,16 +61,15 @@ instance Pretty PackageIdentifier where
-- Nothing
instance Parsec PackageIdentifier where
parsec = do
- comp <- parsec <* P.char '-'
xs' <- P.sepByNonEmpty component (P.char '-')
(v, xs) <- case simpleParsec (NE.last xs') of
Nothing -> return (nullVersion, toList xs') -- all components are version
Just v -> return (v, NE.init xs')
if not (null xs) && all (\c -> all (/= '.') c && not (all isDigit c)) xs
- then return $ PackageIdentifier (mkPackageName (intercalate "-" xs)) v comp
+ then return $ PackageIdentifier (mkPackageName (intercalate "-" xs)) v
else fail "all digits or a dot in a portion of package name"
where
component = P.munch1 (\c -> isAlphaNum c || c == '.')
instance NFData PackageIdentifier where
- rnf (PackageIdentifier name version compiler) = rnf name `seq` rnf version `seq` rnf compiler
+ rnf (PackageIdentifier name version) = rnf name `seq` rnf version
diff --git a/Cabal-syntax/src/Distribution/Types/PackageId/Lens.hs b/Cabal-syntax/src/Distribution/Types/PackageId/Lens.hs
index 5a4682c7ed3..08305234fbd 100644
--- a/Cabal-syntax/src/Distribution/Types/PackageId/Lens.hs
+++ b/Cabal-syntax/src/Distribution/Types/PackageId/Lens.hs
@@ -10,7 +10,6 @@ import Prelude ()
import Distribution.Types.PackageId (PackageIdentifier)
import Distribution.Types.PackageName (PackageName)
import Distribution.Version (Version)
-import Distribution.Compiler (CompilerId)
import qualified Distribution.Types.PackageId as T
@@ -21,8 +20,3 @@ pkgName f s = fmap (\x -> s{T.pkgName = x}) (f (T.pkgName s))
pkgVersion :: Lens' PackageIdentifier Version
pkgVersion f s = fmap (\x -> s{T.pkgVersion = x}) (f (T.pkgVersion s))
{-# INLINE pkgVersion #-}
-
-pkgCompiler :: Lens' PackageIdentifier (Maybe CompilerId)
-pkgCompiler f s = fmap (\x -> s{T.pkgCompiler = x}) (f (T.pkgCompiler s))
-{-# INLINE pkgCompiler #-}
-
diff --git a/Cabal-syntax/src/Distribution/Types/PackageVersionConstraint.hs b/Cabal-syntax/src/Distribution/Types/PackageVersionConstraint.hs
index 5c2b8d9b0b1..013226ca2d5 100644
--- a/Cabal-syntax/src/Distribution/Types/PackageVersionConstraint.hs
+++ b/Cabal-syntax/src/Distribution/Types/PackageVersionConstraint.hs
@@ -53,7 +53,7 @@ instance Pretty PackageVersionConstraint where
-- Just (PackageVersionConstraint (PackageName "foo") (ThisVersion (mkVersion [2,0])))
instance Parsec PackageVersionConstraint where
parsec = do
- PackageIdentifier name ver comp <- parsec
+ PackageIdentifier name ver <- parsec
if ver == nullVersion
then do
P.spaces
@@ -64,7 +64,7 @@ instance Parsec PackageVersionConstraint where
-- | @since 3.4.0.0
thisPackageVersionConstraint :: PackageIdentifier -> PackageVersionConstraint
-thisPackageVersionConstraint (PackageIdentifier pn vr comp) =
+thisPackageVersionConstraint (PackageIdentifier pn vr) =
PackageVersionConstraint pn (thisVersion vr)
-- | @since 3.4.0.0
diff --git a/Cabal/src/Distribution/Backpack/PreExistingComponent.hs b/Cabal/src/Distribution/Backpack/PreExistingComponent.hs
index a72fe20f07f..0fba79bcb87 100644
--- a/Cabal/src/Distribution/Backpack/PreExistingComponent.hs
+++ b/Cabal/src/Distribution/Backpack/PreExistingComponent.hs
@@ -71,9 +71,9 @@ instance HasMungedPackageId PreExistingComponent where
mungedId = pc_munged_id
instance Package PreExistingComponent where
- packageId pec = PackageIdentifier (pc_pkgname pec) v compid
+ packageId pec = PackageIdentifier (pc_pkgname pec) v
where
- MungedPackageId _ v compid = pc_munged_id pec
+ MungedPackageId _ v = pc_munged_id pec
instance HasUnitId PreExistingComponent where
installedUnitId = pc_uid
diff --git a/Cabal/src/Distribution/Backpack/ReadyComponent.hs b/Cabal/src/Distribution/Backpack/ReadyComponent.hs
index b871ebff59f..7a3523d5eab 100644
--- a/Cabal/src/Distribution/Backpack/ReadyComponent.hs
+++ b/Cabal/src/Distribution/Backpack/ReadyComponent.hs
@@ -300,7 +300,6 @@ toReadyComponents pid_map subst0 comps =
MungedPackageId
(MungedPackageName nonExistentPackageThisIsCabalBug LMainLibName)
(mkVersion [0])
- Nothing
instc =
InstantiatedComponent
{ instc_insts = Map.toList insts
diff --git a/Cabal/src/Distribution/PackageDescription/Check.hs b/Cabal/src/Distribution/PackageDescription/Check.hs
index 799e677af17..925bc69d6e1 100644
--- a/Cabal/src/Distribution/PackageDescription/Check.hs
+++ b/Cabal/src/Distribution/PackageDescription/Check.hs
@@ -582,7 +582,7 @@ checkSetupBuildInfo (Just (SetupBuildInfo ds _)) = do
checkPVPs (checkDependencyVersionRange hasGTLowerBound) gtlck ds
checkPackageId :: Monad m => PackageIdentifier -> CheckM m ()
-checkPackageId (PackageIdentifier pkgName_ _pkgVersion_ _compid) = do
+checkPackageId (PackageIdentifier pkgName_ _pkgVersion_) = do
checkP
(not . FilePath.Windows.isValid . prettyShow $ pkgName_)
(PackageDistInexcusable $ InvalidNameWin pkgName_)
diff --git a/Cabal/src/Distribution/Simple/Build.hs b/Cabal/src/Distribution/Simple/Build.hs
index 008a270848f..402f27467d2 100644
--- a/Cabal/src/Distribution/Simple/Build.hs
+++ b/Cabal/src/Distribution/Simple/Build.hs
@@ -821,7 +821,7 @@ testSuiteLibV09AsLibAndExe
}
-- This is, like, the one place where we use a CTestName for a library.
-- Should NOT use library name, since that could conflict!
- PackageIdentifier pkg_name pkg_ver _pkg_compid = package pkg_descr
+ PackageIdentifier pkg_name pkg_ver = package pkg_descr
-- Note: we do make internal library from the test!
compat_name = MungedPackageName pkg_name (LSubLibName (testName test))
compat_key = computeCompatPackageKey (compiler lbi) compat_name pkg_ver (componentUnitId clbi)
diff --git a/Cabal/src/Distribution/Simple/Build/Macros.hs b/Cabal/src/Distribution/Simple/Build/Macros.hs
index e71d5a4a644..f3c51d71c96 100644
--- a/Cabal/src/Distribution/Simple/Build/Macros.hs
+++ b/Cabal/src/Distribution/Simple/Build/Macros.hs
@@ -67,11 +67,11 @@ generateCabalMacrosHeader pkg_descr lbi clbi =
, Z.zMangleStr = map fixchar
}
where
- getPid (_, MungedPackageId (MungedPackageName pn _) v compid) =
+ getPid (_, MungedPackageId (MungedPackageName pn _) v) =
-- NB: Drop the library name! We're just reporting package versions.
-- This would have to be revisited if you are allowed to depend
-- on different versions of the same package
- PackageIdentifier pn v compid
+ PackageIdentifier pn v
-- | Helper function that generates just the @VERSION_pkg@ and @MIN_VERSION_pkg@
-- macros for a list of package ids (usually used with the specific deps of
@@ -91,7 +91,7 @@ generatePackageVersionMacros ver pkgids =
}
mkZPackage :: PackageId -> Z.ZPackage
-mkZPackage (PackageIdentifier name ver compid) =
+mkZPackage (PackageIdentifier name ver) =
Z.ZPackage
{ Z.zpkgName = name
, Z.zpkgVersion = ver
diff --git a/Cabal/src/Distribution/Simple/Configure.hs b/Cabal/src/Distribution/Simple/Configure.hs
index a76b4359bc9..7c96efb33fc 100644
--- a/Cabal/src/Distribution/Simple/Configure.hs
+++ b/Cabal/src/Distribution/Simple/Configure.hs
@@ -335,7 +335,7 @@ writePersistBuildConfig mbWorkDir distPref lbi = do
-- | Identifier of the current Cabal package.
currentCabalId :: PackageIdentifier
-currentCabalId = PackageIdentifier (mkPackageName "Cabal") cabalVersion Nothing
+currentCabalId = PackageIdentifier (mkPackageName "Cabal") cabalVersion
-- | Identifier of the current compiler package.
currentCompilerId :: PackageIdentifier
@@ -343,7 +343,6 @@ currentCompilerId =
PackageIdentifier
(mkPackageName System.Info.compilerName)
(mkVersion' System.Info.compilerVersion)
- Nothing
-- | Parse the @setup-config@ file header, returning the package identifiers
-- for Cabal and the compiler.
@@ -1988,7 +1987,7 @@ selectDependency
-- It's an internal library, and we're not per-component build
do_internal lib
| Set.member lib internalIndex =
- Right $ InternalDependency $ PackageIdentifier dep_pkgname (packageVersion pkgid) (pkgCompiler pkgid)
+ Right $ InternalDependency $ PackageIdentifier dep_pkgname $ packageVersion pkgid
| otherwise =
Left $ DependencyMissingInternal dep_pkgname lib
diff --git a/Cabal/src/Distribution/Simple/PackageIndex.hs b/Cabal/src/Distribution/Simple/PackageIndex.hs
index 6e115ca65a5..a7d23962b72 100644
--- a/Cabal/src/Distribution/Simple/PackageIndex.hs
+++ b/Cabal/src/Distribution/Simple/PackageIndex.hs
@@ -169,7 +169,7 @@ instance Semigroup (PackageIndex IPI.InstalledPackageInfo) where
{-# NOINLINE invariant #-}
invariant :: WithCallStack (InstalledPackageIndex -> Bool)
invariant (PackageIndex pids pnames) =
- trace (show pids' ++ "\n" ++ show pnames') $
+ -- trace (show pids' ++ "\n" ++ show pnames') $
pids' == pnames'
where
pids' = map installedUnitId (Map.elems pids)
@@ -335,21 +335,16 @@ deleteSourcePackageId pkgid original@(PackageIndex pids pnames) =
Just pvers -> case Map.lookup (packageVersion pkgid) pvers of
Nothing -> original
Just pkgs ->
- traceShow (pkgid, pkgs) $ mkPackageIndex
- (Map.update deletePkgInstance (installedUnitId pkgid) pids)
+ mkPackageIndex
+ (foldl' (flip (Map.delete . installedUnitId)) pids pkgs)
(deletePkgName pnames)
where
deletePkgName =
Map.update deletePkgVersion (packageName pkgid, LMainLibName)
- deletePkgVersion :: Map Version [IPI.InstalledPackageInfo] -> Maybe (Map Version [IPI.InstalledPackageInfo])
deletePkgVersion =
(\m -> if Map.null m then Nothing else Just m)
- . Map.update deletePkgInstance (packageVersion pkgid)
-
- deletePkgInstance :: [IPI.InstalledPackageInfo] -> Maybe [IPI.InstalledPackageInfo]
- deletePkgInstance xs = if null xs' then Nothing else Just xs'
- where xs' = [x | x <- xs, pkgCompiler pkgid /= pkgCompiler (IPI.sourcePackageId x)]
+ . Map.delete (packageVersion pkgid)
-- | Removes all packages with this (case-sensitive) name from the index.
--
diff --git a/Cabal/src/Distribution/Types/PackageName/Magic.hs b/Cabal/src/Distribution/Types/PackageName/Magic.hs
index 908e82bea6f..022a62468b1 100644
--- a/Cabal/src/Distribution/Types/PackageName/Magic.hs
+++ b/Cabal/src/Distribution/Types/PackageName/Magic.hs
@@ -21,4 +21,4 @@ fakePackageCabalFileName = "fake-package.cabal"
-- | 'fakePackageName' with 'version0'.
fakePackageId :: PackageId
-fakePackageId = PackageIdentifier fakePackageName version0 Nothing
+fakePackageId = PackageIdentifier fakePackageName version0
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs b/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs
index 6ae45e569fc..d391345d0eb 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs
@@ -39,7 +39,7 @@ convCP iidx sidx (CP qpi fa es ds) =
}
-- "In repo" i.e. a source package
(PI qpn@(Q _path pn) (I stage v InRepo)) ->
- let pi = PackageIdentifier pn v Nothing {-# FIXME: should be COMPILERID #-} in
+ let pi = PackageIdentifier pn v in
Configured $
SolverPackage {
solverPkgQPN = qpn,
@@ -70,4 +70,4 @@ convConfId (PI (Q (PackagePath _ q) pn) (I _stage v loc)) =
, pn == pn' -> Right (PlannedId sourceId)
| otherwise -> Left (PlannedId sourceId)
where
- sourceId = PackageIdentifier pn v Nothing -- FIXME: this should be the compiler id!
+ sourceId = PackageIdentifier pn v
diff --git a/cabal-install-solver/src/Distribution/Solver/Types/InstSolverPackage.hs b/cabal-install-solver/src/Distribution/Solver/Types/InstSolverPackage.hs
index 868d1d9dfe2..15fb9d510ec 100644
--- a/cabal-install-solver/src/Distribution/Solver/Types/InstSolverPackage.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Types/InstSolverPackage.hs
@@ -31,8 +31,8 @@ instance Structured InstSolverPackage
instance Package InstSolverPackage where
packageId i =
-- HACK! See Note [Index conversion with internal libraries]
- let MungedPackageId mpn v compid = mungedId i
- in PackageIdentifier (encodeCompatPackageName mpn) v compid
+ let MungedPackageId mpn v = mungedId i
+ in PackageIdentifier (encodeCompatPackageName mpn) v
instance HasMungedPackageId InstSolverPackage where
mungedId = mungedId . instSolverPkgIPI
diff --git a/cabal-install/src/Distribution/Client/BuildReports/Anonymous.hs b/cabal-install/src/Distribution/Client/BuildReports/Anonymous.hs
index a6febfcca50..ce1d1665327 100644
--- a/cabal-install/src/Distribution/Client/BuildReports/Anonymous.hs
+++ b/cabal-install/src/Distribution/Client/BuildReports/Anonymous.hs
@@ -103,7 +103,7 @@ newBuildReport os' arch' comp pkgid flags deps result =
cabalInstallID :: PackageIdentifier
cabalInstallID =
- PackageIdentifier (mkPackageName "cabal-install") cabalInstallVersion Nothing
+ PackageIdentifier (mkPackageName "cabal-install") cabalInstallVersion
-------------------------------------------------------------------------------
-- FieldGrammar
diff --git a/cabal-install/src/Distribution/Client/Dependency.hs b/cabal-install/src/Distribution/Client/Dependency.hs
index 7f3812d69b4..65f8a06ac97 100644
--- a/cabal-install/src/Distribution/Client/Dependency.hs
+++ b/cabal-install/src/Distribution/Client/Dependency.hs
@@ -1057,7 +1057,7 @@ configuredPackageProblems
(sort $ map fst (PD.unFlagAssignment specifiedFlags)) -- TODO
packageSatisfiesDependency :: PackageIdentifier -> Dependency -> Bool
packageSatisfiesDependency
- (PackageIdentifier name version _compid)
+ (PackageIdentifier name version)
(Dependency name' versionRange _) =
assert (name == name') $
version `withinRange` versionRange
diff --git a/cabal-install/src/Distribution/Client/IndexUtils.hs b/cabal-install/src/Distribution/Client/IndexUtils.hs
index 0cd842d663e..6027f5e53f3 100644
--- a/cabal-install/src/Distribution/Client/IndexUtils.hs
+++ b/cabal-install/src/Distribution/Client/IndexUtils.hs
@@ -617,7 +617,7 @@ extractPkg verbosity entry blockNo = case Tar.entryContent entry of
[pkgname, vers, _] -> case simpleParsec vers of
Just ver -> Just . return $ Just (NormalPackage pkgid descr content blockNo)
where
- pkgid = PackageIdentifier (mkPackageName pkgname) ver Nothing
+ pkgid = PackageIdentifier (mkPackageName pkgname) ver
parsed = parseGenericPackageDescriptionMaybe (BS.toStrict content)
descr = case parsed of
Just d -> d
@@ -1269,10 +1269,10 @@ hashConsCache cache0 =
go !pns !pvs (CachePackageId pid bno ts : rest) =
CachePackageId pid' bno ts : go pns' pvs' rest
where
- !pid' = PackageIdentifier pn' pv' compid
+ !pid' = PackageIdentifier pn' pv'
(!pn', !pns') = mapIntern pn pns
(!pv', !pvs') = mapIntern pv pvs
- PackageIdentifier pn pv compid = pid
+ PackageIdentifier pn pv = pid
go pns pvs (x : xs) = x : go pns pvs xs
mapIntern :: Ord k => k -> Map.Map k k -> (k, Map.Map k k)
@@ -1395,7 +1395,7 @@ read00IndexCacheEntry = \line ->
(Just pkgname, Just pkgver, Just blockno) ->
Just
( CachePackageId
- (PackageIdentifier pkgname pkgver Nothing)
+ (PackageIdentifier pkgname pkgver)
blockno
NoTimestamp
)
diff --git a/cabal-install/src/Distribution/Client/Install.hs b/cabal-install/src/Distribution/Client/Install.hs
index 7f32d51ac3d..6c9a605c553 100644
--- a/cabal-install/src/Distribution/Client/Install.hs
+++ b/cabal-install/src/Distribution/Client/Install.hs
@@ -1101,7 +1101,7 @@ theSpecifiedPackage :: Package pkg => PackageSpecifier pkg -> Maybe PackageId
theSpecifiedPackage pkgSpec =
case pkgSpec of
NamedPackage name [PackagePropertyVersion version] ->
- PackageIdentifier name <$> trivialRange version <*> Nothing
+ PackageIdentifier name <$> trivialRange version
NamedPackage _ _ -> Nothing
SpecificSourcePackage pkg -> Just $ packageId pkg
where
diff --git a/cabal-install/src/Distribution/Client/PackageHash.hs b/cabal-install/src/Distribution/Client/PackageHash.hs
index d99fc9ad250..38240c3888a 100644
--- a/cabal-install/src/Distribution/Client/PackageHash.hs
+++ b/cabal-install/src/Distribution/Client/PackageHash.hs
@@ -133,7 +133,7 @@ hashedInstalledPackageIdShort pkghashinputs@PackageHashInputs{pkgHashPkgId} =
, showHashValue (truncateHash 20 (hashPackageHashInputs pkghashinputs))
]
where
- PackageIdentifier name version _compid = pkgHashPkgId
+ PackageIdentifier name version = pkgHashPkgId
-- Truncate a string, with a visual indication that it is truncated.
truncateStr n s
@@ -172,7 +172,7 @@ hashedInstalledPackageIdVeryShort pkghashinputs@PackageHashInputs{pkgHashPkgId}
, showHashValue (truncateHash 4 (hashPackageHashInputs pkghashinputs))
]
where
- PackageIdentifier name version _compid = pkgHashPkgId
+ PackageIdentifier name version = pkgHashPkgId
-- | All the information that contributes to a package's hash, and thus its
-- 'InstalledPackageId'.
diff --git a/cabal-install/src/Distribution/Client/SetupWrapper.hs b/cabal-install/src/Distribution/Client/SetupWrapper.hs
index d46045c849a..55042e212cd 100644
--- a/cabal-install/src/Distribution/Client/SetupWrapper.hs
+++ b/cabal-install/src/Distribution/Client/SetupWrapper.hs
@@ -1068,7 +1068,7 @@ getExternalSetupMethod verbosity options pkg bt = do
debug verbosity "Setup executable needs to be updated, compiling..."
(compiler, progdb, options'') <- configureCompiler options'
pkgDbs <- traverse (traverse (makeRelativeToDirS mbWorkDir)) (coercePackageDBStack (usePackageDB options''))
- let cabalPkgid = PackageIdentifier (mkPackageName "Cabal") cabalLibVersion Nothing
+ let cabalPkgid = PackageIdentifier (mkPackageName "Cabal") cabalLibVersion
(program, extraOpts) =
case compilerFlavor compiler of
GHCJS -> (ghcjsProgram, ["-build-runner"])
@@ -1155,5 +1155,5 @@ getExternalSetupMethod verbosity options pkg bt = do
return $ i setupProgFile
isCabalPkgId, isBasePkgId :: PackageIdentifier -> Bool
-isCabalPkgId (PackageIdentifier pname _ _compid) = pname == mkPackageName "Cabal"
-isBasePkgId (PackageIdentifier pname _ _compid) = pname == mkPackageName "base"
+isCabalPkgId (PackageIdentifier pname _) = pname == mkPackageName "Cabal"
+isBasePkgId (PackageIdentifier pname _) = pname == mkPackageName "base"
diff --git a/cabal-install/src/Distribution/Client/SolverInstallPlan.hs b/cabal-install/src/Distribution/Client/SolverInstallPlan.hs
index 631dbde5afe..17dcf6d9398 100644
--- a/cabal-install/src/Distribution/Client/SolverInstallPlan.hs
+++ b/cabal-install/src/Distribution/Client/SolverInstallPlan.hs
@@ -218,7 +218,7 @@ showPlanProblem (PackageInconsistency name inconsistencies) =
[ " package "
++ prettyShow pkg
++ " requires "
- ++ prettyShow (PackageIdentifier name ver Nothing)
+ ++ prettyShow (PackageIdentifier name ver)
| (pkg, ver) <- inconsistencies
]
showPlanProblem (PackageStateInvalid pkg pkg') =
diff --git a/cabal-install/src/Distribution/Client/Types/AllowNewer.hs b/cabal-install/src/Distribution/Client/Types/AllowNewer.hs
index 6a6503aaf4c..0a5700174b8 100644
--- a/cabal-install/src/Distribution/Client/Types/AllowNewer.hs
+++ b/cabal-install/src/Distribution/Client/Types/AllowNewer.hs
@@ -109,7 +109,7 @@ relaxedDepStarP =
-- continuation after package identifier
relaxedDepPkgidP :: CabalParsing m => PackageIdentifier -> m RelaxedDep
-relaxedDepPkgidP pid@(PackageIdentifier pn v _compid)
+relaxedDepPkgidP pid@(PackageIdentifier pn v)
| pn == mkPackageName "all"
, v == nullVersion =
RelaxedDep RelaxDepScopeAll <$ P.char ':' <*> modP <*> parsec
From f8600655624c8cc2cdd2fb16237ab115828e3754 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Mon, 24 Mar 2025 12:54:49 +0900
Subject: [PATCH 52/82] fixup! Add compiler to PackageId
---
cabal-install/src/Distribution/Client/ProjectPlanning.hs | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index a55f6bee2da..9590c2e010c 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -1043,7 +1043,7 @@ reportPlanningFailure projectConfig Toolchain{toolchainCompiler = comp, toolchai
theSpecifiedPackage pkgSpec =
case pkgSpec of
NamedPackage name [PackagePropertyVersion version] ->
- PackageIdentifier name <$> trivialRange version
+ PackageIdentifier name <$> trivialRange version <*> Nothing
NamedPackage _ _ -> Nothing
SpecificSourcePackage pkg -> Just $ packageId pkg
-- \| If a range includes only a single version, return Just that version.
From ad675ad5be14e56d3443b64943b378b91647c29e Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Mon, 24 Mar 2025 12:55:26 +0900
Subject: [PATCH 53/82] Revert "fixup! Add compiler to PackageId"
This reverts commit f8600655624c8cc2cdd2fb16237ab115828e3754.
---
cabal-install/src/Distribution/Client/ProjectPlanning.hs | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index 9590c2e010c..a55f6bee2da 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -1043,7 +1043,7 @@ reportPlanningFailure projectConfig Toolchain{toolchainCompiler = comp, toolchai
theSpecifiedPackage pkgSpec =
case pkgSpec of
NamedPackage name [PackagePropertyVersion version] ->
- PackageIdentifier name <$> trivialRange version <*> Nothing
+ PackageIdentifier name <$> trivialRange version
NamedPackage _ _ -> Nothing
SpecificSourcePackage pkg -> Just $ packageId pkg
-- \| If a range includes only a single version, return Just that version.
From 125921422d2cacef165db2a17c032db0d08ebcf6 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Mon, 24 Mar 2025 12:57:16 +0900
Subject: [PATCH 54/82] fixup! Add compiler to PackageId
---
.../Solver/Modular/IndexConversion.hs | 4 ++--
.../Distribution/Client/ProjectPlanning.hs | 19 ++++++++++++++++++-
2 files changed, 20 insertions(+), 3 deletions(-)
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs b/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs
index 9ab501e904a..a1a27b9bb33 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs
@@ -85,7 +85,7 @@ convIPI' toolchains (ShadowPkgs sip) idx =
-- | Extract/recover the package ID from an installed package info, and convert it to a solver's I.
convId :: Toolchains -> IPI.InstalledPackageInfo -> (PN, I)
convId toolchains ipi = (pn, I stage ver $ Inst $ IPI.installedUnitId ipi)
- where MungedPackageId mpn ver = mungedId ipi
+ where MungedPackageId mpn ver compid = mungedId ipi
-- HACK. See Note [Index conversion with internal libraries]
pn = encodeCompatPackageName mpn
stage = case IPI.pkgCompiler ipi of
@@ -169,7 +169,7 @@ convSPI' toolchains constraints strfl solveExes =
-- | Convert a single source package into the solver-specific format.
convSP :: Toolchains -> Map PN [LabeledPackageConstraint]
-> StrongFlags -> SolveExecutables -> SourcePackage loc -> [(PN, I, PInfo)]
-convSP toolchains constraints strfl solveExes (SourcePackage (PackageIdentifier pn pv) gpd _ _pl) =
+convSP toolchains constraints strfl solveExes (SourcePackage (PackageIdentifier pn pv _compid) gpd _ _pl) =
let pkgConstraints = fromMaybe [] $ M.lookup pn constraints
in [(pn, I Host pv InRepo, convGPD (hostToolchain toolchains) pkgConstraints strfl solveExes pn gpd)
,(pn, I Build pv InRepo, convGPD (buildToolchain toolchains) pkgConstraints strfl solveExes pn gpd)]
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index a55f6bee2da..c2d46bd188a 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -198,6 +198,7 @@ import Distribution.Types.GivenComponent
import Distribution.Types.LibraryName
import qualified Distribution.Types.LocalBuildConfig as LBC
import Distribution.Types.PackageVersionConstraint
+import qualified Distribution.Types.PackageId as PI
import Distribution.Types.PkgconfigDependency
import Distribution.Types.UnqualComponentName
@@ -791,8 +792,21 @@ rebuildInstallPlan
-- }
-- deriving (Eq, Generic, Show, Read)
--
- -- can probably use fromList $ Map.elems $ on it.
+ -- let mapPkgIdx f = PI.fromList . map f . PI.allPackages
+ -- let updateIPI :: IPI.InstalledPackageInfo -> IPI.InstalledPackageInfo
+ -- updateIPI ipi = ipi {
+ -- IPI.sourcePackageId = (IPI.sourcePackageId ipi){ PI.pkgCompiler = IPI.pkgCompiler ipi }
+ -- }
+ -- let addCompilerToSourcePkg :: CompilerId -> [PackageSpecifier UnresolvedSourcePackage] -> [PackageSpecifier UnresolvedSourcePackage]
+ -- addCompilerToSourcePkg compilerId = map (addCompilerId compilerId)
+ -- addCompilerId :: CompilerId -> PackageSpecifier UnresolvedSourcePackage -> PackageSpecifier UnresolvedSourcePackage
+ -- addCompilerId compilerId (NamedPackage name props) = NamedPackage name props
+ -- addCompilerId compilerId (SpecificSourcePackage pkg) = SpecificSourcePackage (f pkg)
+ -- where f :: SourcePackage UnresolvedPkgLoc -> SourcePackage UnresolvedPkgLoc
+ -- f pkg = pkg{srcpkgPackageId = (srcpkgPackageId pkg){pkgCompiler = Just compilerId}}
+
hinstalledPkgIndex <-
+ -- mapPkgIdx updateIPI <$>
getInstalledPackages
verbosity
(hostToolchain toolchains)
@@ -802,6 +816,7 @@ rebuildInstallPlan
-- for now. FIXME!
-- let hinstalledPkgIndex' = PI.fromList $ PI.allPackages hinstalledPkgIndex
binstalledPkgIndex <-
+ -- mapPkgIdx updateIPI <$>
getInstalledPackages
verbosity
(buildToolchain toolchains)
@@ -809,6 +824,8 @@ rebuildInstallPlan
-- if host and build compiler are the same, we want to get -package-db in here.
(corePackageDbs $ if buildIsHost toolchains then Host else Build)
+ -- let localPackages' = addCompilerToSourcePkg (compilerId . toolchainCompiler . hostToolchain $ toolchains) localPackages
+
(sourcePkgDb, tis, ar) <-
getSourcePackages
verbosity
From 02f17b1951a1ddeb5f20fc41b16bb1b9bb709bab Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Mon, 24 Mar 2025 12:57:33 +0900
Subject: [PATCH 55/82] Revert "fixup! Add compiler to PackageId"
This reverts commit 125921422d2cacef165db2a17c032db0d08ebcf6.
---
.../Solver/Modular/IndexConversion.hs | 4 ++--
.../Distribution/Client/ProjectPlanning.hs | 19 +------------------
2 files changed, 3 insertions(+), 20 deletions(-)
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs b/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs
index a1a27b9bb33..9ab501e904a 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs
@@ -85,7 +85,7 @@ convIPI' toolchains (ShadowPkgs sip) idx =
-- | Extract/recover the package ID from an installed package info, and convert it to a solver's I.
convId :: Toolchains -> IPI.InstalledPackageInfo -> (PN, I)
convId toolchains ipi = (pn, I stage ver $ Inst $ IPI.installedUnitId ipi)
- where MungedPackageId mpn ver compid = mungedId ipi
+ where MungedPackageId mpn ver = mungedId ipi
-- HACK. See Note [Index conversion with internal libraries]
pn = encodeCompatPackageName mpn
stage = case IPI.pkgCompiler ipi of
@@ -169,7 +169,7 @@ convSPI' toolchains constraints strfl solveExes =
-- | Convert a single source package into the solver-specific format.
convSP :: Toolchains -> Map PN [LabeledPackageConstraint]
-> StrongFlags -> SolveExecutables -> SourcePackage loc -> [(PN, I, PInfo)]
-convSP toolchains constraints strfl solveExes (SourcePackage (PackageIdentifier pn pv _compid) gpd _ _pl) =
+convSP toolchains constraints strfl solveExes (SourcePackage (PackageIdentifier pn pv) gpd _ _pl) =
let pkgConstraints = fromMaybe [] $ M.lookup pn constraints
in [(pn, I Host pv InRepo, convGPD (hostToolchain toolchains) pkgConstraints strfl solveExes pn gpd)
,(pn, I Build pv InRepo, convGPD (buildToolchain toolchains) pkgConstraints strfl solveExes pn gpd)]
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index c2d46bd188a..a55f6bee2da 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -198,7 +198,6 @@ import Distribution.Types.GivenComponent
import Distribution.Types.LibraryName
import qualified Distribution.Types.LocalBuildConfig as LBC
import Distribution.Types.PackageVersionConstraint
-import qualified Distribution.Types.PackageId as PI
import Distribution.Types.PkgconfigDependency
import Distribution.Types.UnqualComponentName
@@ -792,21 +791,8 @@ rebuildInstallPlan
-- }
-- deriving (Eq, Generic, Show, Read)
--
- -- let mapPkgIdx f = PI.fromList . map f . PI.allPackages
- -- let updateIPI :: IPI.InstalledPackageInfo -> IPI.InstalledPackageInfo
- -- updateIPI ipi = ipi {
- -- IPI.sourcePackageId = (IPI.sourcePackageId ipi){ PI.pkgCompiler = IPI.pkgCompiler ipi }
- -- }
- -- let addCompilerToSourcePkg :: CompilerId -> [PackageSpecifier UnresolvedSourcePackage] -> [PackageSpecifier UnresolvedSourcePackage]
- -- addCompilerToSourcePkg compilerId = map (addCompilerId compilerId)
- -- addCompilerId :: CompilerId -> PackageSpecifier UnresolvedSourcePackage -> PackageSpecifier UnresolvedSourcePackage
- -- addCompilerId compilerId (NamedPackage name props) = NamedPackage name props
- -- addCompilerId compilerId (SpecificSourcePackage pkg) = SpecificSourcePackage (f pkg)
- -- where f :: SourcePackage UnresolvedPkgLoc -> SourcePackage UnresolvedPkgLoc
- -- f pkg = pkg{srcpkgPackageId = (srcpkgPackageId pkg){pkgCompiler = Just compilerId}}
-
+ -- can probably use fromList $ Map.elems $ on it.
hinstalledPkgIndex <-
- -- mapPkgIdx updateIPI <$>
getInstalledPackages
verbosity
(hostToolchain toolchains)
@@ -816,7 +802,6 @@ rebuildInstallPlan
-- for now. FIXME!
-- let hinstalledPkgIndex' = PI.fromList $ PI.allPackages hinstalledPkgIndex
binstalledPkgIndex <-
- -- mapPkgIdx updateIPI <$>
getInstalledPackages
verbosity
(buildToolchain toolchains)
@@ -824,8 +809,6 @@ rebuildInstallPlan
-- if host and build compiler are the same, we want to get -package-db in here.
(corePackageDbs $ if buildIsHost toolchains then Host else Build)
- -- let localPackages' = addCompilerToSourcePkg (compilerId . toolchainCompiler . hostToolchain $ toolchains) localPackages
-
(sourcePkgDb, tis, ar) <-
getSourcePackages
verbosity
From 7c321e32f5730929a3c95b95a7373907acd3dcd4 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Mon, 24 Mar 2025 13:39:48 +0900
Subject: [PATCH 56/82] Add build package index
---
.../src/Distribution/Solver/Modular.hs | 8 ++++----
.../Solver/Modular/ConfiguredConversion.hs | 12 +++++++-----
.../Solver/Modular/IndexConversion.hs | 11 +++++++----
.../Solver/Types/DependencyResolver.hs | 3 ++-
.../src/Distribution/Client/Configure.hs | 1 +
.../src/Distribution/Client/Dependency.hs | 19 +++++++++++++++----
.../src/Distribution/Client/Fetch.hs | 2 +-
.../src/Distribution/Client/Freeze.hs | 2 +-
cabal-install/src/Distribution/Client/Get.hs | 2 +-
.../src/Distribution/Client/Install.hs | 1 +
.../Distribution/Client/ProjectPlanning.hs | 8 ++++++--
11 files changed, 46 insertions(+), 23 deletions(-)
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular.hs b/cabal-install-solver/src/Distribution/Solver/Modular.hs
index 733cdc87aa0..f72a0bda371 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular.hs
@@ -80,14 +80,14 @@ showCP (CP qpi fa es ds) =
-- | Ties the two worlds together: classic cabal-install vs. the modular
-- solver. Performs the necessary translations before and after.
modularResolver :: SolverConfig -> DependencyResolver loc
-modularResolver sc toolchains iidx sidx pkgConfigDB pprefs pcs pns = do
- (assignment, revdepmap) <- solve' sc toolchains idx pkgConfigDB pprefs gcs pns
+modularResolver sc toolchains biidx iidx sidx pkgConfigDB pprefs pcs pns = do
+ (assignment, revdepmap) <- solve' sc toolchains (trace (showIdx idx) idx) pkgConfigDB pprefs gcs pns
let cp = toCPs assignment revdepmap
Step (show (vcat (map showCP cp))) $
return $ postprocess assignment revdepmap
where
-- Indices have to be converted into solver-specific uniform index.
- idx = convPIs toolchains gcs (shadowPkgs sc) (strongFlags sc) (solveExecutables sc) iidx sidx
+ idx = convPIs toolchains gcs (shadowPkgs sc) (strongFlags sc) (solveExecutables sc) biidx iidx sidx
-- Constraints have to be converted into a finite map indexed by PN.
gcs = M.fromListWith (++) (map pair pcs)
where
@@ -97,7 +97,7 @@ modularResolver sc toolchains iidx sidx pkgConfigDB pprefs pcs pns = do
-- package qualifiers, which means that linked packages become duplicates
-- and can be removed.
postprocess a rdm = ordNubBy nodeKey $
- map (convCP iidx sidx) (toCPs a rdm)
+ map (convCP biidx iidx sidx) (toCPs a rdm)
-- Helper function to extract the PN from a constraint.
pcName :: PackageConstraint -> PN
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs b/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs
index d391345d0eb..69e41072547 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs
@@ -19,21 +19,23 @@ import Distribution.Solver.Types.SolverId
import Distribution.Solver.Types.SolverPackage
import Distribution.Solver.Types.InstSolverPackage
import Distribution.Solver.Types.SourcePackage
+import Control.Applicative ((<|>))
-- | Converts from the solver specific result @CP QPN@ into
-- a 'ResolverPackage', which can then be converted into
-- the install plan.
-convCP :: SI.InstalledPackageIndex ->
- CI.PackageIndex (SourcePackage loc) ->
- CP QPN -> ResolverPackage loc
-convCP iidx sidx (CP qpi fa es ds) =
+convCP :: SI.InstalledPackageIndex -- ^ build
+ -> SI.InstalledPackageIndex -- ^ host
+ -> CI.PackageIndex (SourcePackage loc)
+ -> CP QPN -> ResolverPackage loc
+convCP biidx iidx sidx (CP qpi fa es ds) =
case qpi of
-- Installed
(PI qpn (I _stage _ (Inst pi))) ->
PreExisting $
InstSolverPackage {
instSolverQPN = qpn,
- instSolverPkgIPI = fromMaybe (error "convCP: lookupUnitId failed") $ SI.lookupUnitId iidx pi,
+ instSolverPkgIPI = fromMaybe (error "convCP: lookupUnitId failed") $ (SI.lookupUnitId iidx pi) <|> (SI.lookupUnitId biidx pi),
instSolverPkgLibDeps = fmap fst ds',
instSolverPkgExeDeps = fmap snd ds'
}
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs b/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs
index 9ab501e904a..2fc84f84697 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs
@@ -58,11 +58,14 @@ import Distribution.Solver.Modular.Version
-- explicitly requested.
convPIs :: Toolchains -> Map PN [LabeledPackageConstraint]
-> ShadowPkgs -> StrongFlags -> SolveExecutables
- -> SI.InstalledPackageIndex -> CI.PackageIndex (SourcePackage loc)
+ -> SI.InstalledPackageIndex -- ^ build
+ -> SI.InstalledPackageIndex -- ^ host
+ -> CI.PackageIndex (SourcePackage loc)
-> Index
-convPIs toolchains constraints sip strfl solveExes iidx sidx =
- mkIndex $
- convIPI' toolchains sip iidx ++ convSPI' toolchains constraints strfl solveExes sidx
+ where bipis = convIPI' toolchains sip biidx
+ hipis = convIPI' toolchains sip iidx
+ ipis = bipis ++ hipis
+ spis = convSPI' toolchains constraints strfl solveExes sidx
-- | Convert a Cabal installed package index to the simpler,
-- more uniform index format of the solver.
diff --git a/cabal-install-solver/src/Distribution/Solver/Types/DependencyResolver.hs b/cabal-install-solver/src/Distribution/Solver/Types/DependencyResolver.hs
index d4e9c2ea707..3306ac620de 100644
--- a/cabal-install-solver/src/Distribution/Solver/Types/DependencyResolver.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Types/DependencyResolver.hs
@@ -28,7 +28,8 @@ import Distribution.System ( Platform )
-- in alternatives.
--
type DependencyResolver loc = Toolchains
- -> InstalledPackageIndex
+ -> InstalledPackageIndex -- ^ build
+ -> InstalledPackageIndex -- ^ host
-> PackageIndex (SourcePackage loc)
-> Maybe PkgConfigDb
-> (PackageName -> PackagePreferences)
diff --git a/cabal-install/src/Distribution/Client/Configure.hs b/cabal-install/src/Distribution/Client/Configure.hs
index f62ee83e61c..bc3c24f9245 100644
--- a/cabal-install/src/Distribution/Client/Configure.hs
+++ b/cabal-install/src/Distribution/Client/Configure.hs
@@ -464,6 +464,7 @@ planLocalPackage
. setSolveExecutables (SolveExecutables False)
. setSolverVerbosity verbosity
$ standardInstallPolicy
+ mempty {- build pkgs -}
installedPkgIndex
-- NB: We pass in an *empty* source package database,
-- because cabal configure assumes that all dependencies
diff --git a/cabal-install/src/Distribution/Client/Dependency.hs b/cabal-install/src/Distribution/Client/Dependency.hs
index 65f8a06ac97..8bde68b8112 100644
--- a/cabal-install/src/Distribution/Client/Dependency.hs
+++ b/cabal-install/src/Distribution/Client/Dependency.hs
@@ -181,6 +181,7 @@ data DepResolverParams = DepResolverParams
, depResolverPreferences :: [PackagePreference]
, depResolverPreferenceDefault :: PackagesPreferenceDefault
, depResolverInstalledPkgIndex :: InstalledPackageIndex
+ , depResolverBuildInstalledPkgIndex :: InstalledPackageIndex
, depResolverSourcePkgIndex :: PackageIndex.PackageIndex UnresolvedSourcePackage
, depResolverReorderGoals :: ReorderGoals
, depResolverCountConflicts :: CountConflicts
@@ -277,15 +278,17 @@ showPackagePreference (PackageStanzasPreference pn st) =
basicDepResolverParams
:: InstalledPackageIndex
+ -> InstalledPackageIndex
-> PackageIndex.PackageIndex UnresolvedSourcePackage
-> DepResolverParams
-basicDepResolverParams installedPkgIndex sourcePkgIndex =
+basicDepResolverParams buildInstalledPkgIndex installedPkgIndex sourcePkgIndex=
DepResolverParams
{ depResolverTargets = Set.empty
, depResolverConstraints = []
, depResolverPreferences = []
, depResolverPreferenceDefault = PreferLatestForSelected
, depResolverInstalledPkgIndex = installedPkgIndex
+ , depResolverBuildInstalledPkgIndex = buildInstalledPkgIndex
, depResolverSourcePkgIndex = sourcePkgIndex
, depResolverReorderGoals = ReorderGoals False
, depResolverCountConflicts = CountConflicts True
@@ -702,11 +705,13 @@ reinstallTargets params =
-- | A basic solver policy on which all others are built.
basicInstallPolicy
- :: InstalledPackageIndex
+ :: InstalledPackageIndex -- ^ Build
+ -> InstalledPackageIndex -- ^ Host
-> SourcePackageDb
-> [PackageSpecifier UnresolvedSourcePackage]
-> DepResolverParams
basicInstallPolicy
+ binstalledPkgIndex
installedPkgIndex
(SourcePackageDb sourcePkgIndex sourcePkgPrefs)
pkgSpecifiers =
@@ -723,6 +728,7 @@ basicInstallPolicy
. addSourcePackages
[pkg | SpecificSourcePackage pkg <- pkgSpecifiers]
$ basicDepResolverParams
+ binstalledPkgIndex
installedPkgIndex
sourcePkgIndex
@@ -731,13 +737,15 @@ basicInstallPolicy
--
-- It extends the 'basicInstallPolicy' with a policy on setup deps.
standardInstallPolicy
- :: InstalledPackageIndex
+ :: InstalledPackageIndex -- ^ Build
+ -> InstalledPackageIndex -- ^ Host
-> SourcePackageDb
-> [PackageSpecifier UnresolvedSourcePackage]
-> DepResolverParams
-standardInstallPolicy installedPkgIndex sourcePkgDb pkgSpecifiers =
+standardInstallPolicy binstalledPkgIndex installedPkgIndex sourcePkgDb pkgSpecifiers =
addDefaultSetupDependencies mkDefaultSetupDeps $
basicInstallPolicy
+ binstalledPkgIndex
installedPkgIndex
sourcePkgDb
pkgSpecifiers
@@ -810,6 +818,7 @@ resolveDependencies toolchains pkgConfigDB params =
(PruneAfterFirstSuccess False)
)
toolchains
+ binstalledPkgIndex
installedPkgIndex
sourcePkgIndex
pkgConfigDB
@@ -823,6 +832,7 @@ resolveDependencies toolchains pkgConfigDB params =
prefs
defpref
installedPkgIndex
+ binstalledPkgIndex
sourcePkgIndex
reordGoals
cntConflicts
@@ -1141,6 +1151,7 @@ resolveWithoutDependencies
prefs
defpref
installedPkgIndex
+ binstalledPkgIndex
sourcePkgIndex
_reorderGoals
_countConflicts
diff --git a/cabal-install/src/Distribution/Client/Fetch.hs b/cabal-install/src/Distribution/Client/Fetch.hs
index abe6d181a7f..e66acf66cc6 100644
--- a/cabal-install/src/Distribution/Client/Fetch.hs
+++ b/cabal-install/src/Distribution/Client/Fetch.hs
@@ -220,7 +220,7 @@ planPackages
-- already installed. Since we want to get the source packages of
-- things we might have installed (but not have the sources for).
. reinstallTargets
- $ standardInstallPolicy installedPkgIndex sourcePkgDb pkgSpecifiers
+ $ standardInstallPolicy mempty {-build-} installedPkgIndex sourcePkgDb pkgSpecifiers
includeDependencies = fromFlag (fetchDeps fetchFlags)
logMsg message rest = debug verbosity message >> rest
diff --git a/cabal-install/src/Distribution/Client/Freeze.hs b/cabal-install/src/Distribution/Client/Freeze.hs
index abcc69797f9..e6a5190260f 100644
--- a/cabal-install/src/Distribution/Client/Freeze.hs
+++ b/cabal-install/src/Distribution/Client/Freeze.hs
@@ -245,7 +245,7 @@ planPackages
in LabeledPackageConstraint pc ConstraintSourceFreeze
| pkgSpecifier <- pkgSpecifiers
]
- $ standardInstallPolicy installedPkgIndex sourcePkgDb pkgSpecifiers
+ $ standardInstallPolicy mempty {- build -} installedPkgIndex sourcePkgDb pkgSpecifiers
logMsg message rest = debug verbosity message >> rest
diff --git a/cabal-install/src/Distribution/Client/Get.hs b/cabal-install/src/Distribution/Client/Get.hs
index 39ace2f2652..08029a53b8d 100644
--- a/cabal-install/src/Distribution/Client/Get.hs
+++ b/cabal-install/src/Distribution/Client/Get.hs
@@ -148,7 +148,7 @@ get verbosity repoCtxt globalFlags getFlags userTargets = do
resolverParams :: SourcePackageDb -> [PackageSpecifier UnresolvedSourcePackage] -> DepResolverParams
resolverParams sourcePkgDb pkgSpecifiers =
-- TODO: add command-line constraint and preference args for unpack
- standardInstallPolicy mempty sourcePkgDb pkgSpecifiers
+ standardInstallPolicy mempty mempty sourcePkgDb pkgSpecifiers
onlyPkgDescr = fromFlagOrDefault False (getOnlyPkgDescr getFlags)
diff --git a/cabal-install/src/Distribution/Client/Install.hs b/cabal-install/src/Distribution/Client/Install.hs
index 6c9a605c553..2fb03562f24 100644
--- a/cabal-install/src/Distribution/Client/Install.hs
+++ b/cabal-install/src/Distribution/Client/Install.hs
@@ -650,6 +650,7 @@ planPackages
-- doesn't understand how to install them
. setSolveExecutables (SolveExecutables False)
$ standardInstallPolicy
+ mempty {- build pkgs -}
installedPkgIndex
sourcePkgDb
pkgSpecifiers
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index a55f6bee2da..76fcbf9bc21 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -837,7 +837,8 @@ rebuildInstallPlan
verbosity
toolchains
solverSettings
- (installedPackages <> hinstalledPkgIndex <> binstalledPkgIndex)
+ binstalledPkgIndex
+ (installedPackages <> hinstalledPkgIndex)
sourcePkgDb
pkgConfigDB
localPackages
@@ -1322,7 +1323,8 @@ planPackages
:: Verbosity
-> Toolchains
-> SolverSettings
- -> InstalledPackageIndex
+ -> InstalledPackageIndex -- ^ Build Installed Package Index
+ -> InstalledPackageIndex -- ^ Host Installed Package Index
-> SourcePackageDb
-> Maybe PkgConfigDb
-> [PackageSpecifier UnresolvedSourcePackage]
@@ -1332,6 +1334,7 @@ planPackages
verbosity
toolchains
SolverSettings{..}
+ binstalledPkgIndex
installedPkgIndex
sourcePkgDb
pkgConfigDB
@@ -1461,6 +1464,7 @@ planPackages
-- Note: we don't use the standardInstallPolicy here, since that uses
-- its own addDefaultSetupDependencies that is not appropriate for us.
basicInstallPolicy
+ binstalledPkgIndex
installedPkgIndex
sourcePkgDb
localPackages
From 409e01fc55aee741e7ab23c1d1ae1663e6760456 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Tue, 25 Mar 2025 12:52:54 +0900
Subject: [PATCH 57/82] Prevent NonReinstallable Packages from Setup
dependencies.
---
cabal-install/src/Distribution/Client/Dependency.hs | 13 +++++++++++--
1 file changed, 11 insertions(+), 2 deletions(-)
diff --git a/cabal-install/src/Distribution/Client/Dependency.hs b/cabal-install/src/Distribution/Client/Dependency.hs
index 8bde68b8112..645e81b1873 100644
--- a/cabal-install/src/Distribution/Client/Dependency.hs
+++ b/cabal-install/src/Distribution/Client/Dependency.hs
@@ -452,7 +452,16 @@ dontInstallNonReinstallablePackages params =
ConstraintSourceNonReinstallablePackage
| pkgname <- nonReinstallablePackages
]
-
+dontInstallNonReinstallablePackagesSetupOnly :: DepResolverParams -> DepResolverParams
+dontInstallNonReinstallablePackagesSetupOnly params =
+ addConstraints extraConstraints params
+ where
+ extraConstraints =
+ [ LabeledPackageConstraint
+ (PackageConstraint (ScopeAnySetupQualifier pkgname) PackagePropertyInstalled)
+ ConstraintSourceNonReinstallablePackage
+ | pkgname <- nonReinstallablePackages
+ ]
-- | The set of non-reinstallable packages includes those which cannot be
-- rebuilt using a GHC installation and Hackage-published source distribution.
-- There are a few reasons why this might be true:
@@ -851,7 +860,7 @@ resolveDependencies toolchains pkgConfigDB params =
verbosity
) =
if asBool (depResolverAllowBootLibInstalls params)
- then params
+ then dontInstallNonReinstallablePackagesSetupOnly params
else dontInstallNonReinstallablePackages params
preferences :: PackageName -> PackagePreferences
From bb2f2e1000410e95b1d0067165ee1445806c9213 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Mon, 24 Mar 2025 12:52:30 +0900
Subject: [PATCH 58/82] Add compiler to PackageId
(cherry picked from commit 79b31e10d39ee54e68e2055587728b4f92c49145)
---
Cabal-syntax/src/Distribution/Compiler.hs | 2 +-
.../PackageDescription/FieldGrammar.hs | 4 +++-
.../Distribution/Types/InstalledPackageInfo.hs | 10 +++++-----
.../Types/InstalledPackageInfo/FieldGrammar.hs | 13 ++++++++-----
.../src/Distribution/Types/MungedPackageId.hs | 17 ++++++++++-------
.../Distribution/Types/PackageDescription.hs | 1 +
.../src/Distribution/Types/PackageId.hs | 12 ++++++++----
.../src/Distribution/Types/PackageId/Lens.hs | 6 ++++++
.../Types/PackageVersionConstraint.hs | 4 ++--
.../Backpack/PreExistingComponent.hs | 4 ++--
.../src/Distribution/Backpack/ReadyComponent.hs | 1 +
.../Distribution/PackageDescription/Check.hs | 2 +-
Cabal/src/Distribution/Simple/Build.hs | 2 +-
Cabal/src/Distribution/Simple/Build/Macros.hs | 6 +++---
Cabal/src/Distribution/Simple/Configure.hs | 5 +++--
Cabal/src/Distribution/Simple/PackageIndex.hs | 13 +++++++++----
.../src/Distribution/Types/PackageName/Magic.hs | 2 +-
.../Solver/Modular/ConfiguredConversion.hs | 4 ++--
.../Solver/Types/InstSolverPackage.hs | 4 ++--
.../Client/BuildReports/Anonymous.hs | 2 +-
.../src/Distribution/Client/Dependency.hs | 2 +-
.../src/Distribution/Client/IndexUtils.hs | 8 ++++----
.../src/Distribution/Client/Install.hs | 2 +-
.../src/Distribution/Client/PackageHash.hs | 4 ++--
.../src/Distribution/Client/SetupWrapper.hs | 6 +++---
.../Distribution/Client/SolverInstallPlan.hs | 2 +-
.../src/Distribution/Client/Types/AllowNewer.hs | 2 +-
27 files changed, 83 insertions(+), 57 deletions(-)
diff --git a/Cabal-syntax/src/Distribution/Compiler.hs b/Cabal-syntax/src/Distribution/Compiler.hs
index cef915a25d3..a4ac948570f 100644
--- a/Cabal-syntax/src/Distribution/Compiler.hs
+++ b/Cabal-syntax/src/Distribution/Compiler.hs
@@ -174,7 +174,7 @@ instance (Semigroup a, Monoid a) => Monoid (PerCompilerFlavor a) where
-- ------------------------------------------------------------
data CompilerId = CompilerId CompilerFlavor Version
- deriving (Eq, Generic, Ord, Read, Show)
+ deriving (Eq, Generic, Ord, Read, Show, Data)
instance Binary CompilerId
instance Structured CompilerId
diff --git a/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs b/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs
index 22912564e49..27e98ee0a82 100644
--- a/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs
+++ b/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs
@@ -74,7 +74,7 @@ import Prelude ()
import Distribution.CabalSpecVersion
import Distribution.Compat.Newtype (Newtype, pack', unpack')
-import Distribution.Compiler (CompilerFlavor (..), PerCompilerFlavor (..))
+import Distribution.Compiler (CompilerFlavor (..), PerCompilerFlavor (..), CompilerId)
import Distribution.FieldGrammar
import Distribution.Fields
import Distribution.ModuleName (ModuleName)
@@ -101,6 +101,7 @@ packageDescriptionFieldGrammar
, c (Identity BuildType)
, c (Identity PackageName)
, c (Identity Version)
+ , c (Identity CompilerId)
, forall from to. c (List FSep (RelativePathNT from to) (RelativePath from to))
, forall from to. c (List VCat (RelativePathNT from to) (RelativePath from to))
, c (List FSep TestedWith (CompilerFlavor, VersionRange))
@@ -150,6 +151,7 @@ packageDescriptionFieldGrammar =
PackageIdentifier
<$> uniqueField "name" L.pkgName
<*> uniqueField "version" L.pkgVersion
+ <*> optionalField "compiler" L.pkgCompiler
licenseFilesGrammar =
(++)
diff --git a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs
index defb1922607..ee1dfca5888 100644
--- a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs
+++ b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs
@@ -16,10 +16,10 @@ import Prelude ()
import Distribution.Backpack
import Distribution.Compat.Graph (IsNode (..))
-import Distribution.Compiler (CompilerId)
+import Distribution.Compiler (CompilerId, buildCompilerId)
import Distribution.License
import Distribution.ModuleName
-import Distribution.Package hiding (installedUnitId)
+import Distribution.Package hiding (installedUnitId, pkgCompiler)
import Distribution.Types.AbiDependency
import Distribution.Types.ExposedModule
import Distribution.Types.LibraryName
@@ -121,8 +121,8 @@ instance IsNode InstalledPackageInfo where
nodeNeighbors = depends
mungedPackageId :: InstalledPackageInfo -> MungedPackageId
-mungedPackageId ipi =
- MungedPackageId (mungedPackageName ipi) (packageVersion ipi)
+mungedPackageId ipi@InstalledPackageInfo{pkgCompiler = comp} =
+ MungedPackageId (mungedPackageName ipi) (packageVersion ipi) comp
-- | Returns the munged package name, which we write into @name@ for
-- compatibility with old versions of GHC.
@@ -132,7 +132,7 @@ mungedPackageName ipi = MungedPackageName (packageName ipi) (sourceLibName ipi)
emptyInstalledPackageInfo :: InstalledPackageInfo
emptyInstalledPackageInfo =
InstalledPackageInfo
- { sourcePackageId = PackageIdentifier (mkPackageName "") nullVersion
+ { sourcePackageId = PackageIdentifier (mkPackageName "") nullVersion Nothing
, sourceLibName = LMainLibName
, installedComponentId_ = mkComponentId ""
, installedUnitId = mkUnitId ""
diff --git a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs
index c2e77292c07..151aaf4b119 100644
--- a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs
+++ b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs
@@ -20,7 +20,7 @@ import Distribution.FieldGrammar
import Distribution.FieldGrammar.FieldDescrs
import Distribution.License
import Distribution.ModuleName
-import Distribution.Package
+import Distribution.Package hiding (pkgCompiler)
import Distribution.Parsec
import Distribution.Pretty
import Distribution.Types.LibraryName
@@ -38,7 +38,7 @@ import qualified Text.PrettyPrint as Disp
import Distribution.Types.InstalledPackageInfo
import qualified Distribution.Types.InstalledPackageInfo.Lens as L
-import qualified Distribution.Types.PackageId.Lens as L
+import qualified Distribution.Types.PackageId.Lens as L hiding (pkgCompiler)
-- Note: GHC goes nuts and inlines everything,
-- One can see e.g. in -ddump-simpl-stats:
@@ -133,7 +133,7 @@ ipiFieldGrammar =
InstalledPackageInfo
-- _basicPkgName is not used
-- setMaybePackageId says it can be no-op.
- (PackageIdentifier pn _basicVersion)
+ (PackageIdentifier pn _basicVersion _basicCompilerId)
(combineLibraryName ln _basicLibName)
(mkComponentId "") -- installedComponentId_, not in use
_basicLibVisibility
@@ -256,6 +256,7 @@ data Basic = Basic
, _basicPkgName :: Maybe PackageName
, _basicLibName :: LibraryName
, _basicLibVisibility :: LibraryVisibility
+ , _basicCompilerId :: Maybe CompilerId
}
basic :: Lens' InstalledPackageInfo Basic
@@ -268,14 +269,16 @@ basic f ipi = g <$> f b
(maybePackageName ipi)
(sourceLibName ipi)
(libVisibility ipi)
+ (pkgCompiler ipi)
- g (Basic n v pn ln lv) =
+ g (Basic n v pn ln lv compid) =
ipi
& setMungedPackageName n
& L.sourcePackageId . L.pkgVersion .~ v
& setMaybePackageName pn
& L.sourceLibName .~ ln
& L.libVisibility .~ lv
+ & L.pkgCompiler .~ compid
basicName :: Lens' Basic MungedPackageName
basicName f b = (\x -> b{_basicName = x}) <$> f (_basicName b)
@@ -319,7 +322,7 @@ basicFieldGrammar =
<*> optionalField "lib-name" basicLibName
<*> optionalFieldDef "visibility" basicLibVisibility LibraryVisibilityPrivate
where
- mkBasic n v pn ln lv = Basic n v pn ln' lv'
+ mkBasic n v pn ln lv = Basic n v pn ln' lv' Nothing
where
ln' = maybe LMainLibName LSubLibName ln
-- Older GHCs (<8.8) always report installed libraries as private
diff --git a/Cabal-syntax/src/Distribution/Types/MungedPackageId.hs b/Cabal-syntax/src/Distribution/Types/MungedPackageId.hs
index 8e879620478..b0edcd99bf5 100644
--- a/Cabal-syntax/src/Distribution/Types/MungedPackageId.hs
+++ b/Cabal-syntax/src/Distribution/Types/MungedPackageId.hs
@@ -15,6 +15,7 @@ import Distribution.Types.LibraryName
import Distribution.Types.MungedPackageName
import Distribution.Types.PackageId
import Distribution.Version (Version, nullVersion)
+import Distribution.Compiler (CompilerId)
import qualified Text.PrettyPrint as Disp
@@ -27,6 +28,7 @@ data MungedPackageId = MungedPackageId
-- 'MungedPackageName'.
, mungedVersion :: Version
-- ^ The version of this package / component, eg 1.2
+ , mingledCompilerId :: Maybe CompilerId
}
deriving (Generic, Read, Show, Eq, Ord, Data)
@@ -41,8 +43,9 @@ instance Structured MungedPackageId
-- >>> prettyShow $ MungedPackageId (MungedPackageName "servant" (LSubLibName "lackey")) (mkVersion [0,1,2])
-- "z-servant-z-lackey-0.1.2"
instance Pretty MungedPackageId where
- pretty (MungedPackageId n v)
- | v == nullVersion = pretty n -- if no version, don't show version.
+ pretty (MungedPackageId n v c)
+ | v == nullVersion = pretty c <<>> Disp.char '-' <<>> pretty n -- if no version, don't show version.
+ | Just c' <- c = pretty c' <<>> Disp.char '-' <<>> pretty n <<>> Disp.char '-' <<>> pretty v
| otherwise = pretty n <<>> Disp.char '-' <<>> pretty v
-- |
@@ -66,15 +69,15 @@ instance Pretty MungedPackageId where
-- Nothing
instance Parsec MungedPackageId where
parsec = do
- PackageIdentifier pn v <- parsec
- return $ MungedPackageId (decodeCompatPackageName pn) v
+ PackageIdentifier pn v comp <- parsec
+ return $ MungedPackageId (decodeCompatPackageName pn) v comp
instance NFData MungedPackageId where
- rnf (MungedPackageId name version) = rnf name `seq` rnf version
+ rnf (MungedPackageId name version compiler) = rnf name `seq` rnf version `seq` rnf compiler
computeCompatPackageId :: PackageId -> LibraryName -> MungedPackageId
-computeCompatPackageId (PackageIdentifier pn vr) ln =
- MungedPackageId (MungedPackageName pn ln) vr
+computeCompatPackageId (PackageIdentifier pn vr comp) ln =
+ MungedPackageId (MungedPackageName pn ln) vr comp
-- $setup
-- >>> :seti -XOverloadedStrings
diff --git a/Cabal-syntax/src/Distribution/Types/PackageDescription.hs b/Cabal-syntax/src/Distribution/Types/PackageDescription.hs
index 4b00a8ef526..17f72e54c95 100644
--- a/Cabal-syntax/src/Distribution/Types/PackageDescription.hs
+++ b/Cabal-syntax/src/Distribution/Types/PackageDescription.hs
@@ -207,6 +207,7 @@ emptyPackageDescription =
PackageIdentifier
(mkPackageName "")
nullVersion
+ Nothing
, licenseRaw = Right UnspecifiedLicense -- TODO:
, licenseFiles = []
, specVersion = CabalSpecV1_0
diff --git a/Cabal-syntax/src/Distribution/Types/PackageId.hs b/Cabal-syntax/src/Distribution/Types/PackageId.hs
index 9cd88a2f810..ca9bfbfc967 100644
--- a/Cabal-syntax/src/Distribution/Types/PackageId.hs
+++ b/Cabal-syntax/src/Distribution/Types/PackageId.hs
@@ -13,6 +13,7 @@ import Distribution.Parsec (Parsec (..), simpleParsec)
import Distribution.Pretty
import Distribution.Types.PackageName
import Distribution.Version (Version, nullVersion)
+import Distribution.Compiler (CompilerId)
import qualified Data.List.NonEmpty as NE
import qualified Distribution.Compat.CharParsing as P
@@ -27,6 +28,7 @@ data PackageIdentifier = PackageIdentifier
-- ^ The name of this package, eg. foo
, pkgVersion :: Version
-- ^ the version of this package, eg 1.2
+ , pkgCompiler :: Maybe CompilerId
}
deriving (Generic, Read, Show, Eq, Ord, Data)
@@ -34,8 +36,9 @@ instance Binary PackageIdentifier
instance Structured PackageIdentifier
instance Pretty PackageIdentifier where
- pretty (PackageIdentifier n v)
- | v == nullVersion = pretty n -- if no version, don't show version.
+ pretty (PackageIdentifier n v c)
+ | v == nullVersion = pretty c <<>> Disp.char '-' <<>> pretty n -- if no version, don't show version.
+ | Just c' <- c = pretty c' <<>> Disp.char '-' <<>> pretty n <<>> Disp.char '-' <<>> pretty v
| otherwise = pretty n <<>> Disp.char '-' <<>> pretty v
-- |
@@ -61,15 +64,16 @@ instance Pretty PackageIdentifier where
-- Nothing
instance Parsec PackageIdentifier where
parsec = do
+ comp <- parsec <* P.char '-'
xs' <- P.sepByNonEmpty component (P.char '-')
(v, xs) <- case simpleParsec (NE.last xs') of
Nothing -> return (nullVersion, toList xs') -- all components are version
Just v -> return (v, NE.init xs')
if not (null xs) && all (\c -> all (/= '.') c && not (all isDigit c)) xs
- then return $ PackageIdentifier (mkPackageName (intercalate "-" xs)) v
+ then return $ PackageIdentifier (mkPackageName (intercalate "-" xs)) v comp
else fail "all digits or a dot in a portion of package name"
where
component = P.munch1 (\c -> isAlphaNum c || c == '.')
instance NFData PackageIdentifier where
- rnf (PackageIdentifier name version) = rnf name `seq` rnf version
+ rnf (PackageIdentifier name version compiler) = rnf name `seq` rnf version `seq` rnf compiler
diff --git a/Cabal-syntax/src/Distribution/Types/PackageId/Lens.hs b/Cabal-syntax/src/Distribution/Types/PackageId/Lens.hs
index 08305234fbd..5a4682c7ed3 100644
--- a/Cabal-syntax/src/Distribution/Types/PackageId/Lens.hs
+++ b/Cabal-syntax/src/Distribution/Types/PackageId/Lens.hs
@@ -10,6 +10,7 @@ import Prelude ()
import Distribution.Types.PackageId (PackageIdentifier)
import Distribution.Types.PackageName (PackageName)
import Distribution.Version (Version)
+import Distribution.Compiler (CompilerId)
import qualified Distribution.Types.PackageId as T
@@ -20,3 +21,8 @@ pkgName f s = fmap (\x -> s{T.pkgName = x}) (f (T.pkgName s))
pkgVersion :: Lens' PackageIdentifier Version
pkgVersion f s = fmap (\x -> s{T.pkgVersion = x}) (f (T.pkgVersion s))
{-# INLINE pkgVersion #-}
+
+pkgCompiler :: Lens' PackageIdentifier (Maybe CompilerId)
+pkgCompiler f s = fmap (\x -> s{T.pkgCompiler = x}) (f (T.pkgCompiler s))
+{-# INLINE pkgCompiler #-}
+
diff --git a/Cabal-syntax/src/Distribution/Types/PackageVersionConstraint.hs b/Cabal-syntax/src/Distribution/Types/PackageVersionConstraint.hs
index 013226ca2d5..5c2b8d9b0b1 100644
--- a/Cabal-syntax/src/Distribution/Types/PackageVersionConstraint.hs
+++ b/Cabal-syntax/src/Distribution/Types/PackageVersionConstraint.hs
@@ -53,7 +53,7 @@ instance Pretty PackageVersionConstraint where
-- Just (PackageVersionConstraint (PackageName "foo") (ThisVersion (mkVersion [2,0])))
instance Parsec PackageVersionConstraint where
parsec = do
- PackageIdentifier name ver <- parsec
+ PackageIdentifier name ver comp <- parsec
if ver == nullVersion
then do
P.spaces
@@ -64,7 +64,7 @@ instance Parsec PackageVersionConstraint where
-- | @since 3.4.0.0
thisPackageVersionConstraint :: PackageIdentifier -> PackageVersionConstraint
-thisPackageVersionConstraint (PackageIdentifier pn vr) =
+thisPackageVersionConstraint (PackageIdentifier pn vr comp) =
PackageVersionConstraint pn (thisVersion vr)
-- | @since 3.4.0.0
diff --git a/Cabal/src/Distribution/Backpack/PreExistingComponent.hs b/Cabal/src/Distribution/Backpack/PreExistingComponent.hs
index 0fba79bcb87..a72fe20f07f 100644
--- a/Cabal/src/Distribution/Backpack/PreExistingComponent.hs
+++ b/Cabal/src/Distribution/Backpack/PreExistingComponent.hs
@@ -71,9 +71,9 @@ instance HasMungedPackageId PreExistingComponent where
mungedId = pc_munged_id
instance Package PreExistingComponent where
- packageId pec = PackageIdentifier (pc_pkgname pec) v
+ packageId pec = PackageIdentifier (pc_pkgname pec) v compid
where
- MungedPackageId _ v = pc_munged_id pec
+ MungedPackageId _ v compid = pc_munged_id pec
instance HasUnitId PreExistingComponent where
installedUnitId = pc_uid
diff --git a/Cabal/src/Distribution/Backpack/ReadyComponent.hs b/Cabal/src/Distribution/Backpack/ReadyComponent.hs
index 7a3523d5eab..b871ebff59f 100644
--- a/Cabal/src/Distribution/Backpack/ReadyComponent.hs
+++ b/Cabal/src/Distribution/Backpack/ReadyComponent.hs
@@ -300,6 +300,7 @@ toReadyComponents pid_map subst0 comps =
MungedPackageId
(MungedPackageName nonExistentPackageThisIsCabalBug LMainLibName)
(mkVersion [0])
+ Nothing
instc =
InstantiatedComponent
{ instc_insts = Map.toList insts
diff --git a/Cabal/src/Distribution/PackageDescription/Check.hs b/Cabal/src/Distribution/PackageDescription/Check.hs
index 925bc69d6e1..799e677af17 100644
--- a/Cabal/src/Distribution/PackageDescription/Check.hs
+++ b/Cabal/src/Distribution/PackageDescription/Check.hs
@@ -582,7 +582,7 @@ checkSetupBuildInfo (Just (SetupBuildInfo ds _)) = do
checkPVPs (checkDependencyVersionRange hasGTLowerBound) gtlck ds
checkPackageId :: Monad m => PackageIdentifier -> CheckM m ()
-checkPackageId (PackageIdentifier pkgName_ _pkgVersion_) = do
+checkPackageId (PackageIdentifier pkgName_ _pkgVersion_ _compid) = do
checkP
(not . FilePath.Windows.isValid . prettyShow $ pkgName_)
(PackageDistInexcusable $ InvalidNameWin pkgName_)
diff --git a/Cabal/src/Distribution/Simple/Build.hs b/Cabal/src/Distribution/Simple/Build.hs
index 402f27467d2..008a270848f 100644
--- a/Cabal/src/Distribution/Simple/Build.hs
+++ b/Cabal/src/Distribution/Simple/Build.hs
@@ -821,7 +821,7 @@ testSuiteLibV09AsLibAndExe
}
-- This is, like, the one place where we use a CTestName for a library.
-- Should NOT use library name, since that could conflict!
- PackageIdentifier pkg_name pkg_ver = package pkg_descr
+ PackageIdentifier pkg_name pkg_ver _pkg_compid = package pkg_descr
-- Note: we do make internal library from the test!
compat_name = MungedPackageName pkg_name (LSubLibName (testName test))
compat_key = computeCompatPackageKey (compiler lbi) compat_name pkg_ver (componentUnitId clbi)
diff --git a/Cabal/src/Distribution/Simple/Build/Macros.hs b/Cabal/src/Distribution/Simple/Build/Macros.hs
index f3c51d71c96..e71d5a4a644 100644
--- a/Cabal/src/Distribution/Simple/Build/Macros.hs
+++ b/Cabal/src/Distribution/Simple/Build/Macros.hs
@@ -67,11 +67,11 @@ generateCabalMacrosHeader pkg_descr lbi clbi =
, Z.zMangleStr = map fixchar
}
where
- getPid (_, MungedPackageId (MungedPackageName pn _) v) =
+ getPid (_, MungedPackageId (MungedPackageName pn _) v compid) =
-- NB: Drop the library name! We're just reporting package versions.
-- This would have to be revisited if you are allowed to depend
-- on different versions of the same package
- PackageIdentifier pn v
+ PackageIdentifier pn v compid
-- | Helper function that generates just the @VERSION_pkg@ and @MIN_VERSION_pkg@
-- macros for a list of package ids (usually used with the specific deps of
@@ -91,7 +91,7 @@ generatePackageVersionMacros ver pkgids =
}
mkZPackage :: PackageId -> Z.ZPackage
-mkZPackage (PackageIdentifier name ver) =
+mkZPackage (PackageIdentifier name ver compid) =
Z.ZPackage
{ Z.zpkgName = name
, Z.zpkgVersion = ver
diff --git a/Cabal/src/Distribution/Simple/Configure.hs b/Cabal/src/Distribution/Simple/Configure.hs
index 7c96efb33fc..a76b4359bc9 100644
--- a/Cabal/src/Distribution/Simple/Configure.hs
+++ b/Cabal/src/Distribution/Simple/Configure.hs
@@ -335,7 +335,7 @@ writePersistBuildConfig mbWorkDir distPref lbi = do
-- | Identifier of the current Cabal package.
currentCabalId :: PackageIdentifier
-currentCabalId = PackageIdentifier (mkPackageName "Cabal") cabalVersion
+currentCabalId = PackageIdentifier (mkPackageName "Cabal") cabalVersion Nothing
-- | Identifier of the current compiler package.
currentCompilerId :: PackageIdentifier
@@ -343,6 +343,7 @@ currentCompilerId =
PackageIdentifier
(mkPackageName System.Info.compilerName)
(mkVersion' System.Info.compilerVersion)
+ Nothing
-- | Parse the @setup-config@ file header, returning the package identifiers
-- for Cabal and the compiler.
@@ -1987,7 +1988,7 @@ selectDependency
-- It's an internal library, and we're not per-component build
do_internal lib
| Set.member lib internalIndex =
- Right $ InternalDependency $ PackageIdentifier dep_pkgname $ packageVersion pkgid
+ Right $ InternalDependency $ PackageIdentifier dep_pkgname (packageVersion pkgid) (pkgCompiler pkgid)
| otherwise =
Left $ DependencyMissingInternal dep_pkgname lib
diff --git a/Cabal/src/Distribution/Simple/PackageIndex.hs b/Cabal/src/Distribution/Simple/PackageIndex.hs
index a7d23962b72..6e115ca65a5 100644
--- a/Cabal/src/Distribution/Simple/PackageIndex.hs
+++ b/Cabal/src/Distribution/Simple/PackageIndex.hs
@@ -169,7 +169,7 @@ instance Semigroup (PackageIndex IPI.InstalledPackageInfo) where
{-# NOINLINE invariant #-}
invariant :: WithCallStack (InstalledPackageIndex -> Bool)
invariant (PackageIndex pids pnames) =
- -- trace (show pids' ++ "\n" ++ show pnames') $
+ trace (show pids' ++ "\n" ++ show pnames') $
pids' == pnames'
where
pids' = map installedUnitId (Map.elems pids)
@@ -335,16 +335,21 @@ deleteSourcePackageId pkgid original@(PackageIndex pids pnames) =
Just pvers -> case Map.lookup (packageVersion pkgid) pvers of
Nothing -> original
Just pkgs ->
- mkPackageIndex
- (foldl' (flip (Map.delete . installedUnitId)) pids pkgs)
+ traceShow (pkgid, pkgs) $ mkPackageIndex
+ (Map.update deletePkgInstance (installedUnitId pkgid) pids)
(deletePkgName pnames)
where
deletePkgName =
Map.update deletePkgVersion (packageName pkgid, LMainLibName)
+ deletePkgVersion :: Map Version [IPI.InstalledPackageInfo] -> Maybe (Map Version [IPI.InstalledPackageInfo])
deletePkgVersion =
(\m -> if Map.null m then Nothing else Just m)
- . Map.delete (packageVersion pkgid)
+ . Map.update deletePkgInstance (packageVersion pkgid)
+
+ deletePkgInstance :: [IPI.InstalledPackageInfo] -> Maybe [IPI.InstalledPackageInfo]
+ deletePkgInstance xs = if null xs' then Nothing else Just xs'
+ where xs' = [x | x <- xs, pkgCompiler pkgid /= pkgCompiler (IPI.sourcePackageId x)]
-- | Removes all packages with this (case-sensitive) name from the index.
--
diff --git a/Cabal/src/Distribution/Types/PackageName/Magic.hs b/Cabal/src/Distribution/Types/PackageName/Magic.hs
index 022a62468b1..908e82bea6f 100644
--- a/Cabal/src/Distribution/Types/PackageName/Magic.hs
+++ b/Cabal/src/Distribution/Types/PackageName/Magic.hs
@@ -21,4 +21,4 @@ fakePackageCabalFileName = "fake-package.cabal"
-- | 'fakePackageName' with 'version0'.
fakePackageId :: PackageId
-fakePackageId = PackageIdentifier fakePackageName version0
+fakePackageId = PackageIdentifier fakePackageName version0 Nothing
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs b/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs
index 69e41072547..e766957be1b 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs
@@ -41,7 +41,7 @@ convCP biidx iidx sidx (CP qpi fa es ds) =
}
-- "In repo" i.e. a source package
(PI qpn@(Q _path pn) (I stage v InRepo)) ->
- let pi = PackageIdentifier pn v in
+ let pi = PackageIdentifier pn v Nothing {-# FIXME: should be COMPILERID #-} in
Configured $
SolverPackage {
solverPkgQPN = qpn,
@@ -72,4 +72,4 @@ convConfId (PI (Q (PackagePath _ q) pn) (I _stage v loc)) =
, pn == pn' -> Right (PlannedId sourceId)
| otherwise -> Left (PlannedId sourceId)
where
- sourceId = PackageIdentifier pn v
+ sourceId = PackageIdentifier pn v Nothing -- FIXME: this should be the compiler id!
diff --git a/cabal-install-solver/src/Distribution/Solver/Types/InstSolverPackage.hs b/cabal-install-solver/src/Distribution/Solver/Types/InstSolverPackage.hs
index 15fb9d510ec..868d1d9dfe2 100644
--- a/cabal-install-solver/src/Distribution/Solver/Types/InstSolverPackage.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Types/InstSolverPackage.hs
@@ -31,8 +31,8 @@ instance Structured InstSolverPackage
instance Package InstSolverPackage where
packageId i =
-- HACK! See Note [Index conversion with internal libraries]
- let MungedPackageId mpn v = mungedId i
- in PackageIdentifier (encodeCompatPackageName mpn) v
+ let MungedPackageId mpn v compid = mungedId i
+ in PackageIdentifier (encodeCompatPackageName mpn) v compid
instance HasMungedPackageId InstSolverPackage where
mungedId = mungedId . instSolverPkgIPI
diff --git a/cabal-install/src/Distribution/Client/BuildReports/Anonymous.hs b/cabal-install/src/Distribution/Client/BuildReports/Anonymous.hs
index ce1d1665327..a6febfcca50 100644
--- a/cabal-install/src/Distribution/Client/BuildReports/Anonymous.hs
+++ b/cabal-install/src/Distribution/Client/BuildReports/Anonymous.hs
@@ -103,7 +103,7 @@ newBuildReport os' arch' comp pkgid flags deps result =
cabalInstallID :: PackageIdentifier
cabalInstallID =
- PackageIdentifier (mkPackageName "cabal-install") cabalInstallVersion
+ PackageIdentifier (mkPackageName "cabal-install") cabalInstallVersion Nothing
-------------------------------------------------------------------------------
-- FieldGrammar
diff --git a/cabal-install/src/Distribution/Client/Dependency.hs b/cabal-install/src/Distribution/Client/Dependency.hs
index 645e81b1873..44309e069ef 100644
--- a/cabal-install/src/Distribution/Client/Dependency.hs
+++ b/cabal-install/src/Distribution/Client/Dependency.hs
@@ -1076,7 +1076,7 @@ configuredPackageProblems
(sort $ map fst (PD.unFlagAssignment specifiedFlags)) -- TODO
packageSatisfiesDependency :: PackageIdentifier -> Dependency -> Bool
packageSatisfiesDependency
- (PackageIdentifier name version)
+ (PackageIdentifier name version _compid)
(Dependency name' versionRange _) =
assert (name == name') $
version `withinRange` versionRange
diff --git a/cabal-install/src/Distribution/Client/IndexUtils.hs b/cabal-install/src/Distribution/Client/IndexUtils.hs
index 6027f5e53f3..0cd842d663e 100644
--- a/cabal-install/src/Distribution/Client/IndexUtils.hs
+++ b/cabal-install/src/Distribution/Client/IndexUtils.hs
@@ -617,7 +617,7 @@ extractPkg verbosity entry blockNo = case Tar.entryContent entry of
[pkgname, vers, _] -> case simpleParsec vers of
Just ver -> Just . return $ Just (NormalPackage pkgid descr content blockNo)
where
- pkgid = PackageIdentifier (mkPackageName pkgname) ver
+ pkgid = PackageIdentifier (mkPackageName pkgname) ver Nothing
parsed = parseGenericPackageDescriptionMaybe (BS.toStrict content)
descr = case parsed of
Just d -> d
@@ -1269,10 +1269,10 @@ hashConsCache cache0 =
go !pns !pvs (CachePackageId pid bno ts : rest) =
CachePackageId pid' bno ts : go pns' pvs' rest
where
- !pid' = PackageIdentifier pn' pv'
+ !pid' = PackageIdentifier pn' pv' compid
(!pn', !pns') = mapIntern pn pns
(!pv', !pvs') = mapIntern pv pvs
- PackageIdentifier pn pv = pid
+ PackageIdentifier pn pv compid = pid
go pns pvs (x : xs) = x : go pns pvs xs
mapIntern :: Ord k => k -> Map.Map k k -> (k, Map.Map k k)
@@ -1395,7 +1395,7 @@ read00IndexCacheEntry = \line ->
(Just pkgname, Just pkgver, Just blockno) ->
Just
( CachePackageId
- (PackageIdentifier pkgname pkgver)
+ (PackageIdentifier pkgname pkgver Nothing)
blockno
NoTimestamp
)
diff --git a/cabal-install/src/Distribution/Client/Install.hs b/cabal-install/src/Distribution/Client/Install.hs
index 2fb03562f24..6f7d3bdd8a9 100644
--- a/cabal-install/src/Distribution/Client/Install.hs
+++ b/cabal-install/src/Distribution/Client/Install.hs
@@ -1102,7 +1102,7 @@ theSpecifiedPackage :: Package pkg => PackageSpecifier pkg -> Maybe PackageId
theSpecifiedPackage pkgSpec =
case pkgSpec of
NamedPackage name [PackagePropertyVersion version] ->
- PackageIdentifier name <$> trivialRange version
+ PackageIdentifier name <$> trivialRange version <*> Nothing
NamedPackage _ _ -> Nothing
SpecificSourcePackage pkg -> Just $ packageId pkg
where
diff --git a/cabal-install/src/Distribution/Client/PackageHash.hs b/cabal-install/src/Distribution/Client/PackageHash.hs
index 38240c3888a..d99fc9ad250 100644
--- a/cabal-install/src/Distribution/Client/PackageHash.hs
+++ b/cabal-install/src/Distribution/Client/PackageHash.hs
@@ -133,7 +133,7 @@ hashedInstalledPackageIdShort pkghashinputs@PackageHashInputs{pkgHashPkgId} =
, showHashValue (truncateHash 20 (hashPackageHashInputs pkghashinputs))
]
where
- PackageIdentifier name version = pkgHashPkgId
+ PackageIdentifier name version _compid = pkgHashPkgId
-- Truncate a string, with a visual indication that it is truncated.
truncateStr n s
@@ -172,7 +172,7 @@ hashedInstalledPackageIdVeryShort pkghashinputs@PackageHashInputs{pkgHashPkgId}
, showHashValue (truncateHash 4 (hashPackageHashInputs pkghashinputs))
]
where
- PackageIdentifier name version = pkgHashPkgId
+ PackageIdentifier name version _compid = pkgHashPkgId
-- | All the information that contributes to a package's hash, and thus its
-- 'InstalledPackageId'.
diff --git a/cabal-install/src/Distribution/Client/SetupWrapper.hs b/cabal-install/src/Distribution/Client/SetupWrapper.hs
index 55042e212cd..d46045c849a 100644
--- a/cabal-install/src/Distribution/Client/SetupWrapper.hs
+++ b/cabal-install/src/Distribution/Client/SetupWrapper.hs
@@ -1068,7 +1068,7 @@ getExternalSetupMethod verbosity options pkg bt = do
debug verbosity "Setup executable needs to be updated, compiling..."
(compiler, progdb, options'') <- configureCompiler options'
pkgDbs <- traverse (traverse (makeRelativeToDirS mbWorkDir)) (coercePackageDBStack (usePackageDB options''))
- let cabalPkgid = PackageIdentifier (mkPackageName "Cabal") cabalLibVersion
+ let cabalPkgid = PackageIdentifier (mkPackageName "Cabal") cabalLibVersion Nothing
(program, extraOpts) =
case compilerFlavor compiler of
GHCJS -> (ghcjsProgram, ["-build-runner"])
@@ -1155,5 +1155,5 @@ getExternalSetupMethod verbosity options pkg bt = do
return $ i setupProgFile
isCabalPkgId, isBasePkgId :: PackageIdentifier -> Bool
-isCabalPkgId (PackageIdentifier pname _) = pname == mkPackageName "Cabal"
-isBasePkgId (PackageIdentifier pname _) = pname == mkPackageName "base"
+isCabalPkgId (PackageIdentifier pname _ _compid) = pname == mkPackageName "Cabal"
+isBasePkgId (PackageIdentifier pname _ _compid) = pname == mkPackageName "base"
diff --git a/cabal-install/src/Distribution/Client/SolverInstallPlan.hs b/cabal-install/src/Distribution/Client/SolverInstallPlan.hs
index 17dcf6d9398..631dbde5afe 100644
--- a/cabal-install/src/Distribution/Client/SolverInstallPlan.hs
+++ b/cabal-install/src/Distribution/Client/SolverInstallPlan.hs
@@ -218,7 +218,7 @@ showPlanProblem (PackageInconsistency name inconsistencies) =
[ " package "
++ prettyShow pkg
++ " requires "
- ++ prettyShow (PackageIdentifier name ver)
+ ++ prettyShow (PackageIdentifier name ver Nothing)
| (pkg, ver) <- inconsistencies
]
showPlanProblem (PackageStateInvalid pkg pkg') =
diff --git a/cabal-install/src/Distribution/Client/Types/AllowNewer.hs b/cabal-install/src/Distribution/Client/Types/AllowNewer.hs
index 0a5700174b8..6a6503aaf4c 100644
--- a/cabal-install/src/Distribution/Client/Types/AllowNewer.hs
+++ b/cabal-install/src/Distribution/Client/Types/AllowNewer.hs
@@ -109,7 +109,7 @@ relaxedDepStarP =
-- continuation after package identifier
relaxedDepPkgidP :: CabalParsing m => PackageIdentifier -> m RelaxedDep
-relaxedDepPkgidP pid@(PackageIdentifier pn v)
+relaxedDepPkgidP pid@(PackageIdentifier pn v _compid)
| pn == mkPackageName "all"
, v == nullVersion =
RelaxedDep RelaxDepScopeAll <$ P.char ':' <*> modP <*> parsec
From fa6d6d102430738d3642a183e77eb56ad1d040f9 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Mon, 24 Mar 2025 12:54:49 +0900
Subject: [PATCH 59/82] fixup! Add compiler to PackageId
(cherry picked from commit f8600655624c8cc2cdd2fb16237ab115828e3754)
---
cabal-install/src/Distribution/Client/ProjectPlanning.hs | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index 76fcbf9bc21..5ed709a2578 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -1044,7 +1044,7 @@ reportPlanningFailure projectConfig Toolchain{toolchainCompiler = comp, toolchai
theSpecifiedPackage pkgSpec =
case pkgSpec of
NamedPackage name [PackagePropertyVersion version] ->
- PackageIdentifier name <$> trivialRange version
+ PackageIdentifier name <$> trivialRange version <*> Nothing
NamedPackage _ _ -> Nothing
SpecificSourcePackage pkg -> Just $ packageId pkg
-- \| If a range includes only a single version, return Just that version.
From 6939af82e142ab5ebcad5aa8930d8020ee5c090a Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Mon, 24 Mar 2025 12:57:16 +0900
Subject: [PATCH 60/82] fixup! Add compiler to PackageId
(cherry picked from commit 125921422d2cacef165db2a17c032db0d08ebcf6)
---
.../Solver/Modular/IndexConversion.hs | 4 ++--
.../Distribution/Client/ProjectPlanning.hs | 19 ++++++++++++++++++-
2 files changed, 20 insertions(+), 3 deletions(-)
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs b/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs
index 2fc84f84697..08583f537d1 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs
@@ -88,7 +88,7 @@ convIPI' toolchains (ShadowPkgs sip) idx =
-- | Extract/recover the package ID from an installed package info, and convert it to a solver's I.
convId :: Toolchains -> IPI.InstalledPackageInfo -> (PN, I)
convId toolchains ipi = (pn, I stage ver $ Inst $ IPI.installedUnitId ipi)
- where MungedPackageId mpn ver = mungedId ipi
+ where MungedPackageId mpn ver compid = mungedId ipi
-- HACK. See Note [Index conversion with internal libraries]
pn = encodeCompatPackageName mpn
stage = case IPI.pkgCompiler ipi of
@@ -172,7 +172,7 @@ convSPI' toolchains constraints strfl solveExes =
-- | Convert a single source package into the solver-specific format.
convSP :: Toolchains -> Map PN [LabeledPackageConstraint]
-> StrongFlags -> SolveExecutables -> SourcePackage loc -> [(PN, I, PInfo)]
-convSP toolchains constraints strfl solveExes (SourcePackage (PackageIdentifier pn pv) gpd _ _pl) =
+convSP toolchains constraints strfl solveExes (SourcePackage (PackageIdentifier pn pv _compid) gpd _ _pl) =
let pkgConstraints = fromMaybe [] $ M.lookup pn constraints
in [(pn, I Host pv InRepo, convGPD (hostToolchain toolchains) pkgConstraints strfl solveExes pn gpd)
,(pn, I Build pv InRepo, convGPD (buildToolchain toolchains) pkgConstraints strfl solveExes pn gpd)]
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index 5ed709a2578..5e95e31d718 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -198,6 +198,7 @@ import Distribution.Types.GivenComponent
import Distribution.Types.LibraryName
import qualified Distribution.Types.LocalBuildConfig as LBC
import Distribution.Types.PackageVersionConstraint
+import qualified Distribution.Types.PackageId as PI
import Distribution.Types.PkgconfigDependency
import Distribution.Types.UnqualComponentName
@@ -791,8 +792,21 @@ rebuildInstallPlan
-- }
-- deriving (Eq, Generic, Show, Read)
--
- -- can probably use fromList $ Map.elems $ on it.
+ -- let mapPkgIdx f = PI.fromList . map f . PI.allPackages
+ -- let updateIPI :: IPI.InstalledPackageInfo -> IPI.InstalledPackageInfo
+ -- updateIPI ipi = ipi {
+ -- IPI.sourcePackageId = (IPI.sourcePackageId ipi){ PI.pkgCompiler = IPI.pkgCompiler ipi }
+ -- }
+ -- let addCompilerToSourcePkg :: CompilerId -> [PackageSpecifier UnresolvedSourcePackage] -> [PackageSpecifier UnresolvedSourcePackage]
+ -- addCompilerToSourcePkg compilerId = map (addCompilerId compilerId)
+ -- addCompilerId :: CompilerId -> PackageSpecifier UnresolvedSourcePackage -> PackageSpecifier UnresolvedSourcePackage
+ -- addCompilerId compilerId (NamedPackage name props) = NamedPackage name props
+ -- addCompilerId compilerId (SpecificSourcePackage pkg) = SpecificSourcePackage (f pkg)
+ -- where f :: SourcePackage UnresolvedPkgLoc -> SourcePackage UnresolvedPkgLoc
+ -- f pkg = pkg{srcpkgPackageId = (srcpkgPackageId pkg){pkgCompiler = Just compilerId}}
+
hinstalledPkgIndex <-
+ -- mapPkgIdx updateIPI <$>
getInstalledPackages
verbosity
(hostToolchain toolchains)
@@ -802,6 +816,7 @@ rebuildInstallPlan
-- for now. FIXME!
-- let hinstalledPkgIndex' = PI.fromList $ PI.allPackages hinstalledPkgIndex
binstalledPkgIndex <-
+ -- mapPkgIdx updateIPI <$>
getInstalledPackages
verbosity
(buildToolchain toolchains)
@@ -809,6 +824,8 @@ rebuildInstallPlan
-- if host and build compiler are the same, we want to get -package-db in here.
(corePackageDbs $ if buildIsHost toolchains then Host else Build)
+ -- let localPackages' = addCompilerToSourcePkg (compilerId . toolchainCompiler . hostToolchain $ toolchains) localPackages
+
(sourcePkgDb, tis, ar) <-
getSourcePackages
verbosity
From 51d9f9513c69a4ce4f4cbce404e8722bb41ebd89 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Tue, 25 Mar 2025 20:38:08 +0900
Subject: [PATCH 61/82] Absolutely hacked nonsense, but ... it works?!
---
Cabal/src/Distribution/Simple/PackageIndex.hs | 14 ++-
.../src/Distribution/Solver/Modular.hs | 10 ++-
.../Solver/Modular/ConfiguredConversion.hs | 16 ++--
.../Solver/Modular/IndexConversion.hs | 9 +-
.../src/Distribution/Solver/Modular/Solver.hs | 5 +-
.../Distribution/Solver/Types/Toolchain.hs | 4 +
.../src/Distribution/Client/Dependency.hs | 24 ++++-
.../src/Distribution/Client/ProjectConfig.hs | 8 ++
.../Client/ProjectOrchestration.hs | 18 +++-
.../Distribution/Client/ProjectPlanning.hs | 87 +++++++++++++------
.../Distribution/Client/SolverInstallPlan.hs | 37 ++++++++
11 files changed, 181 insertions(+), 51 deletions(-)
diff --git a/Cabal/src/Distribution/Simple/PackageIndex.hs b/Cabal/src/Distribution/Simple/PackageIndex.hs
index 6e115ca65a5..eb3e4a22cce 100644
--- a/Cabal/src/Distribution/Simple/PackageIndex.hs
+++ b/Cabal/src/Distribution/Simple/PackageIndex.hs
@@ -336,7 +336,8 @@ deleteSourcePackageId pkgid original@(PackageIndex pids pnames) =
Nothing -> original
Just pkgs ->
traceShow (pkgid, pkgs) $ mkPackageIndex
- (Map.update deletePkgInstance (installedUnitId pkgid) pids)
+ (foldl' (flip (Map.delete . installedUnitId)) pids pkgs)
+-- (Map.update deletePkgInstance (installedUnitId pkgid) pids)
(deletePkgName pnames)
where
deletePkgName =
@@ -345,10 +346,15 @@ deleteSourcePackageId pkgid original@(PackageIndex pids pnames) =
deletePkgVersion :: Map Version [IPI.InstalledPackageInfo] -> Maybe (Map Version [IPI.InstalledPackageInfo])
deletePkgVersion =
(\m -> if Map.null m then Nothing else Just m)
- . Map.update deletePkgInstance (packageVersion pkgid)
+ . Map.update deletePkgInstances (packageVersion pkgid)
- deletePkgInstance :: [IPI.InstalledPackageInfo] -> Maybe [IPI.InstalledPackageInfo]
- deletePkgInstance xs = if null xs' then Nothing else Just xs'
+ deletePkgInstance :: IPI.InstalledPackageInfo -> Maybe IPI.InstalledPackageInfo
+ deletePkgInstance ipi
+ | pkgCompiler pkgid /= pkgCompiler (IPI.sourcePackageId ipi) = Just ipi
+ | otherwise = Nothing
+
+ deletePkgInstances :: [IPI.InstalledPackageInfo] -> Maybe [IPI.InstalledPackageInfo]
+ deletePkgInstances xs = if null xs' then Nothing else Just xs'
where xs' = [x | x <- xs, pkgCompiler pkgid /= pkgCompiler (IPI.sourcePackageId x)]
-- | Removes all packages with this (case-sensitive) name from the index.
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular.hs b/cabal-install-solver/src/Distribution/Solver/Modular.hs
index f72a0bda371..a623d732703 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular.hs
@@ -34,7 +34,7 @@ import Distribution.Solver.Modular.IndexConversion
import Distribution.Solver.Modular.Log
( SolverFailure(..), displayLogMessages )
import Distribution.Solver.Modular.Package
- ( PN, showPI )
+ ( PN, showPI, I )
import Distribution.Solver.Modular.RetryLog
import Distribution.Solver.Modular.Solver
( SolverConfig(..), PruneAfterFirstSuccess(..), solve )
@@ -56,7 +56,7 @@ import Distribution.Simple.Utils
import Distribution.Verbosity
import Distribution.Solver.Modular.Configured (CP (..))
import qualified Distribution.Solver.Types.ComponentDeps as ComponentDeps
-import Distribution.Pretty (Pretty (..))
+import Distribution.Pretty (Pretty (..), prettyShow)
import Text.PrettyPrint (text, vcat, Doc, nest, ($+$))
import Distribution.Solver.Types.OptionalStanza (showStanzas, optStanzaSetNull)
import Distribution.Solver.Types.Toolchain ( Toolchains )
@@ -86,6 +86,10 @@ modularResolver sc toolchains biidx iidx sidx pkgConfigDB pprefs pcs pns = do
Step (show (vcat (map showCP cp))) $
return $ postprocess assignment revdepmap
where
+ showIdx :: Index -> String
+ showIdx idx = unlines [prettyShow pn ++ ": " ++ show i
+ | (pn, m) <- M.toList idx
+ , (i, _info) <- M.toList (m :: Map I PInfo)]
-- Indices have to be converted into solver-specific uniform index.
idx = convPIs toolchains gcs (shadowPkgs sc) (strongFlags sc) (solveExecutables sc) biidx iidx sidx
-- Constraints have to be converted into a finite map indexed by PN.
@@ -97,7 +101,7 @@ modularResolver sc toolchains biidx iidx sidx pkgConfigDB pprefs pcs pns = do
-- package qualifiers, which means that linked packages become duplicates
-- and can be removed.
postprocess a rdm = ordNubBy nodeKey $
- map (convCP biidx iidx sidx) (toCPs a rdm)
+ map (convCP toolchains biidx iidx sidx) (toCPs a rdm)
-- Helper function to extract the PN from a constraint.
pcName :: PackageConstraint -> PN
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs b/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs
index e766957be1b..32148c4dce8 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs
@@ -19,16 +19,18 @@ import Distribution.Solver.Types.SolverId
import Distribution.Solver.Types.SolverPackage
import Distribution.Solver.Types.InstSolverPackage
import Distribution.Solver.Types.SourcePackage
+import Distribution.Solver.Types.Toolchain
import Control.Applicative ((<|>))
-- | Converts from the solver specific result @CP QPN@ into
-- a 'ResolverPackage', which can then be converted into
-- the install plan.
-convCP :: SI.InstalledPackageIndex -- ^ build
+convCP :: Toolchains
+ -> SI.InstalledPackageIndex -- ^ build
-> SI.InstalledPackageIndex -- ^ host
-> CI.PackageIndex (SourcePackage loc)
-> CP QPN -> ResolverPackage loc
-convCP biidx iidx sidx (CP qpi fa es ds) =
+convCP toolchains biidx iidx sidx (CP qpi fa es ds) =
case qpi of
-- Installed
(PI qpn (I _stage _ (Inst pi))) ->
@@ -41,7 +43,7 @@ convCP biidx iidx sidx (CP qpi fa es ds) =
}
-- "In repo" i.e. a source package
(PI qpn@(Q _path pn) (I stage v InRepo)) ->
- let pi = PackageIdentifier pn v Nothing {-# FIXME: should be COMPILERID #-} in
+ let pi = PackageIdentifier pn v (Just $ compilerIdFor stage toolchains) in
Configured $
SolverPackage {
solverPkgQPN = qpn,
@@ -54,10 +56,10 @@ convCP biidx iidx sidx (CP qpi fa es ds) =
}
where
ds' :: ComponentDeps ([SolverId] {- lib -}, [SolverId] {- exe -})
- ds' = fmap (partitionEithers . map convConfId) ds
+ ds' = fmap (partitionEithers . map (convConfId toolchains)) ds
-convConfId :: PI QPN -> Either SolverId {- is lib -} SolverId {- is exe -}
-convConfId (PI (Q (PackagePath _ q) pn) (I _stage v loc)) =
+convConfId :: Toolchains -> PI QPN -> Either SolverId {- is lib -} SolverId {- is exe -}
+convConfId toolchains (PI (Q (PackagePath _ q) pn) (I stage v loc)) =
case loc of
Inst pi ->
Left (PreExistingId sourceId pi)
@@ -72,4 +74,4 @@ convConfId (PI (Q (PackagePath _ q) pn) (I _stage v loc)) =
, pn == pn' -> Right (PlannedId sourceId)
| otherwise -> Left (PlannedId sourceId)
where
- sourceId = PackageIdentifier pn v Nothing -- FIXME: this should be the compiler id!
+ sourceId = PackageIdentifier pn v (Just $ compilerIdFor stage toolchains)
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs b/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs
index 08583f537d1..d6f008e153b 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs
@@ -62,10 +62,14 @@ convPIs :: Toolchains -> Map PN [LabeledPackageConstraint]
-> SI.InstalledPackageIndex -- ^ host
-> CI.PackageIndex (SourcePackage loc)
-> Index
+convPIs toolchains constraints sip strfl solveExes biidx iidx sidx =
+ mkIndex $ (trace (pp "BIPIs" bipis) bipis) ++ (trace (pp "HIPIs" hipis) hipis) ++ (trace (pp "SPIs" spis) spis)
where bipis = convIPI' toolchains sip biidx
hipis = convIPI' toolchains sip iidx
ipis = bipis ++ hipis
spis = convSPI' toolchains constraints strfl solveExes sidx
+ pp :: String -> [(PN, I, PInfo)] -> String
+ pp label xs = unlines $ ("=== " ++ label ++ ":\n"):(map (\(pn, i, pi) -> show pn ++ " " ++ show i) xs)
-- | Convert a Cabal installed package index to the simpler,
-- more uniform index format of the solver.
@@ -154,7 +158,7 @@ convIP toolchains idx ipi =
convIPId :: Toolchains -> DependencyReason PN -> Component -> SI.InstalledPackageIndex -> UnitId -> Either UnitId (FlaggedDep PN)
convIPId toolchains dr comp idx ipid =
case SI.lookupUnitId idx ipid of
- Nothing -> Left ipid
+ Nothing -> traceShow (show comp ++ ": Failed to find: " ++ show ipid ++ " in index.") $ Left ipid
Just ipi -> let (pn, i) = convId toolchains ipi
name = ExposedLib LMainLibName -- TODO: Handle sub-libraries.
in Right (D.Simple (LDep dr (Dep (PkgComponent pn name) (Fixed i))) comp)
@@ -175,7 +179,8 @@ convSP :: Toolchains -> Map PN [LabeledPackageConstraint]
convSP toolchains constraints strfl solveExes (SourcePackage (PackageIdentifier pn pv _compid) gpd _ _pl) =
let pkgConstraints = fromMaybe [] $ M.lookup pn constraints
in [(pn, I Host pv InRepo, convGPD (hostToolchain toolchains) pkgConstraints strfl solveExes pn gpd)
- ,(pn, I Build pv InRepo, convGPD (buildToolchain toolchains) pkgConstraints strfl solveExes pn gpd)]
+ ,(pn, I Build pv InRepo, convGPD (buildToolchain toolchains) pkgConstraints strfl solveExes pn gpd)
+ ]
-- We do not use 'flattenPackageDescription' or 'finalizePD'
-- from 'Distribution.PackageDescription.Configuration' here, because we
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs
index 89c7daa0223..0a6674ce9f5 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs
@@ -105,6 +105,7 @@ solve sc toolchains idx pkgConfigDB userPrefs userConstraints userGoals =
traceTree "cycles.json" id .
detectCycles .
traceTree "heuristics.json" id .
+ stageBuildDeps "post-pref: " .
trav (
heuristicsPhase .
preferencesPhase .
@@ -114,9 +115,9 @@ solve sc toolchains idx pkgConfigDB userPrefs userConstraints userGoals =
validationCata .
traceTree "pruned.json" id .
trav prunePhase .
- -- stageBuildDeps "post-prune: " .
+ stageBuildDeps "post-prune: " .
(if buildIsHost toolchains then id else trav P.pruneHostFromSetup) .
- -- stageBuildDeps "build: " .
+ stageBuildDeps "build: " .
traceTree "build.json" id $
buildPhase
where
diff --git a/cabal-install-solver/src/Distribution/Solver/Types/Toolchain.hs b/cabal-install-solver/src/Distribution/Solver/Types/Toolchain.hs
index d7b9312520b..e965e54bee5 100644
--- a/cabal-install-solver/src/Distribution/Solver/Types/Toolchain.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Types/Toolchain.hs
@@ -5,6 +5,7 @@ module Distribution.Solver.Types.Toolchain
( Toolchain (..)
, Toolchains (..)
, toolchainFor
+ , compilerIdFor
, mkToolchainsWithHost
, buildIsHost
) where
@@ -48,6 +49,9 @@ toolchainFor :: Stage -> Toolchains -> Toolchain
toolchainFor Build = buildToolchain
toolchainFor Host = hostToolchain
+compilerIdFor :: Stage -> Toolchains -> CompilerId
+compilerIdFor stage = compilerId . toolchainCompiler . toolchainFor stage
+
instance Binary Toolchains
instance Structured Toolchains
diff --git a/cabal-install/src/Distribution/Client/Dependency.hs b/cabal-install/src/Distribution/Client/Dependency.hs
index 44309e069ef..51c66a9f691 100644
--- a/cabal-install/src/Distribution/Client/Dependency.hs
+++ b/cabal-install/src/Distribution/Client/Dependency.hs
@@ -166,6 +166,8 @@ import Data.List
import qualified Data.Map as Map
import qualified Data.Set as Set
+import GHC.Stack (HasCallStack)
+
-- ------------------------------------------------------------
-- * High level planner policy
@@ -836,13 +838,13 @@ resolveDependencies toolchains pkgConfigDB params =
targets
where
finalparams@( DepResolverParams
- targets
+ targets -- depResolverTargets
constraints
prefs
defpref
installedPkgIndex
binstalledPkgIndex
- sourcePkgIndex
+ sourcePkgIndex -- depResolverSourcePkgIndex
reordGoals
cntConflicts
fineGrained
@@ -928,17 +930,31 @@ interpretPackagesPreference selected defaultPref prefs =
-- | Make an install plan from the output of the dep resolver.
-- It checks that the plan is valid, or it's an error in the dep resolver.
validateSolverResult
- :: Toolchains
+ :: HasCallStack => Toolchains
-> IndependentGoals
-> [ResolverPackage UnresolvedPkgLoc]
-> SolverInstallPlan
validateSolverResult toolchains indepGoals pkgs =
- case planPackagesProblems toolchains pkgs of
+ case planPackagesProblems toolchains (trace (dump pkgs) pkgs) of
[] -> case SolverInstallPlan.new indepGoals graph of
Right plan -> plan
Left problems -> error (formatPlanProblems problems)
problems -> error (formatPkgProblems problems)
where
+ dump :: [ResolverPackage UnresolvedPkgLoc] -> String
+ dump xs = unlines $
+ "=== DUMP ===":[unlines $ (resolverPkgHead x ++ show (packageId x)):[ "- "++ solverIdHead y ++ show (solverSrcId y)
+ | y <- CD.flatDeps (resolverPackageLibDeps x)]
+ | x <- xs ]
+ ++ ["=== /DUMP =="]
+
+ solverIdHead :: SolverId -> String
+ solverIdHead (PreExistingId{}) = "[PE]"
+ solverIdHead (PlannedId {}) = "[PL]"
+
+ resolverPkgHead (PreExisting _) = "[PE]"
+ resolverPkgHead (Configured _) = "[CF]"
+
graph :: Graph.Graph (ResolverPackage UnresolvedPkgLoc)
graph = Graph.fromDistinctList pkgs
diff --git a/cabal-install/src/Distribution/Client/ProjectConfig.hs b/cabal-install/src/Distribution/Client/ProjectConfig.hs
index fd96eb4d2f3..c211f26abca 100644
--- a/cabal-install/src/Distribution/Client/ProjectConfig.hs
+++ b/cabal-install/src/Distribution/Client/ProjectConfig.hs
@@ -1091,6 +1091,14 @@ findProjectPackages
let repoPkgs = map ProjectPackageRemoteRepo projectPackagesRepo
namedPkgs = map ProjectPackageNamed projectPackagesNamed
+ -- FIXME: We should _REALLY_ Tag the packages here somehow.
+ -- Right now we just slam together requiredPkgs and buildPkgs, ...
+ -- Maybe we can carry the Build/Host distinction in the
+ -- ProjectPackageLocation. Because we later on really want to make
+ -- sure we consider only buildPkgs for building with the Build
+ -- compiler, and all others with the Host compiler. For now we just
+ -- Assume both for both compilers, but this is not god.
+ -- XXX: FIXME!
return (concat [requiredPkgs, buildPkgs, 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 348eb031093..dd43c4298ab 100644
--- a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs
+++ b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs
@@ -659,7 +659,8 @@ resolveTargets
checkTarget bt@(TargetPackage _ (ordNub -> [pkgid]) mkfilter)
| Just ats <-
fmap (maybe id filterTargetsKind mkfilter) $
- Map.lookup pkgid availableTargetsByPackageId =
+ (trace (unlines $ ("Failed to find " ++ prettyShow pkgid ++ " in "):[prettyShow k {-# ++ " -> " ++ show v #-} | (k,v) <- Map.toList availableTargetsByPackageId])
+ (Map.lookup pkgid availableTargetsByPackageId)) =
fmap (componentTargets WholeComponent) $
selectPackageTargets bt ats
| otherwise =
@@ -685,9 +686,18 @@ resolveTargets
$ concat (Map.elems availableTargetsByPackageId)
checkTarget (TargetComponent pkgid cname subtarget)
| Just ats <-
- Map.lookup
- (pkgid, cname)
- availableTargetsByPackageIdAndComponentName =
+ -- FIXME: this is stupid. We do not know what the target selectors HOST compiler is...
+ -- so we'll assume tere is only a _SINGLE_ match in the map if we ignore the pkgCompiler.
+ -- This lookup is now O(n) instead of O(log n).
+ (trace (unlines $ ("Failed to find " ++ prettyShow pkgid ++ ":" ++ show cname ++ " in "):[prettyShow k ++ ":" ++ show k' {-# ++ " -> " ++ show v #-} | ((k,k'),v) <- Map.toList availableTargetsByPackageIdAndComponentName])
+ (case [v | ((k,k'),v) <- Map.toList availableTargetsByPackageIdAndComponentName
+ , k{pkgCompiler = Nothing} == pkgid
+ , k' == cname] of
+ [match] -> Just match))
+ -- (Map.lookup
+ -- (pkgid, cname)
+ -- availableTargetsByPackageIdAndComponentName))
+ =
fmap (componentTargets subtarget) $
selectComponentTargets subtarget ats
| Map.member pkgid availableTargetsByPackageId =
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index 5e95e31d718..38e4d752f03 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -243,6 +243,8 @@ import Distribution.Solver.Types.ProjectConfigPath
import System.FilePath
import qualified Text.PrettyPrint as Disp
+import GHC.Stack (HasCallStack)
+
-- | Check that an 'ElaboratedConfiguredPackage' actually makes
-- sense under some 'ElaboratedSharedConfig'.
sanityCheckElaboratedConfiguredPackage
@@ -758,13 +760,13 @@ rebuildInstallPlan
, projectConfigBuildOnly
}
toolchains
- localPackages
+ localPackages_
installedPackages =
rerunIfChanged
verbosity
fileMonitorSolverPlan
( solverSettings
- , localPackages
+ , localPackages_
, localPackagesEnabledStanzas
, toolchains
, hookHashes
@@ -797,13 +799,6 @@ rebuildInstallPlan
-- updateIPI ipi = ipi {
-- IPI.sourcePackageId = (IPI.sourcePackageId ipi){ PI.pkgCompiler = IPI.pkgCompiler ipi }
-- }
- -- let addCompilerToSourcePkg :: CompilerId -> [PackageSpecifier UnresolvedSourcePackage] -> [PackageSpecifier UnresolvedSourcePackage]
- -- addCompilerToSourcePkg compilerId = map (addCompilerId compilerId)
- -- addCompilerId :: CompilerId -> PackageSpecifier UnresolvedSourcePackage -> PackageSpecifier UnresolvedSourcePackage
- -- addCompilerId compilerId (NamedPackage name props) = NamedPackage name props
- -- addCompilerId compilerId (SpecificSourcePackage pkg) = SpecificSourcePackage (f pkg)
- -- where f :: SourcePackage UnresolvedPkgLoc -> SourcePackage UnresolvedPkgLoc
- -- f pkg = pkg{srcpkgPackageId = (srcpkgPackageId pkg){pkgCompiler = Just compilerId}}
hinstalledPkgIndex <-
-- mapPkgIdx updateIPI <$>
@@ -824,8 +819,20 @@ rebuildInstallPlan
-- if host and build compiler are the same, we want to get -package-db in here.
(corePackageDbs $ if buildIsHost toolchains then Host else Build)
- -- let localPackages' = addCompilerToSourcePkg (compilerId . toolchainCompiler . hostToolchain $ toolchains) localPackages
+ -- getSourcePackages
+ -- :: Verbosity
+ -- -> (forall a. (RepoContext -> IO a) -> IO a)
+ -- -> Maybe IndexUtils.TotalIndexState
+ -- -> Maybe IndexUtils.ActiveRepos
+ -- -> Rebuild (SourcePackageDb, IndexUtils.TotalIndexState, IndexUtils.ActiveRepos)
+
+ -- data SourcePackageDb = SourcePackageDb
+ -- { packageIndex :: PackageIndex UnresolvedSourcePackage
+ -- , packagePreferences :: Map PackageName VersionRange
+ -- }
+ -- NOTE: sourcePkgDbs is the stuff that we pull from Hackage
+ -- and similar Indices!
(sourcePkgDb, tis, ar) <-
getSourcePackages
verbosity
@@ -842,12 +849,14 @@ rebuildInstallPlan
liftIO $ do
notice verbosity "Resolving dependencies..."
- -- putStrLn "== installedPackages"
- -- putStrLn $ unlines $ map (prettyShow . IPI.sourcePackageId) $ PI.allPackages installedPackages
- -- putStrLn "== binstalledPackages"
- -- putStrLn $ unlines $ map (prettyShow . IPI.sourcePackageId) $ PI.allPackages binstalledPkgIndex
- -- putStrLn "== hinstalledPackages"
- -- putStrLn $ unlines $ map (prettyShow . IPI.sourcePackageId) $ PI.allPackages hinstalledPkgIndex
+ putStrLn "== installedPackages"
+ putStrLn $ unlines $ map (prettyShow . IPI.sourcePackageId) $ PI.allPackages installedPackages
+ putStrLn "== binstalledPackages"
+ putStrLn $ unlines $ map (prettyShow . IPI.sourcePackageId) $ PI.allPackages binstalledPkgIndex
+ putStrLn "== hinstalledPackages"
+ putStrLn $ unlines $ map (prettyShow . IPI.sourcePackageId) $ PI.allPackages hinstalledPkgIndex
+ putStrLn "== localPackages"
+ putStrLn $ unlines . map (prettyShow . srcpkgPackageId) $ [pkg | SpecificSourcePackage pkg <- localPackages]
planOrError <-
foldProgress logMsg (pure . Left) (pure . Right) $
planPackages
@@ -866,6 +875,16 @@ rebuildInstallPlan
dieWithException verbosity $ PhaseRunSolverErr msg
Right plan -> return (plan, pkgConfigDB, tis, ar)
where
+ -- FIXME: See FIXME in Distribution.Client.ProjectConfig wrt to buildPackages.
+ addCompilerToSourcePkg :: CompilerId -> [PackageSpecifier UnresolvedSourcePackage] -> [PackageSpecifier UnresolvedSourcePackage]
+ addCompilerToSourcePkg compilerId = map (addCompilerId compilerId)
+ addCompilerId :: CompilerId -> PackageSpecifier UnresolvedSourcePackage -> PackageSpecifier UnresolvedSourcePackage
+ addCompilerId compilerId (NamedPackage name props) = NamedPackage name props
+ addCompilerId compilerId (SpecificSourcePackage pkg) = SpecificSourcePackage (f pkg)
+ where f :: SourcePackage UnresolvedPkgLoc -> SourcePackage UnresolvedPkgLoc
+ f pkg = pkg{srcpkgPackageId = (srcpkgPackageId pkg){pkgCompiler = Just compilerId}}
+ localPackages = (addCompilerToSourcePkg (compilerIdFor Build toolchains) localPackages_)
+ <> (addCompilerToSourcePkg (compilerIdFor Host toolchains) localPackages_)
corePackageDbs :: Stage -> PackageDBStackCWD
corePackageDbs stage =
Cabal.interpretPackageDbFlags False (packageDBs stage)
@@ -942,7 +961,7 @@ rebuildInstallPlan
toolchains
pkgConfigDB
solverPlan
- localPackages = do
+ localPackages_ = do
liftIO $ debug verbosity "Elaborating the install plan..."
sourcePackageHashes <-
@@ -980,6 +999,17 @@ rebuildInstallPlan
liftIO $ debugNoWrap verbosity (showElaboratedInstallPlan instantiatedPlan)
return (instantiatedPlan, elaboratedShared)
where
+ -- FIXME: See FIXME in Distribution.Client.ProjectConfig wrt to buildPackages.
+ addCompilerToSourcePkg :: CompilerId -> [PackageSpecifier (SourcePackage (PackageLocation loc))] -> [PackageSpecifier (SourcePackage (PackageLocation loc))]
+ addCompilerToSourcePkg compilerId = map (addCompilerId compilerId)
+ addCompilerId :: CompilerId -> PackageSpecifier (SourcePackage (PackageLocation loc)) -> PackageSpecifier (SourcePackage (PackageLocation loc))
+ addCompilerId compilerId (NamedPackage name props) = NamedPackage name props
+ addCompilerId compilerId (SpecificSourcePackage pkg) = SpecificSourcePackage (f pkg)
+ where f :: SourcePackage (PackageLocation loc) -> SourcePackage (PackageLocation loc)
+ f pkg = pkg{srcpkgPackageId = (srcpkgPackageId pkg){pkgCompiler = Just compilerId}}
+ localPackages = (addCompilerToSourcePkg (compilerIdFor Build toolchains) localPackages_)
+ <> (addCompilerToSourcePkg (compilerIdFor Host toolchains) localPackages_)
+
withRepoCtx :: (RepoContext -> IO a) -> IO a
withRepoCtx =
projectConfigWithSolverRepoContext
@@ -1752,7 +1782,7 @@ elaborateInstallPlan
let src_comps = componentsGraphToList g
infoProgress $
hang
- (text "Component graph for" <+> pretty pkgid <<>> colon)
+ (text "Component graph for" <+> pretty pkgid <+> text "at stage " <+> text (show $ elabStage elab0) <<>> colon)
4
(dispComponentsWithDeps src_comps)
(_, comps) <-
@@ -1943,7 +1973,7 @@ elaborateInstallPlan
elab0
{ elabPkgOrComp = ElabComponent $ elab_comp
}
- cid = case elabBuildStyle elab0 of
+ cid = case traceShow (elabBuildStyle elab0) (elabBuildStyle elab0) of
BuildInplaceOnly{} ->
mkComponentId $
prettyShow pkgid
@@ -2331,7 +2361,9 @@ elaborateInstallPlan
else cp
elabPkgSourceLocation = srcloc
- elabPkgSourceHash = Map.lookup pkgid sourcePackageHashes
+ elabPkgSourceHash = case Map.lookup pkgid sourcePackageHashes of
+ Just h -> Just h
+ Nothing -> trace (unlines $ ("failed to find " ++ prettyShow pkgid ++ " in "):[ prettyShow k ++ " -> " ++ show v | (k, v) <- Map.toList sourcePackageHashes]) Nothing
elabLocalToProject = isLocalToProject pkg
elabBuildStyle =
if shouldBuildInplaceOnly pkg
@@ -2519,15 +2551,20 @@ elaborateInstallPlan
shouldBuildInplaceOnly pkg =
Set.member
(packageId pkg)
- pkgsToBuildInplaceOnly
+ (traceShowId pkgsToBuildInplaceOnly)
+
+ -- FIXME: This change is stupid, however the previous assumption is
+ -- that ALL pkgsLocalToProject somehow end up in the solverPlan. This
+ -- is not given, as we now have every local package listed twice. Once
+ -- for the Host, and once for the Build. Thus iterating over each individual
+ -- package _does_ work, but is rather idiotic.
pkgsToBuildInplaceOnly :: Set PackageId
pkgsToBuildInplaceOnly =
Set.fromList $
map packageId $
- SolverInstallPlan.reverseDependencyClosure
- solverPlan
- (map PlannedId (Set.toList pkgsLocalToProject))
+ concat [SolverInstallPlan.reverseDependencyClosure solverPlan [PlannedId p]
+ | p <- (Set.toList pkgsLocalToProject)]
isLocalToProject :: Package pkg => pkg -> Bool
isLocalToProject pkg =
@@ -4474,7 +4511,7 @@ setupHsHaddockArgs elab =
-- not replace installed packages with ghc-pkg.
packageHashInputs
- :: ElaboratedSharedConfig
+ :: HasCallStack => ElaboratedSharedConfig
-> ElaboratedConfiguredPackage
-> PackageHashInputs
packageHashInputs
diff --git a/cabal-install/src/Distribution/Client/SolverInstallPlan.hs b/cabal-install/src/Distribution/Client/SolverInstallPlan.hs
index 631dbde5afe..883f9f38a91 100644
--- a/cabal-install/src/Distribution/Client/SolverInstallPlan.hs
+++ b/cabal-install/src/Distribution/Client/SolverInstallPlan.hs
@@ -360,6 +360,43 @@ setupRoots =
-- Each element in the result is a package name along with the packages that
-- depend on it and the versions they require. These are guaranteed to be
-- distinct.
+
+-- type SolverPlanIndex = Graph (ResolverPackage UnresolvedPkgLoc)
+-- data ResolverPackage loc = PreExisting InstSolverPackage
+-- | Configured (SolverPackage loc)
+-- data InstSolverPackage = InstSolverPackage {
+-- instSolverQPN :: QPN,
+-- instSolverPkgIPI :: InstalledPackageInfo,
+-- instSolverPkgLibDeps :: ComponentDeps [SolverId],
+-- instSolverPkgExeDeps :: ComponentDeps [SolverId]
+-- }
+-- data SolverPackage loc = SolverPackage {
+-- solverPkgQPN :: QPN,
+-- solverPkgStage :: Stage,
+-- solverPkgSource :: SourcePackage loc,
+-- solverPkgFlags :: FlagAssignment,
+-- solverPkgStanzas :: OptionalStanzaSet,
+-- solverPkgLibDeps :: ComponentDeps [SolverId],
+-- solverPkgExeDeps :: ComponentDeps [SolverId]
+-- }
+-- newtype ComponentDeps a = ComponentDeps { unComponentDeps :: Map Component a }
+-- data SolverId = PreExistingId { solverSrcId :: PackageId, solverInstId :: UnitId }
+-- | PlannedId { solverSrcId :: PackageId }
+--
+-- flatDeps :: ComponentDeps a -> a
+
+-- instance Package (ResolverPackage loc) where
+-- packageId (PreExisting ipkg) = packageId ipkg
+-- packageId (Configured spkg) = packageId spkg
+
+-- resolverPackageLibDeps :: ResolverPackage loc -> CD.ComponentDeps [SolverId]
+-- resolverPackageLibDeps (PreExisting ipkg) = instSolverPkgLibDeps ipkg
+-- resolverPackageLibDeps (Configured spkg) = solverPkgLibDeps spkg
+
+-- resolverPackageExeDeps :: ResolverPackage loc -> CD.ComponentDeps [SolverId]
+-- resolverPackageExeDeps (PreExisting ipkg) = instSolverPkgExeDeps ipkg
+-- resolverPackageExeDeps (Configured spkg) = solverPkgExeDeps spkg
+
dependencyInconsistencies'
:: SolverPlanIndex
-> [(PackageName, [(PackageIdentifier, Version)])]
From 78afc12dc80772fef4ce996713a8fcd7ea5df8ec Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Tue, 25 Mar 2025 20:45:04 +0900
Subject: [PATCH 62/82] Drop debug
---
Cabal/src/Distribution/Simple/PackageIndex.hs | 3 +--
.../src/Distribution/Solver/Modular.hs | 2 +-
.../Solver/Modular/IndexConversion.hs | 6 ++---
.../src/Distribution/Solver/Modular/Solver.hs | 6 ++---
.../src/Distribution/Client/Dependency.hs | 15 +-----------
.../Client/ProjectOrchestration.hs | 6 ++---
.../Distribution/Client/ProjectPlanning.hs | 24 +++++++++----------
7 files changed, 22 insertions(+), 40 deletions(-)
diff --git a/Cabal/src/Distribution/Simple/PackageIndex.hs b/Cabal/src/Distribution/Simple/PackageIndex.hs
index eb3e4a22cce..545811b5984 100644
--- a/Cabal/src/Distribution/Simple/PackageIndex.hs
+++ b/Cabal/src/Distribution/Simple/PackageIndex.hs
@@ -169,7 +169,6 @@ instance Semigroup (PackageIndex IPI.InstalledPackageInfo) where
{-# NOINLINE invariant #-}
invariant :: WithCallStack (InstalledPackageIndex -> Bool)
invariant (PackageIndex pids pnames) =
- trace (show pids' ++ "\n" ++ show pnames') $
pids' == pnames'
where
pids' = map installedUnitId (Map.elems pids)
@@ -335,7 +334,7 @@ deleteSourcePackageId pkgid original@(PackageIndex pids pnames) =
Just pvers -> case Map.lookup (packageVersion pkgid) pvers of
Nothing -> original
Just pkgs ->
- traceShow (pkgid, pkgs) $ mkPackageIndex
+ mkPackageIndex
(foldl' (flip (Map.delete . installedUnitId)) pids pkgs)
-- (Map.update deletePkgInstance (installedUnitId pkgid) pids)
(deletePkgName pnames)
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular.hs b/cabal-install-solver/src/Distribution/Solver/Modular.hs
index a623d732703..73bb9c5b20b 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular.hs
@@ -81,7 +81,7 @@ showCP (CP qpi fa es ds) =
-- solver. Performs the necessary translations before and after.
modularResolver :: SolverConfig -> DependencyResolver loc
modularResolver sc toolchains biidx iidx sidx pkgConfigDB pprefs pcs pns = do
- (assignment, revdepmap) <- solve' sc toolchains (trace (showIdx idx) idx) pkgConfigDB pprefs gcs pns
+ (assignment, revdepmap) <- solve' sc toolchains idx pkgConfigDB pprefs gcs pns
let cp = toCPs assignment revdepmap
Step (show (vcat (map showCP cp))) $
return $ postprocess assignment revdepmap
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs b/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs
index d6f008e153b..f91b425f593 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs
@@ -63,13 +63,11 @@ convPIs :: Toolchains -> Map PN [LabeledPackageConstraint]
-> CI.PackageIndex (SourcePackage loc)
-> Index
convPIs toolchains constraints sip strfl solveExes biidx iidx sidx =
- mkIndex $ (trace (pp "BIPIs" bipis) bipis) ++ (trace (pp "HIPIs" hipis) hipis) ++ (trace (pp "SPIs" spis) spis)
+ mkIndex $ bipis ++ hipis ++ spis
where bipis = convIPI' toolchains sip biidx
hipis = convIPI' toolchains sip iidx
ipis = bipis ++ hipis
spis = convSPI' toolchains constraints strfl solveExes sidx
- pp :: String -> [(PN, I, PInfo)] -> String
- pp label xs = unlines $ ("=== " ++ label ++ ":\n"):(map (\(pn, i, pi) -> show pn ++ " " ++ show i) xs)
-- | Convert a Cabal installed package index to the simpler,
-- more uniform index format of the solver.
@@ -158,7 +156,7 @@ convIP toolchains idx ipi =
convIPId :: Toolchains -> DependencyReason PN -> Component -> SI.InstalledPackageIndex -> UnitId -> Either UnitId (FlaggedDep PN)
convIPId toolchains dr comp idx ipid =
case SI.lookupUnitId idx ipid of
- Nothing -> traceShow (show comp ++ ": Failed to find: " ++ show ipid ++ " in index.") $ Left ipid
+ Nothing -> Left ipid
Just ipi -> let (pn, i) = convId toolchains ipi
name = ExposedLib LMainLibName -- TODO: Handle sub-libraries.
in Right (D.Simple (LDep dr (Dep (PkgComponent pn name) (Fixed i))) comp)
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs
index 0a6674ce9f5..d519456143f 100644
--- a/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs
@@ -105,7 +105,7 @@ solve sc toolchains idx pkgConfigDB userPrefs userConstraints userGoals =
traceTree "cycles.json" id .
detectCycles .
traceTree "heuristics.json" id .
- stageBuildDeps "post-pref: " .
+ -- stageBuildDeps "post-pref: " .
trav (
heuristicsPhase .
preferencesPhase .
@@ -115,9 +115,9 @@ solve sc toolchains idx pkgConfigDB userPrefs userConstraints userGoals =
validationCata .
traceTree "pruned.json" id .
trav prunePhase .
- stageBuildDeps "post-prune: " .
+ -- stageBuildDeps "post-prune: " .
(if buildIsHost toolchains then id else trav P.pruneHostFromSetup) .
- stageBuildDeps "build: " .
+ -- stageBuildDeps "build: " .
traceTree "build.json" id $
buildPhase
where
diff --git a/cabal-install/src/Distribution/Client/Dependency.hs b/cabal-install/src/Distribution/Client/Dependency.hs
index 51c66a9f691..f3814917ace 100644
--- a/cabal-install/src/Distribution/Client/Dependency.hs
+++ b/cabal-install/src/Distribution/Client/Dependency.hs
@@ -935,25 +935,12 @@ validateSolverResult
-> [ResolverPackage UnresolvedPkgLoc]
-> SolverInstallPlan
validateSolverResult toolchains indepGoals pkgs =
- case planPackagesProblems toolchains (trace (dump pkgs) pkgs) of
+ case planPackagesProblems toolchains pkgs of
[] -> case SolverInstallPlan.new indepGoals graph of
Right plan -> plan
Left problems -> error (formatPlanProblems problems)
problems -> error (formatPkgProblems problems)
where
- dump :: [ResolverPackage UnresolvedPkgLoc] -> String
- dump xs = unlines $
- "=== DUMP ===":[unlines $ (resolverPkgHead x ++ show (packageId x)):[ "- "++ solverIdHead y ++ show (solverSrcId y)
- | y <- CD.flatDeps (resolverPackageLibDeps x)]
- | x <- xs ]
- ++ ["=== /DUMP =="]
-
- solverIdHead :: SolverId -> String
- solverIdHead (PreExistingId{}) = "[PE]"
- solverIdHead (PlannedId {}) = "[PL]"
-
- resolverPkgHead (PreExisting _) = "[PE]"
- resolverPkgHead (Configured _) = "[CF]"
graph :: Graph.Graph (ResolverPackage UnresolvedPkgLoc)
graph = Graph.fromDistinctList pkgs
diff --git a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs
index dd43c4298ab..6d91783326a 100644
--- a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs
+++ b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs
@@ -659,8 +659,7 @@ resolveTargets
checkTarget bt@(TargetPackage _ (ordNub -> [pkgid]) mkfilter)
| Just ats <-
fmap (maybe id filterTargetsKind mkfilter) $
- (trace (unlines $ ("Failed to find " ++ prettyShow pkgid ++ " in "):[prettyShow k {-# ++ " -> " ++ show v #-} | (k,v) <- Map.toList availableTargetsByPackageId])
- (Map.lookup pkgid availableTargetsByPackageId)) =
+ (Map.lookup pkgid availableTargetsByPackageId) =
fmap (componentTargets WholeComponent) $
selectPackageTargets bt ats
| otherwise =
@@ -689,11 +688,10 @@ resolveTargets
-- FIXME: this is stupid. We do not know what the target selectors HOST compiler is...
-- so we'll assume tere is only a _SINGLE_ match in the map if we ignore the pkgCompiler.
-- This lookup is now O(n) instead of O(log n).
- (trace (unlines $ ("Failed to find " ++ prettyShow pkgid ++ ":" ++ show cname ++ " in "):[prettyShow k ++ ":" ++ show k' {-# ++ " -> " ++ show v #-} | ((k,k'),v) <- Map.toList availableTargetsByPackageIdAndComponentName])
(case [v | ((k,k'),v) <- Map.toList availableTargetsByPackageIdAndComponentName
, k{pkgCompiler = Nothing} == pkgid
, k' == cname] of
- [match] -> Just match))
+ [match] -> Just match)
-- (Map.lookup
-- (pkgid, cname)
-- availableTargetsByPackageIdAndComponentName))
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index 38e4d752f03..91a319c83a4 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -849,14 +849,14 @@ rebuildInstallPlan
liftIO $ do
notice verbosity "Resolving dependencies..."
- putStrLn "== installedPackages"
- putStrLn $ unlines $ map (prettyShow . IPI.sourcePackageId) $ PI.allPackages installedPackages
- putStrLn "== binstalledPackages"
- putStrLn $ unlines $ map (prettyShow . IPI.sourcePackageId) $ PI.allPackages binstalledPkgIndex
- putStrLn "== hinstalledPackages"
- putStrLn $ unlines $ map (prettyShow . IPI.sourcePackageId) $ PI.allPackages hinstalledPkgIndex
- putStrLn "== localPackages"
- putStrLn $ unlines . map (prettyShow . srcpkgPackageId) $ [pkg | SpecificSourcePackage pkg <- localPackages]
+ -- putStrLn "== installedPackages"
+ -- putStrLn $ unlines $ map (prettyShow . IPI.sourcePackageId) $ PI.allPackages installedPackages
+ -- putStrLn "== binstalledPackages"
+ -- putStrLn $ unlines $ map (prettyShow . IPI.sourcePackageId) $ PI.allPackages binstalledPkgIndex
+ -- putStrLn "== hinstalledPackages"
+ -- putStrLn $ unlines $ map (prettyShow . IPI.sourcePackageId) $ PI.allPackages hinstalledPkgIndex
+ -- putStrLn "== localPackages"
+ -- putStrLn $ unlines . map (prettyShow . srcpkgPackageId) $ [pkg | SpecificSourcePackage pkg <- localPackages]
planOrError <-
foldProgress logMsg (pure . Left) (pure . Right) $
planPackages
@@ -1782,7 +1782,7 @@ elaborateInstallPlan
let src_comps = componentsGraphToList g
infoProgress $
hang
- (text "Component graph for" <+> pretty pkgid <+> text "at stage " <+> text (show $ elabStage elab0) <<>> colon)
+ (text "Component graph for" <+> pretty pkgid <<>> colon)
4
(dispComponentsWithDeps src_comps)
(_, comps) <-
@@ -1973,7 +1973,7 @@ elaborateInstallPlan
elab0
{ elabPkgOrComp = ElabComponent $ elab_comp
}
- cid = case traceShow (elabBuildStyle elab0) (elabBuildStyle elab0) of
+ cid = case elabBuildStyle elab0 of
BuildInplaceOnly{} ->
mkComponentId $
prettyShow pkgid
@@ -2363,7 +2363,7 @@ elaborateInstallPlan
elabPkgSourceLocation = srcloc
elabPkgSourceHash = case Map.lookup pkgid sourcePackageHashes of
Just h -> Just h
- Nothing -> trace (unlines $ ("failed to find " ++ prettyShow pkgid ++ " in "):[ prettyShow k ++ " -> " ++ show v | (k, v) <- Map.toList sourcePackageHashes]) Nothing
+ Nothing -> Nothing
elabLocalToProject = isLocalToProject pkg
elabBuildStyle =
if shouldBuildInplaceOnly pkg
@@ -2551,7 +2551,7 @@ elaborateInstallPlan
shouldBuildInplaceOnly pkg =
Set.member
(packageId pkg)
- (traceShowId pkgsToBuildInplaceOnly)
+ pkgsToBuildInplaceOnly
-- FIXME: This change is stupid, however the previous assumption is
From 0532529f34d83ff9f95c4350ed1686bb6a315442 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Tue, 25 Mar 2025 21:31:17 +0900
Subject: [PATCH 63/82] Set source-dir witout compiler
---
cabal-install/src/Distribution/Client/ProjectBuilding.hs | 8 ++++----
1 file changed, 4 insertions(+), 4 deletions(-)
diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding.hs b/cabal-install/src/Distribution/Client/ProjectBuilding.hs
index a2aa390e8a7..12bfd0df037 100644
--- a/cabal-install/src/Distribution/Client/ProjectBuilding.hs
+++ b/cabal-install/src/Distribution/Client/ProjectBuilding.hs
@@ -220,7 +220,7 @@ rebuildTargetsDryRun distDirLayout@DistDirLayout{..} shared =
else return (BuildStatusUnpack tarball)
where
srcdir :: FilePath
- srcdir = distUnpackedSrcDirectory (packageId pkg)
+ srcdir = distUnpackedSrcDirectory ((packageId pkg){pkgCompiler = Nothing})
dryRunLocalPkg
:: ElaboratedConfiguredPackage
@@ -713,7 +713,7 @@ withTarballLocalDirectory
let tmpdir = distTempDirectory
builddir = relativeSymbolicPath $ makeRelativePathEx "dist"
in withTempDirectory verbosity tmpdir "src" $ \unpackdir -> do
- let srcdir = makeSymbolicPath $ unpackdir </> prettyShow pkgid
+ let srcdir = makeSymbolicPath $ unpackdir </> prettyShow (pkgid{pkgCompiler = Nothing})
unpackPackageTarball
verbosity
tarball
@@ -727,7 +727,7 @@ withTarballLocalDirectory
-- inplace there
BuildInplaceOnly{} -> do
let srcrootdir = distUnpackedSrcRootDirectory
- srcdir = distUnpackedSrcDirectory pkgid
+ srcdir = distUnpackedSrcDirectory (pkgid{pkgCompiler = Nothing})
builddir =
makeSymbolicPath $
makeRelative (normalise srcdir) $
@@ -791,7 +791,7 @@ unpackPackageTarball verbosity tarball parentdir pkgid pkgTextOverride =
</> pkgsubdir
</> prettyShow pkgname
<.> "cabal"
- pkgsubdir = prettyShow pkgid
+ pkgsubdir = prettyShow (pkgid{pkgCompiler = Nothing})
pkgname = packageName pkgid
-- | This is a bit of a hacky workaround. A number of packages ship
From 5b816930dbec0ea56e7b27067ea609d1eb7fb7c3 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Wed, 26 Mar 2025 11:32:33 +0900
Subject: [PATCH 64/82] BUG: Parsect PackageIdentifier is broken
If we try to parse <flavour>-<version>-<pkg>-<version> for e.g. <pkg>-<version> this will break in
-- | Parse the @setup-config@ file header, returning the package identifiers
-- for Cabal and the compiler.
parseHeader
:: ByteString
-- ^ The file contents.
-> IO (PackageIdentifier, PackageIdentifier)
The issue is that we I guess parse e.g. Cabal-x.y.z as compiler flavour + version, and then have nothing for the PackageIdentifier to parse. This code needs to be fixed properly to try and parse compier-version-pkg-version or only pkg-version (and set compiler to Nothing).
---
Cabal-syntax/src/Distribution/Types/PackageId.hs | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/Cabal-syntax/src/Distribution/Types/PackageId.hs b/Cabal-syntax/src/Distribution/Types/PackageId.hs
index ca9bfbfc967..2da6171fe6d 100644
--- a/Cabal-syntax/src/Distribution/Types/PackageId.hs
+++ b/Cabal-syntax/src/Distribution/Types/PackageId.hs
@@ -64,13 +64,13 @@ instance Pretty PackageIdentifier where
-- Nothing
instance Parsec PackageIdentifier where
parsec = do
- comp <- parsec <* P.char '-'
+ -- comp <- parsec <* P.char '-'
xs' <- P.sepByNonEmpty component (P.char '-')
(v, xs) <- case simpleParsec (NE.last xs') of
Nothing -> return (nullVersion, toList xs') -- all components are version
Just v -> return (v, NE.init xs')
if not (null xs) && all (\c -> all (/= '.') c && not (all isDigit c)) xs
- then return $ PackageIdentifier (mkPackageName (intercalate "-" xs)) v comp
+ then return $ PackageIdentifier (mkPackageName (intercalate "-" xs)) v Nothing
else fail "all digits or a dot in a portion of package name"
where
component = P.munch1 (\c -> isAlphaNum c || c == '.')
From 062f69e69237b53b0ba16e58c5108a05fd11e696 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Wed, 26 Mar 2025 11:47:03 +0900
Subject: [PATCH 65/82] Revert "BUG: Parsect PackageIdentifier is broken"
This reverts commit 5b816930dbec0ea56e7b27067ea609d1eb7fb7c3.
---
Cabal-syntax/src/Distribution/Types/PackageId.hs | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/Cabal-syntax/src/Distribution/Types/PackageId.hs b/Cabal-syntax/src/Distribution/Types/PackageId.hs
index 2da6171fe6d..ca9bfbfc967 100644
--- a/Cabal-syntax/src/Distribution/Types/PackageId.hs
+++ b/Cabal-syntax/src/Distribution/Types/PackageId.hs
@@ -64,13 +64,13 @@ instance Pretty PackageIdentifier where
-- Nothing
instance Parsec PackageIdentifier where
parsec = do
- -- comp <- parsec <* P.char '-'
+ comp <- parsec <* P.char '-'
xs' <- P.sepByNonEmpty component (P.char '-')
(v, xs) <- case simpleParsec (NE.last xs') of
Nothing -> return (nullVersion, toList xs') -- all components are version
Just v -> return (v, NE.init xs')
if not (null xs) && all (\c -> all (/= '.') c && not (all isDigit c)) xs
- then return $ PackageIdentifier (mkPackageName (intercalate "-" xs)) v Nothing
+ then return $ PackageIdentifier (mkPackageName (intercalate "-" xs)) v comp
else fail "all digits or a dot in a portion of package name"
where
component = P.munch1 (\c -> isAlphaNum c || c == '.')
From 8aadca3ee2c43fa41ac7cac4f3de5fe927c69f17 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Thu, 27 Mar 2025 10:30:43 +0900
Subject: [PATCH 66/82] Add ScopeAnyBuildDepQualifier
---
.../Distribution/Solver/Types/PackageConstraint.hs | 11 +++++++++++
1 file changed, 11 insertions(+)
diff --git a/cabal-install-solver/src/Distribution/Solver/Types/PackageConstraint.hs b/cabal-install-solver/src/Distribution/Solver/Types/PackageConstraint.hs
index 06c5ae169fa..37c0d7dd1d7 100644
--- a/cabal-install-solver/src/Distribution/Solver/Types/PackageConstraint.hs
+++ b/cabal-install-solver/src/Distribution/Solver/Types/PackageConstraint.hs
@@ -49,6 +49,9 @@ data ConstraintScope
-- | The package with the specified name when it has a
-- setup qualifier.
| ScopeAnySetupQualifier PackageName
+ -- | The package with the specified name when it is a build-time
+ -- dependency. E.g. a Setup script or a build-depends.
+ | ScopeAnyBuildDepQualifier PackageName
-- | The package with the specified name regardless of
-- qualifier.
| ScopeAnyQualifier PackageName
@@ -65,6 +68,7 @@ scopeToPackageName :: ConstraintScope -> PackageName
scopeToPackageName (ScopeTarget pn) = pn
scopeToPackageName (ScopeQualified _ pn) = pn
scopeToPackageName (ScopeAnySetupQualifier pn) = pn
+scopeToPackageName (ScopeAnyBuildDepQualifier pn) = pn
scopeToPackageName (ScopeAnyQualifier pn) = pn
constraintScopeMatches :: ConstraintScope -> QPN -> Bool
@@ -74,6 +78,12 @@ constraintScopeMatches (ScopeTarget pn) (Q (PackagePath ns q) pn') =
in namespaceMatches ns && q == QualToplevel && pn == pn'
constraintScopeMatches (ScopeQualified q pn) (Q (PackagePath _ q') pn') =
q == q' && pn == pn'
+constraintScopeMatches (ScopeAnyBuildDepQualifier pn) (Q pp pn') =
+ let setup (PackagePath _ (QualSetup _)) = True
+ setup _ = False
+ build (PackagePath _ (QualExe _ _)) = True
+ build _ = False
+ in (setup pp || build pp) && pn == pn'
constraintScopeMatches (ScopeAnySetupQualifier pn) (Q pp pn') =
let setup (PackagePath _ (QualSetup _)) = True
setup _ = False
@@ -83,6 +93,7 @@ constraintScopeMatches (ScopeAnyQualifier pn) (Q _ pn') = pn == pn'
instance Pretty ConstraintScope where
pretty (ScopeTarget pn) = pretty pn <<>> Disp.text "." <<>> pretty pn
pretty (ScopeQualified q pn) = dispQualifier q <<>> pretty pn
+ pretty (ScopeAnyBuildDepQualifier pn) = Disp.text "build." <<>> pretty pn
pretty (ScopeAnySetupQualifier pn) = Disp.text "setup." <<>> pretty pn
pretty (ScopeAnyQualifier pn) = Disp.text "any." <<>> pretty pn
From 2554a524e2b5ec9bd6f225ffbaa94db554b3274d Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Thu, 27 Mar 2025 10:31:30 +0900
Subject: [PATCH 67/82] Fix deleteSourcePackageId
---
Cabal/src/Distribution/Simple/PackageIndex.hs | 18 ++++++++++++------
1 file changed, 12 insertions(+), 6 deletions(-)
diff --git a/Cabal/src/Distribution/Simple/PackageIndex.hs b/Cabal/src/Distribution/Simple/PackageIndex.hs
index 545811b5984..7cb606a0e93 100644
--- a/Cabal/src/Distribution/Simple/PackageIndex.hs
+++ b/Cabal/src/Distribution/Simple/PackageIndex.hs
@@ -323,6 +323,10 @@ deleteUnitId ipkgid original@(PackageIndex pids pnames) =
. List.deleteBy (\_ pkg -> installedUnitId pkg == ipkgid) undefined
-- | Removes all packages with this source 'PackageId' from the index.
+--
+-- The Index maps unitids to instances, however we may have multiple unitids
+-- for the same package. Especially if for multiple compilers, as such we need
+-- to ensure we don't delete by name/version, but by name/version/compiler only.
deleteSourcePackageId
:: PackageId
-> InstalledPackageIndex
@@ -333,11 +337,13 @@ deleteSourcePackageId pkgid original@(PackageIndex pids pnames) =
Nothing -> original
Just pvers -> case Map.lookup (packageVersion pkgid) pvers of
Nothing -> original
- Just pkgs ->
- mkPackageIndex
- (foldl' (flip (Map.delete . installedUnitId)) pids pkgs)
--- (Map.update deletePkgInstance (installedUnitId pkgid) pids)
- (deletePkgName pnames)
+ Just pkgs -> case [pkg | pkg <- pkgs, IPI.pkgCompiler pkg == pkgCompiler pkgid] of
+ [] -> original
+ pkgs' ->
+ mkPackageIndex
+ (foldl' (flip (Map.delete . installedUnitId)) pids pkgs')
+ (deletePkgName pnames)
+
where
deletePkgName =
Map.update deletePkgVersion (packageName pkgid, LMainLibName)
@@ -354,7 +360,7 @@ deleteSourcePackageId pkgid original@(PackageIndex pids pnames) =
deletePkgInstances :: [IPI.InstalledPackageInfo] -> Maybe [IPI.InstalledPackageInfo]
deletePkgInstances xs = if null xs' then Nothing else Just xs'
- where xs' = [x | x <- xs, pkgCompiler pkgid /= pkgCompiler (IPI.sourcePackageId x)]
+ where xs' = [x | x <- xs, pkgCompiler pkgid /= IPI.pkgCompiler x]
-- | Removes all packages with this (case-sensitive) name from the index.
--
From 1a3a0a01222426de4cb5ad8e7d680a6b5913e723 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Thu, 27 Mar 2025 10:33:17 +0900
Subject: [PATCH 68/82] Use ScopeAnyBuildDepQualifier
---
cabal-install/src/Distribution/Client/Dependency.hs | 8 ++++----
1 file changed, 4 insertions(+), 4 deletions(-)
diff --git a/cabal-install/src/Distribution/Client/Dependency.hs b/cabal-install/src/Distribution/Client/Dependency.hs
index f3814917ace..939aabf2e4e 100644
--- a/cabal-install/src/Distribution/Client/Dependency.hs
+++ b/cabal-install/src/Distribution/Client/Dependency.hs
@@ -454,13 +454,13 @@ dontInstallNonReinstallablePackages params =
ConstraintSourceNonReinstallablePackage
| pkgname <- nonReinstallablePackages
]
-dontInstallNonReinstallablePackagesSetupOnly :: DepResolverParams -> DepResolverParams
-dontInstallNonReinstallablePackagesSetupOnly params =
+dontInstallNonReinstallablePackagesForBuild :: DepResolverParams -> DepResolverParams
+dontInstallNonReinstallablePackagesForBuild params =
addConstraints extraConstraints params
where
extraConstraints =
[ LabeledPackageConstraint
- (PackageConstraint (ScopeAnySetupQualifier pkgname) PackagePropertyInstalled)
+ (PackageConstraint (ScopeAnyBuildDepQualifier pkgname) PackagePropertyInstalled)
ConstraintSourceNonReinstallablePackage
| pkgname <- nonReinstallablePackages
]
@@ -862,7 +862,7 @@ resolveDependencies toolchains pkgConfigDB params =
verbosity
) =
if asBool (depResolverAllowBootLibInstalls params)
- then dontInstallNonReinstallablePackagesSetupOnly params
+ then dontInstallNonReinstallablePackagesForBuild params
else dontInstallNonReinstallablePackages params
preferences :: PackageName -> PackagePreferences
From 7f34ae9d24a90eaed0d781f4ee898412a5de0cf0 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Thu, 27 Mar 2025 12:32:03 +0900
Subject: [PATCH 69/82] If build is host, allow installing even for build.
---
cabal-install/src/Distribution/Client/Dependency.hs | 4 +++-
1 file changed, 3 insertions(+), 1 deletion(-)
diff --git a/cabal-install/src/Distribution/Client/Dependency.hs b/cabal-install/src/Distribution/Client/Dependency.hs
index 939aabf2e4e..878a99ca5e9 100644
--- a/cabal-install/src/Distribution/Client/Dependency.hs
+++ b/cabal-install/src/Distribution/Client/Dependency.hs
@@ -862,7 +862,9 @@ resolveDependencies toolchains pkgConfigDB params =
verbosity
) =
if asBool (depResolverAllowBootLibInstalls params)
- then dontInstallNonReinstallablePackagesForBuild params
+ then if buildIsHost toolchains
+ then params
+ else dontInstallNonReinstallablePackagesForBuild params
else dontInstallNonReinstallablePackages params
preferences :: PackageName -> PackagePreferences
From 78342eee234e8cee14ab90f6935382ec98712b5e Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Thu, 27 Mar 2025 12:32:36 +0900
Subject: [PATCH 70/82] Better packageid
---
Cabal-syntax/src/Distribution/Types/PackageId.hs | 10 ++++++----
1 file changed, 6 insertions(+), 4 deletions(-)
diff --git a/Cabal-syntax/src/Distribution/Types/PackageId.hs b/Cabal-syntax/src/Distribution/Types/PackageId.hs
index ca9bfbfc967..486df97a146 100644
--- a/Cabal-syntax/src/Distribution/Types/PackageId.hs
+++ b/Cabal-syntax/src/Distribution/Types/PackageId.hs
@@ -29,6 +29,7 @@ data PackageIdentifier = PackageIdentifier
, pkgVersion :: Version
-- ^ the version of this package, eg 1.2
, pkgCompiler :: Maybe CompilerId
+ -- ^ the associated compiler id of the package, eg ghc-9.8.4
}
deriving (Generic, Read, Show, Eq, Ord, Data)
@@ -37,8 +38,9 @@ instance Structured PackageIdentifier
instance Pretty PackageIdentifier where
pretty (PackageIdentifier n v c)
- | v == nullVersion = pretty c <<>> Disp.char '-' <<>> pretty n -- if no version, don't show version.
- | Just c' <- c = pretty c' <<>> Disp.char '-' <<>> pretty n <<>> Disp.char '-' <<>> pretty v
+ | Just c' <- c, v == nullVersion = pretty c <<>> Disp.char ':' <<>> pretty n -- if no version, don't show version.
+ | Just c' <- c = pretty c' <<>> Disp.char ':' <<>> pretty n <<>> Disp.char '-' <<>> pretty v
+ | v == nullVersion = pretty n
| otherwise = pretty n <<>> Disp.char '-' <<>> pretty v
-- |
@@ -64,13 +66,13 @@ instance Pretty PackageIdentifier where
-- Nothing
instance Parsec PackageIdentifier where
parsec = do
- comp <- parsec <* P.char '-'
+ -- comp <- Just <$> (parsec <* P.char ':') <|> return Nothing
xs' <- P.sepByNonEmpty component (P.char '-')
(v, xs) <- case simpleParsec (NE.last xs') of
Nothing -> return (nullVersion, toList xs') -- all components are version
Just v -> return (v, NE.init xs')
if not (null xs) && all (\c -> all (/= '.') c && not (all isDigit c)) xs
- then return $ PackageIdentifier (mkPackageName (intercalate "-" xs)) v comp
+ then return $ PackageIdentifier (mkPackageName (intercalate "-" xs)) v Nothing --comp
else fail "all digits or a dot in a portion of package name"
where
component = P.munch1 (\c -> isAlphaNum c || c == '.')
From 35e6455674a53127eb74aaef3ff28c88360224d5 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Thu, 27 Mar 2025 12:33:05 +0900
Subject: [PATCH 71/82] Add support for Package Indices
---
.../src/Distribution/Client/FetchUtils.hs | 3 ++-
.../src/Distribution/Client/ProjectPlanning.hs | 14 ++++++++++----
2 files changed, 12 insertions(+), 5 deletions(-)
diff --git a/cabal-install/src/Distribution/Client/FetchUtils.hs b/cabal-install/src/Distribution/Client/FetchUtils.hs
index 62da386573d..6b29dd84bfc 100644
--- a/cabal-install/src/Distribution/Client/FetchUtils.hs
+++ b/cabal-install/src/Distribution/Client/FetchUtils.hs
@@ -60,6 +60,7 @@ import Distribution.Package
( PackageId
, packageName
, packageVersion
+ , pkgCompiler
)
import Distribution.Simple.Utils
( debug
@@ -395,7 +396,7 @@ waitAsyncFetchPackage verbosity downloadMap srcloc =
packageFile :: Repo -> PackageId -> FilePath
packageFile repo pkgid =
packageDir repo pkgid
- </> prettyShow pkgid
+ </> prettyShow pkgid{pkgCompiler = Nothing}
<.> "tar.gz"
-- | Generate the full path to the directory where the local cached copy of
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index 91a319c83a4..d3e417966c0 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -244,6 +244,7 @@ import System.FilePath
import qualified Text.PrettyPrint as Disp
import GHC.Stack (HasCallStack)
+-- import qualified Distribution.Solver.Types.PackageIndex as XXX
-- | Check that an 'ElaboratedConfiguredPackage' actually makes
-- sense under some 'ElaboratedSharedConfig'.
@@ -833,13 +834,17 @@ rebuildInstallPlan
-- NOTE: sourcePkgDbs is the stuff that we pull from Hackage
-- and similar Indices!
- (sourcePkgDb, tis, ar) <-
+ (sourcePkgDb_, tis, ar) <-
getSourcePackages
verbosity
withRepoCtx
(solverSettingIndexState solverSettings)
(solverSettingActiveRepos solverSettings)
+ -- FIXME: we are duplicating the index here, bad for memory use :-/
+ let sourcePkgDb = sourcePkgDb_{packageIndex = (addCompilerIdToSrcPkg (compilerIdFor Build toolchains) <$> packageIndex sourcePkgDb_)
+ <> (addCompilerIdToSrcPkg (compilerIdFor Host toolchains) <$> packageIndex sourcePkgDb_) }
+
pkgConfigDB <- getPkgConfigDb verbosity (toolchainProgramDb $ buildToolchain toolchains)
-- TODO: [code cleanup] it'd be better if the Compiler contained the
@@ -857,6 +862,7 @@ rebuildInstallPlan
-- putStrLn $ unlines $ map (prettyShow . IPI.sourcePackageId) $ PI.allPackages hinstalledPkgIndex
-- putStrLn "== localPackages"
-- putStrLn $ unlines . map (prettyShow . srcpkgPackageId) $ [pkg | SpecificSourcePackage pkg <- localPackages]
+ -- putStrLn $ unlines . take 20 $ map (prettyShow . srcpkgPackageId) (XXX.allPackages (packageIndex sourcePkgDb))
planOrError <-
foldProgress logMsg (pure . Left) (pure . Right) $
planPackages
@@ -880,9 +886,9 @@ rebuildInstallPlan
addCompilerToSourcePkg compilerId = map (addCompilerId compilerId)
addCompilerId :: CompilerId -> PackageSpecifier UnresolvedSourcePackage -> PackageSpecifier UnresolvedSourcePackage
addCompilerId compilerId (NamedPackage name props) = NamedPackage name props
- addCompilerId compilerId (SpecificSourcePackage pkg) = SpecificSourcePackage (f pkg)
- where f :: SourcePackage UnresolvedPkgLoc -> SourcePackage UnresolvedPkgLoc
- f pkg = pkg{srcpkgPackageId = (srcpkgPackageId pkg){pkgCompiler = Just compilerId}}
+ addCompilerId compilerId (SpecificSourcePackage pkg) = SpecificSourcePackage (addCompilerIdToSrcPkg compilerId pkg)
+ addCompilerIdToSrcPkg :: CompilerId -> SourcePackage UnresolvedPkgLoc -> SourcePackage UnresolvedPkgLoc
+ addCompilerIdToSrcPkg compilerId pkg = pkg{srcpkgPackageId = (srcpkgPackageId pkg){pkgCompiler = Just compilerId}}
localPackages = (addCompilerToSourcePkg (compilerIdFor Build toolchains) localPackages_)
<> (addCompilerToSourcePkg (compilerIdFor Host toolchains) localPackages_)
corePackageDbs :: Stage -> PackageDBStackCWD
From c52048294c408446ad9dea836cf3f48f0405693f Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Tue, 1 Apr 2025 20:34:37 +0900
Subject: [PATCH 72/82] UGLY! Forcing pkgCompiler to Nothing across the
codebasy :cry:
---
Cabal/src/Distribution/Backpack/Id.hs | 6 ++++--
Cabal/src/Distribution/Simple/InstallDirs.hs | 6 +++---
cabal-install/src/Distribution/Client/DistDirLayout.hs | 3 ++-
cabal-install/src/Distribution/Client/FetchUtils.hs | 2 +-
.../src/Distribution/Client/ProjectBuilding.hs | 2 +-
.../src/Distribution/Client/ProjectPlanning.hs | 10 +++++-----
6 files changed, 16 insertions(+), 13 deletions(-)
diff --git a/Cabal/src/Distribution/Backpack/Id.hs b/Cabal/src/Distribution/Backpack/Id.hs
index 38e831acf17..7e94dc38008 100644
--- a/Cabal/src/Distribution/Backpack/Id.hs
+++ b/Cabal/src/Distribution/Backpack/Id.hs
@@ -39,12 +39,14 @@ computeComponentId
-- This is used by cabal-install's legacy codepath
-> Maybe ([ComponentId], FlagAssignment)
-> ComponentId
-computeComponentId deterministic mb_ipid mb_cid pid cname mb_details =
+computeComponentId deterministic mb_ipid mb_cid pid0 cname mb_details =
-- show is found to be faster than intercalate and then replacement of
-- special character used in intercalating. We cannot simply hash by
-- doubly concatenating list, as it just flatten out the nested list, so
-- different sources can produce same hash
- let hash_suffix
+ let -- we do not want the compiler to show up in the Id.
+ pid = pid0{pkgCompiler = Nothing}
+ hash_suffix
| Just (dep_ipids, flags) <- mb_details =
"-"
++ hashToBase62
diff --git a/Cabal/src/Distribution/Simple/InstallDirs.hs b/Cabal/src/Distribution/Simple/InstallDirs.hs
index 86e6fa08777..c3f403a27de 100644
--- a/Cabal/src/Distribution/Simple/InstallDirs.hs
+++ b/Cabal/src/Distribution/Simple/InstallDirs.hs
@@ -209,7 +209,7 @@ defaultInstallDirs' False comp userInstall _hasLibs = do
case buildOS of
Windows -> return "$prefix"
_ -> return ("$prefix" </> "lib")
- return $
+ return $ traceShowId $
fmap toPathTemplate $
InstallDirs
{ prefix = installPrefix
@@ -267,7 +267,7 @@ substituteInstallDirTemplates
:: PathTemplateEnv
-> InstallDirTemplates
-> InstallDirTemplates
-substituteInstallDirTemplates env dirs = dirs'
+substituteInstallDirTemplates env dirs = traceShow "BOOM" $ dirs'
where
dirs' =
InstallDirs
@@ -441,7 +441,7 @@ packageTemplateEnv pkgId uid =
, -- Invariant: uid is actually a HashedUnitId. Hard to enforce because
-- it's an API change.
(LibNameVar, PathTemplate [Ordinary $ prettyShow uid])
- , (PkgIdVar, PathTemplate [Ordinary $ prettyShow pkgId])
+ , (PkgIdVar, PathTemplate [Ordinary $ prettyShow (pkgId{pkgCompiler = Nothing})])
]
compilerTemplateEnv :: CompilerInfo -> PathTemplateEnv
diff --git a/cabal-install/src/Distribution/Client/DistDirLayout.hs b/cabal-install/src/Distribution/Client/DistDirLayout.hs
index 64140152453..152e077f105 100644
--- a/cabal-install/src/Distribution/Client/DistDirLayout.hs
+++ b/cabal-install/src/Distribution/Client/DistDirLayout.hs
@@ -39,6 +39,7 @@ import Distribution.Package
, PackageId
, PackageIdentifier
, UnitId
+ , pkgCompiler
)
import Distribution.Simple.Compiler
( Compiler (..)
@@ -200,7 +201,7 @@ defaultDistDirLayout projectRoot mdistDirectory haddockOutputDir =
distBuildRootDirectory
</> prettyShow (distParamPlatform params)
</> prettyShow (distParamCompilerId params)
- </> prettyShow (distParamPackageId params)
+ </> prettyShow ((distParamPackageId params){pkgCompiler = Nothing})
</> ( case distParamComponentName params of
Nothing -> ""
Just (CLibName LMainLibName) -> ""
diff --git a/cabal-install/src/Distribution/Client/FetchUtils.hs b/cabal-install/src/Distribution/Client/FetchUtils.hs
index 6b29dd84bfc..fd6dbe6553b 100644
--- a/cabal-install/src/Distribution/Client/FetchUtils.hs
+++ b/cabal-install/src/Distribution/Client/FetchUtils.hs
@@ -201,7 +201,7 @@ verifyFetchedTarball verbosity file mCallbacks pkgid =
let warnAndFail s = warn verbosity ("Fetched tarball " ++ file ++ " does not match server, will redownload: " ++ s) >> return False
in -- the do block in parens is due to dealing with the checked exceptions mechanism.
( do
- fileInfo <- Sec.indexLookupFileInfo callbacks pkgid
+ fileInfo <- Sec.indexLookupFileInfo callbacks (pkgid{pkgCompiler = Nothing})
sz <- Sec.FileLength . fromInteger <$> getFileSize file
if sz /= Sec.fileInfoLength (Sec.trusted fileInfo)
then warnAndFail "file length mismatch"
diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding.hs b/cabal-install/src/Distribution/Client/ProjectBuilding.hs
index 12bfd0df037..d58df79fe26 100644
--- a/cabal-install/src/Distribution/Client/ProjectBuilding.hs
+++ b/cabal-install/src/Distribution/Client/ProjectBuilding.hs
@@ -718,7 +718,7 @@ withTarballLocalDirectory
verbosity
tarball
unpackdir
- pkgid
+ pkgid{pkgCompiler = Nothing}
pkgTextOverride
buildPkg srcdir builddir
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index d3e417966c0..4c175ca020e 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -1211,7 +1211,7 @@ getPackageSourceHashes verbosity withRepoCtx solverPlan = do
--
let allPkgLocations :: [(PackageId, PackageLocation (Maybe FilePath))]
allPkgLocations =
- [ (packageId pkg, srcpkgSource pkg)
+ [ ((packageId pkg){pkgCompiler = Nothing}, srcpkgSource pkg)
| SolverInstallPlan.Configured (SolverPackage{solverPkgSource = pkg}) <-
SolverInstallPlan.toList solverPlan
]
@@ -1982,7 +1982,7 @@ elaborateInstallPlan
cid = case elabBuildStyle elab0 of
BuildInplaceOnly{} ->
mkComponentId $
- prettyShow pkgid
+ prettyShow (pkgid{pkgCompiler = Nothing})
++ "-inplace"
++ ( case Cabal.componentNameString cname of
Nothing -> ""
@@ -2215,7 +2215,7 @@ elaborateInstallPlan
pkgInstalledId
| shouldBuildInplaceOnly pkg =
- mkComponentId (prettyShow pkgid ++ "-inplace")
+ mkComponentId (prettyShow (pkgid{pkgCompiler = Nothing}) ++ "-inplace")
| otherwise =
assert (isJust elabPkgSourceHash) $
hashedInstalledPackageId
@@ -2226,7 +2226,7 @@ elaborateInstallPlan
-- Need to filter out internal dependencies, because they don't
-- correspond to anything real anymore.
- isExt confid = confSrcId confid /= pkgid
+ isExt confid = (confSrcId confid){pkgCompiler = Nothing} /= pkgid{pkgCompiler = Nothing}
filterExt = filter isExt
filterExt' :: [(ConfiguredId, a)] -> [(ConfiguredId, a)]
@@ -2367,7 +2367,7 @@ elaborateInstallPlan
else cp
elabPkgSourceLocation = srcloc
- elabPkgSourceHash = case Map.lookup pkgid sourcePackageHashes of
+ elabPkgSourceHash = case Map.lookup (pkgid{pkgCompiler = Nothing}) sourcePackageHashes of
Just h -> Just h
Nothing -> Nothing
elabLocalToProject = isLocalToProject pkg
From 6ed744155ba20ee7c26c02595fc061d05eb04e32 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Tue, 1 Apr 2025 20:34:49 +0900
Subject: [PATCH 73/82] Add build. constraint.
---
cabal-install/src/Distribution/Client/Targets.hs | 5 +++++
1 file changed, 5 insertions(+)
diff --git a/cabal-install/src/Distribution/Client/Targets.hs b/cabal-install/src/Distribution/Client/Targets.hs
index bfa94b0da80..cef19b4d277 100644
--- a/cabal-install/src/Distribution/Client/Targets.hs
+++ b/cabal-install/src/Distribution/Client/Targets.hs
@@ -618,6 +618,8 @@ data UserConstraintScope
UserQualified UserQualifier PackageName
| -- | Scope that applies to the package when it has a setup qualifier.
UserAnySetupQualifier PackageName
+ | -- | Scope that applies to all build packages only.
+ UserAnyBuildDepQualifier PackageName
| -- | Scope that applies to the package when it has any qualifier.
UserAnyQualifier PackageName
deriving (Eq, Show, Generic)
@@ -634,6 +636,7 @@ fromUserConstraintScope :: UserConstraintScope -> ConstraintScope
fromUserConstraintScope (UserQualified q pn) =
ScopeQualified (fromUserQualifier q) pn
fromUserConstraintScope (UserAnySetupQualifier pn) = ScopeAnySetupQualifier pn
+fromUserConstraintScope (UserAnyBuildDepQualifier pn) = ScopeAnyBuildDepQualifier pn
fromUserConstraintScope (UserAnyQualifier pn) = ScopeAnyQualifier pn
-- | Version of 'PackageConstraint' that the user can specify on
@@ -650,6 +653,7 @@ userConstraintPackageName (UserConstraint scope _) = scopePN scope
where
scopePN (UserQualified _ pn) = pn
scopePN (UserAnyQualifier pn) = pn
+ scopePN (UserAnyBuildDepQualifier pn) = pn
scopePN (UserAnySetupQualifier pn) = pn
userToPackageConstraint :: UserConstraint -> PackageConstraint
@@ -698,6 +702,7 @@ instance Parsec UserConstraint where
withDot :: PackageName -> m UserConstraintScope
withDot pn
| pn == mkPackageName "any" = UserAnyQualifier <$> parsec
+ | pn == mkPackageName "build" = UserAnyBuildDepQualifier <$> parsec
| pn == mkPackageName "setup" = UserAnySetupQualifier <$> parsec
| otherwise = P.unexpected $ "constraint scope: " ++ unPackageName pn
From 9fe4d069bb1149b339af45d2ed51d1d002a5394e Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Tue, 1 Apr 2025 20:37:30 +0900
Subject: [PATCH 74/82] Drop erronous traces
---
Cabal/src/Distribution/Simple/InstallDirs.hs | 4 ++--
cabal-install/src/Distribution/Client/ProjectBuilding.hs | 2 +-
2 files changed, 3 insertions(+), 3 deletions(-)
diff --git a/Cabal/src/Distribution/Simple/InstallDirs.hs b/Cabal/src/Distribution/Simple/InstallDirs.hs
index c3f403a27de..0611d33071c 100644
--- a/Cabal/src/Distribution/Simple/InstallDirs.hs
+++ b/Cabal/src/Distribution/Simple/InstallDirs.hs
@@ -209,7 +209,7 @@ defaultInstallDirs' False comp userInstall _hasLibs = do
case buildOS of
Windows -> return "$prefix"
_ -> return ("$prefix" </> "lib")
- return $ traceShowId $
+ return $
fmap toPathTemplate $
InstallDirs
{ prefix = installPrefix
@@ -267,7 +267,7 @@ substituteInstallDirTemplates
:: PathTemplateEnv
-> InstallDirTemplates
-> InstallDirTemplates
-substituteInstallDirTemplates env dirs = traceShow "BOOM" $ dirs'
+substituteInstallDirTemplates env dirs = dirs'
where
dirs' =
InstallDirs
diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding.hs b/cabal-install/src/Distribution/Client/ProjectBuilding.hs
index d58df79fe26..87e9167736d 100644
--- a/cabal-install/src/Distribution/Client/ProjectBuilding.hs
+++ b/cabal-install/src/Distribution/Client/ProjectBuilding.hs
@@ -214,7 +214,7 @@ rebuildTargetsDryRun distDirLayout@DistDirLayout{..} shared =
BuildInplaceOnly{} -> do
-- TODO: [nice to have] use a proper file monitor rather
-- than this dir exists test
- exists <- doesDirectoryExist (traceShowId srcdir)
+ exists <- doesDirectoryExist srcdir
if exists
then dryRunLocalPkg pkg depsBuildStatus srcdir
else return (BuildStatusUnpack tarball)
From a1494a8a03099027906b6862e15cc5b64479d463 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Wed, 2 Apr 2025 12:44:05 +0900
Subject: [PATCH 75/82] Revert "UGLY! Forcing pkgCompiler to Nothing across the
codebasy :cry:"
This reverts commit c52048294c408446ad9dea836cf3f48f0405693f.
---
Cabal/src/Distribution/Backpack/Id.hs | 6 ++----
Cabal/src/Distribution/Simple/InstallDirs.hs | 2 +-
cabal-install/src/Distribution/Client/DistDirLayout.hs | 3 +--
cabal-install/src/Distribution/Client/FetchUtils.hs | 2 +-
.../src/Distribution/Client/ProjectBuilding.hs | 2 +-
.../src/Distribution/Client/ProjectPlanning.hs | 10 +++++-----
6 files changed, 11 insertions(+), 14 deletions(-)
diff --git a/Cabal/src/Distribution/Backpack/Id.hs b/Cabal/src/Distribution/Backpack/Id.hs
index 7e94dc38008..38e831acf17 100644
--- a/Cabal/src/Distribution/Backpack/Id.hs
+++ b/Cabal/src/Distribution/Backpack/Id.hs
@@ -39,14 +39,12 @@ computeComponentId
-- This is used by cabal-install's legacy codepath
-> Maybe ([ComponentId], FlagAssignment)
-> ComponentId
-computeComponentId deterministic mb_ipid mb_cid pid0 cname mb_details =
+computeComponentId deterministic mb_ipid mb_cid pid cname mb_details =
-- show is found to be faster than intercalate and then replacement of
-- special character used in intercalating. We cannot simply hash by
-- doubly concatenating list, as it just flatten out the nested list, so
-- different sources can produce same hash
- let -- we do not want the compiler to show up in the Id.
- pid = pid0{pkgCompiler = Nothing}
- hash_suffix
+ let hash_suffix
| Just (dep_ipids, flags) <- mb_details =
"-"
++ hashToBase62
diff --git a/Cabal/src/Distribution/Simple/InstallDirs.hs b/Cabal/src/Distribution/Simple/InstallDirs.hs
index 0611d33071c..86e6fa08777 100644
--- a/Cabal/src/Distribution/Simple/InstallDirs.hs
+++ b/Cabal/src/Distribution/Simple/InstallDirs.hs
@@ -441,7 +441,7 @@ packageTemplateEnv pkgId uid =
, -- Invariant: uid is actually a HashedUnitId. Hard to enforce because
-- it's an API change.
(LibNameVar, PathTemplate [Ordinary $ prettyShow uid])
- , (PkgIdVar, PathTemplate [Ordinary $ prettyShow (pkgId{pkgCompiler = Nothing})])
+ , (PkgIdVar, PathTemplate [Ordinary $ prettyShow pkgId])
]
compilerTemplateEnv :: CompilerInfo -> PathTemplateEnv
diff --git a/cabal-install/src/Distribution/Client/DistDirLayout.hs b/cabal-install/src/Distribution/Client/DistDirLayout.hs
index 152e077f105..64140152453 100644
--- a/cabal-install/src/Distribution/Client/DistDirLayout.hs
+++ b/cabal-install/src/Distribution/Client/DistDirLayout.hs
@@ -39,7 +39,6 @@ import Distribution.Package
, PackageId
, PackageIdentifier
, UnitId
- , pkgCompiler
)
import Distribution.Simple.Compiler
( Compiler (..)
@@ -201,7 +200,7 @@ defaultDistDirLayout projectRoot mdistDirectory haddockOutputDir =
distBuildRootDirectory
</> prettyShow (distParamPlatform params)
</> prettyShow (distParamCompilerId params)
- </> prettyShow ((distParamPackageId params){pkgCompiler = Nothing})
+ </> prettyShow (distParamPackageId params)
</> ( case distParamComponentName params of
Nothing -> ""
Just (CLibName LMainLibName) -> ""
diff --git a/cabal-install/src/Distribution/Client/FetchUtils.hs b/cabal-install/src/Distribution/Client/FetchUtils.hs
index fd6dbe6553b..6b29dd84bfc 100644
--- a/cabal-install/src/Distribution/Client/FetchUtils.hs
+++ b/cabal-install/src/Distribution/Client/FetchUtils.hs
@@ -201,7 +201,7 @@ verifyFetchedTarball verbosity file mCallbacks pkgid =
let warnAndFail s = warn verbosity ("Fetched tarball " ++ file ++ " does not match server, will redownload: " ++ s) >> return False
in -- the do block in parens is due to dealing with the checked exceptions mechanism.
( do
- fileInfo <- Sec.indexLookupFileInfo callbacks (pkgid{pkgCompiler = Nothing})
+ fileInfo <- Sec.indexLookupFileInfo callbacks pkgid
sz <- Sec.FileLength . fromInteger <$> getFileSize file
if sz /= Sec.fileInfoLength (Sec.trusted fileInfo)
then warnAndFail "file length mismatch"
diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding.hs b/cabal-install/src/Distribution/Client/ProjectBuilding.hs
index 87e9167736d..c339d790880 100644
--- a/cabal-install/src/Distribution/Client/ProjectBuilding.hs
+++ b/cabal-install/src/Distribution/Client/ProjectBuilding.hs
@@ -718,7 +718,7 @@ withTarballLocalDirectory
verbosity
tarball
unpackdir
- pkgid{pkgCompiler = Nothing}
+ pkgid
pkgTextOverride
buildPkg srcdir builddir
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index 4c175ca020e..d3e417966c0 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -1211,7 +1211,7 @@ getPackageSourceHashes verbosity withRepoCtx solverPlan = do
--
let allPkgLocations :: [(PackageId, PackageLocation (Maybe FilePath))]
allPkgLocations =
- [ ((packageId pkg){pkgCompiler = Nothing}, srcpkgSource pkg)
+ [ (packageId pkg, srcpkgSource pkg)
| SolverInstallPlan.Configured (SolverPackage{solverPkgSource = pkg}) <-
SolverInstallPlan.toList solverPlan
]
@@ -1982,7 +1982,7 @@ elaborateInstallPlan
cid = case elabBuildStyle elab0 of
BuildInplaceOnly{} ->
mkComponentId $
- prettyShow (pkgid{pkgCompiler = Nothing})
+ prettyShow pkgid
++ "-inplace"
++ ( case Cabal.componentNameString cname of
Nothing -> ""
@@ -2215,7 +2215,7 @@ elaborateInstallPlan
pkgInstalledId
| shouldBuildInplaceOnly pkg =
- mkComponentId (prettyShow (pkgid{pkgCompiler = Nothing}) ++ "-inplace")
+ mkComponentId (prettyShow pkgid ++ "-inplace")
| otherwise =
assert (isJust elabPkgSourceHash) $
hashedInstalledPackageId
@@ -2226,7 +2226,7 @@ elaborateInstallPlan
-- Need to filter out internal dependencies, because they don't
-- correspond to anything real anymore.
- isExt confid = (confSrcId confid){pkgCompiler = Nothing} /= pkgid{pkgCompiler = Nothing}
+ isExt confid = confSrcId confid /= pkgid
filterExt = filter isExt
filterExt' :: [(ConfiguredId, a)] -> [(ConfiguredId, a)]
@@ -2367,7 +2367,7 @@ elaborateInstallPlan
else cp
elabPkgSourceLocation = srcloc
- elabPkgSourceHash = case Map.lookup (pkgid{pkgCompiler = Nothing}) sourcePackageHashes of
+ elabPkgSourceHash = case Map.lookup pkgid sourcePackageHashes of
Just h -> Just h
Nothing -> Nothing
elabLocalToProject = isLocalToProject pkg
From f140135758bafe9419b0acee200b895f38b692d0 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Fri, 4 Apr 2025 17:49:39 +0900
Subject: [PATCH 76/82] Update UnitId
This patch is quite raw.
- Effectively ComponentId and UnitId are very similar. I think UnitId should just be a newtype around ComponentId.
- We have Partial IDs, which should really be called Legacy, as they deal with non-compiler-prefixed ids.
- We need to modify the parsing of installed packages, to inject the compiler into unit-ids.
- We also need to modify parsing configure flags (--dependency=...) to ensure the ids are aligned.
Note: we need to support INTERNAL and EXTERNAL Setup.hs. (This shows up with --dependency=...) especially.
---
Cabal-syntax/src/Distribution/Backpack.hs | 10 ++-
.../src/Distribution/InstalledPackageInfo.hs | 18 +++--
.../src/Distribution/Types/ComponentId.hs | 43 +++++++++--
.../Types/InstalledPackageInfo.hs | 4 +-
.../InstalledPackageInfo/FieldGrammar.hs | 11 ++-
.../Types/InstalledPackageInfo/Lens.hs | 2 +-
.../src/Distribution/Types/PackageId.hs | 5 +-
Cabal-syntax/src/Distribution/Types/UnitId.hs | 75 ++++++++++++++++---
Cabal/src/Distribution/Backpack/Configure.hs | 62 +++++++--------
Cabal/src/Distribution/Simple/Configure.hs | 24 ++++--
Cabal/src/Distribution/Simple/Errors.hs | 4 +-
Cabal/src/Distribution/Simple/GHC.hs | 13 +++-
.../src/Distribution/Simple/Program/HcPkg.hs | 9 ++-
Cabal/src/Distribution/Simple/Register.hs | 5 +-
.../src/Distribution/Client/Errors.hs | 2 +-
.../src/Distribution/Client/PackageHash.hs | 12 ++-
.../Client/ProjectBuilding/UnpackedPackage.hs | 10 ++-
.../Distribution/Client/ProjectPlanning.hs | 32 +++++---
.../src/Distribution/Client/Store.hs | 16 ++--
19 files changed, 248 insertions(+), 109 deletions(-)
diff --git a/Cabal-syntax/src/Distribution/Backpack.hs b/Cabal-syntax/src/Distribution/Backpack.hs
index e70b9ffc692..048abdc0239 100644
--- a/Cabal-syntax/src/Distribution/Backpack.hs
+++ b/Cabal-syntax/src/Distribution/Backpack.hs
@@ -53,6 +53,10 @@ import Distribution.Utils.Base62
import qualified Data.Map as Map
import qualified Data.Set as Set
+import GHC.Stack (HasCallStack)
+
+import Unsafe.Coerce (unsafeCoerce)
+
-----------------------------------------------------------------------
-- OpenUnitId
@@ -147,9 +151,7 @@ mkOpenUnitId uid cid insts =
mkDefUnitId :: ComponentId -> Map ModuleName Module -> DefUnitId
mkDefUnitId cid insts =
unsafeMkDefUnitId
- ( mkUnitId
- (unComponentId cid ++ maybe "" ("+" ++) (hashModuleSubst insts))
- )
+ (addSuffixToUnitId (maybe "" ("+" ++) (hashModuleSubst insts)) (unsafeCoerce cid))
-- impose invariant!
@@ -254,7 +256,7 @@ openModuleSubstFreeHoles insts = Set.unions (map openModuleFreeHoles (Map.elems
-- | When typechecking, we don't demand that a freshly instantiated
-- 'IndefFullUnitId' be compiled; instead, we just depend on the
-- installed indefinite unit installed at the 'ComponentId'.
-abstractUnitId :: OpenUnitId -> UnitId
+abstractUnitId :: HasCallStack => OpenUnitId -> UnitId
abstractUnitId (DefiniteUnitId def_uid) = unDefUnitId def_uid
abstractUnitId (IndefFullUnitId cid _) = newSimpleUnitId cid
diff --git a/Cabal-syntax/src/Distribution/InstalledPackageInfo.hs b/Cabal-syntax/src/Distribution/InstalledPackageInfo.hs
index 2c15d678335..93000823a13 100644
--- a/Cabal-syntax/src/Distribution/InstalledPackageInfo.hs
+++ b/Cabal-syntax/src/Distribution/InstalledPackageInfo.hs
@@ -62,11 +62,15 @@ import qualified Text.PrettyPrint as Disp
import Distribution.Types.InstalledPackageInfo
import Distribution.Types.InstalledPackageInfo.FieldGrammar
-installedComponentId :: InstalledPackageInfo -> ComponentId
+import GHC.Stack (HasCallStack)
+
+import Unsafe.Coerce (unsafeCoerce)
+
+installedComponentId :: HasCallStack => InstalledPackageInfo -> ComponentId
installedComponentId ipi =
- case unComponentId (installedComponentId_ ipi) of
- "" -> mkComponentId (unUnitId (installedUnitId ipi))
- _ -> installedComponentId_ ipi
+ fromMaybe
+ (unsafeCoerce (installedUnitId ipi))
+ (installedComponentId_ ipi)
-- | Get the indefinite unit identity representing this package.
-- This IS NOT guaranteed to give you a substitution; for
@@ -117,12 +121,12 @@ parseInstalledPackageInfo s = case P.readFields s of
-- | Pretty print 'InstalledPackageInfo'.
--
-- @pkgRoot@ isn't printed, as ghc-pkg prints it manually (as GHC-8.4).
-showInstalledPackageInfo :: InstalledPackageInfo -> String
+showInstalledPackageInfo :: HasCallStack => InstalledPackageInfo -> String
showInstalledPackageInfo ipi =
showFullInstalledPackageInfo ipi{pkgRoot = Nothing}
-- | The variant of 'showInstalledPackageInfo' which outputs @pkgroot@ field too.
-showFullInstalledPackageInfo :: InstalledPackageInfo -> String
+showFullInstalledPackageInfo :: HasCallStack => InstalledPackageInfo -> String
showFullInstalledPackageInfo = P.showFields (const NoComment) . prettyFieldGrammar cabalSpecLatest ipiFieldGrammar
-- |
@@ -130,7 +134,7 @@ showFullInstalledPackageInfo = P.showFields (const NoComment) . prettyFieldGramm
-- >>> let ipi = emptyInstalledPackageInfo { maintainer = fromString "Tester" }
-- >>> fmap ($ ipi) $ showInstalledPackageInfoField "maintainer"
-- Just "maintainer: Tester"
-showInstalledPackageInfoField :: String -> Maybe (InstalledPackageInfo -> String)
+showInstalledPackageInfoField :: HasCallStack => String -> Maybe (InstalledPackageInfo -> String)
showInstalledPackageInfoField fn =
fmap (\g -> Disp.render . ppField fn . g) $ fieldDescrPretty ipiFieldGrammar (toUTF8BS fn)
diff --git a/Cabal-syntax/src/Distribution/Types/ComponentId.hs b/Cabal-syntax/src/Distribution/Types/ComponentId.hs
index fa770448363..03820ad0631 100644
--- a/Cabal-syntax/src/Distribution/Types/ComponentId.hs
+++ b/Cabal-syntax/src/Distribution/Types/ComponentId.hs
@@ -17,6 +17,7 @@ import Distribution.Pretty
import qualified Distribution.Compat.CharParsing as P
import Text.PrettyPrint (text)
+import GHC.Stack (HasCallStack)
-- | A 'ComponentId' uniquely identifies the transitive source
-- code closure of a component (i.e. libraries, executables).
--
@@ -30,8 +31,21 @@ import Text.PrettyPrint (text)
-- This type is opaque since @Cabal-2.0@
--
-- @since 2.0.0.2
-newtype ComponentId = ComponentId ShortText
- deriving (Generic, Read, Show, Eq, Ord, Data)
+data ComponentId = ComponentId ShortText ShortText Bool
+ | PartialComponentId ShortText
+ deriving (Generic, Read, Show, Data)
+
+instance Eq ComponentId where
+ (ComponentId c1 s1 _) == (ComponentId c2 s2 _) = c1 == c2 && s1 == s2
+ (PartialComponentId s1) == (PartialComponentId s2) = s1 == s2
+ _ == _ = False
+
+instance Ord ComponentId where
+ compare (ComponentId c1 s1 _) (ComponentId c2 s2 _) = compare (c1, s1) (c2, s2)
+ compare (PartialComponentId s1) (PartialComponentId s2) = compare s1 s2
+ compare (PartialComponentId _) _ = LT
+ compare _ (PartialComponentId _) = GT
+
-- | Construct a 'ComponentId' from a 'String'
--
@@ -41,14 +55,25 @@ newtype ComponentId = ComponentId ShortText
-- 'ComponentId' is valid
--
-- @since 2.0.0.2
-mkComponentId :: String -> ComponentId
-mkComponentId = ComponentId . toShortText
+mkComponentId :: HasCallStack => String -> ComponentId
+mkComponentId s = case (simpleParsec s) of
+ Just cid@ComponentId{} -> cid
+ Just cid@PartialComponentId{} -> error $ "mkPartialComponentId: `" ++ s ++ "' is a partial component id, not a full one."
+ _ -> error $ "Unable to parse PartialComponentId: `" ++ s ++ "'."
+
+mkComponentId' :: HasCallStack => String -> String -> Bool -> ComponentId
+mkComponentId' c i b = ComponentId (toShortText c) (toShortText i) b
+
+mkPartialComponentId :: HasCallStack => String -> ComponentId
+mkPartialComponentId s = PartialComponentId (toShortText s)
-- | Convert 'ComponentId' to 'String'
--
-- @since 2.0.0.2
-unComponentId :: ComponentId -> String
-unComponentId (ComponentId s) = fromShortText s
+unComponentId :: HasCallStack => ComponentId -> String
+unComponentId (ComponentId c s False) = fromShortText c ++ '_':fromShortText s
+unComponentId (ComponentId c s True) = fromShortText s
+unComponentId (PartialComponentId s) = fromShortText s
-- | 'mkComponentId'
--
@@ -63,8 +88,12 @@ instance Pretty ComponentId where
pretty = text . unComponentId
instance Parsec ComponentId where
- parsec = mkComponentId `fmap` P.munch1 abi_char
+ parsec = P.try (mkComponentId' <$> compid <* P.char '_' <*> P.munch1 abi_char <*> return False)
+ <|> mkPartialComponentId <$> P.munch1 abi_char
where
+ compid = (\f v -> f ++ "-" ++ v) <$> P.munch1 isAlpha <* P.char '-' <*> P.munch1 isVerChar
+ isVerChar :: Char -> Bool
+ isVerChar c = c `elem` '.':['0'..'9']
abi_char c = isAlphaNum c || c `elem` "-_."
instance NFData ComponentId where
diff --git a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs
index ee1dfca5888..e5733d158a4 100644
--- a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs
+++ b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs
@@ -42,7 +42,7 @@ data InstalledPackageInfo = InstalledPackageInfo
-- exactly the same as PackageDescription
sourcePackageId :: PackageId
, sourceLibName :: LibraryName
- , installedComponentId_ :: ComponentId
+ , installedComponentId_ :: Maybe ComponentId
, libVisibility :: LibraryVisibility
, installedUnitId :: UnitId
, -- INVARIANT: if this package is definite, OpenModule's
@@ -134,7 +134,7 @@ emptyInstalledPackageInfo =
InstalledPackageInfo
{ sourcePackageId = PackageIdentifier (mkPackageName "") nullVersion Nothing
, sourceLibName = LMainLibName
- , installedComponentId_ = mkComponentId ""
+ , installedComponentId_ = Nothing
, installedUnitId = mkUnitId ""
, instantiatedWith = []
, compatPackageKey = ""
diff --git a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs
index 151aaf4b119..b6be432a6ff 100644
--- a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs
+++ b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs
@@ -40,6 +40,8 @@ import Distribution.Types.InstalledPackageInfo
import qualified Distribution.Types.InstalledPackageInfo.Lens as L
import qualified Distribution.Types.PackageId.Lens as L hiding (pkgCompiler)
+import GHC.Stack (HasCallStack)
+
-- Note: GHC goes nuts and inlines everything,
-- One can see e.g. in -ddump-simpl-stats:
--
@@ -75,7 +77,7 @@ ipiFieldGrammar
, c InstWith
, c SpecLicenseLenient
, c (Identity (Maybe CompilerId))
- )
+ , HasCallStack )
=> g InstalledPackageInfo InstalledPackageInfo
ipiFieldGrammar =
mkInstalledPackageInfo
@@ -86,7 +88,10 @@ ipiFieldGrammar =
-- Very basic fields: name, version, package-name, lib-name and visibility
<@> blurFieldGrammar basic basicFieldGrammar
-- Basic fields
- <@> optionalFieldDef "id" L.installedUnitId (mkUnitId "")
+ -- [note: forced default values]
+ -- Observe optionalFieldDef fn l x = optionalFieldDefAla fn Identity l x
+ -- and optionalFieldDefAla will force x.
+ <@> optionalFieldDef "id" L.installedUnitId (mkUnitId "invalid-invalid")
<@> optionalFieldDefAla "instantiated-with" InstWith L.instantiatedWith []
<@> optionalFieldDefAla "key" CompatPackageKey L.compatPackageKey ""
<@> optionalFieldDefAla "license" SpecLicenseLenient L.license (Left SPDX.NONE)
@@ -135,7 +140,7 @@ ipiFieldGrammar =
-- setMaybePackageId says it can be no-op.
(PackageIdentifier pn _basicVersion _basicCompilerId)
(combineLibraryName ln _basicLibName)
- (mkComponentId "") -- installedComponentId_, not in use
+ Nothing
_basicLibVisibility
where
MungedPackageName pn ln = _basicName
diff --git a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/Lens.hs b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/Lens.hs
index 9e7798e443d..c34e885fa01 100644
--- a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/Lens.hs
+++ b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/Lens.hs
@@ -28,7 +28,7 @@ installedUnitId :: Lens' InstalledPackageInfo UnitId
installedUnitId f s = fmap (\x -> s{T.installedUnitId = x}) (f (T.installedUnitId s))
{-# INLINE installedUnitId #-}
-installedComponentId_ :: Lens' InstalledPackageInfo ComponentId
+installedComponentId_ :: Lens' InstalledPackageInfo (Maybe ComponentId)
installedComponentId_ f s = fmap (\x -> s{T.installedComponentId_ = x}) (f (T.installedComponentId_ s))
{-# INLINE installedComponentId_ #-}
diff --git a/Cabal-syntax/src/Distribution/Types/PackageId.hs b/Cabal-syntax/src/Distribution/Types/PackageId.hs
index 486df97a146..bc366716216 100644
--- a/Cabal-syntax/src/Distribution/Types/PackageId.hs
+++ b/Cabal-syntax/src/Distribution/Types/PackageId.hs
@@ -38,8 +38,9 @@ instance Structured PackageIdentifier
instance Pretty PackageIdentifier where
pretty (PackageIdentifier n v c)
- | Just c' <- c, v == nullVersion = pretty c <<>> Disp.char ':' <<>> pretty n -- if no version, don't show version.
- | Just c' <- c = pretty c' <<>> Disp.char ':' <<>> pretty n <<>> Disp.char '-' <<>> pretty v
+ -- we must never print the compiler, as other tools like hackage-security rely on the Pretty instance
+ -- | Just c' <- c, v == nullVersion = pretty c <<>> Disp.char ':' <<>> pretty n -- if no version, don't show version.
+ -- | Just c' <- c = pretty c' <<>> Disp.char ':' <<>> pretty n <<>> Disp.char '-' <<>> pretty v
| v == nullVersion = pretty n
| otherwise = pretty n <<>> Disp.char '-' <<>> pretty v
diff --git a/Cabal-syntax/src/Distribution/Types/UnitId.hs b/Cabal-syntax/src/Distribution/Types/UnitId.hs
index 0b5ca4bdf7b..d6a403a04c9 100644
--- a/Cabal-syntax/src/Distribution/Types/UnitId.hs
+++ b/Cabal-syntax/src/Distribution/Types/UnitId.hs
@@ -7,6 +7,9 @@ module Distribution.Types.UnitId
( UnitId
, unUnitId
, mkUnitId
+ , isPartialUnitId
+ , addPrefixToUnitId
+ , addSuffixToUnitId
, DefUnitId
, unsafeMkDefUnitId
, unDefUnitId
@@ -27,6 +30,11 @@ import Distribution.Types.PackageId
import Text.PrettyPrint (text)
+import GHC.Stack (HasCallStack)
+import Data.List (isInfixOf)
+
+import Unsafe.Coerce (unsafeCoerce)
+
-- | A unit identifier identifies a (possibly instantiated)
-- package/component that can be installed the installed package
-- database. There are several types of components that can be
@@ -63,11 +71,24 @@ import Text.PrettyPrint (text)
-- representation of a UnitId to pass, e.g., as a @-package-id@
-- flag, use the 'display' function, which will work on all
-- versions of Cabal.
-newtype UnitId = UnitId ShortText
- deriving (Generic, Read, Show, Eq, Ord, Data, NFData)
+data UnitId = UnitId ShortText ShortText Bool
+ | PartialUnitId ShortText
+ deriving (Generic, Read, Show, Data)
+
+instance Eq UnitId where
+ (UnitId c1 s1 _) == (UnitId c2 s2 _) = c1 == c2 && s1 == s2
+ (PartialUnitId s1) == (PartialUnitId s2) = s1 == s2
+ _ == _ = False
+
+instance Ord UnitId where
+ compare (UnitId c1 s1 _) (UnitId c2 s2 _) = compare (c1, s1) (c2, s2)
+ compare (PartialUnitId s1) (PartialUnitId s2) = compare s1 s2
+ compare (PartialUnitId _) _ = LT
+ compare _ (PartialUnitId _) = GT
instance Binary UnitId
instance Structured UnitId
+instance NFData UnitId
-- | The textual format for 'UnitId' coincides with the format
-- GHC accepts for @-package-id@.
@@ -77,8 +98,12 @@ instance Pretty UnitId where
-- | The textual format for 'UnitId' coincides with the format
-- GHC accepts for @-package-id@.
instance Parsec UnitId where
- parsec = mkUnitId <$> P.munch1 isUnitChar
+ parsec = P.try (mkUnitId' <$> compid <* P.char '_' <*> P.munch1 isUnitChar <*> return False)
+ <|> (mkPartialUnitId <$> P.munch1 isUnitChar)
where
+ compid = (\f v -> f ++ "-" ++ v) <$> P.munch1 isAlpha <* P.char '-' <*> P.munch1 isVerChar
+ isVerChar :: Char -> Bool
+ isVerChar c = c `elem` '.':['0'..'9']
-- https://gitlab.haskell.org/ghc/ghc/issues/17752
isUnitChar '-' = True
isUnitChar '_' = True
@@ -86,13 +111,41 @@ instance Parsec UnitId where
isUnitChar '+' = True
isUnitChar c = isAlphaNum c
+isPartialUnitId :: HasCallStack => UnitId -> Bool
+isPartialUnitId (PartialUnitId _) = True
+isPartialUnitId _ = False
+
+addPrefixToUnitId :: HasCallStack => String -> UnitId -> UnitId
+addPrefixToUnitId prefix (PartialUnitId s) = UnitId (toShortText prefix) s True
+addPrefixToUnitId prefix uid@(UnitId _ _ _) = error $ "addPrefixToUnitId: UnitId " ++ show uid ++ " already has a prefix; can't add: " ++ prefix
+
+addSuffixToUnitId :: HasCallStack => String -> UnitId -> UnitId
+addSuffixToUnitId suffix (UnitId c s fromPartial) = UnitId c (s <> toShortText suffix) fromPartial
+addSuffixToUnitId suffix (PartialUnitId s) = PartialUnitId (s <> toShortText suffix)
+
+
+dropPrefixFromUnitId :: HasCallStack => UnitId -> UnitId
+dropPrefixFromUnitId (PartialUnitId s) = PartialUnitId s
+dropPrefixFromUnitId (UnitId _c s _fromPartial) = PartialUnitId s
+
-- | If you need backwards compatibility, consider using 'display'
-- instead, which is supported by all versions of Cabal.
-unUnitId :: UnitId -> String
-unUnitId (UnitId s) = fromShortText s
+unUnitId :: HasCallStack => UnitId -> String
+unUnitId (UnitId c s False) = fromShortText c ++ '_':fromShortText s
+unUnitId (UnitId c s True) = fromShortText s
+unUnitId (PartialUnitId s) = fromShortText s
+
+mkUnitId :: HasCallStack => String -> UnitId
+mkUnitId s = case (simpleParsec s) of
+ Just uid@UnitId{} -> uid
+ Just uid@PartialUnitId{} -> uid -- error $ "mkUnitId: `" ++ s ++ "' is a partial unit id, not a full one."
+ _ -> error $ "Unable to parse UnitId: `" ++ s ++ "'."
+
+mkUnitId' :: HasCallStack => String -> String -> Bool -> UnitId
+mkUnitId' c i b = UnitId (toShortText c) (toShortText i) b
-mkUnitId :: String -> UnitId
-mkUnitId = UnitId . toShortText
+mkPartialUnitId :: HasCallStack => String -> UnitId
+mkPartialUnitId s = PartialUnitId (toShortText s)
-- | 'mkUnitId'
--
@@ -102,17 +155,17 @@ instance IsString UnitId where
-- | Create a unit identity with no associated hash directly
-- from a 'ComponentId'.
-newSimpleUnitId :: ComponentId -> UnitId
-newSimpleUnitId = mkUnitId . unComponentId
+newSimpleUnitId :: HasCallStack => ComponentId -> UnitId
+newSimpleUnitId = unsafeCoerce
-- | Make an old-style UnitId from a package identifier.
-- Assumed to be for the public library
-mkLegacyUnitId :: PackageId -> UnitId
+mkLegacyUnitId :: HasCallStack => PackageId -> UnitId
mkLegacyUnitId = newSimpleUnitId . mkComponentId . prettyShow
-- | Returns library name prefixed with HS, suitable for filenames
getHSLibraryName :: UnitId -> String
-getHSLibraryName uid = "HS" ++ prettyShow uid
+getHSLibraryName uid = "HS" ++ prettyShow (dropPrefixFromUnitId uid)
-- | A 'UnitId' for a definite package. The 'DefUnitId' invariant says
-- that a 'UnitId' identified this way is definite; i.e., it has no
diff --git a/Cabal/src/Distribution/Backpack/Configure.hs b/Cabal/src/Distribution/Backpack/Configure.hs
index d4c00b75c7b..41bf7929bc3 100644
--- a/Cabal/src/Distribution/Backpack/Configure.hs
+++ b/Cabal/src/Distribution/Backpack/Configure.hs
@@ -56,6 +56,8 @@ import qualified Data.Set as Set
import Distribution.Pretty
import Text.PrettyPrint
+import Unsafe.Coerce (unsafeCoerce)
+
------------------------------------------------------------------------------
-- Pipeline
------------------------------------------------------------------------------
@@ -144,7 +146,7 @@ configureComponentLocalBuildInfos
,
( DefiniteUnitId
( unsafeMkDefUnitId
- (mkUnitId (unComponentId (ann_id aid)))
+ (unsafeCoerce (ann_id aid))
)
, emptyModuleShape
)
@@ -303,35 +305,35 @@ toComponentLocalBuildInfos
-- TODO: Move this into a helper function
--
-- TODO: This is probably wrong for Backpack
- let pseudoTopPkg :: InstalledPackageInfo
- pseudoTopPkg =
- emptyInstalledPackageInfo
- { Installed.installedUnitId = mkLegacyUnitId (packageId pkg_descr)
- , Installed.sourcePackageId = packageId pkg_descr
- , Installed.depends = map pc_uid externalPkgDeps
- }
- case PackageIndex.dependencyInconsistencies
- . PackageIndex.insert pseudoTopPkg
- $ packageDependsIndex of
- [] -> return ()
- inconsistencies ->
- warnProgress $
- hang
- ( text "This package indirectly depends on multiple versions of the same"
- <+> text "package. This is very likely to cause a compile failure."
- )
- 2
- ( vcat
- [ text "package"
- <+> pretty (packageName user)
- <+> parens (pretty (installedUnitId user))
- <+> text "requires"
- <+> pretty inst
- | (_dep_key, insts) <- inconsistencies
- , (inst, users) <- insts
- , user <- users
- ]
- )
+ -- let pseudoTopPkg :: InstalledPackageInfo
+ -- pseudoTopPkg =
+ -- emptyInstalledPackageInfo
+ -- { Installed.installedUnitId = mkLegacyUnitId (packageId pkg_descr)
+ -- , Installed.sourcePackageId = packageId pkg_descr
+ -- , Installed.depends = map pc_uid externalPkgDeps
+ -- }
+ -- case PackageIndex.dependencyInconsistencies
+ -- . PackageIndex.insert pseudoTopPkg
+ -- $ packageDependsIndex of
+ -- [] -> return ()
+ -- inconsistencies ->
+ -- warnProgress $
+ -- hang
+ -- ( text "This package indirectly depends on multiple versions of the same"
+ -- <+> text "package. This is very likely to cause a compile failure."
+ -- )
+ -- 2
+ -- ( vcat
+ -- [ text "package"
+ -- <+> pretty (packageName user)
+ -- <+> parens (pretty (installedUnitId user))
+ -- <+> text "requires"
+ -- <+> pretty inst
+ -- | (_dep_key, insts) <- inconsistencies
+ -- , (inst, users) <- insts
+ -- , user <- users
+ -- ]
+ -- )
let clbis = mkLinkedComponentsLocalBuildInfo comp graph
-- forM clbis $ \(clbi,deps) -> info verbosity $ "UNIT" ++ hashUnitId (componentUnitId clbi) ++ "\n" ++ intercalate "\n" (map hashUnitId deps)
return (clbis, packageDependsIndex)
diff --git a/Cabal/src/Distribution/Simple/Configure.hs b/Cabal/src/Distribution/Simple/Configure.hs
index a76b4359bc9..44bce682c5f 100644
--- a/Cabal/src/Distribution/Simple/Configure.hs
+++ b/Cabal/src/Distribution/Simple/Configure.hs
@@ -183,6 +183,10 @@ import qualified Data.Maybe as M
import qualified Data.Set as Set
import qualified Distribution.Compat.NonEmptySet as NES
+import GHC.Stack (HasCallStack)
+
+import Unsafe.Coerce (unsafeCoerce)
+
type UseExternalInternalDeps = Bool
-- | The errors that can be thrown when reading the @setup-config@ file.
@@ -937,7 +941,8 @@ configurePackage cfg lbc0 pkg_descr00 flags enabled comp platform programDb0 pac
return (lbc, pbd)
finalizeAndConfigurePackage
- :: ConfigFlags
+ :: HasCallStack
+ => ConfigFlags
-> LBC.LocalBuildConfig
-> GenericPackageDescription
-> Compiler
@@ -992,9 +997,17 @@ finalizeAndConfigurePackage cfg lbc0 g_pkg_descr comp platform enabled = do
, requiredDepsMap :: Map (PackageName, ComponentName) InstalledPackageInfo
) <-
either (dieWithException verbosity) return $
- combinedConstraints
+ -- why do we need this? We internally now treat everything as properly
+ -- qualified Component/UnitIds. Thus we need to turn Partial ones into
+ -- fully qualified ones. Otherwise any lookup internally will fail.
+ -- installedPackageSet will already contain properly qualified ones.
+ let updCompId :: GivenComponent -> GivenComponent
+ updCompId (GivenComponent pn ln cid) | isPartialUnitId (unsafeCoerce cid) =
+ GivenComponent pn ln (unsafeCoerce (addPrefixToUnitId (prettyShow (compilerId comp)) (unsafeCoerce cid)))
+ updCompId (GivenComponent pn ln cid) = GivenComponent pn ln cid
+ in combinedConstraints
(configConstraints cfg)
- (configDependencies cfg)
+ (map updCompId (configDependencies cfg))
installedPackageSet
let
@@ -2185,7 +2198,8 @@ interpretPackageDbFlags userInstall specificDBs =
-- deps in the end. So we still need to remember which installed packages to
-- pick.
combinedConstraints
- :: [PackageVersionConstraint]
+ :: HasCallStack
+ => [PackageVersionConstraint]
-> [GivenComponent]
-- ^ installed dependencies
-> InstalledPackageIndex
@@ -2220,7 +2234,7 @@ combinedConstraints constraints dependencies installedPackages = do
]
-- The dependencies along with the installed package info, if it exists
- dependenciesPkgInfo :: [(PackageName, ComponentName, ComponentId, Maybe InstalledPackageInfo)]
+ dependenciesPkgInfo :: HasCallStack => [(PackageName, ComponentName, ComponentId, Maybe InstalledPackageInfo)]
dependenciesPkgInfo =
[ (pkgname, CLibName lname, cid, mpkg)
| GivenComponent pkgname lname cid <- dependencies
diff --git a/Cabal/src/Distribution/Simple/Errors.hs b/Cabal/src/Distribution/Simple/Errors.hs
index 1ce4f7ca06a..0d9062cbe08 100644
--- a/Cabal/src/Distribution/Simple/Errors.hs
+++ b/Cabal/src/Distribution/Simple/Errors.hs
@@ -60,7 +60,7 @@ data CabalException
| OnlySupportSpecificPackageDb
| FailedToParseOutputDescribe String PackageId
| DumpFailed String String
- | FailedToParseOutputDump String
+ | FailedToParseOutputDump String String
| ListFailed String
| FailedToParseOutputList String
| ProgramNotFound String
@@ -336,7 +336,7 @@ exceptionMessage e = case e of
OnlySupportSpecificPackageDb -> "HcPkg.writeRegistrationFileDirectly: only supports SpecificPackageDB for now"
FailedToParseOutputDescribe programId pkgId -> "failed to parse output of '" ++ programId ++ " describe " ++ prettyShow pkgId ++ "'"
DumpFailed programId exception -> programId ++ " dump failed: " ++ exception
- FailedToParseOutputDump programId -> "failed to parse output of '" ++ programId ++ " dump'"
+ FailedToParseOutputDump programId err -> "failed to parse output of '" ++ programId ++ " dump': " ++ err
ListFailed programId -> programId ++ " list failed"
FailedToParseOutputList programId -> "failed to parse output of '" ++ programId ++ " list'"
ProgramNotFound progName -> "The program '" ++ progName ++ "' is required but it could not be found"
diff --git a/Cabal/src/Distribution/Simple/GHC.hs b/Cabal/src/Distribution/Simple/GHC.hs
index 8a7bad44b38..427d605949d 100644
--- a/Cabal/src/Distribution/Simple/GHC.hs
+++ b/Cabal/src/Distribution/Simple/GHC.hs
@@ -421,13 +421,22 @@ getInstalledPackages verbosity comp mbWorkDir packagedbs progdb = do
checkPackageDbEnvVar verbosity
checkPackageDbStack verbosity comp packagedbs
pkgss <- getInstalledPackages' verbosity mbWorkDir packagedbs progdb
- let pkgss' = [ (packagedb, (\pkg -> pkg{ InstalledPackageInfo.pkgCompiler = Just (compilerId comp) })
- <$> pkgs)
+ let pkgss' = [ (packagedb, updDependsUnitIds . updUnitId . setPkgCompiler <$> pkgs)
| (packagedb, pkgs) <- pkgss
]
index <- toPackageIndex verbosity pkgss' progdb
return $! hackRtsPackage index
where
+ setPkgCompiler pkg = pkg{ InstalledPackageInfo.pkgCompiler = Just (compilerId comp) }
+ updUnitId pkg | isPartialUnitId (installedUnitId pkg) =
+ pkg { InstalledPackageInfo.installedUnitId =
+ addPrefixToUnitId (prettyShow (compilerId comp)) (InstalledPackageInfo.installedUnitId pkg)
+ }
+ updUnitId pkg = pkg
+ updDependsUnitIds pkg =
+ pkg { InstalledPackageInfo.depends =
+ map (\x -> if isPartialUnitId x then addPrefixToUnitId (prettyShow (compilerId comp)) x else x) (InstalledPackageInfo.depends pkg)
+ }
hackRtsPackage index =
case PackageIndex.lookupPackageName index (mkPackageName "rts") of
[(_, [rts])] ->
diff --git a/Cabal/src/Distribution/Simple/Program/HcPkg.hs b/Cabal/src/Distribution/Simple/Program/HcPkg.hs
index a494bc63f02..024d21542f6 100644
--- a/Cabal/src/Distribution/Simple/Program/HcPkg.hs
+++ b/Cabal/src/Distribution/Simple/Program/HcPkg.hs
@@ -74,6 +74,7 @@ import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.List.NonEmpty as NE
import qualified System.FilePath.Posix as FilePath.Posix
+import GHC.Stack (HasCallStack)
-- | Information about the features and capabilities of an @hc-pkg@
-- program.
@@ -292,9 +293,9 @@ dump hpi verbosity mbWorkDir packagedb = do
case parsePackages output of
Left ok -> return ok
- _ -> dieWithException verbosity $ FailedToParseOutputDump (programId (hcPkgProgram hpi))
+ Right e -> dieWithException verbosity $ FailedToParseOutputDump (programId (hcPkgProgram hpi)) (unwords e)
-parsePackages :: LBS.ByteString -> Either [InstalledPackageInfo] [String]
+parsePackages :: HasCallStack => LBS.ByteString -> Either [InstalledPackageInfo] [String]
parsePackages lbs0 =
case traverse parseInstalledPackageInfo $ splitPkgs lbs0 of
Right ok -> Left [setUnitId . maybe id mungePackagePaths (pkgRoot pkg) $ pkg | (_, pkg) <- ok]
@@ -380,7 +381,7 @@ mungePackagePaths pkgroot pkginfo =
-- Older installed package info files did not have the installedUnitId
-- field, so if it is missing then we fill it as the source package ID.
-- NB: Internal libraries not supported.
-setUnitId :: InstalledPackageInfo -> InstalledPackageInfo
+setUnitId :: HasCallStack => InstalledPackageInfo -> InstalledPackageInfo
setUnitId
pkginfo@InstalledPackageInfo
{ installedUnitId = uid
@@ -389,7 +390,7 @@ setUnitId
| unUnitId uid == "" =
pkginfo
{ installedUnitId = mkLegacyUnitId pid
- , installedComponentId_ = mkComponentId (prettyShow pid)
+ , installedComponentId_ = Just (mkComponentId (prettyShow pid))
}
setUnitId pkginfo = pkginfo
diff --git a/Cabal/src/Distribution/Simple/Register.hs b/Cabal/src/Distribution/Simple/Register.hs
index f5078f69f3d..10ea7f0e94e 100644
--- a/Cabal/src/Distribution/Simple/Register.hs
+++ b/Cabal/src/Distribution/Simple/Register.hs
@@ -90,6 +90,7 @@ import System.FilePath (isAbsolute)
import qualified Data.ByteString.Lazy.Char8 as BS.Char8
+import GHC.Stack (HasCallStack)
-- -----------------------------------------------------------------------------
-- Registration
@@ -163,7 +164,7 @@ generateOne pkg lib lbi clbi regFlags =
mbWorkDir = flagToMaybe $ setupWorkingDir common
registerAll
- :: PackageDescription
+ :: HasCallStack => PackageDescription
-> LocalBuildInfo
-> RegisterFlags
-> [InstalledPackageInfo]
@@ -496,7 +497,7 @@ generalInstalledPackageInfo adjustRelIncDirs pkg abi_hash lib lbi clbi installDi
IPI.InstalledPackageInfo
{ IPI.sourcePackageId = packageId pkg
, IPI.installedUnitId = componentUnitId clbi
- , IPI.installedComponentId_ = componentComponentId clbi
+ , IPI.installedComponentId_ = Just (componentComponentId clbi)
, IPI.instantiatedWith = expectLibraryComponent (maybeComponentInstantiatedWith clbi)
, IPI.sourceLibName = libName lib
, IPI.compatPackageKey = expectLibraryComponent (maybeComponentCompatPackageKey clbi)
diff --git a/cabal-install/src/Distribution/Client/Errors.hs b/cabal-install/src/Distribution/Client/Errors.hs
index 493ce2fc98b..9d750b1548d 100644
--- a/cabal-install/src/Distribution/Client/Errors.hs
+++ b/cabal-install/src/Distribution/Client/Errors.hs
@@ -385,7 +385,7 @@ exceptionMessageCabalInstall e = case e of
FindOpenProgramLocationErr err -> err
PkgConfParseFailed perror ->
"Couldn't parse the output of 'setup register --gen-pkg-config':"
- ++ show perror
+ ++ perror
ErrorPackingSdist err -> "Error packing sdist: " ++ err
SdistException pkgIdentifier -> "sdist of " ++ prettyShow pkgIdentifier
SpecifyAnExecutable -> "Please specify an executable to run"
diff --git a/cabal-install/src/Distribution/Client/PackageHash.hs b/cabal-install/src/Distribution/Client/PackageHash.hs
index d99fc9ad250..0fa147669d9 100644
--- a/cabal-install/src/Distribution/Client/PackageHash.hs
+++ b/cabal-install/src/Distribution/Client/PackageHash.hs
@@ -66,6 +66,8 @@ import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Data.Map as Map
import qualified Data.Set as Set
+import GHC.Stack (HasCallStack)
+
-------------------------------
-- Calculating package hashes
--
@@ -76,7 +78,7 @@ import qualified Data.Set as Set
-- Note that due to path length limitations on Windows, this function uses
-- a different method on Windows that produces shorted package ids.
-- See 'hashedInstalledPackageIdLong' vs 'hashedInstalledPackageIdShort'.
-hashedInstalledPackageId :: PackageHashInputs -> InstalledPackageId
+hashedInstalledPackageId :: HasCallStack => PackageHashInputs -> InstalledPackageId
hashedInstalledPackageId
| buildOS == Windows = hashedInstalledPackageIdShort
| buildOS == OSX = hashedInstalledPackageIdVeryShort
@@ -122,7 +124,7 @@ hashedInstalledPackageIdLong
-- Truncating the hash size is disappointing but also technically ok. We
-- rely on the hash primarily for collision avoidance not for any security
-- properties (at least for now).
-hashedInstalledPackageIdShort :: PackageHashInputs -> InstalledPackageId
+hashedInstalledPackageIdShort :: HasCallStack => PackageHashInputs -> InstalledPackageId
hashedInstalledPackageIdShort pkghashinputs@PackageHashInputs{pkgHashPkgId} =
mkComponentId $
intercalate
@@ -162,10 +164,12 @@ hashedInstalledPackageIdShort pkghashinputs@PackageHashInputs{pkgHashPkgId} =
-- libraries on macOS, such that the proxy libraries and the linked libraries
-- stay under the load command limit, and the recursive linker is still able
-- to link all of them.
-hashedInstalledPackageIdVeryShort :: PackageHashInputs -> InstalledPackageId
+hashedInstalledPackageIdVeryShort :: HasCallStack => PackageHashInputs -> InstalledPackageId
hashedInstalledPackageIdVeryShort pkghashinputs@PackageHashInputs{pkgHashPkgId} =
mkComponentId $
- intercalate
+ prettyShow (pkgHashCompilerId . pkgHashOtherConfig $ pkghashinputs)
+ ++
+ '_':intercalate
"-"
[ prettyShow name
, prettyShow version
diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs b/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs
index 1a1e286596b..8fd229b61fa 100644
--- a/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs
+++ b/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs
@@ -120,6 +120,8 @@ import Distribution.Compat.Directory (listDirectory)
import Distribution.Client.ProjectBuilding.PackageFileMonitor
+import GHC.Stack (HasCallStack)
+
-- | Each unpacked package is processed in the following phases:
--
-- * Configure phase
@@ -995,7 +997,7 @@ hasValidHaddockTargets ElaboratedConfiguredPackage{..}
hasHaddocks = not (null (elabPkgDescription ^. componentModules name))
withTempInstalledPackageInfoFile
- :: Verbosity
+ :: HasCallStack => Verbosity
-> FilePath
-> (FilePath -> IO ())
-> IO InstalledPackageInfo
@@ -1009,15 +1011,15 @@ withTempInstalledPackageInfoFile verbosity tempdir action =
readPkgConf "." pkgConfDest
where
- pkgConfParseFailed :: String -> IO a
+ pkgConfParseFailed :: HasCallStack => String -> IO a
pkgConfParseFailed perror =
dieWithException verbosity $ PkgConfParseFailed perror
- readPkgConf :: FilePath -> FilePath -> IO InstalledPackageInfo
+ readPkgConf :: HasCallStack => FilePath -> FilePath -> IO InstalledPackageInfo
readPkgConf pkgConfDir pkgConfFile = do
pkgConfStr <- BS.readFile (pkgConfDir </> pkgConfFile)
(warns, ipkg) <- case Installed.parseInstalledPackageInfo pkgConfStr of
- Left perrors -> pkgConfParseFailed $ unlines $ NE.toList perrors
+ Left perrors -> pkgConfParseFailed $ unlines $ "While parsing:":LBS.Char8.unpack (LBS.Char8.fromStrict pkgConfStr):"encountered:":NE.toList perrors
Right (warns, ipkg) -> return (warns, ipkg)
unless (null warns) $
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index d3e417966c0..8df269624f4 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -855,11 +855,11 @@ rebuildInstallPlan
liftIO $ do
notice verbosity "Resolving dependencies..."
-- putStrLn "== installedPackages"
- -- putStrLn $ unlines $ map (prettyShow . IPI.sourcePackageId) $ PI.allPackages installedPackages
+ -- putStrLn $ unlines $ map (prettyShow . IPI.installedUnitId) $ PI.allPackages installedPackages
-- putStrLn "== binstalledPackages"
- -- putStrLn $ unlines $ map (prettyShow . IPI.sourcePackageId) $ PI.allPackages binstalledPkgIndex
+ -- putStrLn $ unlines $ map (prettyShow . IPI.installedUnitId) $ PI.allPackages binstalledPkgIndex
-- putStrLn "== hinstalledPackages"
- -- putStrLn $ unlines $ map (prettyShow . IPI.sourcePackageId) $ PI.allPackages hinstalledPkgIndex
+ -- putStrLn $ unlines $ map (prettyShow . IPI.installedUnitId) $ PI.allPackages hinstalledPkgIndex
-- putStrLn "== localPackages"
-- putStrLn $ unlines . map (prettyShow . srcpkgPackageId) $ [pkg | SpecificSourcePackage pkg <- localPackages]
-- putStrLn $ unlines . take 20 $ map (prettyShow . srcpkgPackageId) (XXX.allPackages (packageIndex sourcePkgDb))
@@ -1701,7 +1701,7 @@ planPackages
-- In theory should be able to make an elaborated install plan with a policy
-- matching that of the classic @cabal install --user@ or @--global@
elaborateInstallPlan
- :: Verbosity
+ :: HasCallStack => Verbosity
-> Map FilePath HookAccept
-> Toolchains
-> Maybe PkgConfigDb
@@ -1758,7 +1758,7 @@ elaborateInstallPlan
f _ = Nothing
elaboratedInstallPlan
- :: LogProgress (InstallPlan.GenericInstallPlan IPI.InstalledPackageInfo ElaboratedConfiguredPackage)
+ :: HasCallStack => LogProgress (InstallPlan.GenericInstallPlan IPI.InstalledPackageInfo ElaboratedConfiguredPackage)
elaboratedInstallPlan =
flip InstallPlan.fromSolverInstallPlanWithProgress solverPlan $ \mapDep planpkg ->
case planpkg of
@@ -1779,7 +1779,7 @@ elaborateInstallPlan
-- NB: We don't INSTANTIATE packages at this point. That's
-- a post-pass. This makes it simpler to compute dependencies.
elaborateSolverToComponents
- :: (SolverId -> [ElaboratedPlanPackage])
+ :: HasCallStack => (SolverId -> [ElaboratedPlanPackage])
-> SolverPackage UnresolvedPkgLoc
-> LogProgress [ElaboratedConfiguredPackage]
elaborateSolverToComponents mapDep spkg@(SolverPackage _qpn _stage _ _ _ deps0 exe_deps0) =
@@ -1922,7 +1922,7 @@ elaborateInstallPlan
++ " not implemented yet"
buildComponent
- :: ( ConfiguredComponentMap
+ :: HasCallStack => ( ConfiguredComponentMap
, LinkedComponentMap
, Map ComponentId FilePath
)
@@ -1979,10 +1979,14 @@ elaborateInstallPlan
elab0
{ elabPkgOrComp = ElabComponent $ elab_comp
}
+ elabCompiler = toolchainCompiler (toolchainFor (elabStage elab0) toolchains)
+
cid = case elabBuildStyle elab0 of
BuildInplaceOnly{} ->
mkComponentId $
- prettyShow pkgid
+ prettyShow (compilerId elabCompiler)
+ ++
+ '_':prettyShow pkgid
++ "-inplace"
++ ( case Cabal.componentNameString cname of
Nothing -> ""
@@ -2213,9 +2217,13 @@ elaborateInstallPlan
Nothing -> emptyModuleShape
Just e -> Ty.elabModuleShape e
+ elabCompiler = toolchainCompiler (toolchainFor elabStage toolchains)
+
pkgInstalledId
- | shouldBuildInplaceOnly pkg =
- mkComponentId (prettyShow pkgid ++ "-inplace")
+ | shouldBuildInplaceOnly pkg = mkComponentId $
+ prettyShow (compilerId elabCompiler)
+ ++
+ '_':prettyShow pkgid ++ "-inplace"
| otherwise =
assert (isJust elabPkgSourceHash) $
hashedInstalledPackageId
@@ -2226,7 +2234,7 @@ elaborateInstallPlan
-- Need to filter out internal dependencies, because they don't
-- correspond to anything real anymore.
- isExt confid = confSrcId confid /= pkgid
+ isExt confid = (confSrcId confid){pkgCompiler = Nothing} /= pkgid{pkgCompiler = Nothing}
filterExt = filter isExt
filterExt' :: [(ConfiguredId, a)] -> [(ConfiguredId, a)]
@@ -2765,7 +2773,7 @@ matchElabPkg p elab =
-- and 'ComponentName' to the 'ComponentId' that should be used
-- in this case.
mkCCMapping
- :: ElaboratedPlanPackage
+ :: HasCallStack => ElaboratedPlanPackage
-> (PackageName, Map ComponentName (AnnotatedId ComponentId))
mkCCMapping =
InstallPlan.foldPlanPackage
diff --git a/cabal-install/src/Distribution/Client/Store.hs b/cabal-install/src/Distribution/Client/Store.hs
index dcf4c78d02c..5b82712b963 100644
--- a/cabal-install/src/Distribution/Client/Store.hs
+++ b/cabal-install/src/Distribution/Client/Store.hs
@@ -26,9 +26,11 @@ import Prelude ()
import Distribution.Client.DistDirLayout
import Distribution.Client.RebuildMonad
-import Distribution.Package (UnitId, mkUnitId)
+import Distribution.Package (UnitId, mkUnitId, addPrefixToUnitId, isPartialUnitId)
import Distribution.Simple.Compiler (Compiler (..))
+import GHC.Stack (HasCallStack)
+
import Distribution.Simple.Utils
( debug
, info
@@ -132,18 +134,20 @@ doesStoreEntryExist StoreDirLayout{storePackageDirectory} compiler unitid =
-- | Return the 'UnitId's of all packages\/components already installed in the
-- store.
-getStoreEntries :: StoreDirLayout -> Compiler -> Rebuild (Set UnitId)
+getStoreEntries :: HasCallStack => StoreDirLayout -> Compiler -> Rebuild (Set UnitId)
getStoreEntries StoreDirLayout{storeDirectory} compiler = do
paths <- getDirectoryContentsMonitored (storeDirectory compiler)
return $! mkEntries paths
where
mkEntries =
- Set.delete (mkUnitId "package.db")
- . Set.delete (mkUnitId "incoming")
- . Set.fromList
- . map mkUnitId
+ Set.fromList
+ . map (\pkg -> case mkUnitId pkg of
+ uid | isPartialUnitId uid -> addPrefixToUnitId (prettyShow (compilerId compiler)) uid
+ | otherwise -> uid)
. filter valid
valid ('.' : _) = False
+ valid "incoming" = False
+ valid "package.db" = False
valid _ = True
-- | The outcome of 'newStoreEntry': either the store entry was newly created
From 8a629931bb7cee318214c12d87439216939e7812 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Sat, 5 Apr 2025 11:48:39 +0900
Subject: [PATCH 77/82] Fixup AbiTag logic to deal with
<build>_<host>-<abitag>.
---
Cabal-syntax/src/Distribution/Compiler.hs | 1 +
Cabal-syntax/src/Distribution/Types/UnitId.hs | 15 +++++++++++++++
Cabal/src/Distribution/Simple/GHC.hs | 2 +-
3 files changed, 17 insertions(+), 1 deletion(-)
diff --git a/Cabal-syntax/src/Distribution/Compiler.hs b/Cabal-syntax/src/Distribution/Compiler.hs
index a4ac948570f..e79b18e846f 100644
--- a/Cabal-syntax/src/Distribution/Compiler.hs
+++ b/Cabal-syntax/src/Distribution/Compiler.hs
@@ -229,6 +229,7 @@ instance Binary CompilerInfo
instance Structured CompilerInfo
instance NFData CompilerInfo where rnf = genericRnf
+-- | AbiTag logic
data AbiTag
= NoAbiTag
| AbiTag String
diff --git a/Cabal-syntax/src/Distribution/Types/UnitId.hs b/Cabal-syntax/src/Distribution/Types/UnitId.hs
index d6a403a04c9..a57211a8663 100644
--- a/Cabal-syntax/src/Distribution/Types/UnitId.hs
+++ b/Cabal-syntax/src/Distribution/Types/UnitId.hs
@@ -16,6 +16,7 @@ module Distribution.Types.UnitId
, newSimpleUnitId
, mkLegacyUnitId
, getHSLibraryName
+ , getAbiTag
) where
import Distribution.Compat.Prelude
@@ -184,3 +185,17 @@ instance Parsec DefUnitId where
-- is to ensure that the 'DefUnitId' invariant holds.
unsafeMkDefUnitId :: UnitId -> DefUnitId
unsafeMkDefUnitId = DefUnitId
+
+-- | The ABI tag is the part of the unit id that comes after the
+-- last hyphen. It is used to distinguish between different
+-- versions of the same package that are ABI compatible.
+--
+-- FIXME: ideally this would be part of the proper structure of the
+-- datatype, instead of some heuristic of the string.
+getAbiTag :: HasCallStack => UnitId -> AbiTag
+getAbiTag (UnitId _c s _) = case takeWhile (/= '-') . reverse . fromShortText $ s of
+ [] -> NoAbiTag
+ xs -> AbiTag . reverse $ xs
+getAbiTag (PartialUnitId s) = case takeWhile (/= '-') . reverse . fromShortText $ s of
+ [] -> NoAbiTag
+ xs -> AbiTag . reverse $ xs
\ No newline at end of file
diff --git a/Cabal/src/Distribution/Simple/GHC.hs b/Cabal/src/Distribution/Simple/GHC.hs
index 427d605949d..8d56a4ffd46 100644
--- a/Cabal/src/Distribution/Simple/GHC.hs
+++ b/Cabal/src/Distribution/Simple/GHC.hs
@@ -249,7 +249,7 @@ configure verbosity hcPath hcPkgPath conf0 = do
compilerId = CompilerId GHC ghcVersion
compilerAbiTag :: AbiTag
- compilerAbiTag = maybe NoAbiTag AbiTag (Map.lookup "Project Unit Id" ghcInfoMap >>= stripPrefix (prettyShow compilerId <> "-"))
+ compilerAbiTag = fromMaybe NoAbiTag (getAbiTag . fromString <$> Map.lookup "Project Unit Id" ghcInfoMap)
let comp =
Compiler
From 4e2e0601c8a43389bdd6152482c186c21343830c Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Sat, 5 Apr 2025 15:51:36 +0900
Subject: [PATCH 78/82] +HasCallStack
---
Cabal-syntax/src/Distribution/Compat/Graph.hs | 4 +-
.../src/Distribution/FieldGrammar/Class.hs | 44 ++++++++++---------
.../src/Distribution/InstalledPackageInfo.hs | 2 +-
Cabal-syntax/src/Distribution/Parsec.hs | 4 +-
Cabal/src/Distribution/Simple/Configure.hs | 4 +-
Cabal/src/Distribution/Simple/GHC.hs | 8 ++--
.../src/Distribution/Simple/Program/HcPkg.hs | 2 +-
.../src/Distribution/Client/IndexUtils.hs | 4 +-
8 files changed, 41 insertions(+), 31 deletions(-)
diff --git a/Cabal-syntax/src/Distribution/Compat/Graph.hs b/Cabal-syntax/src/Distribution/Compat/Graph.hs
index c716563f52a..60eeee53631 100644
--- a/Cabal-syntax/src/Distribution/Compat/Graph.hs
+++ b/Cabal-syntax/src/Distribution/Compat/Graph.hs
@@ -105,6 +105,8 @@ import qualified Data.Set as Set
import qualified Data.Tree as Tree
import qualified Distribution.Compat.Prelude as Prelude
+import GHC.Stack (HasCallStack)
+
-- | A graph of nodes @a@. The nodes are expected to have instance
-- of class 'IsNode'.
data Graph a = Graph
@@ -377,7 +379,7 @@ fromMap m =
bounds = (0, Map.size m - 1)
-- | /O(V log V)/. Convert a list of nodes (with distinct keys) into a graph.
-fromDistinctList :: (IsNode a, Show (Key a)) => [a] -> Graph a
+fromDistinctList :: (HasCallStack, IsNode a, Show (Key a)) => [a] -> Graph a
fromDistinctList =
fromMap
. Map.fromListWith (\_ -> duplicateError)
diff --git a/Cabal-syntax/src/Distribution/FieldGrammar/Class.hs b/Cabal-syntax/src/Distribution/FieldGrammar/Class.hs
index fa815a49a5e..f439f9d2b01 100644
--- a/Cabal-syntax/src/Distribution/FieldGrammar/Class.hs
+++ b/Cabal-syntax/src/Distribution/FieldGrammar/Class.hs
@@ -23,6 +23,8 @@ import Distribution.FieldGrammar.Newtypes
import Distribution.Fields.Field
import Distribution.Utils.ShortText
+import GHC.Stack (HasCallStack)
+
-- | 'FieldGrammar' is parametrised by
--
-- * @s@ which is a structure we are parsing. We need this to provide prettyprinter
@@ -43,11 +45,11 @@ class
| g -> c
where
-- | Unfocus, zoom out, /blur/ 'FieldGrammar'.
- blurFieldGrammar :: ALens' a b -> g b d -> g a d
+ blurFieldGrammar :: HasCallStack => ALens' a b -> g b d -> g a d
-- | Field which should be defined, exactly once.
uniqueFieldAla
- :: (c b, Newtype a b)
+ :: (c b, Newtype a b, HasCallStack)
=> FieldName
-- ^ field name
-> (a -> b)
@@ -58,7 +60,7 @@ class
-- | Boolean field with a default value.
booleanFieldDef
- :: FieldName
+ :: HasCallStack => FieldName
-- ^ field name
-> ALens' s Bool
-- ^ lens into the field
@@ -68,7 +70,7 @@ class
-- | Optional field.
optionalFieldAla
- :: (c b, Newtype a b)
+ :: (c b, Newtype a b, HasCallStack)
=> FieldName
-- ^ field name
-> (a -> b)
@@ -79,7 +81,7 @@ class
-- | Optional field with default value.
optionalFieldDefAla
- :: (c b, Newtype a b, Eq a)
+ :: (c b, Newtype a b, Eq a, HasCallStack)
=> FieldName
-- ^ field name
-> (a -> b)
@@ -95,7 +97,7 @@ class
--
-- @since 3.0.0.0
freeTextField
- :: FieldName
+ :: HasCallStack => FieldName
-> ALens' s (Maybe String)
-- ^ lens into the field
-> g s (Maybe String)
@@ -105,14 +107,14 @@ class
--
-- @since 3.0.0.0
freeTextFieldDef
- :: FieldName
+ :: HasCallStack => FieldName
-> ALens' s String
-- ^ lens into the field
-> g s String
-- | @since 3.2.0.0
freeTextFieldDefST
- :: FieldName
+ :: HasCallStack => FieldName
-> ALens' s ShortText
-- ^ lens into the field
-> g s ShortText
@@ -123,7 +125,7 @@ class
--
-- /Note:/ 'optionalFieldAla' is a @monoidalField@ with 'Last' monoid.
monoidalFieldAla
- :: (c b, Monoid a, Newtype a b)
+ :: (c b, Monoid a, Newtype a b, HasCallStack)
=> FieldName
-- ^ field name
-> (a -> b)
@@ -134,21 +136,21 @@ class
-- | Parser matching all fields with a name starting with a prefix.
prefixedFields
- :: FieldName
+ :: HasCallStack => FieldName
-- ^ field name prefix
-> ALens' s [(String, String)]
-- ^ lens into the field
-> g s [(String, String)]
-- | Known field, which we don't parse, nor pretty print.
- knownField :: FieldName -> g s ()
+ knownField :: HasCallStack => FieldName -> g s ()
-- | Field which is parsed but not pretty printed.
- hiddenField :: g s a -> g s a
+ hiddenField :: HasCallStack => g s a -> g s a
-- | Deprecated since
deprecatedSince
- :: CabalSpecVersion
+ :: HasCallStack => CabalSpecVersion
-- ^ version
-> String
-- ^ deprecation message
@@ -157,7 +159,7 @@ class
-- | Removed in. If we encounter removed field, parsing fails.
removedIn
- :: CabalSpecVersion
+ :: HasCallStack => CabalSpecVersion
-- ^ version
-> String
-- ^ removal message
@@ -166,7 +168,7 @@ class
-- | Annotate field with since spec-version.
availableSince
- :: CabalSpecVersion
+ :: HasCallStack => CabalSpecVersion
-- ^ spec version
-> a
-- ^ default value
@@ -181,7 +183,7 @@ class
--
-- @since 3.4.0.0
availableSinceWarn
- :: CabalSpecVersion
+ :: HasCallStack => CabalSpecVersion
-- ^ spec version
-> g s a
-> g s a
@@ -189,7 +191,7 @@ class
-- | Field which can be defined at most once.
uniqueField
- :: (FieldGrammar c g, c (Identity a))
+ :: (FieldGrammar c g, c (Identity a), HasCallStack)
=> FieldName
-- ^ field name
-> ALens' s a
@@ -199,7 +201,7 @@ uniqueField fn l = uniqueFieldAla fn Identity l
-- | Field which can be defined at most once.
optionalField
- :: (FieldGrammar c g, c (Identity a))
+ :: (FieldGrammar c g, c (Identity a), HasCallStack)
=> FieldName
-- ^ field name
-> ALens' s (Maybe a)
@@ -209,7 +211,7 @@ optionalField fn l = optionalFieldAla fn Identity l
-- | Optional field with default value.
optionalFieldDef
- :: (FieldGrammar c g, Functor (g s), c (Identity a), Eq a)
+ :: (FieldGrammar c g, Functor (g s), c (Identity a), Eq a, HasCallStack)
=> FieldName
-- ^ field name
-> ALens' s a
@@ -221,7 +223,7 @@ optionalFieldDef fn l x = optionalFieldDefAla fn Identity l x
-- | Field which can be define multiple times, and the results are @mappend@ed.
monoidalField
- :: (FieldGrammar c g, c (Identity a), Monoid a)
+ :: (FieldGrammar c g, c (Identity a), Monoid a, HasCallStack)
=> FieldName
-- ^ field name
-> ALens' s a
@@ -231,7 +233,7 @@ monoidalField fn l = monoidalFieldAla fn Identity l
-- | Default implementation for 'freeTextFieldDefST'.
defaultFreeTextFieldDefST
- :: (Functor (g s), FieldGrammar c g)
+ :: (Functor (g s), FieldGrammar c g, HasCallStack)
=> FieldName
-> ALens' s ShortText
-- ^ lens into the field
diff --git a/Cabal-syntax/src/Distribution/InstalledPackageInfo.hs b/Cabal-syntax/src/Distribution/InstalledPackageInfo.hs
index 93000823a13..dc2499f7a38 100644
--- a/Cabal-syntax/src/Distribution/InstalledPackageInfo.hs
+++ b/Cabal-syntax/src/Distribution/InstalledPackageInfo.hs
@@ -97,7 +97,7 @@ sourceComponentName = CLibName . sourceLibName
-- | Return either errors, or IPI with list of warnings
parseInstalledPackageInfo
- :: ByteString
+ :: HasCallStack => ByteString
-> Either (NonEmpty String) ([String], InstalledPackageInfo)
parseInstalledPackageInfo s = case P.readFields s of
Left err -> Left (show err :| [])
diff --git a/Cabal-syntax/src/Distribution/Parsec.hs b/Cabal-syntax/src/Distribution/Parsec.hs
index d0197616fd6..bac02a8a63a 100644
--- a/Cabal-syntax/src/Distribution/Parsec.hs
+++ b/Cabal-syntax/src/Distribution/Parsec.hs
@@ -70,6 +70,8 @@ import qualified Distribution.Compat.DList as DList
import qualified Distribution.Compat.MonadFail as Fail
import qualified Text.Parsec as Parsec
+import GHC.Stack (HasCallStack)
+
-------------------------------------------------------------------------------
-- Class
-------------------------------------------------------------------------------
@@ -78,7 +80,7 @@ import qualified Text.Parsec as Parsec
--
-- For parsing @.cabal@ like file structure, see "Distribution.Fields".
class Parsec a where
- parsec :: CabalParsing m => m a
+ parsec :: (HasCallStack, CabalParsing m) => m a
-- | Parsing class which
--
diff --git a/Cabal/src/Distribution/Simple/Configure.hs b/Cabal/src/Distribution/Simple/Configure.hs
index 44bce682c5f..1ed13020f82 100644
--- a/Cabal/src/Distribution/Simple/Configure.hs
+++ b/Cabal/src/Distribution/Simple/Configure.hs
@@ -2065,7 +2065,7 @@ reportFailedDependencies verbosity failed =
-- with a warning and treated as empty ones, since technically they do not
-- contain any package.
getInstalledPackages
- :: Verbosity
+ :: HasCallStack => Verbosity
-> Compiler
-> Maybe (SymbolicPath CWD (Dir from))
-> PackageDBStackX (SymbolicPath from (Dir PkgDB))
@@ -2108,7 +2108,7 @@ getInstalledPackages verbosity comp mbWorkDir packageDBs progdb = do
-- on the package database stack in question. However, when sandboxes
-- are involved these sanity checks are not desirable.
getPackageDBContents
- :: Verbosity
+ :: HasCallStack => Verbosity
-> Compiler
-> Maybe (SymbolicPath CWD (Dir Pkg))
-> PackageDB
diff --git a/Cabal/src/Distribution/Simple/GHC.hs b/Cabal/src/Distribution/Simple/GHC.hs
index 8d56a4ffd46..e865fe436d2 100644
--- a/Cabal/src/Distribution/Simple/GHC.hs
+++ b/Cabal/src/Distribution/Simple/GHC.hs
@@ -150,6 +150,8 @@ import System.Directory
import Distribution.Simple.Setup (BuildingWhat (..))
import Distribution.Simple.Setup.Build
+import GHC.Stack (HasCallStack)
+
-- -----------------------------------------------------------------------------
-- Configuring
@@ -400,7 +402,7 @@ getGhcInfo verbosity ghcProg = Internal.getGhcInfo verbosity implInfo ghcProg
-- | Given a single package DB, return all installed packages.
getPackageDBContents
- :: Verbosity
+ :: HasCallStack => Verbosity
-> Maybe (SymbolicPath CWD (Dir from))
-> PackageDBX (SymbolicPath from (Dir PkgDB))
-> ProgramDb
@@ -411,7 +413,7 @@ getPackageDBContents verbosity mbWorkDir packagedb progdb = do
-- | Given a package DB stack, return all installed packages.
getInstalledPackages
- :: Verbosity
+ :: HasCallStack => Verbosity
-> Compiler
-> Maybe (SymbolicPath CWD (Dir from))
-> PackageDBStackX (SymbolicPath from (Dir PkgDB))
@@ -548,7 +550,7 @@ removeMingwIncludeDir pkg =
-- | Get the packages from specific PackageDBs, not cumulative.
getInstalledPackages'
- :: Verbosity
+ :: HasCallStack => Verbosity
-> Maybe (SymbolicPath CWD (Dir from))
-> [PackageDBX (SymbolicPath from (Dir PkgDB))]
-> ProgramDb
diff --git a/Cabal/src/Distribution/Simple/Program/HcPkg.hs b/Cabal/src/Distribution/Simple/Program/HcPkg.hs
index 024d21542f6..8017850d16e 100644
--- a/Cabal/src/Distribution/Simple/Program/HcPkg.hs
+++ b/Cabal/src/Distribution/Simple/Program/HcPkg.hs
@@ -278,7 +278,7 @@ hide hpi verbosity mbWorkDir packagedb pkgid =
-- | Call @hc-pkg@ to get all the details of all the packages in the given
-- package database.
dump
- :: HcPkgInfo
+ :: HasCallStack => HcPkgInfo
-> Verbosity
-> Maybe (SymbolicPath CWD (Dir from))
-> PackageDBX (SymbolicPath from (Dir PkgDB))
diff --git a/cabal-install/src/Distribution/Client/IndexUtils.hs b/cabal-install/src/Distribution/Client/IndexUtils.hs
index 0cd842d663e..489f8acfdb1 100644
--- a/cabal-install/src/Distribution/Client/IndexUtils.hs
+++ b/cabal-install/src/Distribution/Client/IndexUtils.hs
@@ -156,9 +156,11 @@ import Distribution.Client.Errors
import qualified Hackage.Security.Client as Sec
import qualified Hackage.Security.Util.Some as Sec
+import GHC.Stack (HasCallStack)
+
-- | Reduced-verbosity version of 'Configure.getInstalledPackages'
getInstalledPackages
- :: Verbosity
+ :: HasCallStack => Verbosity
-> Compiler
-> PackageDBStackCWD
-> ProgramDb
From 6744f1a35050928086251f4b665183c258cfefb2 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Sat, 5 Apr 2025 15:51:45 +0900
Subject: [PATCH 79/82] +Debug
---
Cabal-syntax/src/Distribution/Compat/Graph.hs | 6 ++++--
1 file changed, 4 insertions(+), 2 deletions(-)
diff --git a/Cabal-syntax/src/Distribution/Compat/Graph.hs b/Cabal-syntax/src/Distribution/Compat/Graph.hs
index 60eeee53631..6fe6bb3bfec 100644
--- a/Cabal-syntax/src/Distribution/Compat/Graph.hs
+++ b/Cabal-syntax/src/Distribution/Compat/Graph.hs
@@ -380,15 +380,17 @@ fromMap m =
-- | /O(V log V)/. Convert a list of nodes (with distinct keys) into a graph.
fromDistinctList :: (HasCallStack, IsNode a, Show (Key a)) => [a] -> Graph a
-fromDistinctList =
+fromDistinctList xs =
fromMap
. Map.fromListWith (\_ -> duplicateError)
- . map (\n -> n `seq` (nodeKey n, n))
+ . map (\n -> n `seq` (nodeKey n, n)) $ xs
where
duplicateError n =
error $
"Graph.fromDistinctList: duplicate key: "
++ show (nodeKey n)
+ ++ " in "
+ ++ unlines (map (show . nodeKey) xs)
-- Map-like operations
From 3de93d045e35fd84797f80689555c41eabc32de4 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Sat, 5 Apr 2025 15:52:09 +0900
Subject: [PATCH 80/82] +Debug: UnitId
---
Cabal-syntax/src/Distribution/Types/UnitId.hs | 6 +++++-
1 file changed, 5 insertions(+), 1 deletion(-)
diff --git a/Cabal-syntax/src/Distribution/Types/UnitId.hs b/Cabal-syntax/src/Distribution/Types/UnitId.hs
index a57211a8663..5c765cee65c 100644
--- a/Cabal-syntax/src/Distribution/Types/UnitId.hs
+++ b/Cabal-syntax/src/Distribution/Types/UnitId.hs
@@ -19,6 +19,7 @@ module Distribution.Types.UnitId
, getAbiTag
) where
+import Distribution.Compiler (AbiTag (..))
import Distribution.Compat.Prelude
import Distribution.Utils.ShortText
import Prelude ()
@@ -31,7 +32,7 @@ import Distribution.Types.PackageId
import Text.PrettyPrint (text)
-import GHC.Stack (HasCallStack)
+import GHC.Stack (HasCallStack, prettyCallStack, callStack)
import Data.List (isInfixOf)
import Unsafe.Coerce (unsafeCoerce)
@@ -117,6 +118,7 @@ isPartialUnitId (PartialUnitId _) = True
isPartialUnitId _ = False
addPrefixToUnitId :: HasCallStack => String -> UnitId -> UnitId
+-- addPrefixToUnitId prefix (PartialUnitId s) | s == toShortText "process-1.6.25.0-inplace" = trace ("### addPrefixToUnitId': `" ++ prefix ++ "' `" ++ (fromShortText s) ++ "'.\n" ++ prettyCallStack callStack) $ UnitId (toShortText prefix) s True
addPrefixToUnitId prefix (PartialUnitId s) = UnitId (toShortText prefix) s True
addPrefixToUnitId prefix uid@(UnitId _ _ _) = error $ "addPrefixToUnitId: UnitId " ++ show uid ++ " already has a prefix; can't add: " ++ prefix
@@ -143,9 +145,11 @@ mkUnitId s = case (simpleParsec s) of
_ -> error $ "Unable to parse UnitId: `" ++ s ++ "'."
mkUnitId' :: HasCallStack => String -> String -> Bool -> UnitId
+-- mkUnitId' c i b | c == "ghc-9.8.4", i == "process-1.6.25.0-inplace" = trace ("### mkUnitId': `" ++ c ++ "' `" ++ i ++ "' is a full one.\n" ++ prettyCallStack callStack) (UnitId (toShortText c) (toShortText i) b)
mkUnitId' c i b = UnitId (toShortText c) (toShortText i) b
mkPartialUnitId :: HasCallStack => String -> UnitId
+-- mkPartialUnitId s | s == "process-1.6.25.0-inplace" = trace ("### mkPartialUnitId: `" ++ s ++ "' is a partial unit id, not a full one.\n" ++ prettyCallStack callStack) (PartialUnitId (toShortText s))
mkPartialUnitId s = PartialUnitId (toShortText s)
-- | 'mkUnitId'
From df70cef4be330f156e54231254ab7a9583c944e8 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Mon, 7 Apr 2025 17:36:15 +0900
Subject: [PATCH 81/82] Add "flags:" to ipi
---
Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs | 5 ++++-
.../Distribution/Types/InstalledPackageInfo/FieldGrammar.hs | 3 +++
.../src/Distribution/Types/InstalledPackageInfo/Lens.hs | 5 +++++
Cabal/src/Distribution/Simple/Register.hs | 1 +
4 files changed, 13 insertions(+), 1 deletion(-)
diff --git a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs
index e5733d158a4..49893ab1462 100644
--- a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs
+++ b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs
@@ -22,6 +22,7 @@ import Distribution.ModuleName
import Distribution.Package hiding (installedUnitId, pkgCompiler)
import Distribution.Types.AbiDependency
import Distribution.Types.ExposedModule
+import Distribution.Types.Flag (FlagAssignment)
import Distribution.Types.LibraryName
import Distribution.Types.LibraryVisibility
import Distribution.Types.MungedPackageId
@@ -62,7 +63,8 @@ data InstalledPackageInfo = InstalledPackageInfo
, description :: !ShortText
, category :: !ShortText
, -- these parts are required by an installed package only:
- abiHash :: AbiHash
+ unitFlags :: FlagAssignment
+ , abiHash :: AbiHash
, indefinite :: Bool
, exposed :: Bool
, -- INVARIANT: if the package is definite, OpenModule's
@@ -148,6 +150,7 @@ emptyInstalledPackageInfo =
, synopsis = ""
, description = ""
, category = ""
+ , unitFlags = mempty
, abiHash = mkAbiHash ""
, indefinite = False
, exposed = False
diff --git a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs
index b6be432a6ff..9853efc287b 100644
--- a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs
+++ b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs
@@ -23,6 +23,7 @@ import Distribution.ModuleName
import Distribution.Package hiding (pkgCompiler)
import Distribution.Parsec
import Distribution.Pretty
+import Distribution.Types.Flag (FlagAssignment)
import Distribution.Types.LibraryName
import Distribution.Types.LibraryVisibility
import Distribution.Types.MungedPackageName
@@ -61,6 +62,7 @@ ipiFieldGrammar
, Applicative (g InstalledPackageInfo)
, Applicative (g Basic)
, c (Identity AbiHash)
+ , c (Identity FlagAssignment)
, c (Identity LibraryVisibility)
, c (Identity PackageName)
, c (Identity UnitId)
@@ -105,6 +107,7 @@ ipiFieldGrammar =
<@> freeTextFieldDefST "description" L.description
<@> freeTextFieldDefST "category" L.category
-- Installed fields
+ <@> optionalFieldDef "flags" L.unitFlags mempty
<@> optionalFieldDef "abi" L.abiHash (mkAbiHash "")
<@> booleanFieldDef "indefinite" L.indefinite False
<@> booleanFieldDef "exposed" L.exposed False
diff --git a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/Lens.hs b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/Lens.hs
index c34e885fa01..9a35a03816e 100644
--- a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/Lens.hs
+++ b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/Lens.hs
@@ -12,6 +12,7 @@ import Distribution.Backpack (OpenModule)
import Distribution.License (License)
import Distribution.ModuleName (ModuleName)
import Distribution.Package (AbiHash, ComponentId, PackageIdentifier, UnitId)
+import Distribution.Types.Flag (FlagAssignment)
import Distribution.Types.InstalledPackageInfo (AbiDependency, ExposedModule, InstalledPackageInfo)
import Distribution.Types.LibraryName (LibraryName)
import Distribution.Types.LibraryVisibility (LibraryVisibility)
@@ -28,6 +29,10 @@ installedUnitId :: Lens' InstalledPackageInfo UnitId
installedUnitId f s = fmap (\x -> s{T.installedUnitId = x}) (f (T.installedUnitId s))
{-# INLINE installedUnitId #-}
+unitFlags :: Lens' InstalledPackageInfo FlagAssignment
+unitFlags f s = fmap (\x -> s{T.unitFlags = x}) (f (T.unitFlags s))
+{-# INLINE unitFlags #-}
+
installedComponentId_ :: Lens' InstalledPackageInfo (Maybe ComponentId)
installedComponentId_ f s = fmap (\x -> s{T.installedComponentId_ = x}) (f (T.installedComponentId_ s))
{-# INLINE installedComponentId_ #-}
diff --git a/Cabal/src/Distribution/Simple/Register.hs b/Cabal/src/Distribution/Simple/Register.hs
index 10ea7f0e94e..9a9b313d994 100644
--- a/Cabal/src/Distribution/Simple/Register.hs
+++ b/Cabal/src/Distribution/Simple/Register.hs
@@ -500,6 +500,7 @@ generalInstalledPackageInfo adjustRelIncDirs pkg abi_hash lib lbi clbi installDi
, IPI.installedComponentId_ = Just (componentComponentId clbi)
, IPI.instantiatedWith = expectLibraryComponent (maybeComponentInstantiatedWith clbi)
, IPI.sourceLibName = libName lib
+ , IPI.unitFlags = flagAssignment lbi
, IPI.compatPackageKey = expectLibraryComponent (maybeComponentCompatPackageKey clbi)
, -- If GHC >= 8.4 we register with SDPX, otherwise with legacy license
IPI.license =
From 7e50837ade188504d1401bad932a5b8b3769661e Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Mon, 7 Apr 2025 17:36:32 +0900
Subject: [PATCH 82/82] Fixup compiler id in pkgid
---
Cabal-syntax/src/Distribution/Parsec.hs | 10 +++++-----
.../src/Distribution/Types/ComponentId.hs | 6 ++++--
Cabal-syntax/src/Distribution/Types/UnitId.hs | 5 +++--
.../src/Distribution/Client/PackageHash.hs | 15 ++++++++++-----
.../Client/ProjectBuilding/UnpackedPackage.hs | 4 ++++
5 files changed, 26 insertions(+), 14 deletions(-)
diff --git a/Cabal-syntax/src/Distribution/Parsec.hs b/Cabal-syntax/src/Distribution/Parsec.hs
index bac02a8a63a..dcc236b840f 100644
--- a/Cabal-syntax/src/Distribution/Parsec.hs
+++ b/Cabal-syntax/src/Distribution/Parsec.hs
@@ -96,7 +96,7 @@ class (P.CharParsing m, MonadPlus m, Fail.MonadFail m) => CabalParsing m where
askCabalSpecVersion :: m CabalSpecVersion
-- | 'parsec' /could/ consume trailing spaces, this function /will/ consume.
-lexemeParsec :: (CabalParsing m, Parsec a) => m a
+lexemeParsec :: (HasCallStack, CabalParsing m, Parsec a) => m a
lexemeParsec = parsec <* P.spaces
newtype ParsecParser a = PP
@@ -177,14 +177,14 @@ instance CabalParsing ParsecParser where
askCabalSpecVersion = PP pure
-- | Parse a 'String' with 'lexemeParsec'.
-simpleParsec :: Parsec a => String -> Maybe a
+simpleParsec :: (HasCallStack, Parsec a) => String -> Maybe a
simpleParsec =
either (const Nothing) Just
. runParsecParser lexemeParsec "<simpleParsec>"
. fieldLineStreamFromString
-- | Like 'simpleParsec' but for 'ByteString'
-simpleParsecBS :: Parsec a => ByteString -> Maybe a
+simpleParsecBS :: (HasCallStack, Parsec a) => ByteString -> Maybe a
simpleParsecBS =
either (const Nothing) Just
. runParsecParser lexemeParsec "<simpleParsec>"
@@ -193,7 +193,7 @@ simpleParsecBS =
-- | Parse a 'String' with 'lexemeParsec' using specific 'CabalSpecVersion'.
--
-- @since 3.4.0.0
-simpleParsec' :: Parsec a => CabalSpecVersion -> String -> Maybe a
+simpleParsec' :: (HasCallStack, Parsec a) => CabalSpecVersion -> String -> Maybe a
simpleParsec' spec =
either (const Nothing) Just
. runParsecParser' spec lexemeParsec "<simpleParsec>"
@@ -203,7 +203,7 @@ simpleParsec' spec =
-- Fail if there are any warnings.
--
-- @since 3.4.0.0
-simpleParsecW' :: Parsec a => CabalSpecVersion -> String -> Maybe a
+simpleParsecW' :: (HasCallStack, Parsec a) => CabalSpecVersion -> String -> Maybe a
simpleParsecW' spec =
either (const Nothing) (\(x, ws) -> if null ws then Just x else Nothing)
. runParsecParser' spec ((,) <$> lexemeParsec <*> liftParsec Parsec.getState) "<simpleParsec>"
diff --git a/Cabal-syntax/src/Distribution/Types/ComponentId.hs b/Cabal-syntax/src/Distribution/Types/ComponentId.hs
index 03820ad0631..fd2467972e9 100644
--- a/Cabal-syntax/src/Distribution/Types/ComponentId.hs
+++ b/Cabal-syntax/src/Distribution/Types/ComponentId.hs
@@ -17,7 +17,7 @@ import Distribution.Pretty
import qualified Distribution.Compat.CharParsing as P
import Text.PrettyPrint (text)
-import GHC.Stack (HasCallStack)
+import GHC.Stack (HasCallStack, prettyCallStack, callStack)
-- | A 'ComponentId' uniquely identifies the transitive source
-- code closure of a component (i.e. libraries, executables).
--
@@ -31,7 +31,7 @@ import GHC.Stack (HasCallStack)
-- This type is opaque since @Cabal-2.0@
--
-- @since 2.0.0.2
-data ComponentId = ComponentId ShortText ShortText Bool
+data ComponentId = ComponentId {unitComp :: ShortText, unitId :: ShortText, wasPartial :: Bool }
| PartialComponentId ShortText
deriving (Generic, Read, Show, Data)
@@ -57,11 +57,13 @@ instance Ord ComponentId where
-- @since 2.0.0.2
mkComponentId :: HasCallStack => String -> ComponentId
mkComponentId s = case (simpleParsec s) of
+ -- Just cid@ComponentId{ unitComp = c, unitId = i } | (fromShortText c) == "ghc-9.8.4", (fromShortText i) == "rts-1.0.3-cec100dd" -> trace ("### ComponentId: `" ++ (fromShortText c) ++ "' `" ++ (fromShortText i) ++ "' is a full one.\n" ++ prettyCallStack callStack) cid
Just cid@ComponentId{} -> cid
Just cid@PartialComponentId{} -> error $ "mkPartialComponentId: `" ++ s ++ "' is a partial component id, not a full one."
_ -> error $ "Unable to parse PartialComponentId: `" ++ s ++ "'."
mkComponentId' :: HasCallStack => String -> String -> Bool -> ComponentId
+-- mkComponentId' c i b | c == "ghc-9.8.4", i == "rts-1.0.3-cec100dd" = trace ("### mkComponentId': `" ++ c ++ "' `" ++ i ++ "' is a full one.\n" ++ prettyCallStack callStack) (ComponentId (toShortText c) (toShortText i) b)
mkComponentId' c i b = ComponentId (toShortText c) (toShortText i) b
mkPartialComponentId :: HasCallStack => String -> ComponentId
diff --git a/Cabal-syntax/src/Distribution/Types/UnitId.hs b/Cabal-syntax/src/Distribution/Types/UnitId.hs
index 5c765cee65c..a5aae2a38bd 100644
--- a/Cabal-syntax/src/Distribution/Types/UnitId.hs
+++ b/Cabal-syntax/src/Distribution/Types/UnitId.hs
@@ -73,7 +73,7 @@ import Unsafe.Coerce (unsafeCoerce)
-- representation of a UnitId to pass, e.g., as a @-package-id@
-- flag, use the 'display' function, which will work on all
-- versions of Cabal.
-data UnitId = UnitId ShortText ShortText Bool
+data UnitId = UnitId {unitComp :: ShortText, unitId :: ShortText, wasPartial :: Bool }
| PartialUnitId ShortText
deriving (Generic, Read, Show, Data)
@@ -140,12 +140,13 @@ unUnitId (PartialUnitId s) = fromShortText s
mkUnitId :: HasCallStack => String -> UnitId
mkUnitId s = case (simpleParsec s) of
+ -- Just uid@UnitId{ unitComp = c, unitId = i } | (fromShortText c) == "ghc-9.8.4", (fromShortText i) == "rts-1.0.3-cec100dd" -> trace ("### mkUnitId: `" ++ (fromShortText c) ++ "' `" ++ (fromShortText i) ++ "' is a full one.\n" ++ prettyCallStack callStack) uid
Just uid@UnitId{} -> uid
Just uid@PartialUnitId{} -> uid -- error $ "mkUnitId: `" ++ s ++ "' is a partial unit id, not a full one."
_ -> error $ "Unable to parse UnitId: `" ++ s ++ "'."
mkUnitId' :: HasCallStack => String -> String -> Bool -> UnitId
--- mkUnitId' c i b | c == "ghc-9.8.4", i == "process-1.6.25.0-inplace" = trace ("### mkUnitId': `" ++ c ++ "' `" ++ i ++ "' is a full one.\n" ++ prettyCallStack callStack) (UnitId (toShortText c) (toShortText i) b)
+-- mkUnitId' c i b | c == "ghc-9.8.4", i == "rts-1.0.3-cec100dd" = trace ("### mkUnitId': `" ++ c ++ "' `" ++ i ++ "' is a full one.\n" ++ prettyCallStack callStack) (UnitId (toShortText c) (toShortText i) b)
mkUnitId' c i b = UnitId (toShortText c) (toShortText i) b
mkPartialUnitId :: HasCallStack => String -> UnitId
diff --git a/cabal-install/src/Distribution/Client/PackageHash.hs b/cabal-install/src/Distribution/Client/PackageHash.hs
index 0fa147669d9..0be2753dcf5 100644
--- a/cabal-install/src/Distribution/Client/PackageHash.hs
+++ b/cabal-install/src/Distribution/Client/PackageHash.hs
@@ -93,11 +93,14 @@ hashedInstalledPackageIdLong :: PackageHashInputs -> InstalledPackageId
hashedInstalledPackageIdLong
pkghashinputs@PackageHashInputs{pkgHashPkgId, pkgHashComponent} =
mkComponentId $
- prettyShow pkgHashPkgId -- to be a bit user friendly
+ prettyShow compid
+ ++ "_"
+ ++ prettyShow pkgHashPkgId -- to be a bit user friendly
++ maybe "" displayComponent pkgHashComponent
++ "-"
++ showHashValue (hashPackageHashInputs pkghashinputs)
where
+ PackageIdentifier name version (Just compid) = pkgHashPkgId
displayComponent :: CD.Component -> String
displayComponent CD.ComponentLib = ""
displayComponent (CD.ComponentSubLib s) = "-l-" ++ prettyShow s
@@ -127,7 +130,9 @@ hashedInstalledPackageIdLong
hashedInstalledPackageIdShort :: HasCallStack => PackageHashInputs -> InstalledPackageId
hashedInstalledPackageIdShort pkghashinputs@PackageHashInputs{pkgHashPkgId} =
mkComponentId $
- intercalate
+ prettyShow compid
+ ++
+ '_':intercalate
"-"
-- max length now 64
[ truncateStr 14 (prettyShow name)
@@ -135,7 +140,7 @@ hashedInstalledPackageIdShort pkghashinputs@PackageHashInputs{pkgHashPkgId} =
, showHashValue (truncateHash 20 (hashPackageHashInputs pkghashinputs))
]
where
- PackageIdentifier name version _compid = pkgHashPkgId
+ PackageIdentifier name version (Just compid) = pkgHashPkgId
-- Truncate a string, with a visual indication that it is truncated.
truncateStr n s
@@ -167,7 +172,7 @@ hashedInstalledPackageIdShort pkghashinputs@PackageHashInputs{pkgHashPkgId} =
hashedInstalledPackageIdVeryShort :: HasCallStack => PackageHashInputs -> InstalledPackageId
hashedInstalledPackageIdVeryShort pkghashinputs@PackageHashInputs{pkgHashPkgId} =
mkComponentId $
- prettyShow (pkgHashCompilerId . pkgHashOtherConfig $ pkghashinputs)
+ prettyShow compid
++
'_':intercalate
"-"
@@ -176,7 +181,7 @@ hashedInstalledPackageIdVeryShort pkghashinputs@PackageHashInputs{pkgHashPkgId}
, showHashValue (truncateHash 4 (hashPackageHashInputs pkghashinputs))
]
where
- PackageIdentifier name version _compid = pkgHashPkgId
+ PackageIdentifier name version (Just compid) = pkgHashPkgId
-- | All the information that contributes to a package's hash, and thus its
-- 'InstalledPackageId'.
diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs b/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs
index 8fd229b61fa..c0bad4bc39f 100644
--- a/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs
+++ b/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs
@@ -834,6 +834,8 @@ buildAndInstallUnpackedPackage
++ unwords (map whyNotPerComponent $ NE.toList pkgWhyNotPerComponent)
++ ", "
++ dispcompiler (elabStage pkg)
+ -- ++ ", "
+ -- ++ show uid
++ ")"
-- Packages built per component
ElabComponent comp ->
@@ -842,6 +844,8 @@ buildAndInstallUnpackedPackage
++ maybe "custom" prettyShow (compComponentName comp)
++ ", "
++ dispcompiler (elabStage pkg)
+ -- ++ ", "
+ -- ++ show uid
++ ")"
dispcompiler :: Stage -> String
dispcompiler Host = showCompilerId (toolchainCompiler (hostToolchain toolchains))