Fix #6896 Allow dependency package to have no main library

.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]]

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 ::

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)

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

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) <> "."

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

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

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,15 +384,16 @@ 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
   -> Map PackageIdentifier GhcPkgId
 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)

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"]

tests/integration/tests/6896-dep-with-no-main-lib/files/.gitignore

@@ -0,0 +1,2 @@
+myPackageA.cabal
+myPackageB.cabal

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

tests/integration/tests/6896-dep-with-no-main-lib/files/myPackageA/src/Lib.hs

@@ -0,0 +1 @@
+module Lib where

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

tests/integration/tests/6896-dep-with-no-main-lib/files/myPackageB/sub/Sublib.hs

@@ -0,0 +1 @@
+module Sublib where