Skip to content

Commit e1d8947

Browse files
dcouttsdcoutts
committed
Merge pull request #2025 from lfairy/reports++
Improve build reporting for cabal-install
2 parents cd89a6c + 47cc3de commit e1d8947

File tree

5 files changed

+135
-29
lines changed

5 files changed

+135
-29
lines changed

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

Lines changed: 12 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,7 @@ module Distribution.Client.BuildReports.Anonymous (
1818

1919
-- * Constructing and writing reports
2020
new,
21+
new',
2122

2223
-- * parsing and pretty printing
2324
parse,
@@ -106,7 +107,8 @@ data BuildReport
106107
}
107108

108109
data InstallOutcome
109-
= DependencyFailed PackageIdentifier
110+
= PlanningFailed
111+
| DependencyFailed PackageIdentifier
110112
| DownloadFailed
111113
| UnpackFailed
112114
| SetupFailed
@@ -124,8 +126,13 @@ new :: OS -> Arch -> CompilerId -- -> Version
124126
-> ConfiguredPackage -> BR.BuildResult
125127
-> BuildReport
126128
new os' arch' comp (ConfiguredPackage pkg flags _ deps) result =
129+
new' os' arch' comp (packageId pkg) flags deps result
130+
131+
new' :: OS -> Arch -> CompilerId -> PackageIdentifier -> FlagAssignment
132+
-> [PackageIdentifier] -> BR.BuildResult -> BuildReport
133+
new' os' arch' comp pkgid flags deps result =
127134
BuildReport {
128-
package = packageId pkg,
135+
package = pkgid,
129136
os = os',
130137
arch = arch',
131138
compiler = comp,
@@ -139,6 +146,7 @@ new os' arch' comp (ConfiguredPackage pkg flags _ deps) result =
139146
}
140147
where
141148
convertInstallOutcome = case result of
149+
Left BR.PlanningFailed -> PlanningFailed
142150
Left (BR.DependentFailed p) -> DependencyFailed p
143151
Left (BR.DownloadFailed _) -> DownloadFailed
144152
Left (BR.UnpackFailed _) -> UnpackFailed
@@ -276,6 +284,7 @@ parseFlag = do
276284
flag -> return (FlagName flag, True)
277285

278286
instance Text.Text InstallOutcome where
287+
disp PlanningFailed = Disp.text "PlanningFailed"
279288
disp (DependencyFailed pkgid) = Disp.text "DependencyFailed" <+> Text.disp pkgid
280289
disp DownloadFailed = Disp.text "DownloadFailed"
281290
disp UnpackFailed = Disp.text "UnpackFailed"
@@ -289,6 +298,7 @@ instance Text.Text InstallOutcome where
289298
parse = do
290299
name <- Parse.munch1 Char.isAlphaNum
291300
case name of
301+
"PlanningFailed" -> return PlanningFailed
292302
"DependencyFailed" -> do Parse.skipSpaces
293303
pkgid <- Text.parse
294304
return (DependencyFailed pkgid)

‎cabal-install/Distribution/Client/BuildReports/Storage.hs‎

Lines changed: 26 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,7 @@ module Distribution.Client.BuildReports.Storage (
2020

2121
-- * 'InstallPlan' support
2222
fromInstallPlan,
23+
fromPlanningFailure,
2324
) where
2425

2526
import qualified Distribution.Client.BuildReports.Anonymous as BuildReport
@@ -30,6 +31,10 @@ import qualified Distribution.Client.InstallPlan as InstallPlan
3031
import Distribution.Client.InstallPlan
3132
( InstallPlan )
3233

34+
import Distribution.Package
35+
( PackageId )
36+
import Distribution.PackageDescription
37+
( FlagAssignment )
3338
import Distribution.Simple.InstallDirs
3439
( PathTemplate, fromPathTemplate
3540
, initialPathTemplateEnv, substPathTemplate )
@@ -49,7 +54,7 @@ import System.FilePath
4954
import System.Directory
5055
( createDirectoryIfMissing )
5156

