Skip to content

Commit 68a73d0

Browse files
sheafsheaf
committed
cabal-install: add --build-timings flag
This new flag makes cabal-install dump timing information for the various stages of building a package. This allows us to better see how much time is spending in configure/build stages.
1 parent ee7d5da commit 68a73d0

12 files changed

Lines changed: 99 additions & 10 deletions

File tree

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -173,6 +173,7 @@ testProjectConfigBuildOnly = do
173173
, cinstInstallMethod = Flag InstallMethodSymlink
174174
, cinstInstalldir = Flag "path/to/installdir"
175175
}
176+
projectConfigBuildTimings = mempty
176177

177178
testProjectConfigShared :: Assertion
178179
testProjectConfigShared = do

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -447,6 +447,7 @@ instance Semigroup SavedConfig where
447447
, installKeepGoing = combine installKeepGoing
448448
, installRunTests = combine installRunTests
449449
, installOfflineMode = combine installOfflineMode
450+
, installBuildTimings = combine installBuildTimings
450451
}
451452
where
452453
combine = combine' savedInstallFlags

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

Lines changed: 51 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE BangPatterns #-}
12
{-# LANGUAGE CPP #-}
23
{-# LANGUAGE DataKinds #-}
34
{-# LANGUAGE GADTs #-}
@@ -118,10 +119,12 @@ import qualified Data.List.NonEmpty as NE
118119
import Control.Concurrent.STM (TVar, atomically, modifyTVar)
119120
import Control.Exception (ErrorCall, Handler (..), SomeAsyncException, assert, catches, onException)
120121
import Data.IORef (newIORef, readIORef, writeIORef)
122+
import GHC.Clock (getMonotonicTime)
121123
import System.Directory (canonicalizePath, createDirectoryIfMissing, doesDirectoryExist, listDirectory)
122124
import System.FilePath (dropDrive, normalise, takeDirectory, (<.>), (</>))
123125
import System.IO (Handle, IOMode (AppendMode), withFile)
124126
import System.Semaphore (SemaphoreIdentifier)
127+
import Text.Printf (printf)
125128

126129
import GHC.Stack
127130
import Web.Browser (openBrowser)
@@ -189,7 +192,10 @@ buildAndRegisterUnpackedPackage
189192
verbosity
190193
distDirLayout@DistDirLayout{distTempDirectory}
191194
maybe_semaphore
192-
buildTimeSettings@BuildTimeSettings{buildSettingKeepTempFiles}
195+
buildTimeSettings@BuildTimeSettings
196+
{ buildSettingKeepTempFiles
197+
, buildSettingBuildTimings
198+
}
193199
registerLock
194200
cacheLock
195201
pkgshared@ElaboratedSharedConfig
@@ -205,7 +211,7 @@ buildAndRegisterUnpackedPackage
205211
delegate = do
206212
-- Configure phase
207213
mbLBI <-
208-
delegate $
214+
timedDelegate $
209215
PBConfigurePhase $
210216
annotateFailure mlogFile ConfigureFailed $
211217
setup
@@ -216,7 +222,7 @@ buildAndRegisterUnpackedPackage
216222
(InLibraryArgs $ InLibraryConfigureArgs pkgshared rpkg ipiTVar)
217223

218224
-- Build phase
219-
delegate $
225+
timedDelegate $
220226
PBBuildPhase $
221227
annotateFailure mlogFile BuildFailed $ do
222228
setup
@@ -228,7 +234,7 @@ buildAndRegisterUnpackedPackage
228234

229235
-- Haddock phase
230236
whenHaddock $
231-
delegate $
237+
timedDelegate $
232238
PBHaddockPhase $
233239
annotateFailure mlogFile HaddocksFailed $ do
234240
setup
@@ -244,7 +250,7 @@ buildAndRegisterUnpackedPackage
244250
-- the installed package id is, not the build system.
245251
ipkg0 <- generateInstalledPackageInfo mbLBI
246252
return ipkg0{Installed.installedUnitId = uid}
247-
delegate $
253+
timedDelegate $
248254
PBInstallPhase
249255
{ runCopy = \destdir ->
250256
annotateFailure mlogFile InstallFailed $
@@ -273,7 +279,7 @@ buildAndRegisterUnpackedPackage
273279

274280
-- Test phase
275281
whenTest $
276-
delegate $
282+
timedDelegate $
277283
PBTestPhase $
278284
annotateFailure mlogFile TestsFailed $
279285
setup
@@ -285,7 +291,7 @@ buildAndRegisterUnpackedPackage
285291

286292
-- Bench phase
287293
whenBench $
288-
delegate $
294+
timedDelegate $
289295
PBBenchPhase $
290296
annotateFailure mlogFile BenchFailed $
291297
setup
@@ -297,7 +303,7 @@ buildAndRegisterUnpackedPackage
297303

298304
-- Repl phase
299305
whenRepl $
300-
delegate $
306+
timedDelegate $
301307
PBReplPhase $
302308
annotateFailure mlogFile ReplFailed $
303309
setupInteractive
@@ -311,6 +317,33 @@ buildAndRegisterUnpackedPackage
311317
where
312318
uid = installedUnitId rpkg
313319

320+
timedDelegate :: forall r. PackageBuildingPhase r -> IO r
321+
timedDelegate phase
322+
| buildSettingBuildTimings = do
323+
t0 <- getMonotonicTime
324+
let
325+
printTiming :: String -> IO ()
326+
printTiming suffix = do
327+
t1 <- getMonotonicTime
328+
let
329+
elapsed = t1 - t0
330+
pkgstr = prettyShow (packageId rpkg)
331+
msg =
332+
unwords
333+
[ "[build-timings]"
334+
, buildPhaseName phase
335+
, pkgstr
336+
, -- Print milliseconds (3 decimal places)
337+
printf "%.3fs" elapsed
338+
, suffix
339+
]
340+
notice verbosity msg
341+
r <- delegate phase `onException` printTiming "(failed)"
342+
!_ <- evaluate r
343+
printTiming ""
344+
return r
345+
| otherwise = delegate phase
346+
314347
comp_par_strat = case maybe_semaphore of
315348
Just sem_ident -> Cabal.toFlag sem_ident
316349
_ -> Cabal.NoFlag
@@ -1014,6 +1047,16 @@ annotateFailure mlogFile annotate action =
10141047
-- * Other Utils
10151048
--------------------------------------------------------------------------------
10161049

1050+
-- | Display name for each build phase, used in timing output.
1051+
buildPhaseName :: PackageBuildingPhase r -> String
1052+
buildPhaseName PBConfigurePhase{} = "configure"
1053+
buildPhaseName PBBuildPhase{} = "build"
1054+
buildPhaseName PBHaddockPhase{} = "haddock"
1055+
buildPhaseName PBReplPhase{} = "repl"
1056+
buildPhaseName PBInstallPhase{} = "install"
1057+
buildPhaseName PBTestPhase{} = "test"
1058+
buildPhaseName PBBenchPhase{} = "bench"
1059+
10171060
hasValidHaddockTargets :: ElaboratedConfiguredPackage -> Bool
10181061
hasValidHaddockTargets ElaboratedConfiguredPackage{..}
10191062
| not elabBuildHaddocks = False

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -470,6 +470,7 @@ resolveBuildTimeSettings
470470
fromFlag projectConfigReportPlanningFailure
471471
buildSettingProgPathExtra = fromNubList projectConfigProgPathExtra
472472
buildSettingHaddockOpen = False
473+
buildSettingBuildTimings = fromFlagOrDefault False projectConfigBuildTimings
473474

474475
ProjectConfigBuildOnly{..} =
475476
defaults

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -66,6 +66,7 @@ projectConfigBuildOnlyFieldGrammar =
6666
<*> optionalFieldDefAla "remote-repo-cache" (alaFlag FilePathNT) L.projectConfigCacheDir mempty
6767
<*> optionalFieldDefAla "logs-dir" (alaFlag FilePathNT) L.projectConfigLogsDir mempty
6868
<*> blurFieldGrammar L.projectConfigClientInstallFlags clientInstallFlagsGrammar
69+
<*> optionalFieldDef "build-timings" L.projectConfigBuildTimings mempty
6970

7071
projectConfigSharedFieldGrammar :: ProjectConfigPath -> ParsecFieldGrammar' ProjectConfigShared
7172
projectConfigSharedFieldGrammar source =

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

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -887,6 +887,7 @@ convertLegacyBuildOnlyFlags
887887
, installUseSemaphore = projectConfigUseSemaphore
888888
, installKeepGoing = projectConfigKeepGoing
889889
, installOfflineMode = projectConfigOfflineMode
890+
, installBuildTimings = projectConfigBuildTimings
890891
} = installFlags
891892

892893
convertToLegacyProjectConfig :: ProjectConfig -> LegacyProjectConfig
@@ -1022,6 +1023,7 @@ convertToLegacySharedConfig
10221023
, installKeepGoing = projectConfigKeepGoing
10231024
, installRunTests = mempty
10241025
, installOfflineMode = projectConfigOfflineMode
1026+
, installBuildTimings = projectConfigBuildTimings
10251027
}
10261028

10271029
projectFlags =
@@ -1458,6 +1460,7 @@ legacySharedConfigFieldDescrs constraintSrc =
14581460
, "keep-going"
14591461
, "offline"
14601462
, "per-component"
1463+
, "build-timings"
14611464
, -- solver flags:
14621465
"max-backjumps"
14631466
, "reorder-goals"

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

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -164,6 +164,10 @@ projectConfigClientInstallFlags :: Lens' ProjectConfigBuildOnly ClientInstallFla
164164
projectConfigClientInstallFlags f s = fmap (\x -> s{T.projectConfigClientInstallFlags = x}) (f (T.projectConfigClientInstallFlags s))
165165
{-# INLINEABLE projectConfigClientInstallFlags #-}
166166

167+
projectConfigBuildTimings :: Lens' ProjectConfigBuildOnly (Flag Bool)
168+
projectConfigBuildTimings f s = fmap (\x -> s{T.projectConfigBuildTimings = x}) (f (T.projectConfigBuildTimings s))
169+
{-# INLINEABLE projectConfigBuildTimings #-}
170+
167171
projectConfigDistDir :: Lens' ProjectConfigShared (Flag FilePath)
168172
projectConfigDistDir f s = fmap (\x -> s{T.projectConfigDistDir = x}) (f (T.projectConfigDistDir s))
169173
{-# INLINEABLE projectConfigDistDir #-}

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

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -184,6 +184,7 @@ data ProjectConfigBuildOnly = ProjectConfigBuildOnly
184184
, projectConfigCacheDir :: Flag FilePath
185185
, projectConfigLogsDir :: Flag FilePath
186186
, projectConfigClientInstallFlags :: ClientInstallFlags
187+
, projectConfigBuildTimings :: Flag Bool
187188
}
188189
deriving (Eq, Show, Generic)
189190
deriving (Semigroup, Monoid) via Generically ProjectConfigBuildOnly
@@ -497,6 +498,7 @@ data BuildTimeSettings = BuildTimeSettings
497498
, buildSettingIgnoreExpiry :: Bool
498499
, buildSettingProgPathExtra :: [FilePath]
499500
, buildSettingHaddockOpen :: Bool
501+
, buildSettingBuildTimings :: Bool
500502
}
501503
deriving (Generic)
502504

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

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2243,6 +2243,7 @@ data InstallFlags = InstallFlags
22432243
, installKeepGoing :: Flag Bool
22442244
, installRunTests :: Flag Bool
22452245
, installOfflineMode :: Flag Bool
2246+
, installBuildTimings :: Flag Bool
22462247
}
22472248
deriving (Eq, Show, Generic)
22482249
deriving (Semigroup, Monoid) via Generically InstallFlags
@@ -2287,6 +2288,7 @@ defaultInstallFlags =
22872288
, installKeepGoing = Flag False
22882289
, installRunTests = mempty
22892290
, installOfflineMode = Flag False
2291+
, installBuildTimings = Flag False
22902292
}
22912293
where
22922294
docIndexFile =
@@ -2790,6 +2792,13 @@ installOptions showOrParseArgs =
27902792
installOfflineMode
27912793
(\v flags -> flags{installOfflineMode = v})
27922794
(yesNoOpt showOrParseArgs)
2795+
, option
2796+
[]
2797+
["build-timings"]
2798+
"Print elapsed time for each build phase."
2799+
installBuildTimings
2800+
(\v flags -> flags{installBuildTimings = v})
2801+
(yesNoOpt showOrParseArgs)
27932802
]
27942803
++ case showOrParseArgs of -- TODO: remove when "cabal install"
27952804
-- avoids

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

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -524,6 +524,7 @@ instance Arbitrary ProjectConfigBuildOnly where
524524
<*> (fmap getShortToken <$> arbitrary)
525525
<*> (fmap getShortToken <$> arbitrary)
526526
<*> arbitrary
527+
<*> arbitrary
527528
where
528529
arbitraryNumJobs = fmap (fmap getPositive) <$> arbitrary
529530

