cabal-install: add --build-timings flag

cabal-install/parser-tests/Tests/ParserTests.hs

@@ -173,6 +173,7 @@ testProjectConfigBuildOnly = do
         , cinstInstallMethod = Flag InstallMethodSymlink
         , cinstInstalldir = Flag "path/to/installdir"
         }
+    projectConfigBuildTimings = mempty
 
 testProjectConfigShared :: Assertion
 testProjectConfigShared = do

cabal-install/src/Distribution/Client/Config.hs

@@ -453,6 +453,7 @@ instance Semigroup SavedConfig where
           , installKeepGoing = combine installKeepGoing
           , installRunTests = combine installRunTests
           , installOfflineMode = combine installOfflineMode
+          , installBuildTimings = combine installBuildTimings
           }
         where
           combine = combine' savedInstallFlags

cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
@@ -113,10 +114,12 @@ import qualified Data.ByteString.Lazy.Char8 as LBS.Char8
 import qualified Data.List.NonEmpty as NE
 
 import Control.Exception (ErrorCall, Handler (..), SomeAsyncException, assert, catches, onException)
+import GHC.Clock (getMonotonicTime)
 import System.Directory (canonicalizePath, createDirectoryIfMissing, doesDirectoryExist, listDirectory)
 import System.FilePath (dropDrive, normalise, takeDirectory, (<.>), (</>))
 import System.IO (Handle, IOMode (AppendMode), withFile)
 import System.Semaphore (SemaphoreName (..))
+import Text.Printf (printf)
 
 import GHC.Stack
 import Web.Browser (openBrowser)
@@ -178,7 +181,10 @@ buildAndRegisterUnpackedPackage
   verbosity
   distDirLayout@DistDirLayout{distTempDirectory}
   maybe_semaphore
-  buildTimeSettings@BuildTimeSettings{buildSettingKeepTempFiles}
+  buildTimeSettings@BuildTimeSettings
+    { buildSettingKeepTempFiles
+    , buildSettingBuildTimings
+    }
   registerLock
   cacheLock
   pkgshared@ElaboratedSharedConfig
@@ -193,7 +199,7 @@ buildAndRegisterUnpackedPackage
   delegate = do
     -- Configure phase
     mbLBI <-
-      delegate $
+      timedDelegate $
         PBConfigurePhase $
           annotateFailure mlogFile ConfigureFailed $
             setup
@@ -204,7 +210,7 @@ buildAndRegisterUnpackedPackage
               (InLibraryArgs $ InLibraryConfigureArgs pkgshared rpkg)
 
     -- Build phase
-    delegate $
+    timedDelegate $
       PBBuildPhase $
         annotateFailure mlogFile BuildFailed $ do
           setup
@@ -216,7 +222,7 @@ buildAndRegisterUnpackedPackage
 
     -- Haddock phase
     whenHaddock $
-      delegate $
+      timedDelegate $
         PBHaddockPhase $
           annotateFailure mlogFile HaddocksFailed $ do
             setup
@@ -227,7 +233,7 @@ buildAndRegisterUnpackedPackage
               (InLibraryArgs $ InLibraryPostConfigureArgs SHaddockPhase mbLBI)
 
     -- Install phase
