Consistent handling of internal libraries

ChangeLog.md

@@ -11,6 +11,9 @@ Behavior changes:
 
 * `ghc-options` from `stack.yaml` are now appended to `ghc-options` from
   `config.yaml`, whereas before they would be replaced.
+* `stack build` will now announce when sublibraries of a package are being
+  build, in the same way executables, tests, benchmarks and libraries are
+  announced
 
 Other enhancements:
 
@@ -57,6 +60,19 @@ Bug fixes:
   displays. Also fixes a similar issue with ghci target selection prompt.
 * If `cabal` is not on PATH, running `stack solver` now prompts the user
   to run `stack install cabal-install`
+* `stack build` now succeeds in building packages which contain sublibraries
+  which are dependencies of executables, tests or benchmarks but not of the
+  main library. See
+  [#3787](https://github.com/commercialhaskell/stack/issues/3959).
+* Sublibraries are now properly considered for coverage reports when the test
+  suite depends on the internal library. Before, stack was erroring when
+  trying to generate the coverage report, see
+  [#4105](https://github.com/commercialhaskell/stack/issues/4105).
+* Sublibraries are now added to the precompiled cache and recovered from there
+  when the snapshot gets updated. Previously, updating the snapshot when there
+  was a package with a sublibrary in the snapshot resulted in broken builds.
+  This is now fixed, see
+  [#4071](https://github.com/commercialhaskell/stack/issues/4071).
 
 
 ## v1.7.1

src/Stack/Build/Cache.hs

@@ -324,29 +324,33 @@ writePrecompiledCache :: HasEnvConfig env
                       -> ConfigureOpts
                       -> Set GhcPkgId -- ^ dependencies
                       -> Installed -- ^ library
+                      -> [GhcPkgId] -- ^ sublibraries, in the GhcPkgId format
                       -> Set Text -- ^ executables
                       -> RIO env ()
-writePrecompiledCache baseConfigOpts loc copts depIDs mghcPkgId exes = do
+writePrecompiledCache baseConfigOpts loc copts depIDs mghcPkgId sublibs exes = do
   mfile <- precompiledCacheFile loc copts depIDs
   forM_ mfile $ \file -> do
     ensureDir (parent file)
     ec <- view envConfigL
     let stackRootRelative = makeRelative (view stackRootL ec)
-    mlibpath <-
-        case mghcPkgId of
-            Executable _ -> return Nothing
-            Library _ ipid _ -> liftM Just $ do
-                ipid' <- parseRelFile $ ghcPkgIdString ipid ++ ".conf"
-                relPath <- stackRootRelative $ bcoSnapDB baseConfigOpts </> ipid'
-                return $ toFilePath relPath
+    mlibpath <- case mghcPkgId of
+      Executable _ -> return Nothing
+      Library _ ipid _ -> liftM Just $ pathFromPkgId stackRootRelative ipid
+    sublibpaths <- mapM (pathFromPkgId stackRootRelative) sublibs
     exes' <- forM (Set.toList exes) $ \exe -> do
         name <- parseRelFile $ T.unpack exe
         relPath <- stackRootRelative $ bcoSnapInstallRoot baseConfigOpts </> bindirSuffix </> name
         return $ toFilePath relPath
     $(versionedEncodeFile precompiledCacheVC) file PrecompiledCache
         { pcLibrary = mlibpath
+        , pcSubLibs = sublibpaths
         , pcExes = exes'
         }
+  where
+    pathFromPkgId stackRootRelative ipid = do
+      ipid' <- parseRelFile $ ghcPkgIdString ipid ++ ".conf"
+      relPath <- stackRootRelative $ bcoSnapDB baseConfigOpts </> ipid'
+      return $ toFilePath relPath
 
 -- | Check the cache for a precompiled package matching the given
 -- configuration.
@@ -372,6 +376,7 @@ readPrecompiledCache loc copts depIDs = runMaybeT $
       let mkAbs' = (toFilePath stackRoot FP.</>)
       return PrecompiledCache
         { pcLibrary = mkAbs' <$> pcLibrary pc0
+        , pcSubLibs = mkAbs' <$> pcSubLibs pc0
         , pcExes = mkAbs' <$> pcExes pc0
         }
 

src/Stack/Build/ConstructPlan.hs

@@ -716,8 +716,10 @@ addPackageDeps treatAsDep package = do
         TTFiles lp _ -> packageHasLibrary $ lpPackage lp
         TTIndex p _ _ -> packageHasLibrary p
 
+    -- make sure we consider internal libraries as libraries too
     packageHasLibrary :: Package -> Bool
     packageHasLibrary p =
+      Set.null (packageInternalLibraries p) ||
       case packageLibraries p of
         HasLibraries _ -> True
         NoLibraries -> False

src/Stack/Build/Execute.hs

@@ -1245,20 +1245,24 @@ singleBuild ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} installedMap
       where
         result = T.intercalate " + " $ concat
             [ ["lib" | taskAllInOne && hasLib]
+            , ["internal-lib" | taskAllInOne && hasSubLib]
             , ["exe" | taskAllInOne && hasExe]
             , ["test" | enableTests]
             , ["bench" | enableBenchmarks]
             ]
-        (hasLib, hasExe) = case taskType of
+        (hasLib, hasSubLib, hasExe) = case taskType of
             TTFiles lp Local ->
-              let hasLibrary =
-                    case packageLibraries (lpPackage lp) of
+              let package = lpPackage lp
+                  hasLibrary =
+                    case packageLibraries package of
                       NoLibraries -> False
                       HasLibraries _ -> True
-               in (hasLibrary, not (Set.null (exesToBuild executableBuildStatuses lp)))
+                  hasSubLibrary = not . Set.null $ packageInternalLibraries package
+                  hasExecutables = not . Set.null $ exesToBuild executableBuildStatuses lp
+               in (hasLibrary, hasSubLibrary, hasExecutables)
             -- This isn't true, but we don't want to have this info for
             -- upstream deps.
-            _ -> (False, False)
+            _ -> (False, False, False)
 
     getPrecompiled cache =
         case taskLocation task of
@@ -1291,10 +1295,27 @@ singleBuild ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} installedMap
                         return $ if b then Just pc else Nothing
             _ -> return Nothing
 
-    copyPreCompiled (PrecompiledCache mlib exes) = do
+    copyPreCompiled (PrecompiledCache mlib sublibs exes) = do
         wc <- view $ actualCompilerVersionL.whichCompilerL
         announceTask task "using precompiled package"
-        forM_ mlib $ \libpath -> do
+
+        -- We need to copy .conf files for the main library and all sublibraries which exist in the cache,
+        -- from their old snapshot to the new one. However, we must unregister any such library in the new
+        -- snapshot, in case it was built with different flags.
+        let
+          subLibNames = map T.unpack . Set.toList $ case taskType of
+            TTFiles lp _ -> packageInternalLibraries $ lpPackage lp
+            TTIndex p _ _ -> packageInternalLibraries p
+          (name, version) = toTuple taskProvides
+          mainLibName = packageNameString name
+          mainLibVersion = versionString version
+          pkgName = mainLibName ++ "-" ++ mainLibVersion
+          -- z-package-z-internal for internal lib internal of package package
+          toCabalInternalLibName n = concat ["z-", mainLibName, "-z-", n, "-", mainLibVersion]
+          allToUnregister = map (const pkgName) (maybeToList mlib) ++ map toCabalInternalLibName subLibNames
+          allToRegister = maybeToList mlib ++ sublibs
+
+        unless (null allToRegister) $ do
             withMVar eeInstallLock $ \() -> do
                 -- We want to ignore the global and user databases.
                 -- Unfortunately, ghc-pkg doesn't take such arguments on the
@@ -1306,23 +1327,17 @@ singleBuild ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} installedMap
                       (T.pack $ toFilePathNoTrailingSep $ bcoSnapDB eeBaseConfigOpts)
 
                 withModifyEnvVars modifyEnv $ do