52-
storeAnonymous :: [(BuildReport, Repo)] -> IO ()
57+
storeAnonymous :: [(BuildReport, Maybe Repo)] -> IO ()
5358
storeAnonymous reports = sequence_
5459
[ appendFile file (concatMap format reports')
5560
| (repo, reports') <- separate reports
@@ -59,7 +64,7 @@ storeAnonymous reports = sequence_
5964

6065
where
6166
format r = '\n' : BuildReport.show r ++ "\n"
62-
separate :: [(BuildReport, Repo)]
67+
separate :: [(BuildReport, Maybe Repo)]
6368
-> [(Repo, [BuildReport])]
6469
separate = map (\rs@((_,repo,_):_) -> (repo, [ r | (r,_,_) <- rs ]))
6570
. map concat
@@ -69,12 +74,12 @@ storeAnonymous reports = sequence_
6974
. onlyRemote
7075
repoName (_,_,rrepo) = remoteRepoName rrepo
7176

72-
onlyRemote :: [(BuildReport, Repo)] -> [(BuildReport, Repo, RemoteRepo)]
77+
onlyRemote :: [(BuildReport, Maybe Repo)] -> [(BuildReport, Repo, RemoteRepo)]
7378
onlyRemote rs =
7479
[ (report, repo, remoteRepo)
75-
| (report, repo@Repo { repoKind = Left remoteRepo }) <- rs ]
80+
| (report, Just repo@Repo { repoKind = Left remoteRepo }) <- rs ]
7681

77-
storeLocal :: [PathTemplate] -> [(BuildReport, Repo)] -> Platform -> IO ()
82+
storeLocal :: [PathTemplate] -> [(BuildReport, Maybe Repo)] -> Platform -> IO ()
7883
storeLocal templates reports platform = sequence_
7984
[ do createDirectoryIfMissing True (takeDirectory file)
8085
appendFile file output
@@ -109,7 +114,7 @@ storeLocal templates reports platform = sequence_
109114
-- * InstallPlan support
110115
-- ------------------------------------------------------------
111116

112-
fromInstallPlan :: InstallPlan -> [(BuildReport, Repo)]
117+
fromInstallPlan :: InstallPlan -> [(BuildReport, Maybe Repo)]
113118
fromInstallPlan plan = catMaybes
114119
. map (fromPlanPackage platform comp)
115120
. InstallPlan.toList
@@ -119,16 +124,24 @@ fromInstallPlan plan = catMaybes
119124

120125
fromPlanPackage :: Platform -> CompilerId
121126
-> InstallPlan.PlanPackage
122-
-> Maybe (BuildReport, Repo)
127+
-> Maybe (BuildReport, Maybe Repo)
123128
fromPlanPackage (Platform arch os) comp planPackage = case planPackage of
124129

125-
InstallPlan.Installed pkg@(ReadyPackage (SourcePackage {
126-
packageSource = RepoTarballPackage repo _ _ }) _ _ _) result
130+
InstallPlan.Installed pkg@(ReadyPackage srcPkg _ _ _) result
127131
-> Just $ (BuildReport.new os arch comp
128-
(readyPackageToConfiguredPackage pkg) (Right result), repo)
132+
(readyPackageToConfiguredPackage pkg) (Right result), extractRepo srcPkg)
129133

130-
InstallPlan.Failed pkg@(ConfiguredPackage (SourcePackage {
131-
packageSource = RepoTarballPackage repo _ _ }) _ _ _) result
132-
-> Just $ (BuildReport.new os arch comp pkg (Left result), repo)
134+
InstallPlan.Failed pkg@(ConfiguredPackage srcPkg _ _ _) result
135+
-> Just $ (BuildReport.new os arch comp pkg (Left result), extractRepo srcPkg)
133136

134137
_ -> Nothing
138+
139+
where
140+
extractRepo (SourcePackage { packageSource = RepoTarballPackage repo _ _ }) = Just repo
141+
extractRepo _ = Nothing
142+
143+
fromPlanningFailure :: Platform -> CompilerId
144+
-> [PackageId] -> FlagAssignment -> [(BuildReport, Maybe Repo)]
145+
fromPlanningFailure (Platform arch os) comp pkgids flags =
146+
[ (BuildReport.new' os arch comp pkgid flags [] (Left PlanningFailed), Nothing)
147+
| pkgid <- pkgids ]

‎cabal-install/Distribution/Client/Install.hs‎

Lines changed: 86 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -32,7 +32,7 @@ import Data.List
3232
( isPrefixOf, unfoldr, nub, sort, (\\) )
3333
import qualified Data.Set as S
3434
import Data.Maybe
35-
( isJust, fromMaybe, maybeToList )
35+
( isJust, fromMaybe, mapMaybe, maybeToList )
3636
import Control.Exception as Exception
3737
( Exception(toException), bracket, catches
3838
, Handler(Handler), handleJust, IOException, SomeException )
@@ -44,8 +44,10 @@ import System.Exit
4444
( ExitCode(..) )
4545
import Distribution.Compat.Exception
4646
( catchIO, catchExit )
47+
import Control.Applicative
48+
( (<$>) )
4749
import Control.Monad
48-
( when, unless )
50+
( forM_, when, unless )
4951
import System.Directory
5052
( getTemporaryDirectory, doesDirectoryExist, doesFileExist,
5153
createDirectoryIfMissing, removeFile, renameDirectory )
@@ -87,7 +89,7 @@ import Distribution.Client.SetupWrapper
8789
( setupWrapper, SetupScriptOptions(..), defaultSetupScriptOptions )
8890
import qualified Distribution.Client.BuildReports.Anonymous as BuildReports
8991
import qualified Distribution.Client.BuildReports.Storage as BuildReports
90-
( storeAnonymous, storeLocal, fromInstallPlan )
92+
( storeAnonymous, storeLocal, fromInstallPlan, fromPlanningFailure )
9193
import qualified Distribution.Client.InstallSymlink as InstallSymlink
9294
( symlinkBinaries )
9395
import qualified Distribution.Client.PackageIndex as SourcePackageIndex
@@ -99,7 +101,7 @@ import Distribution.Client.JobControl
99101

100102
import Distribution.Simple.Compiler
101103
( CompilerId(..), Compiler(compilerId), compilerFlavor
102-
, PackageDB(..), PackageDBStack )
104+
, packageKeySupported , PackageDB(..), PackageDBStack )
103105
import Distribution.Simple.Program (ProgramConfiguration,
104106
defaultProgramConfiguration)
105107
import qualified Distribution.Simple.InstallDirs as InstallDirs
@@ -121,8 +123,8 @@ import Distribution.Simple.InstallDirs as InstallDirs
121123
( PathTemplate, fromPathTemplate, toPathTemplate, substPathTemplate
122124
, initialPathTemplateEnv, installDirsTemplateEnv )
123125
import Distribution.Package
124-
( PackageIdentifier, PackageId, packageName, packageVersion
125-
, Package(..), PackageFixedDeps(..), PackageKey
126+
( PackageIdentifier(..), PackageId, packageName, packageVersion
127+
, Package(..), PackageFixedDeps(..), PackageKey, mkPackageKey
126128
, Dependency(..), thisPackageVersion, InstalledPackageId )
127129
import qualified Distribution.PackageDescription as PackageDescription
128130
import Distribution.PackageDescription
@@ -133,7 +135,7 @@ import Distribution.PackageDescription.Configuration
133135
import Distribution.ParseUtils
134136
( showPWarning )
135137
import Distribution.Version
136-
( Version )
138+
( Version, VersionRange, foldVersionRange )
137139
import Distribution.Simple.Utils as Utils
138140
( notice, info, warn, debug, debugNoWrap, die
139141
, intercalate, withTempDirectory )
@@ -187,10 +189,15 @@ install verbosity packageDBs repos comp platform conf useSandbox mSandboxPkgInfo
187189
userTargets0 = do
188190

189191
installContext <- makeInstallContext verbosity args (Just userTargets0)
190-
installPlan <- foldProgress logMsg die' return =<<
192+
planResult <- foldProgress logMsg (return . Left) (return . Right) =<<
191193
makeInstallPlan verbosity args installContext
192194

193-
processInstallPlan verbosity args installContext installPlan
195+
case planResult of
196+
Left message -> do
197+
reportPlanningFailure verbosity args installContext message
198+
die' message
199+
Right installPlan ->
200+
processInstallPlan verbosity args installContext installPlan
194201
where
195202
args :: InstallArgs
196203
args = (packageDBs, repos, comp, platform, conf, useSandbox, mSandboxPkgInfo,
@@ -596,12 +603,11 @@ printPlan dryRun verbosity plan sourcePkgDb = case plan of
596603
showLatest :: ReadyPackage -> String
597604
showLatest pkg = case mLatestVersion of
598605
Just latestVersion ->
599-
if pkgVersion < latestVersion
606+
if packageVersion pkg < latestVersion
600607
then (" (latest: " ++ display latestVersion ++ ")")
601608
else ""
602609
Nothing -> ""
603610
where
604-
pkgVersion = packageVersion pkg
605611
mLatestVersion :: Maybe Version
606612
mLatestVersion = case SourcePackageIndex.lookupPackageName
607613
(packageIndex sourcePkgDb)
@@ -643,6 +649,70 @@ printPlan dryRun verbosity plan sourcePkgDb = case plan of
643649
-- * Post installation stuff
644650
-- ------------------------------------------------------------
645651

652+
-- | Report a solver failure. This works slightly differently to
653+
-- 'postInstallActions', as (by definition) we don't have an install plan.
654+
reportPlanningFailure :: Verbosity -> InstallArgs -> InstallContext -> String -> IO ()
655+
reportPlanningFailure verbosity
656+
(_, _, comp, platform, _, _, _
657+
,_, configFlags, _, installFlags, _)
658+
(_, sourcePkgDb, _, pkgSpecifiers)
659+
message = do
660+
661+
when reportFailure $ do
662+
663+
-- Only create reports for explicitly named packages
664+
let pkgids =
665+
filter (SourcePackageIndex.elemByPackageId (packageIndex sourcePkgDb)) $
666+
mapMaybe theSpecifiedPackage pkgSpecifiers
667+
668+
buildReports = BuildReports.fromPlanningFailure platform (compilerId comp)
669+
pkgids (configConfigurationsFlags configFlags)
670+
671+
when (not (null buildReports)) $
672+
notice verbosity $
673+
"Notice: this solver failure will be reported for "
674+
++ intercalate "," (map display pkgids)
675+
676+
-- Save reports
677+
BuildReports.storeLocal (installSummaryFile installFlags) buildReports platform
678+
679+
-- Save solver log
680+
case logFile of
681+
Nothing -> return ()
682+
Just template -> forM_ pkgids $ \pkgid ->
683+
let env = initialPathTemplateEnv pkgid dummyPackageKey
684+
(compilerId comp) platform
685+
path = fromPathTemplate $ substPathTemplate env template
686+
in writeFile path message
687+
688+
where
689+
reportFailure = fromFlag (installReportPlanningFailure installFlags)
690+
logFile = flagToMaybe (installLogFile installFlags)
691+
692+
-- A PackageKey is calculated from the transitive closure of
693+
-- dependencies, but when the solver fails we don't have that.
694+
-- So we fail.
695+
dummyPackageKey = error "reportPlanningFailure: package key not available"
696+
697+
-- | If a 'PackageSpecifier' refers to a single package, return Just that package.
698+
theSpecifiedPackage :: Package pkg => PackageSpecifier pkg -> Maybe PackageId
699+
theSpecifiedPackage pkgSpec =
700+
case pkgSpec of
701+
NamedPackage name [PackageConstraintVersion name' version]
702+
| name == name' -> PackageIdentifier name <$> trivialRange version
703+
NamedPackage _ _ -> Nothing
704+
SpecificSourcePackage pkg -> Just $ packageId pkg
705+
where
706+
-- | If a range includes only a single version, return Just that version.
707+
trivialRange :: VersionRange -> Maybe Version
708+
trivialRange = foldVersionRange
709+
Nothing
710+
Just -- "== v"
711+
(\_ -> Nothing)
712+
(\_ -> Nothing)
713+
(\_ _ -> Nothing)
714+
(\_ _ -> Nothing)
715+
646716
-- | Various stuff we do after successful or unsuccessfully installing a bunch
647717
-- of packages. This includes:
648718
--
@@ -693,7 +763,7 @@ postInstallActions verbosity
693763
worldFile = fromFlag $ globalWorldFile globalFlags
694764

695765
storeDetailedBuildReports :: Verbosity -> FilePath
696-
-> [(BuildReports.BuildReport, Repo)] -> IO ()
766+
-> [(BuildReports.BuildReport, Maybe Repo)] -> IO ()
697767
storeDetailedBuildReports verbosity logsDir reports = sequence_
698768
[ do dotCabal <- defaultCabalDir
699769
let logFileName = display (BuildReports.package report) <.> "log"
@@ -706,7 +776,7 @@ storeDetailedBuildReports verbosity logsDir reports = sequence_
706776
createDirectoryIfMissing True reportsDir -- FIXME
707777
writeFile reportFile (show (BuildReports.show report, buildLog))
708778

709-
| (report, Repo { repoKind = Left remoteRepo }) <- reports
779+
| (report, Just Repo { repoKind = Left remoteRepo }) <- reports
710780
, isLikelyToHaveLogFile (BuildReports.installOutcome report) ]
711781

712782
where
@@ -841,6 +911,9 @@ printBuildFailures plan =
841911
InstallFailed e -> " failed during the final install step."
842912
++ showException e
843913

914+
-- This will never happen, but we include it for completeness
915+
PlanningFailed -> " failed during the planning phase."
916+
844917
showException e = " The exception was:\n " ++ show e ++ maybeOOM e
845918
#ifdef mingw32_HOST_OS
846919
maybeOOM _ = ""

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

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -973,6 +973,7 @@ data InstallFlags = InstallFlags {
973973
installSummaryFile :: [PathTemplate],
974974
installLogFile :: Flag PathTemplate,
975975
installBuildReports :: Flag ReportLevel,
976+
installReportPlanningFailure :: Flag Bool,
976977
installSymlinkBinDir :: Flag FilePath,
977978
installOneShot :: Flag Bool,
978979
installNumJobs :: Flag (Maybe Int),
@@ -999,6 +1000,7 @@ defaultInstallFlags = InstallFlags {
9991000
installSummaryFile = mempty,
10001001
installLogFile = mempty,
10011002
installBuildReports = Flag NoReports,
1003+
installReportPlanningFailure = Flag False,
10021004
installSymlinkBinDir = mempty,
10031005
installOneShot = Flag False,
10041006
installNumJobs = mempty,
@@ -1177,6 +1179,11 @@ installOptions showOrParseArgs =
11771179
(toFlag `fmap` parse))
11781180
(flagToList . fmap display))
11791181

1182+
, option [] ["report-planning-failure"]
1183+
"Generate build reports when the dependency solver fails. This is used by the Hackage build bot."
1184+
installReportPlanningFailure (\v flags -> flags { installReportPlanningFailure = v })
1185+
trueArg
1186+
11801187
, option [] ["one-shot"]
11811188
"Do not record the packages in the world file."
11821189
installOneShot (\v flags -> flags { installOneShot = v })
@@ -1220,6 +1227,7 @@ instance Monoid InstallFlags where
12201227
installSummaryFile = mempty,
12211228
installLogFile = mempty,
12221229
installBuildReports = mempty,
1230+
installReportPlanningFailure = mempty,
12231231
installSymlinkBinDir = mempty,
12241232
installOneShot = mempty,
12251233
installNumJobs = mempty,
@@ -1244,6 +1252,7 @@ instance Monoid InstallFlags where
12441252
installSummaryFile = combine installSummaryFile,
12451253
installLogFile = combine installLogFile,
12461254
installBuildReports = combine installBuildReports,
1255+
installReportPlanningFailure = combine installReportPlanningFailure,
12471256
installSymlinkBinDir = combine installSymlinkBinDir,
12481257
installOneShot = combine installOneShot,
12491258
installNumJobs = combine installNumJobs,

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

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -206,7 +206,8 @@ data Repo = Repo {
206206
-- ------------------------------------------------------------
207207

208208
type BuildResult = Either BuildFailure BuildSuccess
209-
data BuildFailure = DependentFailed PackageId
209+
data BuildFailure = PlanningFailed
210+
| DependentFailed PackageId
210211
| DownloadFailed SomeException
211212
| UnpackFailed SomeException
212213
| ConfigureFailed SomeException

0 commit comments

Comments
 (0)