Commit 113a7d25 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Refactor BuildResult type and related types

Split BuildResult into Either BuildFailure BuildSuccess
Make BuildSuccess contain info for docs and tests.
Make PlanPackage use BuildSuccess and BuildFailure directly
rather than being parameterised by any build result type.
This has a knock on effect on lots of other types which
were parameterised just because PlanPackage was.
parent 7d84912c
......@@ -50,7 +50,7 @@ import qualified Data.Set as Set
import Data.Set (Set)
import Control.Exception (assert)
defaultResolver :: DependencyResolver a
defaultResolver :: DependencyResolver
defaultResolver = topDownResolver
--for the brave: try the new topDownResolver, but only with --dry-run !!!
......@@ -84,7 +84,7 @@ resolveDependencies :: OS
-> PackageIndex AvailablePackage
-> PackagesVersionPreference
-> [UnresolvedDependency]
-> Either String (InstallPlan a)
-> Either String InstallPlan
resolveDependencies os arch comp installed available pref deps =
foldProgress (flip const) Left Right $
resolveDependenciesWithProgress os arch comp installed available pref deps
......@@ -96,7 +96,7 @@ resolveDependenciesWithProgress :: OS
-> PackageIndex AvailablePackage
-> PackagesVersionPreference
-> [UnresolvedDependency]
-> Progress String String (InstallPlan a)
-> Progress String String InstallPlan
resolveDependenciesWithProgress os arch comp (Just installed) =
dependencyResolver defaultResolver os arch comp installed
......@@ -118,13 +118,13 @@ hideBasePackage = PackageIndex.deletePackageName "base"
. PackageIndex.deletePackageName "ghc-prim"
dependencyResolver
:: DependencyResolver a
:: DependencyResolver
-> OS -> Arch -> CompilerId
-> PackageIndex InstalledPackageInfo
-> PackageIndex AvailablePackage
-> PackagesVersionPreference
-> [UnresolvedDependency]
-> Progress String String (InstallPlan a)
-> Progress String String InstallPlan
dependencyResolver resolver os arch comp installed available pref deps =
let installed' = hideBrokenPackages installed
available' = hideBasePackage available
......
......@@ -45,7 +45,7 @@ import Data.List
-- We need this for hugs and nhc98 which do not track installed packages.
-- We just pretend that everything is installed and hope for the best.
--
bogusResolver :: DependencyResolver a
bogusResolver :: DependencyResolver
bogusResolver os arch comp _ available _ = resolveFromAvailable []
. combineDependencies
where
......
......@@ -48,7 +48,7 @@ import Data.List (maximumBy)
import Data.Maybe (fromMaybe)
import Data.Monoid (Monoid(mappend))
naiveResolver :: DependencyResolver a
naiveResolver :: DependencyResolver
naiveResolver os arch comp installed available _ deps =
packagesToInstall installed
[ resolveDependency os arch comp installed available dep flags
......
......@@ -196,7 +196,7 @@ search configure pref constraints =
-- | The main exported resolver, with string logging and failure types to fit
-- the standard 'DependencyResolver' interface.
--
topDownResolver :: DependencyResolver a
topDownResolver :: DependencyResolver
topDownResolver = ((((((mapMessages .).).).).).) . topDownResolver'
where
mapMessages :: Progress Log Failure a -> Progress String String a
......@@ -209,7 +209,7 @@ topDownResolver' :: OS -> Arch -> CompilerId
-> PackageIndex AvailablePackage
-> (PackageName -> PackageVersionPreference)
-> [UnresolvedDependency]
-> Progress Log Failure [PlanPackage a]
-> Progress Log Failure [PlanPackage]
topDownResolver' os arch comp installed available pref deps =
fmap (uncurry finalise)
. (\cs -> search configure pref cs initialPkgNames)
......@@ -370,7 +370,7 @@ selectNeededSubset installed available = select mempty mempty
finaliseSelectedPackages :: SelectedPackages
-> Constraints
-> [PlanPackage a]
-> [PlanPackage]
finaliseSelectedPackages selected constraints =
map finaliseSelected (PackageIndex.allPackages selected)
where
......@@ -397,8 +397,8 @@ finaliseSelectedPackages selected constraints =
-- packages we plan to install with ones that are already installed.
--
improvePlan :: PackageIndex InstalledPackageInfo
-> PackageIndex (PlanPackage a)
-> PackageIndex (PlanPackage a)
-> PackageIndex PlanPackage
-> PackageIndex PlanPackage
improvePlan installed selected = foldl' improve selected
$ reverseTopologicalOrder selected
where
......
......@@ -43,14 +43,14 @@ type PackageName = String
-- solving the package dependency problem and we want to make it easy to swap
-- in alternatives.
--
type DependencyResolver a = OS
-> Arch
-> CompilerId
-> PackageIndex InstalledPackageInfo
-> PackageIndex AvailablePackage
-> (PackageName -> PackageVersionPreference)
-> [UnresolvedDependency]
-> Progress String String [InstallPlan.PlanPackage a]
type DependencyResolver = OS
-> Arch
-> CompilerId
-> PackageIndex InstalledPackageInfo
-> PackageIndex AvailablePackage
-> (PackageName -> PackageVersionPreference)
-> [UnresolvedDependency]
-> Progress String String [InstallPlan.PlanPackage]
-- | A per-package preference on the version. It is a soft constraint that the
-- 'DependencyResolver' should try to respect where possible.
......
......@@ -44,7 +44,8 @@ import Distribution.Client.Tar (extractTarGzFile)
import Distribution.Client.Types as Available
( UnresolvedDependency(..), AvailablePackage(..)
, AvailablePackageSource(..), Repo, ConfiguredPackage(..)
, BuildResult(..) )
, BuildResult, BuildFailure(..), BuildSuccess(..)
, DocsResult(..), TestsResult(..) )
import Distribution.Client.SetupWrapper
( setupWrapper, SetupScriptOptions(..), defaultSetupScriptOptions )
import Distribution.Client.Reporting
......@@ -121,7 +122,7 @@ upgrade verbosity packageDB repos comp conf configFlags installFlags deps =
type Planner = Maybe (PackageIndex InstalledPackageInfo)
-> PackageIndex AvailablePackage
-> IO (Progress String String (InstallPlan BuildResult))
-> IO (Progress String String InstallPlan)
-- |Installs the packages generated by a planner.
installWithPlanner ::
......@@ -235,7 +236,7 @@ planUpgradePackages comp _ _ =
++ " does not track installed packages so cabal cannot figure out what"
++ " packages need to be upgraded."
printDryRun :: Verbosity -> InstallPlan BuildResult -> IO ()
printDryRun :: Verbosity -> InstallPlan -> IO ()
printDryRun verbosity plan = case unfoldr next plan of
[] -> notice verbosity "No packages to be installed."
pkgs -> notice verbosity $ unlines $
......@@ -244,13 +245,16 @@ printDryRun verbosity plan = case unfoldr next plan of
where
next plan' = case InstallPlan.ready plan' of
[] -> Nothing
(pkg:_) -> Just (pkgid, InstallPlan.completed pkgid plan')
(pkg:_) -> Just (pkgid, InstallPlan.completed pkgid result plan')
where pkgid = packageId pkg
result = BuildOk DocsNotTried TestsNotTried
--FIXME: This is a bit of a hack,
-- pretending that each package is installed
symlinkBinaries :: Verbosity
-> Cabal.ConfigFlags
-> InstallFlags
-> InstallPlan BuildResult -> IO ()
-> InstallPlan -> IO ()
symlinkBinaries verbosity configFlags installFlags plan = do
failed <- InstallSymlink.symlinkBinaries configFlags installFlags plan
case failed of
......@@ -273,7 +277,7 @@ symlinkBinaries verbosity configFlags installFlags plan = do
where
bindir = Cabal.fromFlag (installSymlinkBinDir installFlags)
printBuildFailures :: InstallPlan BuildResult -> IO ()
printBuildFailures :: InstallPlan -> IO ()
printBuildFailures plan =
case [ (pkg, reason)
| InstallPlan.Failed pkg reason <- InstallPlan.toList plan ] of
......@@ -294,29 +298,31 @@ printBuildFailures plan =
++ " The exception was:\n " ++ show e
InstallFailed e -> " failed during the final install step."
++ " The exception was:\n " ++ show e
_ -> ""
executeInstallPlan :: Monad m
=> InstallPlan BuildResult
=> InstallPlan
-> (ConfiguredPackage -> m BuildResult)
-> m (InstallPlan BuildResult)
-> m InstallPlan
executeInstallPlan plan installPkg = case InstallPlan.ready plan of
[] -> return plan
(pkg: _) -> do
buildResult <- installPkg pkg
let pkgid = packageId pkg
updatePlan = case buildResult of
BuildOk -> InstallPlan.completed pkgid
_ -> InstallPlan.failed pkgid buildResult depsResult
where depsResult = DependentFailed pkgid
-- So this first pkgid failed for whatever reason (buildResult)
-- all the other packages that depended on this pkgid which we
-- now cannot build we mark as failing due to DependentFailed
-- which kind of means it was not their fault.
executeInstallPlan (updatePlan plan) installPkg
[] -> return plan
(pkg: _) -> do buildResult <- installPkg pkg
let plan' = updatePlan (packageId pkg) buildResult plan
executeInstallPlan plan' installPkg
where
updatePlan pkgid (Right buildSuccess) =
InstallPlan.completed pkgid buildSuccess
updatePlan pkgid (Left buildFailure) =
InstallPlan.failed pkgid buildFailure depsFailure
where
depsFailure = DependentFailed pkgid
-- So this first pkgid failed for whatever reason (buildFailure).
-- All the other packages that depended on this pkgid, which we
-- now cannot build, we mark as failing due to 'DependentFailed'
-- which kind of means it was not their fault.
-- | Call an installer for an 'AvailablePackage' but override the configure
-- flags with the ones given by the 'ConfiguredPackage'. In particular the
-- flags with the ones given by the 'ConfiguredPackage'. In particular the
-- 'ConfiguredPackage' specifies an exact 'FlagAssignment' and exactly
-- versioned package dependencies. So we ignore any previous partial flag
-- assignment or dependency constraints and use the new ones.
......@@ -372,7 +378,7 @@ installUnpackedPackage verbosity scriptOptions miscOptions configFlags
case rootCmd miscOptions of
(Just cmd) -> reexec cmd
Nothing -> setup Cabal.installCommand installFlags
return BuildOk
return (Right (BuildOk DocsNotTried TestsNotTried))
where
buildCommand = Cabal.buildCommand defaultProgramConfiguration
buildFlags _ = Cabal.emptyBuildFlags {
......@@ -405,7 +411,7 @@ installUnpackedPackage verbosity scriptOptions miscOptions configFlags
[self, "install", "--only"
,"--verbose=" ++ showForCabal verbosity]
else die $ "Unable to find cabal executable at: " ++ self
-- helper
onFailure :: (Exception -> BuildResult) -> IO BuildResult -> IO BuildResult
onFailure result = Exception.handle (return . result)
onFailure :: (Exception -> BuildFailure) -> IO BuildResult -> IO BuildResult
onFailure result = Exception.handle (return . Left . result)
......@@ -45,7 +45,8 @@ module Distribution.Client.InstallPlan (
) where
import Distribution.Client.Types
( AvailablePackage(packageDescription), ConfiguredPackage(..) )
( AvailablePackage(packageDescription), ConfiguredPackage(..)
, BuildFailure, BuildSuccess )
import Distribution.Package
( PackageIdentifier(..), Package(..), PackageFixedDeps(..)
, packageName, Dependency(..) )
......@@ -124,26 +125,25 @@ import Control.Exception
-- have problems with inconsistent dependencies.
-- On the other hand it is true that every closed sub plan is valid.
data PlanPackage buildResult = PreExisting InstalledPackageInfo
| Configured ConfiguredPackage
| Installed ConfiguredPackage
| Failed ConfiguredPackage buildResult
deriving Show
data PlanPackage = PreExisting InstalledPackageInfo
| Configured ConfiguredPackage
| Installed ConfiguredPackage BuildSuccess
| Failed ConfiguredPackage BuildFailure
instance Package (PlanPackage buildResult) where
instance Package PlanPackage where
packageId (PreExisting pkg) = packageId pkg
packageId (Configured pkg) = packageId pkg
packageId (Installed pkg) = packageId pkg
packageId (Failed pkg _) = packageId pkg
packageId (Configured pkg) = packageId pkg
packageId (Installed pkg _) = packageId pkg
packageId (Failed pkg _) = packageId pkg
instance PackageFixedDeps (PlanPackage buildResult) where
instance PackageFixedDeps PlanPackage where
depends (PreExisting pkg) = depends pkg
depends (Configured pkg) = depends pkg
depends (Installed pkg) = depends pkg
depends (Failed pkg _) = depends pkg
depends (Configured pkg) = depends pkg
depends (Installed pkg _) = depends pkg
depends (Failed pkg _) = depends pkg
data InstallPlan buildResult = InstallPlan {
planIndex :: PackageIndex (PlanPackage buildResult),
data InstallPlan = InstallPlan {
planIndex :: PackageIndex PlanPackage,
planGraph :: Graph,
planGraphRev :: Graph,
planPkgIdOf :: Graph.Vertex -> PackageIdentifier,
......@@ -153,7 +153,7 @@ data InstallPlan buildResult = InstallPlan {
planCompiler :: CompilerId
}
invariant :: InstallPlan a -> Bool
invariant :: InstallPlan -> Bool
invariant plan =
valid (planOS plan) (planArch plan) (planCompiler plan) (planIndex plan)
......@@ -162,8 +162,8 @@ internalError msg = error $ "InstallPlan: internal error: " ++ msg
-- | Build an installation plan from a valid set of resolved packages.
--
new :: OS -> Arch -> CompilerId -> PackageIndex (PlanPackage a)
-> Either [PlanProblem a] (InstallPlan a)
new :: OS -> Arch -> CompilerId -> PackageIndex PlanPackage
-> Either [PlanProblem] InstallPlan
new os arch compiler index =
case problems os arch compiler index of
[] -> Right InstallPlan {
......@@ -181,14 +181,14 @@ new os arch compiler index =
noSuchPkgId = internalError "package is not in the graph"
probs -> Left probs
toList :: InstallPlan buildResult -> [PlanPackage buildResult]
toList :: InstallPlan -> [PlanPackage]
toList = PackageIndex.allPackages . planIndex
-- | The packages that are ready to be installed. That is they are in the
-- configured state and have all their dependencies installed already.
-- The plan is complete if the result is @[]@.
--
ready :: InstallPlan buildResult -> [ConfiguredPackage]
ready :: InstallPlan -> [ConfiguredPackage]
ready plan = assert check readyPackages
where
check = if null readyPackages then null configuredPackages else True
......@@ -200,7 +200,7 @@ ready plan = assert check readyPackages
Just (Configured _) -> False
Just (Failed _ _) -> internalError depOnFailed
Just (PreExisting _) -> True
Just (Installed _) -> True
Just (Installed _ _) -> True
Nothing -> internalError incomplete
incomplete = "install plan is not closed"
depOnFailed = "configured package depends on failed package"
......@@ -212,13 +212,14 @@ ready plan = assert check readyPackages
-- * The package must have had no uninstalled dependent packages.
--
completed :: PackageIdentifier
-> InstallPlan buildResult -> InstallPlan buildResult
completed pkgid plan = assert (invariant plan') plan'
-> BuildSuccess
-> InstallPlan -> InstallPlan
completed pkgid buildResult plan = assert (invariant plan') plan'
where
plan' = plan {
planIndex = PackageIndex.insert installed (planIndex plan)
}
installed = Installed (lookupConfiguredPackage plan pkgid)
installed = Installed (lookupConfiguredPackage plan pkgid) buildResult
-- | Marks a package in the graph as having failed. It also marks all the
-- packages that depended on it as having failed.
......@@ -226,10 +227,10 @@ completed pkgid plan = assert (invariant plan') plan'
-- * The package must exist in the graph and be in the configured state.
--
failed :: PackageIdentifier -- ^ The id of the package that failed to install
-> buildResult -- ^ The build result to use for the failed package
-> buildResult -- ^ The build result to use for its dependencies
-> InstallPlan buildResult
-> InstallPlan buildResult
-> BuildFailure -- ^ The build result to use for the failed package
-> BuildFailure -- ^ The build result to use for its dependencies
-> InstallPlan
-> InstallPlan
failed pkgid buildResult buildResult' plan = assert (invariant plan') plan'
where
plan' = plan {
......@@ -244,7 +245,7 @@ failed pkgid buildResult buildResult' plan = assert (invariant plan') plan'
-- | lookup the reachable packages in the reverse dependency graph
--
packagesThatDependOn :: InstallPlan a
packagesThatDependOn :: InstallPlan
-> PackageIdentifier -> [PackageIdentifier]
packagesThatDependOn plan = map (planPkgIdOf plan)
. tail
......@@ -253,7 +254,7 @@ packagesThatDependOn plan = map (planPkgIdOf plan)
-- | lookup a package that we expect to be in the configured state
--
lookupConfiguredPackage :: InstallPlan a
lookupConfiguredPackage :: InstallPlan
-> PackageIdentifier -> ConfiguredPackage
lookupConfiguredPackage plan pkgid =
case PackageIndex.lookupPackageId (planIndex plan) pkgid of
......@@ -262,7 +263,7 @@ lookupConfiguredPackage plan pkgid =
-- | lookup a package that we expect to be in the configured or failed state
--
lookupConfiguredPackage' :: InstallPlan a
lookupConfiguredPackage' :: InstallPlan
-> PackageIdentifier -> Maybe ConfiguredPackage
lookupConfiguredPackage' plan pkgid =
case PackageIndex.lookupPackageId (planIndex plan) pkgid of
......@@ -280,17 +281,17 @@ lookupConfiguredPackage' plan pkgid =
--
-- * if the result is @False@ use 'problems' to get a detailed list.
--
valid :: OS -> Arch -> CompilerId -> PackageIndex (PlanPackage a) -> Bool
valid :: OS -> Arch -> CompilerId -> PackageIndex PlanPackage -> Bool
valid os arch comp index = null (problems os arch comp index)
data PlanProblem a =
data PlanProblem =
PackageInvalid ConfiguredPackage [PackageProblem]
| PackageMissingDeps (PlanPackage a) [PackageIdentifier]
| PackageCycle [PlanPackage a]
| PackageMissingDeps PlanPackage [PackageIdentifier]
| PackageCycle [PlanPackage]
| PackageInconsistency String [(PackageIdentifier, Version)]
| PackageStateInvalid (PlanPackage a) (PlanPackage a)
| PackageStateInvalid PlanPackage PlanPackage
showPlanProblem :: PlanProblem a -> String
showPlanProblem :: PlanProblem -> String
showPlanProblem (PackageInvalid pkg packageProblems) =
"Package " ++ display (packageId pkg)
++ " has an invalid configuration, in particular:\n"
......@@ -323,7 +324,7 @@ showPlanProblem (PackageStateInvalid pkg pkg') =
where
showPlanState (PreExisting _) = "pre-existing"
showPlanState (Configured _) = "configured"
showPlanState (Installed _) = "installed"
showPlanState (Installed _ _) = "installed"
showPlanState (Failed _ _) = "failed"
-- | For an invalid plan, produce a detailed list of problems as human readable
......@@ -331,7 +332,7 @@ showPlanProblem (PackageStateInvalid pkg pkg') =
-- Use 'showPlanProblem' for a human readable explanation.
--
problems :: OS -> Arch -> CompilerId
-> PackageIndex (PlanPackage a) -> [PlanProblem a]
-> PackageIndex PlanPackage -> [PlanProblem]
problems os arch comp index =
[ PackageInvalid pkg packageProblems
| Configured pkg <- PackageIndex.allPackages index
......@@ -357,7 +358,7 @@ problems os arch comp index =
-- * if the result is @False@ use 'PackageIndex.dependencyCycles' to find out
-- which packages are involved in dependency cycles.
--
acyclic :: PackageIndex (PlanPackage a) -> Bool
acyclic :: PackageIndex PlanPackage -> Bool
acyclic = null . PackageIndex.dependencyCycles
-- | An installation plan is closed if for every package in the set, all of
......@@ -367,7 +368,7 @@ acyclic = null . PackageIndex.dependencyCycles
-- * if the result is @False@ use 'PackageIndex.brokenPackages' to find out
-- which packages depend on packages not in the index.
--
closed :: PackageIndex (PlanPackage a) -> Bool
closed :: PackageIndex PlanPackage -> Bool
closed = null . PackageIndex.brokenPackages
-- | An installation plan is consistent if all dependencies that target a
......@@ -386,29 +387,29 @@ closed = null . PackageIndex.brokenPackages
-- * if the result is @False@ use 'PackageIndex.dependencyInconsistencies' to
-- find out which packages are.
--
consistent :: PackageIndex (PlanPackage a) -> Bool
consistent :: PackageIndex PlanPackage -> Bool
consistent = null . PackageIndex.dependencyInconsistencies
-- | The states of packages have that depend on each other must respect
-- this relation. That is for very case where package @a@ depends on
-- package @b@ we require that @dependencyStatesOk a b = True@.
--
stateDependencyRelation :: PlanPackage a -> PlanPackage a -> Bool
stateDependencyRelation :: PlanPackage -> PlanPackage -> Bool
stateDependencyRelation (PreExisting _) (PreExisting _) = True
stateDependencyRelation (Configured _) (PreExisting _) = True
stateDependencyRelation (Configured _) (Configured _) = True
stateDependencyRelation (Configured _) (Installed _) = True
stateDependencyRelation (Configured _) (Installed _ _) = True
stateDependencyRelation (Installed _) (PreExisting _) = True
stateDependencyRelation (Installed _) (Installed _) = True
stateDependencyRelation (Installed _ _) (PreExisting _) = True
stateDependencyRelation (Installed _ _) (Installed _ _) = True
stateDependencyRelation (Failed _ _) (PreExisting _) = True
-- failed can depends on configured because a package can depend on
-- several other packages and if one of the deps fail then we fail
-- but we still depend on the other ones that did not fail:
stateDependencyRelation (Failed _ _) (Configured _) = True
stateDependencyRelation (Failed _ _) (Installed _) = True
stateDependencyRelation (Failed _ _) (Installed _ _) = True
stateDependencyRelation (Failed _ _) (Failed _ _) = True
stateDependencyRelation _ _ = False
......
......@@ -23,14 +23,13 @@ module Distribution.Client.InstallSymlink (
#if mingw32_HOST_OS || mingw32_TARGET_OS
import Distribution.Client.Types (BuildResult)
import Distribution.Client.InstallPlan (InstallPlan)
import Distribution.Client.Setup (InstallFlags)
import Distribution.Simple.Setup (ConfigFlags)
symlinkBinaries :: ConfigFlags
-> InstallFlags
-> InstallPlan BuildResult -> IO ()
-> InstallPlan -> IO ()
symlinkBinaries _ _ = symlinkBinary undefined undefined undefined undefined
symlinkBinary :: FilePath -> FilePath -> String -> String -> IO Bool
......@@ -39,7 +38,7 @@ symlinkBinary _ _ _ _ = fail "Symlinking feature not available on Windows"
#else
import Distribution.Client.Types
( AvailablePackage(..), ConfiguredPackage(..), BuildResult )
( AvailablePackage(..), ConfiguredPackage(..) )
import Distribution.Client.Setup
( InstallFlags(installSymlinkBinDir) )
import qualified Distribution.Client.InstallPlan as InstallPlan
......@@ -95,7 +94,7 @@ import Data.Maybe
--
symlinkBinaries :: ConfigFlags
-> InstallFlags
-> InstallPlan BuildResult
-> InstallPlan
-> IO [(PackageIdentifier, String, FilePath)]
symlinkBinaries configFlags installFlags plan =
case flagToMaybe (installSymlinkBinDir installFlags) of
......@@ -115,7 +114,7 @@ symlinkBinaries configFlags installFlags plan =
then return Nothing
else return (Just (pkgid, publicExeName,
privateBinDir </> privateExeName))
| InstallPlan.Installed cpkg <- InstallPlan.toList plan
| InstallPlan.Installed cpkg _ <- InstallPlan.toList plan
, let pkg = pkgDescription cpkg
pkgid = packageId pkg
, exe <- PackageDescription.executables pkg
......
......@@ -38,7 +38,8 @@ import Distribution.Client.Types
import Distribution.Client.Config
( defaultCabalDir )
import qualified Distribution.Client.Types as BR
( BuildResult(..) )
( BuildFailure(..), BuildSuccess(..)
, DocsResult(..), TestsResult(..) )
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.InstallPlan
( InstallPlan, PlanPackage )
......@@ -130,7 +131,7 @@ writeBuildLog reports = do
format r = '\n' : showBuildLogEntry r ++ "\n"
buildLogEntry :: OS -> Arch -> CompilerId -- -> Version
-> ConfiguredPackage -> BR.BuildResult
-> ConfiguredPackage -> BuildResult
-> BuildLogEntry
buildLogEntry os' arch' comp (ConfiguredPackage pkg flags deps) result =
BuildLogEntry {
......@@ -142,21 +143,33 @@ buildLogEntry os' arch' comp (ConfiguredPackage pkg flags deps) result =
client = cabalInstallID,
flagAssignment = flags,
dependencies = deps,
installOutcome = case result of
BR.DependentFailed p -> DependencyFailed p
BR.UnpackFailed _ -> UnpackFailed
BR.ConfigureFailed _ -> ConfigureFailed
BR.BuildFailed _ -> BuildFailed
BR.InstallFailed _ -> InstallFailed
BR.BuildOk -> InstallOk,
installOutcome = convertInstallOutcome,
-- cabalVersion = undefined
docsOutcome = NotTried,
testsOutcome = NotTried
docsOutcome = convertDocsOutcome,
testsOutcome = convertTestsOutcome
}
where
cabalInstallID =
PackageIdentifier "cabal-install" Paths_cabal_install.version
convertInstallOutcome = case result of
Left (BR.DependentFailed p) -> DependencyFailed p
Left (BR.UnpackFailed _) -> UnpackFailed
Left (BR.ConfigureFailed _) -> ConfigureFailed
Left (BR.BuildFailed _) -> BuildFailed
Left (BR.InstallFailed _) -> InstallFailed
Right (BR.BuildOk _ _) -> InstallOk
convertDocsOutcome = case result of
Left _ -> NotTried
Right (BR.BuildOk BR.DocsNotTried _) -> NotTried
Right (BR.BuildOk BR.DocsFailed _) -> Failed
Right (BR.BuildOk BR.DocsOk _) -> Ok
convertTestsOutcome = case result of
Left _ -> NotTried
Right (BR.BuildOk _ BR.TestsNotTried) -> NotTried
Right (BR.BuildOk _ BR.TestsFailed) -> Failed
Right (BR.BuildOk _ BR.TestsOk) -> Ok
-- ------------------------------------------------------------
-- * External format
-- ------------------------------------------------------------
......@@ -253,10 +266,10 @@ instance Text URI where
-- * InstallPlan support
-- ------------------------------------------------------------