Minor refactoring around DumpPackage

Author: mpilgrem

src/Stack/Build/ConstructPlan.hs

@@ -65,7 +65,7 @@ import           Stack.Types.ConfigureOpts ( BaseConfigOpts (..) )
 import qualified Stack.Types.ConfigureOpts as ConfigureOpts
 import           Stack.Types.Curator ( Curator (..) )
 import           Stack.Types.Dependency ( DepValue (..), isDepTypeLibrary )
-import           Stack.Types.DumpPackage ( DumpPackage (..), dpParentLibIdent )
+import           Stack.Types.DumpPackage ( DumpPackage (..), sublibParentPkgId )
 import           Stack.Types.EnvConfig ( EnvConfig (..), HasEnvConfig (..) )
 import           Stack.Types.EnvSettings
                    ( EnvSettings (..), minimalEnvSettings )
@@ -371,7 +371,7 @@ mkUnregisterLocal tasks dirtyReason localDumpPkgs initialBuildSteps =
    where
     gid = dp.ghcPkgId
     ident = dp.packageIdent
-    mParentLibId = dpParentLibIdent dp
+    mParentLibId = sublibParentPkgId dp
     deps = dp.depends
 
   maybeUnregisterReason ::

src/Stack/Build/Installed.hs

@@ -22,7 +22,7 @@ import           Stack.Prelude
 import           Stack.SourceMap ( getPLIVersion, loadVersion )
 import           Stack.Types.CompilerPaths ( getGhcPkgExe )
 import           Stack.Types.DumpPackage
