Merge pull request #7567 from haskell/gb/build-reports-v2

handle build reports in v2-build

cabal-install/src/Distribution/Client/BuildReports/Anonymous.hs

@@ -25,6 +25,7 @@ module Distribution.Client.BuildReports.Anonymous (
     parseBuildReport,
     parseBuildReportList,
     showBuildReport,
+    cabalInstallID
 --    showList,
   ) where
 

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

@@ -121,7 +121,10 @@ import           Distribution.Client.Types
                    ( GenericReadyPackage(..), UnresolvedSourcePackage
                    , PackageSpecifier(..)
                    , SourcePackageDb(..)
-                   , WriteGhcEnvironmentFilesPolicy(..) )
+                   , WriteGhcEnvironmentFilesPolicy(..)
+                   , PackageLocation(..)
+                   , DocsResult(..)
+                   , TestsResult(..) )
 import           Distribution.Solver.Types.PackageIndex
                    ( lookupPackageName )
 import qualified Distribution.Client.InstallPlan as InstallPlan
@@ -130,6 +133,12 @@ import           Distribution.Client.TargetSelector
                    , ComponentKind(..), componentKind
                    , readTargetSelectors, reportTargetSelectorProblems )
 import           Distribution.Client.DistDirLayout
+
+import           Distribution.Client.BuildReports.Anonymous (cabalInstallID)
+import qualified Distribution.Client.BuildReports.Anonymous as BuildReports
+import qualified Distribution.Client.BuildReports.Storage as BuildReports
+         ( storeLocal )
+
 import           Distribution.Client.Config (getCabalDir)
 import           Distribution.Client.Setup hiding (packageName)
 import           Distribution.Compiler
@@ -160,13 +169,16 @@ import           Distribution.Verbosity
 import           Distribution.Version
                    ( mkVersion )
 import           Distribution.Simple.Compiler
-                   ( compilerCompatVersion, showCompilerId
+                   ( compilerCompatVersion, showCompilerId, compilerId, compilerInfo
                    , OptimisationLevel(..))
 
+import           Distribution.System
+                   ( Platform(Platform) )
+
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Set as Set
 import qualified Data.Map as Map
-import           Control.Exception (assert)
+import           Control.Exception ( assert )
 #ifdef MIN_VERSION_unix
 import           System.Posix.Signals (sigKILL, sigSEGV)
 #endif
@@ -405,7 +417,7 @@ runProjectPostBuildPhase _ ProjectBaseContext{buildSettings} _ _
   = return ()
 
 runProjectPostBuildPhase verbosity
-                         ProjectBaseContext {..} ProjectBuildContext {..}
+                         ProjectBaseContext {..} bc@ProjectBuildContext {..}
                          buildOutcomes = do
     -- Update other build artefacts
     -- TODO: currently none, but could include:
@@ -444,6 +456,9 @@ runProjectPostBuildPhase verbosity
                                      elaboratedShared
                                      postBuildStatus
 
+    -- Write the build reports
+    writeBuildReports buildSettings bc elaboratedPlanToExecute buildOutcomes
+
     -- Finally if there were any build failures then report them and throw
     -- an exception to terminate the program
     dieOnBuildFailures verbosity currentCommand elaboratedPlanToExecute buildOutcomes
@@ -985,6 +1000,59 @@ printPlan verbosity
                 Setup.NoFlag                   -> "1")]
       ++ "\n"
 
+
+writeBuildReports :: BuildTimeSettings -> ProjectBuildContext -> ElaboratedInstallPlan -> BuildOutcomes -> IO ()
+writeBuildReports settings buildContext plan buildOutcomes = do
+  let plat@(Platform arch os) = pkgConfigPlatform . elaboratedShared $ buildContext
+      comp = pkgConfigCompiler . elaboratedShared $ buildContext
+      getRepo (RepoTarballPackage r _ _) = Just r
+      getRepo _ = Nothing
+      fromPlanPackage (InstallPlan.Configured pkg) (Just result) =
+            let installOutcome = case result of
+                   Left bf -> case buildFailureReason bf of
+                      DependentFailed p -> BuildReports.DependencyFailed p
+                      DownloadFailed _  -> BuildReports.DownloadFailed
+                      UnpackFailed _ -> BuildReports.UnpackFailed
+                      ConfigureFailed _ -> BuildReports.ConfigureFailed
+                      BuildFailed _ -> BuildReports.BuildFailed
+                      TestsFailed _ -> BuildReports.TestsFailed
+                      InstallFailed _ -> BuildReports.InstallFailed
+
+                      ReplFailed _ -> BuildReports.InstallOk
+                      HaddocksFailed _ -> BuildReports.InstallOk
+                      BenchFailed _ -> BuildReports.InstallOk
+
+                   Right _br -> BuildReports.InstallOk
+
+                docsOutcome = case result of
+                   Left bf -> case buildFailureReason bf of
+                      HaddocksFailed _ -> BuildReports.Failed
+                      _ -> BuildReports.NotTried
+                   Right br -> case buildResultDocs br of
+                      DocsNotTried -> BuildReports.NotTried
+                      DocsFailed -> BuildReports.Failed
+                      DocsOk -> BuildReports.Ok
+
+                testsOutcome = case result of
+                   Left bf -> case buildFailureReason bf of
+                      TestsFailed _ -> BuildReports.Failed
+                      _ -> BuildReports.NotTried
+                   Right br -> case buildResultTests br of
+                      TestsNotTried -> BuildReports.NotTried
+                      TestsOk -> BuildReports.Ok
+
+            in Just $ (BuildReports.BuildReport (packageId pkg) os arch (compilerId comp) cabalInstallID (elabFlagAssignment pkg) (map packageId $ elabLibDependencies pkg) installOutcome docsOutcome testsOutcome, getRepo . elabPkgSourceLocation $ pkg) -- TODO handle failure log files?
+      fromPlanPackage _ _ = Nothing
+      buildReports = mapMaybe (\x -> fromPlanPackage x (InstallPlan.lookupBuildOutcome x buildOutcomes)) $ InstallPlan.toList plan
+
+
+  BuildReports.storeLocal (compilerInfo comp)
+                          (buildSettingSummaryFile settings)
+                          buildReports
+                          plat
+  -- Note this doesn't handle the anonymous build reports set by buildSettingBuildReports but those appear to not be used or missed from v1
+  -- The usage pattern appears to be that rather than rely on flags to cabal to send build logs to the right place and package them with reports, etc, it is easier to simply capture its output to an appropriate handle.
+
 -- | If there are build failures then report them and throw an exception.
 --
 dieOnBuildFailures :: Verbosity -> CurrentCommand

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

