merge queue: checking master (bc27d17) and [#11787 + #11769] together

Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs

@@ -27,10 +27,14 @@ tests = testGroup "Distribution.Utils.Structured"
 md5Check :: Structured a => Proxy a -> Integer -> Assertion
 md5Check proxy md5Int = structureHash proxy @?= md5FromInteger md5Int
 
+-- NB: if you need to update these values locally, you can run:
+--
+-- > cabal run Cabal-tests:unit-tests -- -p "/Structured/"
+
 md5CheckGenericPackageDescription :: Proxy GenericPackageDescription -> Assertion
 md5CheckGenericPackageDescription proxy = md5Check proxy
     0xfbca1c1f2a700fb3a174ec5346e86cbb
 
 md5CheckLocalBuildInfo :: Proxy LocalBuildInfo -> Assertion
 md5CheckLocalBuildInfo proxy = md5Check proxy
-    0x3bf7bf1420847ce5fdaf6e36e33aecb2
+    0xd9542841ab7584d348aa142053fe934f

Cabal/src/Distribution/Simple/Configure.hs

@@ -914,6 +914,8 @@ buildOptionsFromConfigFlags verbosity cfg comp = do
         , exeCoverage = False
         , libCoverage = False
         , relocatable = fromFlagOrDefault False $ configRelocatable cfg
+        , programPrefix = flagToMaybe $ configProgPrefix cfg
+        , programSuffix = flagToMaybe $ configProgSuffix cfg
         }
 
 -- | Adjust 'LBC.BuildOptions' to be compatible with the given 'Compiler' and

Cabal/src/Distribution/Types/LocalBuildConfig.hs

@@ -188,6 +188,10 @@ data BuildOptions = BuildOptions
   -- ^ Whether to enable library program coverage
   , relocatable :: Bool
   -- ^ Whether to build a relocatable package
+  , programPrefix :: Maybe PathTemplate
+  -- ^ Installed executable prefix
+  , programSuffix :: Maybe PathTemplate
+  -- ^ Installed executable suffix
   }
   deriving (Eq, Generic, Read, Show)
 
@@ -229,4 +233,6 @@ buildOptionsConfigFlags (BuildOptions{..}) =
     , configStripExes = toFlag stripExes
     , configStripLibs = toFlag stripLibs
     , configDebugInfo = toFlag withDebugInfo
+    , configProgPrefix = maybeToFlag programPrefix
+    , configProgSuffix = maybeToFlag programSuffix
     }

Cabal/src/Distribution/Types/LocalBuildInfo.hs

@@ -47,6 +47,8 @@ module Distribution.Types.LocalBuildInfo
       , libCoverage
       , extraCoverageFor
       , relocatable
+      , programPrefix
+      , programSuffix
       , ..
       )
 
@@ -188,6 +190,8 @@ pattern LocalBuildInfo
   -> Bool
   -> [UnitId]
   -> Bool
+  -> Maybe PathTemplate
+  -> Maybe PathTemplate
   -> LocalBuildInfo
 pattern LocalBuildInfo
   { configFlags
@@ -227,6 +231,8 @@ pattern LocalBuildInfo
   , libCoverage
   , extraCoverageFor
   , relocatable
+  , programPrefix
+  , programSuffix
   } =
   NewLocalBuildInfo
     { localBuildDescr =
@@ -279,6 +285,8 @@ pattern LocalBuildInfo
             , exeCoverage
             , libCoverage
             , relocatable
+            , programPrefix
+            , programSuffix
             }
         }
     }
@@ -316,10 +324,13 @@ packageRoot cfg =
     mbWorkDir = flagToMaybe $ setupWorkingDir cfg
 
 progPrefix, progSuffix :: LocalBuildInfo -> PathTemplate
-progPrefix (LocalBuildInfo{configFlags = cfg}) =
-  fromFlag $ configProgPrefix cfg
-progSuffix (LocalBuildInfo{configFlags = cfg}) =
-  fromFlag $ configProgSuffix cfg
+-- NB: make sure to read from 'BuildOptions' rather than the 'ConfigFlags'
+-- stored in 'PackageBuildDescr', as the latter are the original command-line
+-- input and are not updated by 'SetupHooks' configure hooks.
+progPrefix (LocalBuildInfo{programPrefix = pfix}) =
+  fromMaybe (toPathTemplate "") pfix
+progSuffix (LocalBuildInfo{programSuffix = sfix}) =
+  fromMaybe (toPathTemplate "") sfix
 
 -- TODO: Get rid of these functions, as much as possible.  They are
 -- a bit useful in some cases, but you should be very careful!

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

@@ -447,6 +447,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 #-}
@@ -118,10 +119,12 @@ import qualified Data.List.NonEmpty as NE
 import Control.Concurrent.STM (TVar, atomically, modifyTVar)
 import Control.Exception (ErrorCall, Handler (..), SomeAsyncException, assert, catches, onException)
 import Data.IORef (newIORef, readIORef, writeIORef)
+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 (SemaphoreIdentifier)
+import Text.Printf (printf)
 
 import GHC.Stack
 import Web.Browser (openBrowser)
@@ -189,7 +192,10 @@ buildAndRegisterUnpackedPackage
   verbosity
   distDirLayout@DistDirLayout{distTempDirectory}
   maybe_semaphore
-  buildTimeSettings@BuildTimeSettings{buildSettingKeepTempFiles}
+  buildTimeSettings@BuildTimeSettings
+    { buildSettingKeepTempFiles
+    , buildSettingBuildTimings
+    }
   registerLock
   cacheLock
   pkgshared@ElaboratedSharedConfig
@@ -205,7 +211,7 @@ buildAndRegisterUnpackedPackage
   delegate = do
     -- Configure phase
     mbLBI <-