-    delegate $
+    timedDelegate $
       PBInstallPhase
         { runCopy = \destdir ->
             annotateFailure mlogFile InstallFailed $
@@ -258,7 +264,7 @@ buildAndRegisterUnpackedPackage
 
     -- Test phase
     whenTest $
-      delegate $
+      timedDelegate $
         PBTestPhase $
           annotateFailure mlogFile TestsFailed $
             setup
@@ -270,7 +276,7 @@ buildAndRegisterUnpackedPackage
 
     -- Bench phase
     whenBench $
-      delegate $
+      timedDelegate $
         PBBenchPhase $
           annotateFailure mlogFile BenchFailed $
             setup
@@ -282,7 +288,7 @@ buildAndRegisterUnpackedPackage
 
     -- Repl phase
     whenRepl $
-      delegate $
+      timedDelegate $
         PBReplPhase $
           annotateFailure mlogFile ReplFailed $
             setupInteractive
@@ -296,6 +302,33 @@ buildAndRegisterUnpackedPackage
     where
       uid = installedUnitId rpkg
 
+      timedDelegate :: forall r. PackageBuildingPhase r -> IO r
+      timedDelegate phase
+        | buildSettingBuildTimings = do
+            t0 <- getMonotonicTime
+            let
+              printTiming :: String -> IO ()
+              printTiming suffix = do
+                t1 <- getMonotonicTime
+                let
+                  elapsed = t1 - t0
+                  pkgstr = prettyShow (packageId rpkg)
+                  msg =
+                    unwords
+                      [ "[build-timings]"
+                      , buildPhaseName phase
+                      , pkgstr
+                      , -- Print milliseconds (3 decimal places)
+                        printf "%.3fs" elapsed
+                      , suffix
+                      ]
+                notice verbosity msg
+            r <- delegate phase `onException` printTiming "(failed)"
+            !_ <- evaluate r
+            printTiming ""
+            return r
+        | otherwise = delegate phase
+
       comp_par_strat = case maybe_semaphore of
         Just sem_name -> Cabal.toFlag (getSemaphoreName sem_name)
         _ -> Cabal.NoFlag
@@ -957,6 +990,16 @@ annotateFailure mlogFile annotate action =
 -- * Other Utils
 --------------------------------------------------------------------------------
 
+-- | Display name for each build phase, used in timing output.
+buildPhaseName :: PackageBuildingPhase r -> String
+buildPhaseName PBConfigurePhase{} = "configure"
+buildPhaseName PBBuildPhase{} = "build"
+buildPhaseName PBHaddockPhase{} = "haddock"
+buildPhaseName PBReplPhase{} = "repl"
+buildPhaseName PBInstallPhase{} = "install"
+buildPhaseName PBTestPhase{} = "test"
+buildPhaseName PBBenchPhase{} = "bench"
+
 hasValidHaddockTargets :: ElaboratedConfiguredPackage -> Bool
 hasValidHaddockTargets ElaboratedConfiguredPackage{..}
   | not elabBuildHaddocks = False

cabal-install/src/Distribution/Client/ProjectConfig.hs

@@ -468,6 +468,7 @@ resolveBuildTimeSettings
         fromFlag projectConfigReportPlanningFailure
       buildSettingProgPathExtra = fromNubList projectConfigProgPathExtra
       buildSettingHaddockOpen = False
+      buildSettingBuildTimings = fromFlagOrDefault False projectConfigBuildTimings
 
       ProjectConfigBuildOnly{..} =
         defaults

cabal-install/src/Distribution/Client/ProjectConfig/FieldGrammar.hs

@@ -66,6 +66,7 @@ projectConfigBuildOnlyFieldGrammar =
     <*> optionalFieldDefAla "remote-repo-cache" (alaFlag FilePathNT) L.projectConfigCacheDir mempty
     <*> optionalFieldDefAla "logs-dir" (alaFlag FilePathNT) L.projectConfigLogsDir mempty
     <*> blurFieldGrammar L.projectConfigClientInstallFlags clientInstallFlagsGrammar
+    <*> optionalFieldDef "build-timings" L.projectConfigBuildTimings mempty
 
 projectConfigSharedFieldGrammar :: ProjectConfigPath -> ParsecFieldGrammar' ProjectConfigShared
 projectConfigSharedFieldGrammar source =

cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs

@@ -926,6 +926,7 @@ convertLegacyBuildOnlyFlags
         , installUseSemaphore = projectConfigUseSemaphore
         , installKeepGoing = projectConfigKeepGoing
         , installOfflineMode = projectConfigOfflineMode
+        , installBuildTimings = projectConfigBuildTimings
         } = installFlags
 
 convertToLegacyProjectConfig :: ProjectConfig -> LegacyProjectConfig
@@ -1061,6 +1062,7 @@ convertToLegacySharedConfig
           , installKeepGoing = projectConfigKeepGoing
           , installRunTests = mempty
           , installOfflineMode = projectConfigOfflineMode
+          , installBuildTimings = projectConfigBuildTimings
           }
 
       projectFlags =
@@ -1497,6 +1499,7 @@ legacySharedConfigFieldDescrs constraintSrc =
           , "keep-going"
           , "offline"
           , "per-component"
+          , "build-timings"
           , -- solver flags:
             "max-backjumps"
           , "reorder-goals"

cabal-install/src/Distribution/Client/ProjectConfig/Lens.hs

