Commit 1070b225 authored by Chris Wong's avatar Chris Wong
Browse files

Add --report-planning-failure option to cabal-install

parent 5c70361b
......@@ -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 = packageId pkg,
package = pkgid,
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)
......
......@@ -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
]
......@@ -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 _ = ""
......
......@@ -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,
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment