Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
Packages
Cabal
Commits
1070b225
Commit
1070b225
authored
Jul 22, 2014
by
Chris Wong
Browse files
Add --report-planning-failure option to cabal-install
parent
5c70361b
Changes
5
Hide whitespace changes
Inline
Side-by-side
cabal-install/Distribution/Client/BuildReports/Anonymous.hs
View file @
1070b225
...
...
@@ -18,6 +18,7 @@ module Distribution.Client.BuildReports.Anonymous (
-- * Constructing and writing reports
new
,
new'
,
-- * parsing and pretty printing
parse
,
...
...
@@ -106,7 +107,8 @@ data BuildReport
}
data
InstallOutcome
=
DependencyFailed
PackageIdentifier
=
PlanningFailed
|
DependencyFailed
PackageIdentifier
|
DownloadFailed
|
UnpackFailed
|
SetupFailed
...
...
@@ -124,8 +126,13 @@ new :: OS -> Arch -> CompilerId -- -> Version
->
ConfiguredPackage
->
BR
.
BuildResult
->
BuildReport
new
os'
arch'
comp
(
ConfiguredPackage
pkg
flags
_
deps
)
result
=
new'
os'
arch'
comp
(
packageId
pkg
)
flags
deps
result
new'
::
OS
->
Arch
->
CompilerId
->
PackageIdentifier
->
FlagAssignment
->
[
PackageIdentifier
]
->
BR
.
BuildResult
->
BuildReport
new'
os'
arch'
comp
pkgid
flags
deps
result
=
BuildReport
{
package
=
p
ackageId
p
kg
,
package
=
pkg
id
,
os
=
os'
,
arch
=
arch'
,
compiler
=
comp
,
...
...
@@ -139,6 +146,7 @@ new os' arch' comp (ConfiguredPackage pkg flags _ deps) result =
}
where
convertInstallOutcome
=
case
result
of
Left
BR
.
PlanningFailed
->
PlanningFailed
Left
(
BR
.
DependentFailed
p
)
->
DependencyFailed
p
Left
(
BR
.
DownloadFailed
_
)
->
DownloadFailed
Left
(
BR
.
UnpackFailed
_
)
->
UnpackFailed
...
...
@@ -276,6 +284,7 @@ parseFlag = do
flag
->
return
(
FlagName
flag
,
True
)
instance
Text
.
Text
InstallOutcome
where
disp
PlanningFailed
=
Disp
.
text
"PlanningFailed"
disp
(
DependencyFailed
pkgid
)
=
Disp
.
text
"DependencyFailed"
<+>
Text
.
disp
pkgid
disp
DownloadFailed
=
Disp
.
text
"DownloadFailed"
disp
UnpackFailed
=
Disp
.
text
"UnpackFailed"
...
...
@@ -289,6 +298,7 @@ instance Text.Text InstallOutcome where
parse
=
do
name
<-
Parse
.
munch1
Char
.
isAlphaNum
case
name
of
"PlanningFailed"
->
return
PlanningFailed
"DependencyFailed"
->
do
Parse
.
skipSpaces
pkgid
<-
Text
.
parse
return
(
DependencyFailed
pkgid
)
...
...
cabal-install/Distribution/Client/BuildReports/Storage.hs
View file @
1070b225
...
...
@@ -20,6 +20,7 @@ module Distribution.Client.BuildReports.Storage (
-- * 'InstallPlan' support
fromInstallPlan
,
fromPlanningFailure
,
)
where
import
qualified
Distribution.Client.BuildReports.Anonymous
as
BuildReport
...
...
@@ -30,6 +31,10 @@ import qualified Distribution.Client.InstallPlan as InstallPlan
import
Distribution.Client.InstallPlan
(
InstallPlan
)
import
Distribution.Package
(
PackageId
)
import
Distribution.PackageDescription
(
FlagAssignment
)
import
Distribution.Simple.InstallDirs
(
PathTemplate
,
fromPathTemplate
,
initialPathTemplateEnv
,
substPathTemplate
)
...
...
@@ -127,3 +132,11 @@ fromPlanPackage (Platform arch os) comp planPackage = case planPackage of
->
Just
$
(
BuildReport
.
new
os
arch
comp
pkg
(
Left
result
),
repo
)
_
->
Nothing
fromPlanningFailure
::
Platform
->
CompilerId
->
[
PackageId
]
->
FlagAssignment
->
[
Repo
]
->
[(
BuildReport
,
Repo
)]
fromPlanningFailure
(
Platform
arch
os
)
comp
pkgids
flags
repos
=
[
(
BuildReport
.
new'
os
arch
comp
pkgid
flags
[]
(
Left
PlanningFailed
),
repo
)
|
pkgid
<-
pkgids
,
repo
@
Repo
{
repoKind
=
Left
RemoteRepo
{}
}
<-
repos
]
cabal-install/Distribution/Client/Install.hs
View file @
1070b225
...
...
@@ -32,7 +32,7 @@ import Data.List
(
isPrefixOf
,
unfoldr
,
nub
,
sort
,
(
\\
)
)
import
qualified
Data.Set
as
S
import
Data.Maybe
(
isJust
,
fromMaybe
,
maybeToList
)
(
isJust
,
fromMaybe
,
mapMaybe
,
maybeToList
)
import
Control.Exception
as
Exception
(
Exception
(
toException
),
bracket
,
catches
,
Handler
(
Handler
),
handleJust
,
IOException
,
SomeException
)
...
...
@@ -44,6 +44,8 @@ import System.Exit
(
ExitCode
(
..
)
)
import
Distribution.Compat.Exception
(
catchIO
,
catchExit
)
import
Control.Applicative
(
(
<$>
)
)
import
Control.Monad
(
when
,
unless
)
import
System.Directory
...
...
@@ -87,7 +89,7 @@ import Distribution.Client.SetupWrapper
(
setupWrapper
,
SetupScriptOptions
(
..
),
defaultSetupScriptOptions
)
import
qualified
Distribution.Client.BuildReports.Anonymous
as
BuildReports
import
qualified
Distribution.Client.BuildReports.Storage
as
BuildReports
(
storeAnonymous
,
storeLocal
,
fromInstallPlan
)
(
storeAnonymous
,
storeLocal
,
fromInstallPlan
,
fromPlanningFailure
)
import
qualified
Distribution.Client.InstallSymlink
as
InstallSymlink
(
symlinkBinaries
)
import
qualified
Distribution.Client.PackageIndex
as
SourcePackageIndex
...
...
@@ -121,7 +123,7 @@ import Distribution.Simple.InstallDirs as InstallDirs
(
PathTemplate
,
fromPathTemplate
,
toPathTemplate
,
substPathTemplate
,
initialPathTemplateEnv
,
installDirsTemplateEnv
)
import
Distribution.Package
(
PackageIdentifier
,
PackageId
,
packageName
,
packageVersion
(
PackageIdentifier
(
..
)
,
PackageId
,
packageName
,
packageVersion
,
Package
(
..
),
PackageFixedDeps
(
..
)
,
Dependency
(
..
),
thisPackageVersion
,
InstalledPackageId
)
import
qualified
Distribution.PackageDescription
as
PackageDescription
...
...
@@ -133,7 +135,7 @@ import Distribution.PackageDescription.Configuration
import
Distribution.ParseUtils
(
showPWarning
)
import
Distribution.Version
(
Version
)
(
Version
,
VersionRange
,
foldVersionRange
)
import
Distribution.Simple.Utils
as
Utils
(
notice
,
info
,
warn
,
debug
,
debugNoWrap
,
die
,
intercalate
,
withTempDirectory
)
...
...
@@ -187,10 +189,15 @@ install verbosity packageDBs repos comp platform conf useSandbox mSandboxPkgInfo
userTargets0
=
do
installContext
<-
makeInstallContext
verbosity
args
(
Just
userTargets0
)
installPlan
<-
foldProgress
logMsg
die'
return
=<<
planResult
<-
foldProgress
logMsg
(
return
.
Left
)
(
return
.
Right
)
=<<
makeInstallPlan
verbosity
args
installContext
processInstallPlan
verbosity
args
installContext
installPlan
case
planResult
of
Left
message
->
do
reportPlanningFailure
verbosity
args
installContext
die'
message
Right
installPlan
->
processInstallPlan
verbosity
args
installContext
installPlan
where
args
::
InstallArgs
args
=
(
packageDBs
,
repos
,
comp
,
platform
,
conf
,
useSandbox
,
mSandboxPkgInfo
,
...
...
@@ -641,6 +648,54 @@ printPlan dryRun verbosity plan sourcePkgDb = case plan of
-- * Post installation stuff
-- ------------------------------------------------------------
-- | Report a solver failure. This works slightly differently to
-- 'postInstallActions', as (by definition) we don't have an install plan.
reportPlanningFailure
::
Verbosity
->
InstallArgs
->
InstallContext
->
IO
()
reportPlanningFailure
verbosity
(
_
,
repos
,
comp
,
platform
,
_
,
_
,
_
,
_
,
configFlags
,
_
,
installFlags
,
_
)
(
_
,
sourcePkgDb
,
_
,
pkgSpecifiers
)
=
do
when
reportFailure
$
do
-- Only create reports for explicitly named packages
let
pkgids
=
filter
(
SourcePackageIndex
.
elemByPackageId
(
packageIndex
sourcePkgDb
))
$
mapMaybe
theSpecifiedPackage
pkgSpecifiers
buildReports
=
BuildReports
.
fromPlanningFailure
platform
(
compilerId
comp
)
pkgids
(
configConfigurationsFlags
configFlags
)
repos
when
(
not
(
null
buildReports
))
$
notice
verbosity
$
"Notice: this solver failure will be reported for "
++
intercalate
","
(
map
display
pkgids
)
-- Save reports
BuildReports
.
storeLocal
(
installSummaryFile
installFlags
)
buildReports
platform
where
reportFailure
=
fromFlag
(
installReportPlanningFailure
installFlags
)
-- | If a 'PackageSpecifier' refers to a single package, return Just that package.
theSpecifiedPackage
::
Package
pkg
=>
PackageSpecifier
pkg
->
Maybe
PackageId
theSpecifiedPackage
pkgSpec
=
case
pkgSpec
of
NamedPackage
name
[
PackageConstraintVersion
name'
version
]
|
name
==
name'
->
PackageIdentifier
name
<$>
trivialRange
version
NamedPackage
_
_
->
Nothing
SpecificSourcePackage
pkg
->
Just
$
packageId
pkg
where
-- | 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
)
-- | Various stuff we do after successful or unsuccessfully installing a bunch
-- of packages. This includes:
--
...
...
@@ -836,6 +891,9 @@ printBuildFailures plan =
InstallFailed
e
->
" failed during the final install step."
++
showException
e
-- This will never happen, but we include it for completeness
PlanningFailed
->
" failed during the planning phase."
showException
e
=
" The exception was:
\n
"
++
show
e
++
maybeOOM
e
#
ifdef
mingw32_HOST_OS
maybeOOM
_
=
""
...
...
cabal-install/Distribution/Client/Setup.hs
View file @
1070b225
...
...
@@ -953,6 +953,7 @@ data InstallFlags = InstallFlags {
installSummaryFile
::
[
PathTemplate
],
installLogFile
::
Flag
PathTemplate
,
installBuildReports
::
Flag
ReportLevel
,
installReportPlanningFailure
::
Flag
Bool
,
installSymlinkBinDir
::
Flag
FilePath
,
installOneShot
::
Flag
Bool
,
installNumJobs
::
Flag
(
Maybe
Int
),
...
...
@@ -979,6 +980,7 @@ defaultInstallFlags = InstallFlags {
installSummaryFile
=
mempty
,
installLogFile
=
mempty
,
installBuildReports
=
Flag
NoReports
,
installReportPlanningFailure
=
Flag
False
,
installSymlinkBinDir
=
mempty
,
installOneShot
=
Flag
False
,
installNumJobs
=
mempty
,
...
...
@@ -1157,6 +1159,11 @@ installOptions showOrParseArgs =
(
toFlag
`
fmap
`
parse
))
(
flagToList
.
fmap
display
))
,
option
[]
[
"report-planning-failure"
]
"Generate build reports when the dependency solver fails. This is used by the Hackage build bot."
installReportPlanningFailure
(
\
v
flags
->
flags
{
installReportPlanningFailure
=
v
})
trueArg
,
option
[]
[
"one-shot"
]
"Do not record the packages in the world file."
installOneShot
(
\
v
flags
->
flags
{
installOneShot
=
v
})
...
...
@@ -1200,6 +1207,7 @@ instance Monoid InstallFlags where
installSummaryFile
=
mempty
,
installLogFile
=
mempty
,
installBuildReports
=
mempty
,
installReportPlanningFailure
=
mempty
,
installSymlinkBinDir
=
mempty
,
installOneShot
=
mempty
,
installNumJobs
=
mempty
,
...
...
@@ -1224,6 +1232,7 @@ instance Monoid InstallFlags where
installSummaryFile
=
combine
installSummaryFile
,
installLogFile
=
combine
installLogFile
,
installBuildReports
=
combine
installBuildReports
,
installReportPlanningFailure
=
combine
installReportPlanningFailure
,
installSymlinkBinDir
=
combine
installSymlinkBinDir
,
installOneShot
=
combine
installOneShot
,
installNumJobs
=
combine
installNumJobs
,
...
...
cabal-install/Distribution/Client/Types.hs
View file @
1070b225
...
...
@@ -195,7 +195,8 @@ data Repo = Repo {
-- ------------------------------------------------------------
type
BuildResult
=
Either
BuildFailure
BuildSuccess
data
BuildFailure
=
DependentFailed
PackageId
data
BuildFailure
=
PlanningFailed
|
DependentFailed
PackageId
|
DownloadFailed
SomeException
|
UnpackFailed
SomeException
|
ConfigureFailed
SomeException
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment