[commit: ghc] wip/andrey/trace-cabal: Hadrian: trace the execution of expensive Cabal calls (19a99be)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/andrey/trace-cabal
Link       : http://ghc.haskell.org/trac/ghc/changeset/19a99beeaa83fdeff132dbd54f1785bccf52a939/ghc

>---------------------------------------------------------------

commit 19a99beeaa83fdeff132dbd54f1785bccf52a939
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Thu Mar 14 14:12:20 2019 +0000

    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.


>---------------------------------------------------------------

19a99beeaa83fdeff132dbd54f1785bccf52a939
 hadrian/src/Hadrian/Haskell/Cabal/Parse.hs | 22 +++++++++++++---------
 1 file changed, 13 insertions(+), 9 deletions(-)

diff --git a/hadrian/src/Hadrian/Haskell/Cabal/Parse.hs b/hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
index d53aabd..055a27a 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 parse " ++ pkgCabalFile pkg) $
+        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 at 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 " ++ quote (pkgName package)) $
+        C.defaultMainWithHooksNoReadArgs hooks gpd
+            (argList ++ ["--flags=" ++ unwords flagList, v])
 
     dir <- Context.buildPath context
     files <- liftIO $ getDirectoryFilesIO "." [ dir -/- "include" <//> "*"
@@ -161,8 +163,9 @@ copyPackage context at 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 " ++ quote (pkgName package)) $
+        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 at 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 " ++ quote (pkgName package)) $
+        C.defaultMainWithHooksNoReadArgs C.autoconfUserHooks gpd
+            [ "register", "--builddir", ctxPath, v ]
 
 -- | Parse the 'ContextData' of a given 'Context'.
 resolveContextData :: Context -> Action ContextData
@@ -286,14 +290,14 @@ resolveContextData context at Context {..} = do
 
 -- | Build autogenerated files @autogen/cabal_macros.h@ and @autogen/Paths_*.hs at .
 buildAutogenFiles :: Context -> Action ()
-buildAutogenFiles context = do
+buildAutogenFiles context at Context {..} = do
     cPath <- Context.contextPath context
     setupConfig <- pkgSetupConfigFile context
     need [setupConfig] -- This triggers 'configurePackage'
     pd <- packageDescription <$> readContextData context
     -- Note: the @cPath@ is ignored. The path that's used is the 'buildDir' path
     -- from the local build info @lbi at .
-    liftIO $ do
+    traced ("Cabal build autogen files for " ++ quote (pkgName package)) $ do
         lbi <- C.getPersistBuildConfig cPath
         C.initialBuildSteps cPath pd (lbi { C.localPkgDescr = pd }) C.silent