-                   ( DumpPackage (..), SublibDump (..), dpParentLibIdent )
+                   ( DumpPackage (..), SublibDump (..), sublibParentPkgId )
 import           Stack.Types.EnvConfig
                     ( HasEnvConfig, packageDatabaseDeps, packageDatabaseExtra
                     , packageDatabaseLocal
@@ -199,7 +199,7 @@ isAllowed installMap pkgDb dp = case Map.lookup name installMap of
     -- If the sourceMap has nothing to say about this package,
     -- check if it represents a sub-library first
     -- See: https://github.com/commercialhaskell/stack/issues/3899
-    case dpParentLibIdent dp of
+    case sublibParentPkgId dp of
       Just (PackageIdentifier parentLibName version') ->
         case Map.lookup parentLibName installMap of
           Nothing -> checkNotFound

src/Stack/Build/Source.hs

@@ -31,8 +31,8 @@ import           Stack.Package
 import           Stack.PackageFile ( getPackageFile )
 import           Stack.Prelude
 import           Stack.SourceMap
-                   ( DumpedGlobalPackage, getCompilerInfo, immutableLocSha
-                   , mkProjectPackage, pruneGlobals
+                   ( getCompilerInfo, immutableLocSha, mkProjectPackage
+                   , pruneGlobals
                    )
 import           Stack.Types.ApplyGhcOptions ( ApplyGhcOptions (..) )
 import           Stack.Types.ApplyProgOptions ( ApplyProgOptions (..) )
@@ -48,6 +48,7 @@ import           Stack.Types.CabalConfigKey ( CabalConfigKey (..) )
 import           Stack.Types.CompilerPaths ( HasCompiler, getCompilerPath )
 import           Stack.Types.Config ( Config (..), HasConfig (..), buildOptsL )
 import           Stack.Types.Curator ( Curator (..) )
+import           Stack.Types.DumpPackage ( DumpedGlobalPackage )
 import           Stack.Types.EnvConfig
                    ( EnvConfig (..), HasEnvConfig (..), HasSourceMap (..)
                    , actualCompilerVersionL

src/Stack/SourceMap.hs

@@ -10,7 +10,6 @@ module Stack.SourceMap
   , loadVersion
   , getPLIVersion
   , loadGlobalHints
-  , DumpedGlobalPackage
   , actualFromGhc
   , actualFromHints
   , globalCondCheck
@@ -39,7 +38,8 @@ import           Stack.Types.Compiler
 import           Stack.Types.CompilerPaths
                    ( CompilerPaths (..), GhcPkgExe, HasCompiler (..) )
 import           Stack.Types.Config ( HasConfig )
-import           Stack.Types.DumpPackage ( DumpPackage (..) )
+import           Stack.Types.DumpPackage
+                   ( DumpPackage (..), DumpedGlobalPackage )
 import           Stack.Types.Platform ( HasPlatform (..) )
 import           Stack.Types.Runner ( rslInLogL )
 import           Stack.Types.SourceMap
@@ -167,8 +167,6 @@ globalsFromHints compiler = do
         ]
       pure mempty
 
-type DumpedGlobalPackage = DumpPackage
-
 actualFromGhc ::
      (HasConfig env, HasCompiler env)
   => SMWanted

src/Stack/Types/DumpPackage.hs

@@ -5,7 +5,8 @@
 module Stack.Types.DumpPackage
   ( DumpPackage (..)
   , SublibDump (..)
-  , dpParentLibIdent
+  , DumpedGlobalPackage
+  , sublibParentPkgId
   ) where
 
 import qualified Distribution.License as C
@@ -14,17 +15,17 @@ import           Stack.Prelude
 import           Stack.Types.Component ( StackUnqualCompName )
 import           Stack.Types.GhcPkgId ( GhcPkgId )
 
--- | Type representing dump information for a single package, as output by the
--- @ghc-pkg describe@ command.
+-- | Type representing dump information for a single installed package, as
+-- output by the @ghc-pkg describe@ command.
 data DumpPackage = DumpPackage
   { ghcPkgId :: !GhcPkgId
     -- ^ The @id@ field.
   , packageIdent :: !PackageIdentifier
     -- ^ The @name@ and @version@ fields. The @name@ field is the munged package
-    -- name. If the package is not for a sub library, its munged name is its
+    -- name. If the package is not for a sub-library, its munged name is its
     -- name.
   , sublib :: !(Maybe SublibDump)
-    -- ^ The sub library information if it's a sub-library.
+    -- ^ The sub-library information, if it is a sub-library.
   , license :: !(Maybe C.License)
   , libDirs :: ![FilePath]
     -- ^ The @library-dirs@ field.
@@ -40,20 +41,22 @@ data DumpPackage = DumpPackage
   }
   deriving (Eq, Read, Show)
 
--- | ghc-pkg has a notion of sublibraries when using ghc-pkg dump. We can only
--- know it's different through the fields it shows.
+-- | An installed package for a sub-library of a Cabal package has additional
+-- fields.
 data SublibDump = SublibDump
   { packageName :: PackageName
-    -- ^ "package-name" field from ghc-pkg
+    -- ^ The @package-name@ field.
   , libraryName :: StackUnqualCompName
-    -- ^ "lib-name" field from ghc-pkg
+    -- ^ The @lib-name@ field.
   }
   deriving (Eq, Read, Show)
 
-dpParentLibIdent :: DumpPackage -> Maybe PackageIdentifier
-dpParentLibIdent dp = case (dp.sublib, dp.packageIdent) of
-  (Nothing, _) -> Nothing
-  (Just sublibDump, PackageIdentifier _ v) ->
-    Just $ PackageIdentifier libParentPackageName v
-   where
-    SublibDump { packageName = libParentPackageName } = sublibDump
+-- | Type synonym representing dump information for a single installed package
+-- in the global package database.
+type DumpedGlobalPackage = DumpPackage
+
+-- | If the given 'DumpPackage' is for a sub-library of a Cabal package, yields
+-- the package identifier of the Cabal package.
+sublibParentPkgId :: DumpPackage -> Maybe PackageIdentifier
+sublibParentPkgId dp = dp.sublib <&> \subLibDump ->
+  PackageIdentifier subLibDump.packageName dp.packageIdent.pkgVersion