Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/6e0bcd098e0504202655c63c7316d17e0ac76136 >--------------------------------------------------------------- commit 6e0bcd098e0504202655c63c7316d17e0ac76136 Author: Duncan Coutts <[email protected]> Date: Tue Jun 10 01:40:11 2008 +0000 Put build-reports into per-server dirs Don't bother putting the server url into each report since we do not want to upload that information anyway. >--------------------------------------------------------------- cabal-install/Hackage/Config.hs | 6 +--- cabal-install/Hackage/Reporting.hs | 60 +++++++++++++++++------------------ 2 files changed, 30 insertions(+), 36 deletions(-) diff --git a/cabal-install/Hackage/Config.hs b/cabal-install/Hackage/Config.hs index 77ccbd5..93e47c7 100644 --- a/cabal-install/Hackage/Config.hs +++ b/cabal-install/Hackage/Config.hs @@ -16,7 +16,7 @@ module Hackage.Config , configRepos , configPackageDB , defaultConfigFile - , defaultBuildReportFile + , defaultCacheDir , loadConfig , showConfig ) where @@ -109,10 +109,6 @@ 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" diff --git a/cabal-install/Hackage/Reporting.hs b/cabal-install/Hackage/Reporting.hs index bc0e37d..b087c0f 100644 --- a/cabal-install/Hackage/Reporting.hs +++ b/cabal-install/Hackage/Reporting.hs @@ -1,4 +1,3 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- | -- Module : Hackage.Reporting @@ -34,14 +33,13 @@ module Hackage.Reporting ( import Hackage.Types ( ConfiguredPackage(..), AvailablePackage(..) - , AvailablePackageSource(..), repoURI, BuildResult ) + , AvailablePackageSource(..), BuildResult + , Repo(repoCacheDir), repoName ) import qualified Hackage.Types as BR ( BuildResult(..) ) import qualified Hackage.InstallPlan as InstallPlan import Hackage.InstallPlan ( InstallPlan, PlanPackage ) -import Hackage.Config - ( defaultBuildReportFile ) import Hackage.ParseUtils ( showFields, parseBasicStanza ) @@ -63,25 +61,23 @@ import qualified Distribution.Compat.ReadP as Parse ( ReadP, pfail, munch1, char, option, skipSpaces ) import Text.PrettyPrint.HughesPJ as Disp ( Doc, char, text, (<+>), (<>) ) +import Distribution.Simple.Utils + ( comparing, equating ) import Data.List - ( unfoldr ) + ( unfoldr, groupBy, sortBy ) import Data.Maybe ( catMaybes ) import Data.Char as Char ( isAlpha, isAlphaNum ) -import Network.URI - ( URI, uriToString, parseAbsoluteURI ) +import System.FilePath + ( (</>) ) data BuildReport = BuildReport { -- | The package this build report is about package :: PackageIdentifier, - -- | Which hackage server this package is from and thus which server this - -- report should be sent to. - server :: URI, - -- | The OS and Arch the package was built on os :: OS, arch :: Arch, @@ -123,19 +119,30 @@ data InstallOutcome data Outcome = NotTried | Failed | Ok -writeBuildReports :: [BuildReport] -> IO () -writeBuildReports reports = do - file <- defaultBuildReportFile - appendFile file (concatMap (("\n\n"++) . showBuildReport) reports) +writeBuildReports :: [(BuildReport, Repo)] -> IO () +writeBuildReports reports = sequence_ + [ appendFile file (concatMap format reports') + | (repo, reports') <- separate reports + , let file = repoCacheDir repo </> "build-reports.log" ] + --TODO: make this concurrency safe, either lock the report file or make sure + -- the writes for each report are atomic (under 4k and flush at boundaries) + + where + format r = '\n' : showBuildReport r ++ "\n" + separate :: [(BuildReport, Repo)] -> [(Repo, [BuildReport])] + separate = map (\rs@((_,repo):_) -> (repo, map fst rs)) + . map concat + . groupBy (equating (repoName . snd . head)) + . sortBy (comparing (repoName . snd . head)) + . groupBy (equating (repoName . snd)) buildReport :: OS -> Arch -> CompilerId -- -> Version - -> URI -> ConfiguredPackage -> BR.BuildResult + -> ConfiguredPackage -> BR.BuildResult -> BuildReport -buildReport os' arch' comp uri (ConfiguredPackage pkg flags deps) result = +buildReport os' arch' comp (ConfiguredPackage pkg flags deps) result = BuildReport { package = packageId pkg, os = os', - server = uri, arch = arch', compiler = comp, flagAssignment = flags, @@ -159,7 +166,6 @@ buildReport os' arch' comp uri (ConfiguredPackage pkg flags deps) result = initialBuildReport :: BuildReport initialBuildReport = BuildReport { package = requiredField "package", - server = requiredField "server", os = requiredField "os", arch = requiredField "arch", compiler = requiredField "compiler", @@ -204,8 +210,6 @@ fieldDescrs :: [FieldDescr BuildReport] fieldDescrs = [ simpleField "package" disp parse package (\v r -> r { package = v }) - , simpleField "server" disp parse - server (\v r -> r { server = v }) , simpleField "os" disp parse os (\v r -> r { os = v }) , simpleField "arch" disp parse @@ -271,12 +275,6 @@ instance Text Outcome where "Ok" -> return Ok _ -> Parse.pfail -instance Text URI where - disp uri = Disp.text (uriToString id uri []) - parse = do - str <- Parse.munch1 (\c -> isAlphaNum c || c `elem` "+-=._/*()@'$:;&!?") - maybe Parse.pfail return (parseAbsoluteURI str) - -- ------------------------------------------------------------ -- * InstallPlan support -- ------------------------------------------------------------ @@ -284,7 +282,7 @@ instance Text URI where writeInstallPlanBuildReports :: InstallPlan BuildResult -> IO () writeInstallPlanBuildReports = writeBuildReports . installPlanBuildReports -installPlanBuildReports :: InstallPlan BuildResult -> [BuildReport] +installPlanBuildReports :: InstallPlan BuildResult -> [(BuildReport, Repo)] installPlanBuildReports plan = catMaybes . map (planPackageBuildReport os' arch' comp) . InstallPlan.toList @@ -295,15 +293,15 @@ installPlanBuildReports plan = catMaybes planPackageBuildReport :: OS -> Arch -> CompilerId -> InstallPlan.PlanPackage BuildResult - -> Maybe BuildReport + -> Maybe (BuildReport, Repo) planPackageBuildReport os' arch' comp planPackage = case planPackage of InstallPlan.Installed pkg@(ConfiguredPackage (AvailablePackage { packageSource = RepoTarballPackage repo }) _ _) - -> Just $ buildReport os' arch' comp (repoURI repo) pkg BR.BuildOk + -> Just $ (buildReport os' arch' comp pkg BR.BuildOk, repo) InstallPlan.Failed pkg@(ConfiguredPackage (AvailablePackage { packageSource = RepoTarballPackage repo }) _ _) result - -> Just $ buildReport os' arch' comp (repoURI repo) pkg result + -> Just $ (buildReport os' arch' comp pkg result, repo) _ -> Nothing _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
