From 64948336906d441cd943e6d965d103f00c0323e0 Mon Sep 17 00:00:00 2001 From: Mike Pilgrem Date: Tue, 2 Jun 2026 23:37:34 +0100 Subject: [PATCH 1/2] Fix #6896 Allow dependency package to have no main library The basic idea is: * The `InstalledLibraryInfo` constructor is modified so that the `GhcPkgId` of a main library is optional. * A `ConfigCacheTypeFlagLibrary` value is, like a `ConfigCacheTypeFlagExecutable` value, based on the package identifier (rather than the 'GhcPkgId' of the main library, which may not be present) * `Stack.SDist` needs to be considered more carefully. * `fetchAndMarkInstalledPackage` allows for the absence of a buildable main library but the presence of sublibraries. An integration test is added. --- src/Stack/Build/Cache.hs | 13 ++--- src/Stack/Build/ExecutePackage.hs | 50 +++++++++---------- src/Stack/Build/Installed.hs | 24 +++++---- src/Stack/SDist.hs | 5 +- src/Stack/Types/Cache.hs | 37 ++++++++------ src/Stack/Types/Installed.hs | 28 +++++++---- src/Stack/Types/Package.hs | 9 ++-- .../tests/6896-dep-with-no-main-lib/Main.hs | 7 +++ .../files/.gitignore | 2 + .../files/myPackageA/package.yaml | 11 ++++ .../files/myPackageA/src/Lib.hs | 1 + .../files/myPackageB/package.yaml | 13 +++++ .../files/myPackageB/sub/Sublib.hs | 1 + .../files/stack.yaml | 5 ++ 14 files changed, 131 insertions(+), 75 deletions(-) create mode 100644 tests/integration/tests/6896-dep-with-no-main-lib/Main.hs create mode 100644 tests/integration/tests/6896-dep-with-no-main-lib/files/.gitignore create mode 100644 tests/integration/tests/6896-dep-with-no-main-lib/files/myPackageA/package.yaml create mode 100644 tests/integration/tests/6896-dep-with-no-main-lib/files/myPackageA/src/Lib.hs create mode 100644 tests/integration/tests/6896-dep-with-no-main-lib/files/myPackageB/package.yaml create mode 100644 tests/integration/tests/6896-dep-with-no-main-lib/files/myPackageB/sub/Sublib.hs create mode 100644 tests/integration/tests/6896-dep-with-no-main-lib/files/stack.yaml diff --git a/src/Stack/Build/Cache.hs b/src/Stack/Build/Cache.hs index 2f5aca0d3e..366ae18b39 100644 --- a/src/Stack/Build/Cache.hs +++ b/src/Stack/Build/Cache.hs @@ -79,9 +79,7 @@ import Stack.Types.EnvConfig ) import Stack.Types.GhcPkgId ( ghcPkgIdString ) import Stack.Types.Installed - ( InstallLocation (..), Installed (..) - , InstalledLibraryInfo (..), foldOnGhcPkgId' - ) + ( InstallLocation (..), Installed (..), foldOnGhcPkgId' ) import Stack.Types.NamedComponent ( NamedComponent (..), componentCachePath ) import Stack.Types.SourceMap ( smRelDir ) @@ -301,12 +299,9 @@ deleteCaches dir = flagCacheKey :: (HasEnvConfig env) => Installed -> RIO env ConfigCacheKey flagCacheKey installed = do installationRoot <- installationRootLocal - case installed of - Library _ installedInfo -> do - let gid = installedInfo.ghcPkgId - pure $ configCacheKey installationRoot (ConfigCacheTypeFlagLibrary gid) - Executable ident -> pure $ - configCacheKey installationRoot (ConfigCacheTypeFlagExecutable ident) + pure $ configCacheKey installationRoot $ case installed of + Library ident _ -> ConfigCacheTypeFlagLibrary ident + Executable ident -> ConfigCacheTypeFlagExecutable ident -- | Loads the Cabal flag cache for the given installed extra-deps. tryGetFlagCache :: diff --git a/src/Stack/Build/ExecutePackage.hs b/src/Stack/Build/ExecutePackage.hs index 903a647b77..5f6f0a681c 100644 --- a/src/Stack/Build/ExecutePackage.hs +++ b/src/Stack/Build/ExecutePackage.hs @@ -129,7 +129,7 @@ import Stack.Types.GhcPkgId ( GhcPkgId, ghcPkgIdToText ) import Stack.Types.GlobalOpts ( GlobalOpts (..) ) import Stack.Types.Installed ( InstallLocation (..), Installed (..), InstalledMap - , InstalledLibraryInfo (..) + , InstalledLibraryInfo (..), simpleInstalledLib ) import Stack.Types.IsMutable ( IsMutable (..) ) import Stack.Types.NamedComponent @@ -138,8 +138,7 @@ import Stack.Types.NamedComponent ) import Stack.Types.Package ( LocalPackage (..), Package (..), installedPackageToGhcPkgId - , runMemoizedWith, simpleInstalledLib - , toCabalMungedPackageName + , runMemoizedWith, toCabalMungedPackageName ) import Stack.Types.PackageFile ( PackageWarning (..) ) import Stack.Types.Plan @@ -721,27 +720,28 @@ fetchAndMarkInstalledPackage :: -> PackageIdentifier -> RIO env Installed fetchAndMarkInstalledPackage ee taskInstallLocation package pkgId = do - let ghcPkgIdLoader = fetchGhcPkgIdForLib ee taskInstallLocation package.name - -- Only pure the sub-libraries to cache them if we also cache the main - -- library (that is, if it exists) - if hasBuildableMainLibrary package + let hasMainLibrary = hasBuildableMainLibrary package + subLibs = package.subLibraries + if not hasMainLibrary && null subLibs then do - let foldSubLibToMap subLib mapInMonad = do - maybeGhcpkgId <- ghcPkgIdLoader (Just subLib.name) - mapInMonad <&> case maybeGhcpkgId of - Just v -> Map.insert subLib.name v - _ -> id - subLibsPkgIds <- foldComponentToAnotherCollection - package.subLibraries - foldSubLibToMap - mempty - ghcPkgIdLoader Nothing >>= \case - Nothing -> throwM $ Couldn'tFindPkgId package.name - Just ghcPkgId -> pure $ simpleInstalledLib pkgId ghcPkgId subLibsPkgIds - else do - markExeInstalled taskInstallLocation pkgId -- TODO unify somehow - -- with writeFlagCache? + markExeInstalled taskInstallLocation pkgId + -- TODO: Unify the above somehow with writeFlagCache? pure $ Executable pkgId + else do + ghcPkgId <- if hasMainLibrary + then ghcPkgIdLoader Nothing + else pure Nothing + subLibsPkgIds <- + foldComponentToAnotherCollection subLibs foldSubLibToMap mempty + pure $ simpleInstalledLib pkgId ghcPkgId subLibsPkgIds + where + ghcPkgIdLoader = fetchGhcPkgIdForLib ee taskInstallLocation package.name + + foldSubLibToMap subLib mapInMonad = do + maybeGhcpkgId <- ghcPkgIdLoader (Just subLib.name) + mapInMonad <&> case maybeGhcpkgId of + Just v -> Map.insert subLib.name v + _ -> id fetchGhcPkgIdForLib :: (HasTerm env, HasEnvConfig env) @@ -921,7 +921,7 @@ copyPreCompiled ee task pkgId (PrecompiledCache mlib subLibs exes) = do pure $ Just $ case mpkgid of Nothing -> assert False $ Executable pkgId - Just pkgid -> simpleInstalledLib pkgId pkgid mempty + _ -> simpleInstalledLib pkgId mpkgid mempty where bindir = ee.baseConfigOpts.snapInstallRoot bindirSuffix @@ -1062,8 +1062,8 @@ singleTest topts testsToRun ac ee task installedMap = do idMap <- liftIO $ readTVarIO ee.ghcPkgIds pure $ Map.lookup (taskProvides task) idMap let pkgGhcIdList = case installed of - Just (Library _ libInfo) -> [libInfo.ghcPkgId] - _ -> [] + Just (Library _ libInfo) -> maybeToList libInfo.mMainGhcPkgId + _ -> [] -- doctest relies on template-haskell in QuickCheck-based tests thGhcId <- case L.find ((== "template-haskell") . pkgName . (.packageIdent) . snd) diff --git a/src/Stack/Build/Installed.hs b/src/Stack/Build/Installed.hs index 1e2d4d5b45..77c7cd80f1 100644 --- a/src/Stack/Build/Installed.hs +++ b/src/Stack/Build/Installed.hs @@ -287,7 +287,8 @@ toLoadHelper compiler pkgDb dp = LoadHelper if name `Set.member` wiredInPackages compiler then [] else dp.depends - installedLibInfo = InstalledLibraryInfo ghcPkgId (Right <$> dp.license) mempty + installedLibInfo = + InstalledLibraryInfo (Just ghcPkgId) (Right <$> dp.license) mempty toInstallLocation :: PackageDbVariety -> InstallLocation toInstallLocation GlobalDb = Snap @@ -313,23 +314,26 @@ gatherAndTransformSubLoadHelper lh = (_, Library _ existingLibInfo) = ( pLoc , Library pn existingLibInfo - { subLib = Map.union - incomingLibInfo.subLib - existingLibInfo.subLib - , ghcPkgId = if isJust lh.subLibDump - then existingLibInfo.ghcPkgId - else incomingLibInfo.ghcPkgId + { subLib = Map.union incomingLibInfo.subLib existingLibInfo.subLib + , mMainGhcPkgId = + if isJust lh.subLibDump + then existingLibInfo.mMainGhcPkgId + else incomingLibInfo.mMainGhcPkgId } ) onPreviousLoadHelper newVal _oldVal = newVal (key, value) = case lh.subLibDump of Nothing -> (rawPackageName, rawValue) Just sd -> (sd.packageName, updateAsSublib sd <$> rawValue) + -- rawValue should always have a main library: see toLoadHelper. (rawPackageName, rawValue) = lh.pair updateAsSublib sd (Library (PackageIdentifier _sublibMungedPackageName version) libInfo) - = Library - (PackageIdentifier key version) - libInfo { subLib = Map.singleton sd.libraryName libInfo.ghcPkgId } + = case libInfo.mMainGhcPkgId of + Nothing -> + error "gatherAndTransformSubLoadHelper: the impossible happened!" + Just ghcPkgId' -> Library + (PackageIdentifier key version) + libInfo { subLib = Map.singleton sd.libraryName ghcPkgId' } updateAsSublib _ v = v diff --git a/src/Stack/SDist.hs b/src/Stack/SDist.hs index a27f117ad6..ca94712a73 100644 --- a/src/Stack/SDist.hs +++ b/src/Stack/SDist.hs @@ -227,8 +227,9 @@ getSDistTarball mpvpBounds pkgDir = do (installedMap, _globalDumpPkgs, _snapshotDumpPkgs, _localDumpPkgs) <- getInstalled installMap let deps = Map.fromList - [ (pid, libInfo.ghcPkgId) - | (_, Library pid libInfo) <- Map.elems installedMap] + [ (pid, ghcPkgId) + | (_, Library pid (InstalledLibraryInfo (Just ghcPkgId) _ _)) <- Map.elems installedMap + ] prettyInfoL [ flow "Getting the file list for" , style File (fromString pkgFp) <> "." diff --git a/src/Stack/Types/Cache.hs b/src/Stack/Types/Cache.hs index 154b6499b5..f114d51652 100644 --- a/src/Stack/Types/Cache.hs +++ b/src/Stack/Types/Cache.hs @@ -29,14 +29,13 @@ import Database.Persist.Sql ) import Stack.Prelude import Stack.Types.ConfigureOpts ( ConfigureOpts ) -import Stack.Types.GhcPkgId - ( GhcPkgId, ghcPkgIdToText, parseGhcPkgId ) +import Stack.Types.GhcPkgId ( GhcPkgId ) -- | Type representing types of cache in the Stack project SQLite database. data ConfigCacheType = ConfigCacheTypeConfig -- ^ Cabal configuration cache. - | ConfigCacheTypeFlagLibrary GhcPkgId + | ConfigCacheTypeFlagLibrary PackageIdentifier -- ^ Library Cabal flag cache. | ConfigCacheTypeFlagExecutable PackageIdentifier -- ^ Executable Cabal flag cache. @@ -45,25 +44,35 @@ data ConfigCacheType instance PersistField ConfigCacheType where toPersistValue ConfigCacheTypeConfig = PersistText "config" toPersistValue (ConfigCacheTypeFlagLibrary v) = - PersistText $ "lib:" <> ghcPkgIdToText v + PersistText $ "lib:" <> T.pack (packageIdentifierString v) toPersistValue (ConfigCacheTypeFlagExecutable v) = PersistText $ "exe:" <> T.pack (packageIdentifierString v) + fromPersistValue (PersistText t) = fromMaybe (Left $ "Unexpected ConfigCacheType value: " <> t) $ - config <|> fmap lib (T.stripPrefix "lib:" t) <|> - fmap exe (T.stripPrefix "exe:" t) + config + <|> flagCache ConfigCacheTypeFlagLibrary "lib:" + <|> flagCache ConfigCacheTypeFlagExecutable "exe:" where config | t == "config" = Just (Right ConfigCacheTypeConfig) | otherwise = Nothing - lib v = do - ghcPkgId <- mapLeft tshow (parseGhcPkgId v) - Right $ ConfigCacheTypeFlagLibrary ghcPkgId - exe v = do - pkgId <- - maybe (Left $ "Unexpected ConfigCacheType value: " <> t) Right $ - parsePackageIdentifier (T.unpack v) - Right $ ConfigCacheTypeFlagExecutable pkgId + + flagCache :: + (PackageIdentifier -> ConfigCacheType) + -- ^ Constructor + -> Text + -- ^ Prefex + -> Maybe (Either Text ConfigCacheType) + flagCache constructor prefix = + fmap toConfigCacheType (T.stripPrefix prefix t) + where + toConfigCacheType :: Text -> Either Text ConfigCacheType + toConfigCacheType v = do + pkgId <- + maybe (Left $ "Unexpected ConfigCacheType value: " <> t) Right $ + parsePackageIdentifier (T.unpack v) + Right $ constructor pkgId fromPersistValue _ = Left "Unexpected ConfigCacheType type" instance PersistFieldSql ConfigCacheType where diff --git a/src/Stack/Types/Installed.hs b/src/Stack/Types/Installed.hs index ba84f66b1e..84bb89ca46 100644 --- a/src/Stack/Types/Installed.hs +++ b/src/Stack/Types/Installed.hs @@ -101,10 +101,15 @@ type InstallMap = Map PackageName (InstallLocation, Version) -- information about what is installed. type InstalledMap = Map PackageName (InstallLocation, Installed) +-- TODO: This may not be the best type, as it allows invalid values to be +-- represented. data InstalledLibraryInfo = InstalledLibraryInfo - { ghcPkgId :: GhcPkgId + { mMainGhcPkgId :: Maybe GhcPkgId + -- ^ The main library, if present. If absent, there must be one or more + -- installed sublibraries. , license :: Maybe (Either SPDX.License License) , subLib :: Map StackUnqualCompName GhcPkgId + -- ^ If there are no sublibraries, there must be a main library. } deriving (Eq, Show) @@ -119,19 +124,22 @@ data Installed installedLibraryInfoFromGhcPkgId :: GhcPkgId -> InstalledLibraryInfo installedLibraryInfoFromGhcPkgId ghcPkgId = - InstalledLibraryInfo ghcPkgId Nothing mempty + InstalledLibraryInfo (Just ghcPkgId) Nothing mempty simpleInstalledLib :: PackageIdentifier - -> GhcPkgId + -> Maybe GhcPkgId + -- ^ The id of the installed main library, if any. -> Map StackUnqualCompName GhcPkgId + -- ^ The id of any sublibraries. -> Installed simpleInstalledLib pkgIdentifier ghcPkgId = Library pkgIdentifier . InstalledLibraryInfo ghcPkgId Nothing installedToPackageIdOpt :: InstalledLibraryInfo -> [String] installedToPackageIdOpt libInfo = - M.foldr' (iterator (++)) (pure $ toStr libInfo.ghcPkgId) libInfo.subLib + let acc0 = toStr <$> maybeToList libInfo.mMainGhcPkgId + in M.foldr' (iterator (++)) acc0 libInfo.subLib where toStr ghcPkgId = "-package-id=" <> ghcPkgIdString ghcPkgId iterator op ghcPkgId acc = pure (toStr ghcPkgId) `op` acc @@ -141,17 +149,17 @@ installedPackageIdentifier (Library pid _) = pid installedPackageIdentifier (Executable pid) = pid -- | A strict fold over the 'GhcPkgId' of the given installed package. This will --- iterate on both sub and main libraries, if any. +-- iterate on the main library (if any) and sublibraries (if any). foldOnGhcPkgId' :: - (Maybe StackUnqualCompName -> GhcPkgId -> resT -> resT) + (Maybe StackUnqualCompName -> GhcPkgId -> a -> a) -> Installed - -> resT - -> resT + -> a + -> a foldOnGhcPkgId' _ Executable{} res = res foldOnGhcPkgId' fn (Library _ libInfo) res = - M.foldrWithKey' (fn . Just) (base res) libInfo.subLib + M.foldrWithKey' (fn . Just) base libInfo.subLib where - base = fn Nothing libInfo.ghcPkgId + base = maybe res (\ghcPkgId -> fn Nothing ghcPkgId res) libInfo.mMainGhcPkgId -- | Get the installed Version. installedVersion :: Installed -> Version diff --git a/src/Stack/Types/Package.hs b/src/Stack/Types/Package.hs index 488415ddea..42c295166d 100644 --- a/src/Stack/Types/Package.hs +++ b/src/Stack/Types/Package.hs @@ -40,7 +40,6 @@ module Stack.Types.Package , packageIdentifier , psVersion , runMemoizedWith - , simpleInstalledLib , toCabalMungedPackageName , toPackageDbVariety ) where @@ -74,8 +73,7 @@ import Stack.Types.Installed ( InstallLocation (..), InstallMap, Installed (..) , InstalledLibraryInfo (..), InstalledMap , InstalledPackageLocation (..), PackageDatabase (..) - , PackageDbVariety(..), simpleInstalledLib - , toPackageDbVariety + , PackageDbVariety(..), toPackageDbVariety ) import Stack.Types.NamedComponent ( NamedComponent ) import Stack.Types.PackageFile @@ -386,7 +384,8 @@ dotCabalGetPath dcp = DotCabalFilePath fp -> fp DotCabalCFilePath fp -> fp --- | Gathers all the GhcPkgId provided by a library into a map +-- | Gathers all the GhcPkgId provided by a library into a map, where the +-- package identifier of a sublibrary is its munged package identifier. installedMapGhcPkgId :: PackageIdentifier -> InstalledLibraryInfo @@ -394,7 +393,7 @@ installedMapGhcPkgId :: installedMapGhcPkgId pkgId@(PackageIdentifier pkgName version) installedLib = finalMap where - finalMap = M.insert pkgId installedLib.ghcPkgId baseMap + finalMap = maybe id (M.insert pkgId) installedLib.mMainGhcPkgId baseMap baseMap = M.mapKeysMonotonic (toCabalMungedPackageIdentifier pkgName version) diff --git a/tests/integration/tests/6896-dep-with-no-main-lib/Main.hs b/tests/integration/tests/6896-dep-with-no-main-lib/Main.hs new file mode 100644 index 0000000000..36b1ff3ab4 --- /dev/null +++ b/tests/integration/tests/6896-dep-with-no-main-lib/Main.hs @@ -0,0 +1,7 @@ +-- | Stack can support a dependency package that has one or more public +-- sublibraries but no unnamed main library. + +import StackTest + +main :: IO () +main = stack ["build"] diff --git a/tests/integration/tests/6896-dep-with-no-main-lib/files/.gitignore b/tests/integration/tests/6896-dep-with-no-main-lib/files/.gitignore new file mode 100644 index 0000000000..f9a6e152d2 --- /dev/null +++ b/tests/integration/tests/6896-dep-with-no-main-lib/files/.gitignore @@ -0,0 +1,2 @@ +myPackageA.cabal +myPackageB.cabal diff --git a/tests/integration/tests/6896-dep-with-no-main-lib/files/myPackageA/package.yaml b/tests/integration/tests/6896-dep-with-no-main-lib/files/myPackageA/package.yaml new file mode 100644 index 0000000000..89c90db88c --- /dev/null +++ b/tests/integration/tests/6896-dep-with-no-main-lib/files/myPackageA/package.yaml @@ -0,0 +1,11 @@ +spec-version: 0.36.0 + +name: myPackageA + +dependencies: +- base + +library: + source-dirs: src + dependencies: + - myPackageB:myPackageB-sub diff --git a/tests/integration/tests/6896-dep-with-no-main-lib/files/myPackageA/src/Lib.hs b/tests/integration/tests/6896-dep-with-no-main-lib/files/myPackageA/src/Lib.hs new file mode 100644 index 0000000000..6d85a26fe1 --- /dev/null +++ b/tests/integration/tests/6896-dep-with-no-main-lib/files/myPackageA/src/Lib.hs @@ -0,0 +1 @@ +module Lib where diff --git a/tests/integration/tests/6896-dep-with-no-main-lib/files/myPackageB/package.yaml b/tests/integration/tests/6896-dep-with-no-main-lib/files/myPackageB/package.yaml new file mode 100644 index 0000000000..05fd49c434 --- /dev/null +++ b/tests/integration/tests/6896-dep-with-no-main-lib/files/myPackageB/package.yaml @@ -0,0 +1,13 @@ +# This package has no unnamed main library. + +spec-version: 0.36.0 + +name: myPackageB + +dependencies: +- base + +internal-libraries: + myPackageB-sub: + visibility: public + source-dirs: sub diff --git a/tests/integration/tests/6896-dep-with-no-main-lib/files/myPackageB/sub/Sublib.hs b/tests/integration/tests/6896-dep-with-no-main-lib/files/myPackageB/sub/Sublib.hs new file mode 100644 index 0000000000..c41d4cbf16 --- /dev/null +++ b/tests/integration/tests/6896-dep-with-no-main-lib/files/myPackageB/sub/Sublib.hs @@ -0,0 +1 @@ +module Sublib where diff --git a/tests/integration/tests/6896-dep-with-no-main-lib/files/stack.yaml b/tests/integration/tests/6896-dep-with-no-main-lib/files/stack.yaml new file mode 100644 index 0000000000..68891a8d7c --- /dev/null +++ b/tests/integration/tests/6896-dep-with-no-main-lib/files/stack.yaml @@ -0,0 +1,5 @@ +snapshot: ghc-9.10.3 + +packages: +- myPackageA +- myPackageB From 6eab2a7e9bb2f548d7fb5a73caf8a423f1ae9d16 Mon Sep 17 00:00:00 2001 From: Mike Pilgrem Date: Wed, 3 Jun 2026 22:02:41 +0100 Subject: [PATCH 2/2] Update STAN configuration --- .stan.toml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/.stan.toml b/.stan.toml index 066f2ef802..1143376d39 100644 --- a/.stan.toml +++ b/.stan.toml @@ -151,14 +151,14 @@ # Anti-pattern: Data.ByteString.Char8.pack [[ignore]] - id = "OBS-STAN-0203-tuE+RG-252:24" + id = "OBS-STAN-0203-tuE+RG-251:24" # ✦ Description: Usage of 'pack' function that doesn't handle Unicode characters # ✦ Category: #AntiPattern # ✦ File: src\Stack\Build\ExecutePackage.hs # -# 249 ┃ -# 250 ┃ newConfigFileRoot <- S8.pack . toFilePath <$> view configFileRootL -# 251 ┃ ^^^^^^^ +# 250 ┃ +# 251 ┃ newConfigFileRoot <- S8.pack . toFilePath <$> view configFileRootL +# 252 ┃ ^^^^^^^ # Anti-pattern: Data.ByteString.Char8.pack [[ignore]]