From 2c3c9d0133853a33a657030b95dfffe928d7bead Mon Sep 17 00:00:00 2001 From: Mike Pilgrem Date: Sat, 7 Dec 2024 19:57:01 +0000 Subject: [PATCH] Minor refactoring around DumpPackage --- src/Stack/Build/ConstructPlan.hs | 4 ++-- src/Stack/Build/Installed.hs | 4 ++-- src/Stack/Build/Source.hs | 5 +++-- src/Stack/SourceMap.hs | 6 ++---- src/Stack/Types/DumpPackage.hs | 35 +++++++++++++++++--------------- 5 files changed, 28 insertions(+), 26 deletions(-) diff --git a/src/Stack/Build/ConstructPlan.hs b/src/Stack/Build/ConstructPlan.hs index 9fb79bddd4..9e5913d05d 100644 --- a/src/Stack/Build/ConstructPlan.hs +++ b/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 :: diff --git a/src/Stack/Build/Installed.hs b/src/Stack/Build/Installed.hs index dea753f187..6d90803fd5 100644 --- a/src/Stack/Build/Installed.hs +++ b/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 diff --git a/src/Stack/Build/Source.hs b/src/Stack/Build/Source.hs index 65c9645207..c7f7c4c5b8 100644 --- a/src/Stack/Build/Source.hs +++ b/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 diff --git a/src/Stack/SourceMap.hs b/src/Stack/SourceMap.hs index cf26fb68f6..5e89a0d4cb 100644 --- a/src/Stack/SourceMap.hs +++ b/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 diff --git a/src/Stack/Types/DumpPackage.hs b/src/Stack/Types/DumpPackage.hs index 823d047ae7..2d67e2e722 100644 --- a/src/Stack/Types/DumpPackage.hs +++ b/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