From 14830b250fe1dca72dcfc102d36a33157cc906e1 Mon Sep 17 00:00:00 2001 From: Chris Wong Date: Tue, 22 Jul 2014 19:13:09 +1200 Subject: [PATCH 1/2] Add --report-planning-failure option to cabal-install --- .../Client/BuildReports/Anonymous.hs | 14 ++++- .../Client/BuildReports/Storage.hs | 13 ++++ cabal-install/Distribution/Client/Install.hs | 59 +++++++++++++++++-- cabal-install/Distribution/Client/Setup.hs | 9 +++ cabal-install/Distribution/Client/Types.hs | 3 +- 5 files changed, 90 insertions(+), 8 deletions(-) diff --git a/cabal-install/Distribution/Client/BuildReports/Anonymous.hs b/cabal-install/Distribution/Client/BuildReports/Anonymous.hs index 23d5681b9cd..c6d6b1014c3 100644 --- a/cabal-install/Distribution/Client/BuildReports/Anonymous.hs +++ b/cabal-install/Distribution/Client/BuildReports/Anonymous.hs @@ -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) diff --git a/cabal-install/Distribution/Client/BuildReports/Storage.hs b/cabal-install/Distribution/Client/BuildReports/Storage.hs index 35f019d3217..f6bba54ec6c 100644 --- a/cabal-install/Distribution/Client/BuildReports/Storage.hs +++ b/cabal-install/Distribution/Client/BuildReports/Storage.hs @@ -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 + ] diff --git a/cabal-install/Distribution/Client/Install.hs b/cabal-install/Distribution/Client/Install.hs index f215be4c981..4442c03810c 100644 --- a/cabal-install/Distribution/Client/Install.hs +++ b/cabal-install/Distribution/Client/Install.hs @@ -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, foldVersionRange ) import Distribution.Simple.Utils as Utils ( notice, info, warn, debug, debugNoWrap, die , intercalate, withTempDirectory ) @@ -187,10 +189,16 @@ 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 + let (_, _, userTargets, _) = installContext + reportPlanningFailure verbosity args userTargets + die' message + Right installPlan -> + processInstallPlan verbosity args installContext installPlan where args :: InstallArgs args = (packageDBs, repos, comp, platform, conf, useSandbox, mSandboxPkgInfo, @@ -641,6 +649,44 @@ 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 -> [UserTarget] -> IO () +reportPlanningFailure verbosity + (_, repos, comp, platform, _, _, _ + ,_, configFlags, _, installFlags, _) targets = do + + when reportFailure $ do + + -- Only create reports for explicitly named packages + let pkgids = [ pkgid | UserTargetNamed dep <- targets + , pkgid <- maybeToList $ pickExactVersion dep ] + + 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) + + pickExactVersion :: Dependency -> Maybe PackageId + pickExactVersion (Dependency n v) = PackageIdentifier n <$> + foldVersionRange + Nothing + Just -- "== v" + (\_ -> Nothing) + (\_ -> Nothing) + (\_ _ -> Nothing) + (\_ _ -> Nothing) + v + -- | Various stuff we do after successful or unsuccessfully installing a bunch -- of packages. This includes: -- @@ -836,6 +882,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 _ = "" diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs index 0d0a0f0fa14..87d6ea54c69 100644 --- a/cabal-install/Distribution/Client/Setup.hs +++ b/cabal-install/Distribution/Client/Setup.hs @@ -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, diff --git a/cabal-install/Distribution/Client/Types.hs b/cabal-install/Distribution/Client/Types.hs index ce154d4996d..0fb8a1d9058 100644 --- a/cabal-install/Distribution/Client/Types.hs +++ b/cabal-install/Distribution/Client/Types.hs @@ -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 From 1bfa56d295e56559bbbd8c8c51da782f1f82fffe Mon Sep 17 00:00:00 2001 From: Chris Wong Date: Tue, 22 Jul 2014 19:15:23 +1200 Subject: [PATCH 2/2] Fix warnings --- cabal-install/Distribution/Client/Install.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/cabal-install/Distribution/Client/Install.hs b/cabal-install/Distribution/Client/Install.hs index 4442c03810c..4a7e4acabc4 100644 --- a/cabal-install/Distribution/Client/Install.hs +++ b/cabal-install/Distribution/Client/Install.hs @@ -602,12 +602,11 @@ printPlan dryRun verbosity plan sourcePkgDb = case plan of showLatest :: ReadyPackage -> String showLatest pkg = case mLatestVersion of Just latestVersion -> - if pkgVersion < latestVersion + if packageVersion pkg < latestVersion then (" (latest: " ++ display latestVersion ++ ")") else "" Nothing -> "" where - pkgVersion = packageVersion pkg mLatestVersion :: Maybe Version mLatestVersion = case SourcePackageIndex.lookupPackageName (packageIndex sourcePkgDb)