-                  -- In case a build of the library with different flags already exists, unregister it
-                  -- before copying.
                   let ghcPkgExe = ghcPkgExeName wc
-                  catchAny
-                      (readProcessNull ghcPkgExe
-                          [ "unregister"
-                          , "--force"
-                          , packageIdentifierString taskProvides
-                          ])
+
+                  -- first unregister everything that needs to be unregistered
+                  forM_ allToUnregister $ \packageName -> catchAny
+                      (readProcessNull ghcPkgExe [ "unregister", "--force", packageName])
                       (const (return ()))
 
-                  void $ proc ghcPkgExe
-                      [ "register"
-                      , "--force"
-                      , libpath
-                      ]
-                      readProcess_
+                  -- now, register the cached conf files
+                  forM_ allToRegister $ \libpath ->
+                    proc ghcPkgExe [ "register", "--force", libpath] readProcess_
+
         liftIO $ forM_ exes $ \exe -> do
             D.createDirectoryIfMissing True bindir
             let dst = bindir FP.</> FP.takeFileName exe
@@ -1478,7 +1493,10 @@ singleBuild ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} installedMap
               case packageLibraries package of
                 NoLibraries -> False
                 HasLibraries _ -> True
-            shouldCopy = not isFinalBuild && (hasLibrary || not (Set.null (packageExes package)))
+            packageHasComponentSet f = not $ Set.null $ f package
+            hasInternalLibrary = packageHasComponentSet packageInternalLibraries
+            hasExecutables = packageHasComponentSet packageExes
+            shouldCopy = not isFinalBuild && (hasLibrary || hasInternalLibrary || hasExecutables)
         when shouldCopy $ withMVar eeInstallLock $ \() -> do
             announce "copy/register"
             eres <- try $ cabal KeepTHLoading ["copy"]