@@ -548,6 +549,7 @@ instance Arbitrary ProjectConfigBuildOnly where
548549
, projectConfigCacheDir = x15
549550
, projectConfigLogsDir = x16
550551
, projectConfigClientInstallFlags = x17
552+
, projectConfigBuildTimings = x20
551553
} =
552554
[ ProjectConfigBuildOnly
553555
{ projectConfigVerbosity = x00'
@@ -569,17 +571,18 @@ instance Arbitrary ProjectConfigBuildOnly where
569571
, projectConfigCacheDir = x15
570572
, projectConfigLogsDir = x16
571573
, projectConfigClientInstallFlags = x17'
574+
, projectConfigBuildTimings = x20'
572575
}
573576
| ( (x00', x01', x02', x03', x04')
574577
, (x05', x06', x07', x09')
575578
, (x10', x11', x12', x14')
576-
, (x17', x18', x19')
579+
, (x17', x18', x19', x20')
577580
) <-
578581
shrink
579582
( (x00, x01, x02, x03, x04)
580583
, (x05, x06, x07, preShrink_NumJobs x09)
581584
, (x10, x11, x12, x14)
582-
, (x17, x18, x19)
585+
, (x17, x18, x19, x20)
583586
)
584587
]
585588
where

0 commit comments

Comments
 (0)