Use packageSubLibDeps :: !(Map MungedPackageName DepValue)

mpilgrem · mpilgrem · commit 751d2a6c8a15 · 2023-02-07T16:06:46.000Z
This then follows `packageDeps :: !(Map PackageName DepValue)`.

`Stack.Build.ConstructPlan.addDep` is now type `MungedPackageName -&gt; _` and `Stack.Build.ConstructPlan.addPackagesDeps` considers both `packageDeps` and `packageSubLibDeps`.
diff --git a/src/Stack/Build/ConstructPlan.hs b/src/Stack/Build/ConstructPlan.hs
@@ -16,6 +16,8 @@ import           Data.Monoid.Map ( MonoidMap(..) )
 import qualified Data.Set as Set
 import qualified Data.Text as T
 import           Distribution.Types.BuildType ( BuildType (Configure) )
+import           Distribution.Types.MungedPackageName
+                   ( encodeCompatPackageName )
 import           Distribution.Types.PackageName ( mkPackageName )
 import           Generics.Deriving.Monoid ( memptydefault, mappenddefault )
 import           Path ( parent )
@@ -238,7 +240,7 @@ constructPlan baseConfigOpts0 localDumpPkgs loadPackage0 sourceMap installedMap
   sources <- getSources globalCabalVersion
   mcur <- view $ buildConfigL.to bcCurator
 
-  let onTarget = void . addDep
+  let onTarget = void . addDep . toMungedPackageName
   let inner = mapM_ onTarget $ Map.keys (smtTargets $ smTargets sourceMap)
   pathEnvVar' <- liftIO $ maybe mempty T.pack <$> lookupEnv "PATH"
   let ctx = mkCtx econfig globalCabalVersion sources mcur pathEnvVar'
@@ -515,11 +517,12 @@ addFinal lp package isAllInOne buildHaddocks = do
 -- marked as a dependency, even if it is directly wanted. This makes sense - if
 -- we left out packages that are deps, it would break the --only-dependencies
 -- build plan.
-addDep :: PackageName
+addDep :: MungedPackageName
        -> M (Either ConstructPlanException AddDepRes)
-addDep name = do
+addDep mungedName = do
   ctx <- ask
   m <- get
+  let name = encodeCompatPackageName mungedName
   case Map.lookup name m of
     Just res -> do
       planDebug $
@@ -803,6 +806,9 @@ addEllipsis t
   | T.length t < 100 = t
   | otherwise = T.take 97 t <> "..."
 
+toMungedPackageName :: PackageName -> MungedPackageName
+toMungedPackageName pn = MungedPackageName pn LMainLibName
+
 -- | Given a package, recurses into all of its dependencies. The results
 -- indicate which packages are missing, meaning that their 'GhcPkgId's will be
 -- figured out during the build, after they've been built. The 2nd part of the
@@ -824,9 +830,12 @@ addPackageDeps ::
 addPackageDeps package = do
   ctx <- ask
   checkAndWarnForUnknownTools package
-  let deps' = packageDeps package
-  deps <- forM (Map.toList deps') $ \(depname, DepValue range depType) -> do
-    eres <- addDep depname
+  let deps' =
+        map (first toMungedPackageName) (Map.toList $ packageDeps package) <>
+        Map.toList (packageSubLibDeps package)
+  deps <- forM deps' $ \(mungedDepname, DepValue range depType) -> do
+    let MungedPackageName depname depLib = mungedDepname
+    eres <- addDep mungedDepname
     let getLatestApplicableVersionAndRev :: M (Maybe (Version, BlobKey))
         getLatestApplicableVersionAndRev = do
           vsAndRevs <-
diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs
@@ -251,11 +251,13 @@ packageFromPackageDescription packageConfig pkgFlags (PackageDescriptionPair pkg
     (setupBuildInfo pkg)
 
   -- TODO: Should merge this calculation with deps.
-  subLibDeps = S.fromList $ concatMap
-    (\(Dependency n _ libs) -> mapMaybe (getSubLibName n) (NES.toList libs))
+  subLibDeps = M.fromList $ concatMap
+    (\(Dependency n vr libs) -> mapMaybe (getSubLibName n vr) (NES.toList libs))
     (concatMap targetBuildDepends (allBuildInfo' pkg))
-  getSubLibName pn lib@(LSubLibName _) = Just (MungedPackageName pn lib)
-  getSubLibName _ _ = Nothing
+
+  getSubLibName pn vr lib@(LSubLibName _) =
+    Just (MungedPackageName pn lib, asLibrary vr)
+  getSubLibName _ _ _ = Nothing
 
   asLibrary range = DepValue
     { dvVersionRange = range
diff --git a/src/Stack/Types/Build.hs b/src/Stack/Types/Build.hs
@@ -61,6 +61,8 @@ import           Database.Persist.Sql
 import qualified Distribution.Package as C
 import           Distribution.System ( Arch )
 import qualified Distribution.Text as C
+import           Distribution.Types.MungedPackageName
+                   ( decodeCompatPackageName )
 import           Distribution.Types.PackageName ( mkPackageName, unPackageName )
 import           Distribution.Types.TestSuiteInterface ( TestSuiteInterface )
 import           Distribution.Types.UnqualComponentName
@@ -1214,28 +1216,20 @@ configureOptsNoDir econfig bco deps isLocal package = concat
   -- --exact-configuration.
   flags = packageFlags package `Map.union` packageDefaultFlags package
 
-  sublibDeps = flip mapMaybe (Set.toList (packageSubLibDeps package)) $ \sublib ->
-    let deps' = Map.toList deps
-        MungedPackageName subPkgName lib = sublib
-        subname = mkPackageName $ case lib of
+  depOptions = map toDepOption (Map.toList deps)
+
+  toDepOption (PackageIdentifier name _, gid) =
+    let MungedPackageName subPkgName lib = decodeCompatPackageName name
+        depOptionKey = case lib of
+          LMainLibName -> unPackageName name
           LSubLibName cn ->
             unPackageName subPkgName <> ":" <> unUnqualComponentName cn
-          LMainLibName -> throwM $ LibraryNotSubLibraryBug subPkgName
-        hasSubPkgName :: (PackageIdentifier, GhcPkgId) -> Bool
-        hasSubPkgName (ident, _) = C.packageName ident == subPkgName
-    in  case find hasSubPkgName deps' of
-          Just (PackageIdentifier _ v, gid) ->
-            Just (PackageIdentifier subname v, gid)
-          _ -> Nothing
-
-  depOptions = map (uncurry toDepOption) (Map.toList deps <> sublibDeps)
-
-  toDepOption (PackageIdentifier name _) gid = concat
-    [ "--dependency="
-    , packageNameString name
-    , "="
-    , ghcPkgIdString gid
-    ]
+    in  concat
+          [ "--dependency="
+          , depOptionKey
+          , "="
+          , ghcPkgIdString gid
+          ]
 
 -- | Get set of wanted package names from locals.
 wantedLocalPackages :: [LocalPackage] -> Set PackageName
diff --git a/src/Stack/Types/Package.hs b/src/Stack/Types/Package.hs
@@ -165,7 +165,7 @@ data Package = Package
   , packageAllDeps :: !(Set PackageName)
     -- ^ Original dependencies (not sieved).
     -- FIXME: Having `packageDeps`, `packageAllDeps`, and `packageSubLibDeps` seem redundant.
-  , packageSubLibDeps :: !(Set MungedPackageName)
+  , packageSubLibDeps :: !(Map MungedPackageName DepValue)
     -- ^ Original sub-library dependencies (not sieved).
   , packageGhcOptions :: ![Text]
     -- ^ Ghc options used on package.