@@ -1497,15 +1515,24 @@ singleBuild ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} installedMap
                         ( bcoLocalDB eeBaseConfigOpts
                         , eeLocalDumpPkgs )
         let ident = PackageIdentifier (packageName package) (packageVersion package)
-        mpkgid <- case packageLibraries package of
+        -- only return the sublibs to cache them if we also cache the main lib (that is, if it exists)
+        (mpkgid, sublibsPkgIds) <- case packageLibraries package of
             HasLibraries _ -> do
+                sublibsPkgIds <- fmap catMaybes $
+                  forM (Set.toList $ packageInternalLibraries package) $ \sublib -> do
+                    -- z-haddock-library-z-attoparsec for internal lib attoparsec of haddock-library
+                    let sublibName = T.concat ["z-", packageNameText $ packageName package, "-z-", sublib]
+                    case parsePackageName sublibName of
+                      Nothing -> return Nothing -- invalid lib, ignored
+                      Just subLibName -> loadInstalledPkg wc [installedPkgDb] installedDumpPkgsTVar subLibName
+
                 mpkgid <- loadInstalledPkg wc [installedPkgDb] installedDumpPkgsTVar (packageName package)
                 case mpkgid of
                     Nothing -> throwM $ Couldn'tFindPkgId $ packageName package
-                    Just pkgid -> return $ Library ident pkgid Nothing
+                    Just pkgid -> return (Library ident pkgid Nothing, sublibsPkgIds)
             NoLibraries -> do
                 markExeInstalled (taskLocation task) taskProvides -- TODO unify somehow with writeFlagCache?
-                return $ Executable ident
+                return (Executable ident, []) -- don't return sublibs in this case
 
         case taskLocation task of
             Snap ->
@@ -1514,7 +1541,7 @@ singleBuild ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} installedMap
                 (ttPackageLocation taskType)
                 (configCacheOpts cache)
                 (configCacheDeps cache)
-                mpkgid (packageExes package)
+                mpkgid sublibsPkgIds (packageExes package)
             _ -> return ()
 
         case taskType of