@@ -164,6 +164,10 @@ projectConfigClientInstallFlags :: Lens' ProjectConfigBuildOnly (ClientInstallFl
 projectConfigClientInstallFlags f s = fmap (\x -> s{T.projectConfigClientInstallFlags = x}) (f (T.projectConfigClientInstallFlags s))
 {-# INLINEABLE projectConfigClientInstallFlags #-}
 
+projectConfigBuildTimings :: Lens' ProjectConfigBuildOnly (Flag Bool)
+projectConfigBuildTimings f s = fmap (\x -> s{T.projectConfigBuildTimings = x}) (f (T.projectConfigBuildTimings s))
+{-# INLINEABLE projectConfigBuildTimings #-}
+
 projectConfigDistDir :: Lens' ProjectConfigShared (Flag FilePath)
 projectConfigDistDir f s = fmap (\x -> s{T.projectConfigDistDir = x}) (f (T.projectConfigDistDir s))
 {-# INLINEABLE projectConfigDistDir #-}

cabal-install/src/Distribution/Client/ProjectConfig/Types.hs

@@ -182,6 +182,7 @@ data ProjectConfigBuildOnly = ProjectConfigBuildOnly
   , projectConfigCacheDir :: Flag FilePath
   , projectConfigLogsDir :: Flag FilePath
   , projectConfigClientInstallFlags :: ClientInstallFlags
+  , projectConfigBuildTimings :: Flag Bool
   }
   deriving (Eq, Show, Generic)
 
@@ -522,6 +523,7 @@ data BuildTimeSettings = BuildTimeSettings
   , buildSettingIgnoreExpiry :: Bool
   , buildSettingProgPathExtra :: [FilePath]
   , buildSettingHaddockOpen :: Bool
+  , buildSettingBuildTimings :: Bool
   }
   deriving (Generic)
 

cabal-install/src/Distribution/Client/Setup.hs

@@ -2276,6 +2276,7 @@ data InstallFlags = InstallFlags
   , installKeepGoing :: Flag Bool
   , installRunTests :: Flag Bool
   , installOfflineMode :: Flag Bool
+  , installBuildTimings :: Flag Bool
   }
   deriving (Eq, Show, Generic)
 
@@ -2319,6 +2320,7 @@ defaultInstallFlags =
     , installKeepGoing = Flag False
     , installRunTests = mempty
     , installOfflineMode = Flag False
+    , installBuildTimings = Flag False
     }
   where
     docIndexFile =
@@ -2822,6 +2824,13 @@ installOptions showOrParseArgs =
           installOfflineMode
           (\v flags -> flags{installOfflineMode = v})
           (yesNoOpt showOrParseArgs)
+       , option
+          []
+          ["build-timings"]
+          "Print elapsed time for each build phase."
+          installBuildTimings
+          (\v flags -> flags{installBuildTimings = v})
+          (yesNoOpt showOrParseArgs)
        ]
     ++ case showOrParseArgs of -- TODO: remove when "cabal install"
     -- avoids

cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs

@@ -525,6 +525,7 @@ instance Arbitrary ProjectConfigBuildOnly where
       <*> (fmap getShortToken <$> arbitrary)
       <*> (fmap getShortToken <$> arbitrary)
       <*> arbitrary
+      <*> arbitrary
     where
       arbitraryNumJobs = fmap (fmap getPositive) <$> arbitrary
 
@@ -549,6 +550,7 @@ instance Arbitrary ProjectConfigBuildOnly where
       , projectConfigCacheDir = x15
       , projectConfigLogsDir = x16
       , projectConfigClientInstallFlags = x17
+      , projectConfigBuildTimings = x20
       } =
       [ ProjectConfigBuildOnly
         { projectConfigVerbosity = x00'
@@ -570,17 +572,18 @@ instance Arbitrary ProjectConfigBuildOnly where
         , projectConfigCacheDir = x15
         , projectConfigLogsDir = x16
         , projectConfigClientInstallFlags = x17'
+        , projectConfigBuildTimings = x20'
         }
       | ( (x00', x01', x02', x03', x04')
           , (x05', x06', x07', x09')
           , (x10', x11', x12', x14')
-          , (x17', x18', x19')
+          , (x17', x18', x19', x20')
           ) <-
           shrink
             ( (x00, x01, x02, x03, x04)
             , (x05, x06, x07, preShrink_NumJobs x09)
             , (x10, x11, x12, x14)
-            , (x17, x18, x19)
+            , (x17, x18, x19, x20)
             )
       ]
       where

changelog.d/build-timings.md

@@ -0,0 +1,13 @@
+synopsis: Add flag for build timings
+packages: cabal-install
+prs: #11769
+description:{
+Introduce `--build-timings` flag to `cabal-install`. This flag makes `cabal-install`
+log timing information to stdout, in a format like:
+
+```
+[build-timings] configure aeson-2.2.3.0 0.042s
+[build-timings] build     aeson-2.2.3.0 3.284s
+[build-timings] install   aeson-2.2.3.0 0.123s
+```
+}

doc/cabal-project-description-file.rst

@@ -511,6 +511,14 @@ package, and thus apply globally:
     The command line variant of this flag is ``--package-db=DB`` which can be
     specified multiple times.
 
+.. option:: --build-timings
+
+    Log timing information to stdout, in the following format::
+
+        [build-timings] configure aeson-2.2.3.0 0.042s
+        [build-timings] build     aeson-2.2.3.0 3.284s
+        [build-timings] install   aeson-2.2.3.0 0.123s
+
 Phase control
 -------------