@@ -97,6 +97,9 @@ import           Distribution.Utils.NubList
 import           Distribution.Utils.LogProgress
 import           Distribution.Utils.MapAccum
 
+import qualified Distribution.Client.BuildReports.Storage as BuildReports
+         ( storeLocal, fromPlanningFailure )
+
 import qualified Distribution.Solver.Types.ComponentDeps as CD
 import           Distribution.Solver.Types.ComponentDeps (ComponentDeps)
 import           Distribution.Solver.Types.ConstraintSource
@@ -581,11 +584,14 @@ rebuildInstallPlan verbosity
                                    (compilerInfo compiler)
 
             notice verbosity "Resolving dependencies..."
-            plan <- foldProgress logMsg (die' verbosity) return $
+            planOrError <- foldProgress logMsg (pure . Left) (pure . Right) $
               planPackages verbosity compiler platform solver solverSettings
                            installedPkgIndex sourcePkgDb pkgConfigDB
                            localPackages localPackagesEnabledStanzas
-            return (plan, pkgConfigDB, tis, ar)
+            case planOrError of
+              Left msg -> do reportPlanningFailure projectConfig compiler platform localPackages
+                             die' verbosity msg
+              Right plan -> return (plan, pkgConfigDB, tis, ar)
       where
         corePackageDbs = [GlobalPackageDB]
         withRepoCtx    = projectConfigWithSolverRepoContext verbosity
@@ -720,6 +726,44 @@ rebuildInstallPlan verbosity
         compid = compilerId (pkgConfigCompiler elaboratedShared)
 
 
+-- | If a 'PackageSpecifier' refers to a single package, return Just that
+-- package.
+
+
+reportPlanningFailure :: ProjectConfig -> Compiler -> Platform -> [PackageSpecifier UnresolvedSourcePackage] -> IO ()
+reportPlanningFailure projectConfig comp platform pkgSpecifiers = when reportFailure $
+
+    BuildReports.storeLocal (compilerInfo comp)
+                            (fromNubList $ projectConfigSummaryFile . projectConfigBuildOnly $ projectConfig)
+                            buildReports platform
+
+    -- TODO may want to handle the projectConfigLogFile paramenter here, or just remove it entirely?
+  where
+    reportFailure = Cabal.fromFlag . projectConfigReportPlanningFailure . projectConfigBuildOnly $ projectConfig
+    pkgids = mapMaybe theSpecifiedPackage pkgSpecifiers
+    buildReports = BuildReports.fromPlanningFailure platform
+                       (compilerId comp) pkgids
+                       -- TODO we may want to get more flag assignments and merge them here?
+                       (packageConfigFlagAssignment . projectConfigAllPackages $ projectConfig)
+
+    theSpecifiedPackage :: Package pkg => PackageSpecifier pkg -> Maybe PackageId
+    theSpecifiedPackage pkgSpec =
+       case pkgSpec of
+          NamedPackage name [PackagePropertyVersion version]
+            -> PackageIdentifier name <$> trivialRange version
+          NamedPackage _ _ -> Nothing
+          SpecificSourcePackage pkg -> Just $ packageId pkg
+    -- | If a range includes only a single version, return Just that version.
+    trivialRange :: VersionRange -> Maybe Version
+    trivialRange = foldVersionRange
+        Nothing
+        Just     -- "== v"
+        (\_ -> Nothing)
+        (\_ -> Nothing)
+        (\_ _ -> Nothing)
+        (\_ _ -> Nothing)
+
+
 programsMonitorFiles :: ProgramDb -> [MonitorFilePath]
 programsMonitorFiles progdb =
     [ monitor