@@ -1905,7 +1932,7 @@ primaryComponentOptions executableBuildStatuses lp =
       -- TODO: get this information from target parsing instead,
       -- which will allow users to turn off library building if
       -- desired
-      (case packageLibraries (lpPackage lp) of
+      (case packageLibraries package of
          NoLibraries -> []
          HasLibraries names ->
              map T.unpack

src/Stack/Build/Source.hs

@@ -214,7 +214,9 @@ loadLocalPackage isLocal boptsCli targets (name, lpv) = do
                     case packageLibraries pkg of
                       NoLibraries -> False
                       HasLibraries _ -> True
-               in hasLibrary || not (Set.null nonLibComponents)
+               in hasLibrary
+               || not (Set.null nonLibComponents)
+               || not (Set.null $ packageInternalLibraries pkg)
 
         filterSkippedComponents = Set.filter (not . (`elem` boptsSkipComponents bopts))
 

src/Stack/Coverage.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE NoImplicitPrelude     #-}
 {-# LANGUAGE ConstraintKinds       #-}
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
@@ -7,6 +7,8 @@
 {-# LANGUAGE TemplateHaskell       #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE LambdaCase            #-}
+{-# LANGUAGE TupleSections         #-}
+
 -- | Generate HPC (Haskell Program Coverage) reports
 module Stack.Coverage
     ( deleteHpcReports
@@ -23,6 +25,7 @@ import qualified Data.ByteString.Char8 as S8
 import qualified Data.ByteString.Lazy as BL
 import           Data.List
 import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
 import qualified Data.Text.Lazy as LT
@@ -106,23 +109,24 @@ generateHpcReport pkgDir package tests = do
           case packageLibraries package of
             NoLibraries -> False
             HasLibraries _ -> True
+        internalLibs = packageInternalLibraries package
     eincludeName <-
         -- Pre-7.8 uses plain PKG-version in tix files.
-        if ghcVersion < $(mkVersion "7.10") then return $ Right $ Just pkgId
+        if ghcVersion < $(mkVersion "7.10") then return $ Right $ Just [pkgId]
         -- We don't expect to find a package key if there is no library.
-        else if not hasLibrary then return $ Right Nothing
+        else if not hasLibrary && Set.null internalLibs then return $ Right Nothing
         -- Look in the inplace DB for the package key.
         -- See https://github.com/commercialhaskell/stack/issues/1181#issuecomment-148968986
         else do
             -- GHC 8.0 uses package id instead of package key.
             -- See https://github.com/commercialhaskell/stack/issues/2424
             let hpcNameField = if ghcVersion >= $(mkVersion "8.0") then "id" else "key"
-            eincludeName <- findPackageFieldForBuiltPackage pkgDir (packageIdentifier package) hpcNameField
+            eincludeName <- findPackageFieldForBuiltPackage pkgDir (packageIdentifier package) internalLibs hpcNameField
             case eincludeName of
                 Left err -> do
                     logError $ RIO.display err
                     return $ Left err
-                Right includeName -> return $ Right $ Just $ T.unpack includeName
+                Right includeNames -> return $ Right $ Just $ map T.unpack includeNames
     forM_ tests $ \testName -> do
         tixSrc <- tixFilePath (packageName package) (T.unpack testName)
         let report = "coverage report for " <> pkgName <> "'s test-suite \"" <> testName <> "\""
@@ -133,7 +137,7 @@ generateHpcReport pkgDir package tests = do
             -- #634 - this will likely be customizable in the future)
             Right mincludeName -> do
                 let extraArgs = case mincludeName of
-                        Just includeName -> ["--include", includeName ++ ":"]
+                        Just includeNames -> "--include" : intersperse "--include" (map (\n -> n ++ ":") includeNames)
                         Nothing -> []
                 mreportPath <- generateHpcReportInternal tixSrc reportDir report extraArgs extraArgs
                 forM_ mreportPath (displayReportPath report . display)
@@ -425,9 +429,9 @@ dirnameString = dropWhileEnd isPathSeparator . toFilePath . dirname
 
 findPackageFieldForBuiltPackage
     :: HasEnvConfig env
-    => Path Abs Dir -> PackageIdentifier -> Text
-    -> RIO env (Either Text Text)
-findPackageFieldForBuiltPackage pkgDir pkgId field = do
+    => Path Abs Dir -> PackageIdentifier -> Set.Set Text -> Text
+    -> RIO env (Either Text [Text])
+findPackageFieldForBuiltPackage pkgDir pkgId internalLibs field = do
     distDir <- distDirFromDir pkgDir
     let inplaceDir = distDir </> $(mkRelDir "package.conf.inplace")
         pkgIdStr = packageIdentifierString pkgId
@@ -440,20 +444,42 @@ findPackageFieldForBuiltPackage pkgDir pkgId field = do
     cabalVer <- view cabalVersionL
     if cabalVer < $(mkVersion "1.24")
         then do
+            -- here we don't need to handle internal libs
             path <- liftM (inplaceDir </>) $ parseRelFile (pkgIdStr ++ "-inplace.conf")
             logDebug $ "Parsing config in Cabal < 1.24 location: " <> fromString (toFilePath path)
             exists <- doesFileExist path
-            if exists then extractField path else notFoundErr
+            if exists then fmap (:[]) <$> extractField path else notFoundErr
         else do
             -- With Cabal-1.24, it's in a different location.
             logDebug $ "Scanning " <> fromString (toFilePath inplaceDir) <> " for files matching " <> fromString pkgIdStr
             (_, files) <- handleIO (const $ return ([], [])) $ listDir inplaceDir
             logDebug $ displayShow files
-            case mapMaybe (\file -> fmap (const file) . (T.stripSuffix ".conf" <=< T.stripPrefix (T.pack (pkgIdStr ++ "-")))
-                          . T.pack . toFilePath . filename $ file) files of
+            -- From all the files obtained from the scanning process above, we
+            -- need to identify which are .conf files and then ensure that
+            -- there is at most one .conf file for each library and internal
+            -- library (some might be missing if that component has not been
+            -- built yet). We should error if there are more than one .conf
+            -- file for a component or if there are no .conf files at all in
+            -- the searched location.
+            let toFilename = T.pack . toFilePath . filename
+                -- strip known prefix and suffix from the found files to determine only the conf files
+                stripKnown =  T.stripSuffix ".conf" <=< T.stripPrefix (T.pack (pkgIdStr ++ "-"))
+                stripped = mapMaybe (\file -> fmap (,file) . stripKnown . toFilename $ file) files
+                -- which component could have generated each of these conf files
+                stripHash n = let z = T.dropWhile (/= '-') n in if T.null z then "" else T.tail z
+                matchedComponents = map (\(n, f) -> (stripHash n, [f])) stripped
+                byComponents = Map.restrictKeys (Map.fromListWith (++) matchedComponents) $ Set.insert "" internalLibs
+            logDebug $ displayShow byComponents
+            if Map.null $ Map.filter (\fs -> length fs > 1) byComponents
+            then case concat $ Map.elems byComponents of
                 [] -> notFoundErr
-                [path] -> extractField path
-                _ -> return $ Left $ "Multiple files matching " <> T.pack (pkgIdStr ++ "-*.conf") <> " found in " <>
+                -- for each of these files, we need to extract the requested field
+                paths -> do
+                  (errors, keys) <-  partitionEithers <$> traverse extractField paths
+                  case errors of
+                    (a:_) -> return $ Left a -- the first error only, since they're repeated anyway
+                    [] -> return $ Right keys
+            else return $ Left $ "Multiple files matching " <> T.pack (pkgIdStr ++ "-*.conf") <> " found in " <>
                     T.pack (toFilePath inplaceDir) <> ". Maybe try 'stack clean' on this package?"
 
 displayReportPath :: (HasRunner env)