From 88d1da327420a9c9651744beb2c3b62dad2ae6c0 Mon Sep 17 00:00:00 2001 From: Mihai Maruseac Date: Thu, 24 May 2018 20:24:02 -0700 Subject: [PATCH 01/20] Don't recompute package --- src/Stack/Build/Execute.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index 499c4ebc75..ed74c62f87 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -1905,7 +1905,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 From 47347b59342be684b757fda2997f182b6604d684 Mon Sep 17 00:00:00 2001 From: Mihai Maruseac Date: Sat, 26 May 2018 17:51:55 -0800 Subject: [PATCH 02/20] Handle sublibs when determining plan dependencies. --- src/Stack/Build/ConstructPlan.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/Stack/Build/ConstructPlan.hs b/src/Stack/Build/ConstructPlan.hs index d10ba6f499..fcd3037a63 100644 --- a/src/Stack/Build/ConstructPlan.hs +++ b/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 From db230c2d2743cd261dc1a9e8ab61161abc876d20 Mon Sep 17 00:00:00 2001 From: Mihai Maruseac Date: Sun, 27 May 2018 18:18:11 -0800 Subject: [PATCH 03/20] Handle sublibs when determining if a package has wanted components. --- src/Stack/Build/Source.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Stack/Build/Source.hs b/src/Stack/Build/Source.hs index f1cb548d3d..6defa8f6a0 100644 --- a/src/Stack/Build/Source.hs +++ b/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)) From 4a4b63f59130bb66477d155dcb401d50fac02fab Mon Sep 17 00:00:00 2001 From: Mihai Maruseac Date: Mon, 28 May 2018 18:28:58 -0700 Subject: [PATCH 04/20] Announce when building sublibraries --- src/Stack/Build/Execute.hs | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index ed74c62f87..55bacf92eb 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -1245,20 +1245,23 @@ 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 + in (hasLibrary, hasSubLibrary, not (Set.null (exesToBuild executableBuildStatuses lp))) -- 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 From 62771ef53a46b07667a6501525c2bdfe2fc154fe Mon Sep 17 00:00:00 2001 From: Mihai Maruseac Date: Mon, 28 May 2018 18:31:41 -0700 Subject: [PATCH 05/20] Refactor to have an easier to read expression --- src/Stack/Build/Execute.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index 55bacf92eb..850f4df89b 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -1258,7 +1258,8 @@ singleBuild ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} installedMap NoLibraries -> False HasLibraries _ -> True hasSubLibrary = not . Set.null $ packageInternalLibraries package - in (hasLibrary, hasSubLibrary, not (Set.null (exesToBuild executableBuildStatuses lp))) + 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) From d5a04f5643ffbb1da4a1b9fb0097d4464382ead7 Mon Sep 17 00:00:00 2001 From: Mihai Maruseac Date: Tue, 29 May 2018 18:18:11 -0800 Subject: [PATCH 06/20] Handle sublibs when determining if a build result needs copying. --- src/Stack/Build/Execute.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index 850f4df89b..156e5e4193 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -1482,7 +1482,8 @@ 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))) + hasInternalLibrary = not $ Set.null $ packageInternalLibraries package + shouldCopy = not isFinalBuild && (hasLibrary || hasInternalLibrary || not (Set.null (packageExes package))) when shouldCopy $ withMVar eeInstallLock $ \() -> do announce "copy/register" eres <- try $ cabal KeepTHLoading ["copy"] From 95e88fc7ae4709697e5acf0c221541ba3491e23d Mon Sep 17 00:00:00 2001 From: Mihai Maruseac Date: Tue, 29 May 2018 18:23:47 -0800 Subject: [PATCH 07/20] Shorten line by factoring out the check for executables --- src/Stack/Build/Execute.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index 156e5e4193..00631bf983 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -1483,7 +1483,8 @@ singleBuild ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} installedMap NoLibraries -> False HasLibraries _ -> True hasInternalLibrary = not $ Set.null $ packageInternalLibraries package - shouldCopy = not isFinalBuild && (hasLibrary || hasInternalLibrary || not (Set.null (packageExes package))) + hasExecutables = not $ Set.null $ packageExes package + shouldCopy = not isFinalBuild && (hasLibrary || hasInternalLibrary || hasExecutables) when shouldCopy $ withMVar eeInstallLock $ \() -> do announce "copy/register" eres <- try $ cabal KeepTHLoading ["copy"] From 964a46c686da8aa59afffe017ec57318112a423d Mon Sep 17 00:00:00 2001 From: Mihai Maruseac Date: Tue, 29 May 2018 18:26:41 -0800 Subject: [PATCH 08/20] Extract common expression. --- src/Stack/Build/Execute.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index 00631bf983..5fe9ff53f4 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -1482,8 +1482,9 @@ singleBuild ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} installedMap case packageLibraries package of NoLibraries -> False HasLibraries _ -> True - hasInternalLibrary = not $ Set.null $ packageInternalLibraries package - hasExecutables = 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" From 7e8fd9d1a56222e7f061c53dc392afe7eec9da0e Mon Sep 17 00:00:00 2001 From: Mihai Maruseac Date: Wed, 30 May 2018 20:46:36 -0800 Subject: [PATCH 09/20] Allow building with sublibs and no libs (#3787). --- src/Stack/Package.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs index 1e8cc8f040..d452e51739 100644 --- a/src/Stack/Package.hs +++ b/src/Stack/Package.hs @@ -277,9 +277,7 @@ packageFromPackageDescription packageConfig pkgFlags (PackageDescriptionPair pkg Just lib in case mlib of - Nothing - | null extraLibNames -> NoLibraries - | otherwise -> error "Package has buildable sublibraries but no buildable libraries, I'm giving up" + Nothing -> NoLibraries Just _ -> HasLibraries foreignLibNames , packageInternalLibraries = subLibNames , packageTests = M.fromList From 43f37d8555beb8ca724c65a1f730e209e2d46a0f Mon Sep 17 00:00:00 2001 From: Mihai Maruseac Date: Thu, 31 May 2018 23:36:36 -0800 Subject: [PATCH 10/20] Handle sublibs in coverage reports. --- src/Stack/Coverage.hs | 54 ++++++++++++++++++++++++++++++++----------- 1 file changed, 40 insertions(+), 14 deletions(-) diff --git a/src/Stack/Coverage.hs b/src/Stack/Coverage.hs index 5b4623e4f4..0d5393b1cc 100644 --- a/src/Stack/Coverage.hs +++ b/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 (\x -> [x]) <$> 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) <- fmap partitionEithers $ sequence $ fmap 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) From 8d94aaf7c4500237bc7cf56d9e46291be70321e7 Mon Sep 17 00:00:00 2001 From: Mihai Maruseac Date: Thu, 14 Jun 2018 20:37:08 -0800 Subject: [PATCH 11/20] Add sublibraries to the precompiled cache. Next commit will actually handle the addition, for now these are stubs/empty lists. --- src/Stack/Build/Cache.hs | 2 ++ src/Stack/Build/Execute.hs | 2 +- src/Stack/Types/Build.hs | 6 ++++-- 3 files changed, 7 insertions(+), 3 deletions(-) diff --git a/src/Stack/Build/Cache.hs b/src/Stack/Build/Cache.hs index 2f60678906..0e8b04d3f4 100644 --- a/src/Stack/Build/Cache.hs +++ b/src/Stack/Build/Cache.hs @@ -345,6 +345,7 @@ writePrecompiledCache baseConfigOpts loc copts depIDs mghcPkgId exes = do return $ toFilePath relPath $(versionedEncodeFile precompiledCacheVC) file PrecompiledCache { pcLibrary = mlibpath + , pcSubLibs = [] , pcExes = exes' } @@ -372,6 +373,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 } diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index 5fe9ff53f4..3c76958480 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -1295,7 +1295,7 @@ 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 diff --git a/src/Stack/Types/Build.hs b/src/Stack/Types/Build.hs index 1e54a7fc42..67bc55c29f 100644 --- a/src/Stack/Types/Build.hs +++ b/src/Stack/Types/Build.hs @@ -671,11 +671,13 @@ instance Store ConfigureOpts instance NFData ConfigureOpts -- | Information on a compiled package: the library conf file (if relevant), --- and all of the executable paths. +-- the sublibraries (if present) and all of the executable paths. data PrecompiledCache = PrecompiledCache -- Use FilePath instead of Path Abs File for Binary instances { pcLibrary :: !(Maybe FilePath) -- ^ .conf file inside the package database + , pcSubLibs :: ![FilePath] + -- ^ .conf file inside the package database, for each of the sublibraries , pcExes :: ![FilePath] -- ^ Full paths to executables } @@ -684,4 +686,4 @@ instance Store PrecompiledCache instance NFData PrecompiledCache precompiledCacheVC :: VersionConfig PrecompiledCache -precompiledCacheVC = storeVersionConfig "precompiled-v1" "eMzSOwaHJMamA5iNKs1A025frlQ=" +precompiledCacheVC = storeVersionConfig "precompiled-v2" "55vMMtbIlS4UukKnSmjs1SrI01o=" From af27253d83057ff64c6b46c5c08d1f82d4afb04b Mon Sep 17 00:00:00 2001 From: Mihai Maruseac Date: Thu, 14 Jun 2018 20:40:18 -0800 Subject: [PATCH 12/20] Store the sublibraries in the precompiled cache after building. Next commit will handle reloading them from the cache when switching to a new snapshot. --- src/Stack/Build/Cache.hs | 21 ++++++++++++--------- src/Stack/Build/Execute.hs | 9 ++++++++- 2 files changed, 20 insertions(+), 10 deletions(-) diff --git a/src/Stack/Build/Cache.hs b/src/Stack/Build/Cache.hs index 0e8b04d3f4..fbb93d1f9d 100644 --- a/src/Stack/Build/Cache.hs +++ b/src/Stack/Build/Cache.hs @@ -324,30 +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 = [] + , 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. diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index 3c76958480..2249c30370 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -1513,6 +1513,13 @@ singleBuild ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} installedMap NoLibraries -> do markExeInstalled (taskLocation task) taskProvides -- TODO unify somehow with writeFlagCache? return $ Executable ident + sublibsPkgIds <- fmap (mapMaybe id) $ + 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 case taskLocation task of Snap -> @@ -1521,7 +1528,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 From 9c1d512bd0c2f291bc1ad985adcc4821c0415807 Mon Sep 17 00:00:00 2001 From: Mihai Maruseac Date: Sat, 16 Jun 2018 21:44:43 -0800 Subject: [PATCH 13/20] Properly handle precompiled cache entries for sublibraries. --- src/Stack/Build/Execute.hs | 41 ++++++++++++++++++++++++-------------- 1 file changed, 26 insertions(+), 15 deletions(-) diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index 2249c30370..e88dbb798f 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -1298,7 +1298,24 @@ singleBuild ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} installedMap 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 + + when (not $ 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 @@ -1310,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 From 8bfab462d1f555683d3371858c50eb535a5e3f99 Mon Sep 17 00:00:00 2001 From: Mihai Maruseac Date: Sun, 17 Jun 2018 20:09:37 -0800 Subject: [PATCH 14/20] Make sure we don't cache sublibraries when there is no library. --- src/Stack/Build/Execute.hs | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index e88dbb798f..fd5a00892b 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -1515,22 +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 (mapMaybe id) $ + 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 - sublibsPkgIds <- fmap (mapMaybe id) $ - 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 + return (Executable ident, []) -- don't return sublibs in this case case taskLocation task of Snap -> From 3e2202adc1e2f5a0fd3c54c1902eeb8b2df739a4 Mon Sep 17 00:00:00 2001 From: Mihai Maruseac Date: Mon, 18 Jun 2018 07:32:19 -0800 Subject: [PATCH 15/20] Document changes in `ChangeLog.md`. --- ChangeLog.md | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/ChangeLog.md b/ChangeLog.md index e8dcd5690d..60ab70dacc 100644 --- a/ChangeLog.md +++ b/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,16 @@ 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. +* 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 From 3e1c7d338a174fc794d5a783fe8f79efc2bbe1a7 Mon Sep 17 00:00:00 2001 From: Mihai Maruseac Date: Thu, 21 Jun 2018 06:54:39 -0700 Subject: [PATCH 16/20] Update the ChangeLog description of the coverage bug fix. --- ChangeLog.md | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/ChangeLog.md b/ChangeLog.md index 60ab70dacc..a2fd8e2648 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -64,7 +64,10 @@ Bug fixes: 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. +* 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. From 013d1c41bb519a22f366d397fab59f2fc0d7621b Mon Sep 17 00:00:00 2001 From: Mihai Maruseac Date: Fri, 22 Jun 2018 06:46:34 -0700 Subject: [PATCH 17/20] Add integration test for #3787 --- .../3787-internal-libs-with-no-main-lib/Main.hs | 6 ++++++ .../files/exe/Main.hs | 1 + .../files/files.cabal | 16 ++++++++++++++++ .../files/src-sublib/B.hs | 5 +++++ .../files/stack.yaml | 1 + 5 files changed, 29 insertions(+) create mode 100644 test/integration/tests/3787-internal-libs-with-no-main-lib/Main.hs create mode 100644 test/integration/tests/3787-internal-libs-with-no-main-lib/files/exe/Main.hs create mode 100644 test/integration/tests/3787-internal-libs-with-no-main-lib/files/files.cabal create mode 100644 test/integration/tests/3787-internal-libs-with-no-main-lib/files/src-sublib/B.hs create mode 100644 test/integration/tests/3787-internal-libs-with-no-main-lib/files/stack.yaml diff --git a/test/integration/tests/3787-internal-libs-with-no-main-lib/Main.hs b/test/integration/tests/3787-internal-libs-with-no-main-lib/Main.hs new file mode 100644 index 0000000000..09bd4aa3b0 --- /dev/null +++ b/test/integration/tests/3787-internal-libs-with-no-main-lib/Main.hs @@ -0,0 +1,6 @@ +import StackTest + +main :: IO () +main = do + stack ["clean"] + stack ["build"] diff --git a/test/integration/tests/3787-internal-libs-with-no-main-lib/files/exe/Main.hs b/test/integration/tests/3787-internal-libs-with-no-main-lib/files/exe/Main.hs new file mode 100644 index 0000000000..83db768ed3 --- /dev/null +++ b/test/integration/tests/3787-internal-libs-with-no-main-lib/files/exe/Main.hs @@ -0,0 +1 @@ +main = putStrLn "OK" diff --git a/test/integration/tests/3787-internal-libs-with-no-main-lib/files/files.cabal b/test/integration/tests/3787-internal-libs-with-no-main-lib/files/files.cabal new file mode 100644 index 0000000000..631f10c48d --- /dev/null +++ b/test/integration/tests/3787-internal-libs-with-no-main-lib/files/files.cabal @@ -0,0 +1,16 @@ +name: files +version: 0.1.0.0 +build-type: Simple +cabal-version: >= 2.0 + +library sublib + exposed-modules: B + hs-source-dirs: src-sublib + build-depends: base + default-language: Haskell2010 + +executable exe + main-is: Main.hs + hs-source-dirs: exe + build-depends: base, sublib + default-language: Haskell2010 diff --git a/test/integration/tests/3787-internal-libs-with-no-main-lib/files/src-sublib/B.hs b/test/integration/tests/3787-internal-libs-with-no-main-lib/files/src-sublib/B.hs new file mode 100644 index 0000000000..53253d5dcc --- /dev/null +++ b/test/integration/tests/3787-internal-libs-with-no-main-lib/files/src-sublib/B.hs @@ -0,0 +1,5 @@ +module B where + +-- | A function of the internal library +funInternal :: Int -> Int +funInternal = pred diff --git a/test/integration/tests/3787-internal-libs-with-no-main-lib/files/stack.yaml b/test/integration/tests/3787-internal-libs-with-no-main-lib/files/stack.yaml new file mode 100644 index 0000000000..1203bf4507 --- /dev/null +++ b/test/integration/tests/3787-internal-libs-with-no-main-lib/files/stack.yaml @@ -0,0 +1 @@ +resolver: lts-11.11 From 0ec30631295f2658dfea1f7d1a98b0342992d017 Mon Sep 17 00:00:00 2001 From: Mihai Maruseac Date: Fri, 22 Jun 2018 07:01:22 -0700 Subject: [PATCH 18/20] Add integration test for #4105 --- .../Main.hs | 19 +++++++++++++++ .../files/files.cabal | 23 +++++++++++++++++++ .../files/src-sublib/B.hs | 5 ++++ .../files/src/Src.hs | 5 ++++ .../files/stack.yaml | 1 + .../files/test/Main.hs | 6 +++++ 6 files changed, 59 insertions(+) create mode 100644 test/integration/tests/4105-test-coverage-of-internal-lib/Main.hs create mode 100644 test/integration/tests/4105-test-coverage-of-internal-lib/files/files.cabal create mode 100644 test/integration/tests/4105-test-coverage-of-internal-lib/files/src-sublib/B.hs create mode 100644 test/integration/tests/4105-test-coverage-of-internal-lib/files/src/Src.hs create mode 100644 test/integration/tests/4105-test-coverage-of-internal-lib/files/stack.yaml create mode 100644 test/integration/tests/4105-test-coverage-of-internal-lib/files/test/Main.hs diff --git a/test/integration/tests/4105-test-coverage-of-internal-lib/Main.hs b/test/integration/tests/4105-test-coverage-of-internal-lib/Main.hs new file mode 100644 index 0000000000..59e3373f29 --- /dev/null +++ b/test/integration/tests/4105-test-coverage-of-internal-lib/Main.hs @@ -0,0 +1,19 @@ +import Control.Monad (unless) +import Data.List (isInfixOf, isPrefixOf) +import StackTest + +main :: IO () +main = do + stack ["clean"] + stack ["build"] + res <- getCoverageLines . snd <$> stackStderr ["test", "--coverage"] + case res of + _:exprs:_ -> unless ("2/2" `isInfixOf` exprs) testFail + _ -> testFail + where + testFail = fail "Stack didn't generate coverage from both libraries" + +getCoverageLines :: String -> [String] +getCoverageLines = dropWhile (not . isCoverageHeader) . lines + where + isCoverageHeader = isPrefixOf "Generating coverage report for " diff --git a/test/integration/tests/4105-test-coverage-of-internal-lib/files/files.cabal b/test/integration/tests/4105-test-coverage-of-internal-lib/files/files.cabal new file mode 100644 index 0000000000..49cd5a2431 --- /dev/null +++ b/test/integration/tests/4105-test-coverage-of-internal-lib/files/files.cabal @@ -0,0 +1,23 @@ +name: files +version: 0.1.0.0 +build-type: Simple +cabal-version: >= 2.0 + +library + exposed-modules: Src + hs-source-dirs: src + build-depends: base + default-language: Haskell2010 + +library sublib + exposed-modules: B + hs-source-dirs: src-sublib + build-depends: base + default-language: Haskell2010 + +test-suite test + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: test + build-depends: base, files, sublib + default-language: Haskell2010 diff --git a/test/integration/tests/4105-test-coverage-of-internal-lib/files/src-sublib/B.hs b/test/integration/tests/4105-test-coverage-of-internal-lib/files/src-sublib/B.hs new file mode 100644 index 0000000000..53253d5dcc --- /dev/null +++ b/test/integration/tests/4105-test-coverage-of-internal-lib/files/src-sublib/B.hs @@ -0,0 +1,5 @@ +module B where + +-- | A function of the internal library +funInternal :: Int -> Int +funInternal = pred diff --git a/test/integration/tests/4105-test-coverage-of-internal-lib/files/src/Src.hs b/test/integration/tests/4105-test-coverage-of-internal-lib/files/src/Src.hs new file mode 100644 index 0000000000..0f8db7fb77 --- /dev/null +++ b/test/integration/tests/4105-test-coverage-of-internal-lib/files/src/Src.hs @@ -0,0 +1,5 @@ +module Src where + +-- | A function of the main library +funMainLib :: Int -> Int +funMainLib = succ diff --git a/test/integration/tests/4105-test-coverage-of-internal-lib/files/stack.yaml b/test/integration/tests/4105-test-coverage-of-internal-lib/files/stack.yaml new file mode 100644 index 0000000000..1203bf4507 --- /dev/null +++ b/test/integration/tests/4105-test-coverage-of-internal-lib/files/stack.yaml @@ -0,0 +1 @@ +resolver: lts-11.11 diff --git a/test/integration/tests/4105-test-coverage-of-internal-lib/files/test/Main.hs b/test/integration/tests/4105-test-coverage-of-internal-lib/files/test/Main.hs new file mode 100644 index 0000000000..b1cf81b0dc --- /dev/null +++ b/test/integration/tests/4105-test-coverage-of-internal-lib/files/test/Main.hs @@ -0,0 +1,6 @@ +import Control.Monad (when) + +import Src +import B + +main = when (funMainLib 41 /= funInternal 43) $ error "test failed" From 7d5ddd68bb6c7c166da06fe7383372e40be8c638 Mon Sep 17 00:00:00 2001 From: Mihai Maruseac Date: Fri, 22 Jun 2018 07:50:23 -0700 Subject: [PATCH 19/20] Style fixes --- src/Stack/Build/ConstructPlan.hs | 2 +- src/Stack/Build/Execute.hs | 6 +++--- src/Stack/Coverage.hs | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/Stack/Build/ConstructPlan.hs b/src/Stack/Build/ConstructPlan.hs index fcd3037a63..2dea78e4a5 100644 --- a/src/Stack/Build/ConstructPlan.hs +++ b/src/Stack/Build/ConstructPlan.hs @@ -719,7 +719,7 @@ addPackageDeps treatAsDep package = do -- make sure we consider internal libraries as libraries too packageHasLibrary :: Package -> Bool packageHasLibrary p = - (Set.null $ packageInternalLibraries p) || + Set.null (packageInternalLibraries p) || case packageLibraries p of HasLibraries _ -> True NoLibraries -> False diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index fd5a00892b..39a76b2deb 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -1315,7 +1315,7 @@ singleBuild ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} installedMap allToUnregister = map (const pkgName) (maybeToList mlib) ++ map toCabalInternalLibName subLibNames allToRegister = maybeToList mlib ++ sublibs - when (not $ null allToRegister) $ do + 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 @@ -1518,7 +1518,7 @@ singleBuild ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} installedMap -- 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 (mapMaybe id) $ + 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] @@ -1529,7 +1529,7 @@ singleBuild ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} installedMap mpkgid <- loadInstalledPkg wc [installedPkgDb] installedDumpPkgsTVar (packageName package) case mpkgid of Nothing -> throwM $ Couldn'tFindPkgId $ packageName package - Just pkgid -> return $ (Library ident pkgid Nothing, sublibsPkgIds) + Just pkgid -> return (Library ident pkgid Nothing, sublibsPkgIds) NoLibraries -> do markExeInstalled (taskLocation task) taskProvides -- TODO unify somehow with writeFlagCache? return (Executable ident, []) -- don't return sublibs in this case diff --git a/src/Stack/Coverage.hs b/src/Stack/Coverage.hs index 0d5393b1cc..72ee3dd10b 100644 --- a/src/Stack/Coverage.hs +++ b/src/Stack/Coverage.hs @@ -448,7 +448,7 @@ findPackageFieldForBuiltPackage pkgDir pkgId internalLibs field = do path <- liftM (inplaceDir ) $ parseRelFile (pkgIdStr ++ "-inplace.conf") logDebug $ "Parsing config in Cabal < 1.24 location: " <> fromString (toFilePath path) exists <- doesFileExist path - if exists then fmap (\x -> [x]) <$> 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 @@ -475,7 +475,7 @@ findPackageFieldForBuiltPackage pkgDir pkgId internalLibs field = do [] -> notFoundErr -- for each of these files, we need to extract the requested field paths -> do - (errors, keys) <- fmap partitionEithers $ sequence $ fmap extractField paths + (errors, keys) <- fmap partitionEithers $ traverse extractField paths case errors of (a:_) -> return $ Left a -- the first error only, since they're repeated anyway [] -> return $ Right keys From cbe07a0a7703ccdbd2fd00f6df31941bfa0b7342 Mon Sep 17 00:00:00 2001 From: Mihai Maruseac Date: Fri, 22 Jun 2018 08:30:27 -0700 Subject: [PATCH 20/20] One more style fix --- src/Stack/Coverage.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Stack/Coverage.hs b/src/Stack/Coverage.hs index 72ee3dd10b..c9f4c3d887 100644 --- a/src/Stack/Coverage.hs +++ b/src/Stack/Coverage.hs @@ -475,7 +475,7 @@ findPackageFieldForBuiltPackage pkgDir pkgId internalLibs field = do [] -> notFoundErr -- for each of these files, we need to extract the requested field paths -> do - (errors, keys) <- fmap partitionEithers $ traverse extractField paths + (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