Add Stage = Host | Build

Author: angerman

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)

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
 

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"

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)
 

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.

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

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