Commit 20ce7327 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

First cut at generating build reports

parent 9d650d2c
......@@ -16,6 +16,7 @@ module Hackage.Config
, configRepos
, configPackageDB
, defaultConfigFile
, defaultBuildReportFile
, loadConfig
, showConfig
) where
......@@ -106,6 +107,10 @@ defaultConfigFile :: IO FilePath
defaultConfigFile = do dir <- defaultCabalDir
return $ dir </> "config"
defaultBuildReportFile :: IO FilePath
defaultBuildReportFile = do dir <- defaultCabalDir
return $ dir </> "build-reports"
defaultCacheDir :: IO FilePath
defaultCacheDir = do dir <- defaultCabalDir
return $ dir </> "packages"
......
......@@ -40,11 +40,12 @@ import Hackage.Setup
import Hackage.Tar (extractTarGzFile)
import Hackage.Types as Available
( UnresolvedDependency(..), AvailablePackage(..)
, AvailablePackageSource(..), Repo, ConfiguredPackage(..) )
, AvailablePackageSource(..), Repo, ConfiguredPackage(..)
, BuildResult(..) )
import Hackage.SetupWrapper
( setupWrapper, SetupScriptOptions(..), defaultSetupScriptOptions )
import Hackage.Reporting
( )
( writeInstallPlanBuildReports )
import Paths_cabal_install (getBinDir)
import Distribution.Simple.Compiler
......@@ -75,13 +76,6 @@ import Distribution.Text
import Distribution.Verbosity (Verbosity, showForCabal, verbose)
import Distribution.Simple.BuildPaths ( exeExtension )
data BuildResult = DependentFailed PackageIdentifier
| UnpackFailed Exception
| ConfigureFailed Exception
| BuildFailed Exception
| InstallFailed Exception
| BuildOk
data InstallMisc = InstallMisc {
rootCmd :: Maybe FilePath,
libVersion :: Maybe Version
......@@ -151,8 +145,8 @@ installWithPlanner planner verbosity packageDB repos comp conf configFlags insta
installAvailablePackage verbosity apkg $
installUnpackedPackage verbosity (setupScriptOptions installed)
miscOptions configFlags'
writeInstallPlanBuildReports installPlan'
printBuildFailures installPlan'
-- writeBuildReports installPlan'
where
setupScriptOptions index = SetupScriptOptions {
......
......@@ -23,6 +23,11 @@ module Hackage.InstallPlan (
completed,
failed,
-- ** Query functions
planOS,
planArch,
planCompiler,
-- * Checking valididy of plans
valid,
closed,
......
......@@ -13,104 +13,156 @@
-----------------------------------------------------------------------------
module Hackage.Reporting (
BuildReport(..),
ConfigurePhase(..),
BuildPhase(..),
InstallPhase(..),
Outcome(..),
writeBuildReport,
makeSuccessReport,
InstallOutcome(..),
DocsOutcome(..),
TestsOutcome(..),
-- * Constructing and writing reports
buildReport,
writeBuildReports,
-- * 'InstallPlan' variants
planPackageBuildReport,
installPlanBuildReports,
writeInstallPlanBuildReports
) where
import Hackage.Types
( ConfiguredPackage(..) )
( ConfiguredPackage(..), BuildResult )
import qualified Hackage.Types as BR
( BuildResult(..) )
import qualified Hackage.InstallPlan as InstallPlan
import Hackage.InstallPlan
( InstallPlan, PlanPackage(..) )
import Hackage.Config
( defaultBuildReportFile )
import Distribution.Package
( PackageIdentifier, Package(packageId) )
import Distribution.PackageDescription
( FlagAssignment )
--import Distribution.Version
-- ( Version )
import Distribution.System
( OS, Arch )
import Distribution.Compiler
( CompilerId )
import System.FilePath
( takeDirectory )
import System.Directory
( createDirectoryIfMissing )
import Data.Maybe
( catMaybes )
data BuildReport = BuildReport {
data BuildReport
= BuildReport {
-- | The package this build report is about
buildPackage :: PackageIdentifier,
package :: PackageIdentifier,
-- | Which hackage server this package is from and thus which server this
-- report should be sent to.
-- server :: String,
-- | The OS and Arch the package was built on
buildOS :: OS,
buildArch :: Arch,
os :: OS,
arch :: Arch,
-- | The Haskell compiler (and hopefully version) used
buildCompiler :: CompilerId,
-- | Configure outcome, did configure work ok?
buildOutcomeConfigure :: Outcome ConfigurePhase
}
deriving (Show, Read)
compiler :: CompilerId,
data ConfigurePhase = ConfigurePhase {
-- | Which configurations flags we used
buildFlagAssignment :: FlagAssignment,
flagAssignment :: FlagAssignment,
-- | Which dependent packages we were using exactly
buildResolvedDeps :: [PackageIdentifier],
dependencies :: [PackageIdentifier],
-- | Which build tools we were using (with versions)
-- buildResolvedTools :: [PackageIdentifier],
-- | Did installing work ok?
installOutcome :: InstallOutcome,
-- | Build outcome, did the build phase work ok?
buildOutcomeBuild :: Outcome BuildPhase
-- | Which version of the Cabal library was used to compile the Setup.hs
-- cabalVersion :: Version,
-- | Build outcome, did building the docs work?
-- buildOutcomeDocs :: Outcome DocsPhase
}
deriving (Show, Read)
-- | Which build tools we were using (with versions)
-- tools :: [PackageIdentifier],
-- | Configure outcome, did configure work ok?
docsOutcome :: DocsOutcome,
data BuildPhase = BuildPhase {
-- | Build outcome, did installing work ok?
buildOutcomeInstall :: Outcome InstallPhase
-- | Configure outcome, did configure work ok?
testsOutcome :: TestsOutcome
}
deriving (Show, Read)
--data DocsPhase = DocsPhase deriving (Show, Read)
data InstallPhase = InstallPhase deriving (Show, Read)
data Outcome a = OutcomeOk a | OutcomeFailed | OutcomeNotTried
deriving (Show, Read)
writeBuildReport :: FilePath -> BuildReport -> IO ()
writeBuildReport file report = do
createDirectoryIfMissing True (takeDirectory file)
writeFile file $ show report
makeSuccessReport :: OS -> Arch -> CompilerId
-> ConfiguredPackage -> BuildReport
makeSuccessReport os arch comp (ConfiguredPackage pkg flags deps) =
data InstallOutcome
= DependencyFailed PackageIdentifier
| DownloadFailed
| UnpackFailed
| SetupFailed
| ConfigureFailed
| BuildFailed
| InstallFailed
| InstallOk
deriving (Show, Read)
data DocsOutcome
= DocsNotTried
| DocsFailed
| DocsOk
deriving (Show, Read)
data TestsOutcome
= TestsNotTried
| TestsFailed
| TestsOk
deriving (Show, Read)
writeBuildReports :: [BuildReport] -> IO ()
writeBuildReports reports = do
file <- defaultBuildReportFile
appendFile file (unlines (map show reports))
buildReport :: OS -> Arch -> CompilerId -- -> Version
-> ConfiguredPackage -> BR.BuildResult
-> BuildReport
buildReport os' arch' comp (ConfiguredPackage pkg flags deps) result =
BuildReport {
buildPackage = packageId pkg,
buildOS = os,
buildArch = arch,
buildCompiler = comp,
buildOutcomeConfigure = OutcomeOk ConfigurePhase {
buildFlagAssignment = flags,
buildResolvedDeps = deps,
buildOutcomeBuild = OutcomeOk BuildPhase {
buildOutcomeInstall = OutcomeOk InstallPhase
}
}
package = packageId pkg,
os = os',
-- server = undefined,
arch = arch',
compiler = comp,
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,
-- cabalVersion = undefined
docsOutcome = DocsNotTried,
testsOutcome = TestsNotTried
}
--makeFailureReport :: OS -> Arch -> CompilerId
-- -> ConfiguredPackage -> BuildReport
-- ------------------------------------------------------------
-- * InstallPlan support
-- ------------------------------------------------------------
writeInstallPlanBuildReports :: InstallPlan BuildResult -> IO ()
writeInstallPlanBuildReports = writeBuildReports . installPlanBuildReports
installPlanBuildReports :: InstallPlan BuildResult -> [BuildReport]
installPlanBuildReports plan = catMaybes
. map (planPackageBuildReport os' arch' comp)
. InstallPlan.toList
$ plan
where os' = InstallPlan.planOS plan
arch' = InstallPlan.planArch plan
comp = InstallPlan.planCompiler plan
planPackageBuildReport :: OS -> Arch -> CompilerId
-> PlanPackage BuildResult -> Maybe BuildReport
planPackageBuildReport os' arch' comp planPackage = case planPackage of
PreExisting _ -> Nothing
Configured _ -> Nothing
Installed pkg -> Just $ buildReport os' arch' comp pkg BR.BuildOk
Failed pkg result -> Just $ buildReport os' arch' comp pkg result
......@@ -18,6 +18,9 @@ import Distribution.Package
import Distribution.PackageDescription
( GenericPackageDescription, FlagAssignment )
import Control.Exception
( Exception )
newtype Username = Username { unUsername :: String }
newtype Password = Password { unPassword :: String }
......@@ -94,3 +97,10 @@ data UnresolvedDependency
, depFlags :: FlagAssignment
}
deriving (Show)
data BuildResult = DependentFailed PackageIdentifier
| UnpackFailed Exception
| ConfigureFailed Exception
| BuildFailed Exception
| InstallFailed Exception
| BuildOk
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