-      delegate $
+      timedDelegate $
         PBConfigurePhase $
           annotateFailure mlogFile ConfigureFailed $
             setup
@@ -216,7 +222,7 @@ buildAndRegisterUnpackedPackage
               (InLibraryArgs $ InLibraryConfigureArgs pkgshared rpkg ipiTVar)
 
     -- Build phase
-    delegate $
+    timedDelegate $
       PBBuildPhase $
         annotateFailure mlogFile BuildFailed $ do
           setup
@@ -228,7 +234,7 @@ buildAndRegisterUnpackedPackage
 
     -- Haddock phase
     whenHaddock $
-      delegate $
+      timedDelegate $
         PBHaddockPhase $
           annotateFailure mlogFile HaddocksFailed $ do
             setup
@@ -244,7 +250,7 @@ buildAndRegisterUnpackedPackage
           -- the installed package id is, not the build system.
           ipkg0 <- generateInstalledPackageInfo mbLBI
           return ipkg0{Installed.installedUnitId = uid}
-    delegate $
+    timedDelegate $
       PBInstallPhase
         { runCopy = \destdir ->
             annotateFailure mlogFile InstallFailed $
@@ -273,7 +279,7 @@ buildAndRegisterUnpackedPackage
 
     -- Test phase
     whenTest $
-      delegate $
+      timedDelegate $
         PBTestPhase $
           annotateFailure mlogFile TestsFailed $
             setup
@@ -285,7 +291,7 @@ buildAndRegisterUnpackedPackage
 
     -- Bench phase
     whenBench $
-      delegate $
+      timedDelegate $
         PBBenchPhase $
           annotateFailure mlogFile BenchFailed $
             setup
@@ -297,7 +303,7 @@ buildAndRegisterUnpackedPackage
 
     -- Repl phase
     whenRepl $
-      delegate $
+      timedDelegate $
         PBReplPhase $
           annotateFailure mlogFile ReplFailed $
             setupInteractive
@@ -311,6 +317,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_ident -> Cabal.toFlag sem_ident
         _ -> Cabal.NoFlag
@@ -1014,6 +1047,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

@@ -470,6 +470,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

@@ -887,6 +887,7 @@ convertLegacyBuildOnlyFlags
         , installUseSemaphore = projectConfigUseSemaphore
         , installKeepGoing = projectConfigKeepGoing
         , installOfflineMode = projectConfigOfflineMode
+        , installBuildTimings = projectConfigBuildTimings
         } = installFlags
 
 convertToLegacyProjectConfig :: ProjectConfig -> LegacyProjectConfig
@@ -1022,6 +1023,7 @@ convertToLegacySharedConfig
           , installKeepGoing = projectConfigKeepGoing
           , installRunTests = mempty
           , installOfflineMode = projectConfigOfflineMode
+          , installBuildTimings = projectConfigBuildTimings
           }
 
       projectFlags =
@@ -1458,6 +1460,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 ClientInstallFla
 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

@@ -184,6 +184,7 @@ data ProjectConfigBuildOnly = ProjectConfigBuildOnly
   , projectConfigCacheDir :: Flag FilePath
   , projectConfigLogsDir :: Flag FilePath
   , projectConfigClientInstallFlags :: ClientInstallFlags
+  , projectConfigBuildTimings :: Flag Bool
   }
   deriving (Eq, Show, Generic)
   deriving (Semigroup, Monoid) via Generically ProjectConfigBuildOnly
@@ -497,6 +498,7 @@ data BuildTimeSettings = BuildTimeSettings
   , buildSettingIgnoreExpiry :: Bool
   , buildSettingProgPathExtra :: [FilePath]
   , buildSettingHaddockOpen :: Bool
+  , buildSettingBuildTimings :: Bool
   }
   deriving (Generic)
 

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

@@ -2405,6 +2405,8 @@ elaborateInstallPlan
                 , relocatable = perPkgOptionFlag pkgid False packageConfigRelocatable
                 , withProfLibDetail = elabProfExeDetail
                 , withProfExeDetail = elabProfLibDetail
+                , programPrefix = elabProgPrefix
+                , programSuffix = elabProgSuffix
                 }
             okProfDyn = profilingDynamicSupportedOrUnknown compiler
             profExe = perPkgOptionFlag pkgid False packageConfigProf

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

@@ -2243,6 +2243,7 @@ data InstallFlags = InstallFlags
   , installKeepGoing :: Flag Bool
   , installRunTests :: Flag Bool
   , installOfflineMode :: Flag Bool
+  , installBuildTimings :: Flag Bool
   }
   deriving (Eq, Show, Generic)
   deriving (Semigroup, Monoid) via Generically InstallFlags
@@ -2287,6 +2288,7 @@ defaultInstallFlags =
     , installKeepGoing = Flag False
     , installRunTests = mempty
     , installOfflineMode = Flag False
+    , installBuildTimings = Flag False
     }
   where
     docIndexFile =
@@ -2790,6 +2792,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

@@ -524,6 +524,7 @@ instance Arbitrary ProjectConfigBuildOnly where
       <*> (fmap getShortToken <$> arbitrary)
       <*> (fmap getShortToken <$> arbitrary)
       <*> arbitrary
+      <*> arbitrary
     where
       arbitraryNumJobs = fmap (fmap getPositive) <$> arbitrary
 
@@ -548,6 +549,7 @@ instance Arbitrary ProjectConfigBuildOnly where
       , projectConfigCacheDir = x15
       , projectConfigLogsDir = x16
       , projectConfigClientInstallFlags = x17
+      , projectConfigBuildTimings = x20
       } =
       [ ProjectConfigBuildOnly
         { projectConfigVerbosity = x00'
@@ -569,17 +571,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