diff options
author | Andrey Mokhov <andrey.mokhov@gmail.com> | 2019-03-14 14:12:20 +0000 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-03-27 07:20:03 -0400 |
commit | 646f2e79c5d6e79341693b1b9660da974102cec2 (patch) | |
tree | 47aec452033043e7caa84130eff5020123dcbde8 /hadrian | |
parent | ab41c1b429374e22f51c06128c173ef4f14be67d (diff) | |
download | haskell-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.
Diffstat (limited to 'hadrian')
-rw-r--r-- | hadrian/src/Hadrian/Haskell/Cabal/Parse.hs | 20 |
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 |