Thread toolchains everywhere.

Author: angerman

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)

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
 
 

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 ->

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

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")
+    }

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

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, _) ->

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
 

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
 

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