summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndrey Mokhov <andrey.mokhov@gmail.com>2019-03-14 14:12:20 +0000
committerMarge Bot <ben+marge-bot@smart-cactus.org>2019-03-27 07:20:03 -0400
commit646f2e79c5d6e79341693b1b9660da974102cec2 (patch)
tree47aec452033043e7caa84130eff5020123dcbde8
parentab41c1b429374e22f51c06128c173ef4f14be67d (diff)
downloadhaskell-646f2e79c5d6e79341693b1b9660da974102cec2.tar.gz
Hadrian: trace the execution of expensive Cabal calls
We use Cabal to parse, configure, register and copy packages, which are expensive operations that are currently not visible to Shake's profiling infrastructure. By using `traced` we tell Shake to add these IO actions to the profiling report, helping us to identify performance bottlenecks. We use short tracing keys, as recommended in Shake docs: the name of the current target is already available in the rest of the profiling information.
-rw-r--r--hadrian/src/Hadrian/Haskell/Cabal/Parse.hs20
1 files changed, 12 insertions, 8 deletions
diff --git a/hadrian/src/Hadrian/Haskell/Cabal/Parse.hs b/hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
index d53aabd5e1..347aa99b15 100644
--- a/hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
+++ b/hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
@@ -55,7 +55,8 @@ import Settings
-- "Hadrian.Oracles.TextFile.readPackageData" oracle.
parsePackageData :: Package -> Action PackageData
parsePackageData pkg = do
- gpd <- liftIO $ C.readGenericPackageDescription C.verbose (pkgCabalFile pkg)
+ gpd <- traced "cabal-read" $
+ C.readGenericPackageDescription C.verbose (pkgCabalFile pkg)
let pd = C.packageDescription gpd
pkgId = C.package pd
name = C.unPackageName (C.pkgName pkgId)
@@ -141,8 +142,9 @@ configurePackage context@Context {..} = do
argList <- interpret (target context (Cabal Setup stage) [] []) flavourArgs
verbosity <- getVerbosity
let v = if verbosity >= Loud then "-v3" else "-v0"
- liftIO $ C.defaultMainWithHooksNoReadArgs hooks gpd
- (argList ++ ["--flags=" ++ unwords flagList, v])
+ traced "cabal-configure" $
+ C.defaultMainWithHooksNoReadArgs hooks gpd
+ (argList ++ ["--flags=" ++ unwords flagList, v])
dir <- Context.buildPath context
files <- liftIO $ getDirectoryFilesIO "." [ dir -/- "include" <//> "*"
@@ -161,8 +163,9 @@ copyPackage context@Context {..} = do
pkgDbPath <- packageDbPath stage
verbosity <- getVerbosity
let v = if verbosity >= Loud then "-v3" else "-v0"
- liftIO $ C.defaultMainWithHooksNoReadArgs C.autoconfUserHooks gpd
- [ "copy", "--builddir", ctxPath, "--target-package-db", pkgDbPath, v ]
+ traced "cabal-copy" $
+ C.defaultMainWithHooksNoReadArgs C.autoconfUserHooks gpd
+ [ "copy", "--builddir", ctxPath, "--target-package-db", pkgDbPath, v ]
-- | Register the 'Package' of a given 'Context' into the package database.
registerPackage :: Context -> Action ()
@@ -172,8 +175,9 @@ registerPackage context@Context {..} = do
gpd <- pkgGenericDescription package
verbosity <- getVerbosity
let v = if verbosity >= Loud then "-v3" else "-v0"
- liftIO $ C.defaultMainWithHooksNoReadArgs C.autoconfUserHooks gpd
- [ "register", "--builddir", ctxPath, v ]
+ traced "cabal-register" $
+ C.defaultMainWithHooksNoReadArgs C.autoconfUserHooks gpd
+ [ "register", "--builddir", ctxPath, v ]
-- | Parse the 'ContextData' of a given 'Context'.
resolveContextData :: Context -> Action ContextData
@@ -293,7 +297,7 @@ buildAutogenFiles context = do
pd <- packageDescription <$> readContextData context
-- Note: the @cPath@ is ignored. The path that's used is the 'buildDir' path
-- from the local build info @lbi@.
- liftIO $ do
+ traced "cabal-autogen" $ do
lbi <- C.getPersistBuildConfig cPath
C.initialBuildSteps cPath pd (lbi { C.localPkgDescr = pd }) C.silent