diff --git a/cabal-install/parser-tests/Tests/ParserTests.hs b/cabal-install/parser-tests/Tests/ParserTests.hs index 34b65edcb5e..9c7572c5ab7 100644 --- a/cabal-install/parser-tests/Tests/ParserTests.hs +++ b/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 diff --git a/cabal-install/src/Distribution/Client/Config.hs b/cabal-install/src/Distribution/Client/Config.hs index de06da57c29..53ef8552696 100644 --- a/cabal-install/src/Distribution/Client/Config.hs +++ b/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 diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs b/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs index 4168472065f..a468ee7b2af 100644 --- a/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs +++ b/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 diff --git a/cabal-install/src/Distribution/Client/ProjectConfig.hs b/cabal-install/src/Distribution/Client/ProjectConfig.hs index c81b9c16535..ee1ad046a30 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig.hs +++ b/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 diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/FieldGrammar.hs b/cabal-install/src/Distribution/Client/ProjectConfig/FieldGrammar.hs index f49279f7781..f5672a3ccf8 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/FieldGrammar.hs +++ b/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 = diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs index 90e0c347995..c3731ac79d5 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs +++ b/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" diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Lens.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Lens.hs index 03164305a62..ce30f4639c1 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Lens.hs +++ b/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 #-} diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs index 751875be403..a15339f2f4d 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs +++ b/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) diff --git a/cabal-install/src/Distribution/Client/Setup.hs b/cabal-install/src/Distribution/Client/Setup.hs index c2651a33331..5b91524ab91 100644 --- a/cabal-install/src/Distribution/Client/Setup.hs +++ b/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 diff --git a/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs b/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs index 2b98aa05432..118727500d2 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs +++ b/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 diff --git a/changelog.d/build-timings.md b/changelog.d/build-timings.md new file mode 100644 index 00000000000..b6ef65593dd --- /dev/null +++ b/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 +``` +} diff --git a/doc/cabal-project-description-file.rst b/doc/cabal-project-description-file.rst index fc7d9a3eb87..588e6e73481 100644 --- a/doc/cabal-project-description-file.rst +++ b/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 -------------