diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,31 +1,31 @@ -The Glasgow Haskell Compiler License +Copyright (c) 2015, David Terei. +Copyright (c) 2002, The University Court of the University of Glasgow. -Copyright 2002, The University Court of the University of Glasgow. All rights reserved. Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: +modification, are permitted provided that the following conditions +are met: -- Redistributions of source code must retain the above copyright notice, -this list of conditions and the following disclaimer. - -- Redistributions in binary form must reproduce the above copyright notice, -this list of conditions and the following disclaimer in the documentation -and/or other materials provided with the distribution. - -- Neither name of the University nor the names of its contributors may be -used to endorse or promote products derived from this software without -specific prior written permission. +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. -THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF -GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, -INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND -FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE -UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE -FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT -LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY -OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH -DAMAGE. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS +OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN +ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,9 +1,10 @@ # Hackager [![Hackage version](https://img.shields.io/hackage/v/hackager.svg?style=flat)](https://hackage.haskell.org/package/hackager) [![Build Status](https://img.shields.io/travis/dterei/hackager.svg?style=flat)](https://travis-ci.org/dterei/hackager) -Hackager is a tool to compile all of the Haskell Hackage package -repository. This is useful for testing Haskell compilers. +Hackager is a tool to compile all of the Haskell Hackage package repository. +This is useful for testing Haskell compilers. ## Using + Hackager consists of one tool that supports multiple commands. ''hackager'' is invoked with the following options: @@ -38,41 +39,76 @@ hackage is built ~~~~ -For example, here is a run with GHC, no special options and using 4 -threads (note that this generally takes a long time, i.e. a few days): +### Executing a run of Hackager +Here is a run with GHC, no special options and using 4 threads (note that this +generally takes a long time, i.e. a few days): + ~~~ {.sh} $ hackager record -o normal -n 4 ~~~~ -Then another run, this time using ''-XAlternativeLayoutRule'' to -compile each package (but not the build dependencies of the package): +This run has two parts. First, the 'stats' part, where Hackager checks which +packages of the ones requested it believes it can build. Packages that can't be +built are ones that we can't satisfy the dependencies for, usually due to the +package itself or one of its dependencies not being compatible with the version +of GHC in use. This produces files of the form `stats.*` in the output +directory and should only take a few minutes. +The second part consists of attempting to build every package (in isolation) +that Hackager reported it could attempt to build from the first part. This +takes hours to days (for all of Hackage), and stores results in files of the +form `build.*`. Log files for the build results of each package are also saved +under folders (with alphabetical grouping to make browsing easier). + +### Comparing Results of Two Runs + +After the first fun, execute a second run with the delta you wish. For example, +this time using ''-XAlternativeLayoutRule'' to compile each package (but not +the dependencies of the package): + ~~~~ {.sh} $ hackager record -o altern -f "--ghc-option=-XAlternativeLayoutRule" -n 4 ~~~~ -And finally a comparison of the results: +Once done, you can compare the results of the two runs: ~~~~ {.sh} $ hackager report normal altern normal - Buildable Build failed Deps failed Not tried -altern Buildable 628 0 0 0 - Build failed 73 215 0 0 - Deps failed 0 0 170 0 - Not tried 0 0 0 0 + Built, Failed, Deps Failed, Not Tried +altern Built 628 0 0 0 + Failed 73 215 0 0 + Deps Failed 0 0 170 0 + Not Tried 0 0 0 0 ~~~~ -These results mean that 73 packages became unbuildable when the -alternative layout rule is used. +These results mean that 73 packages became unbuildable when the alternative +layout rule is used. +## File Output + +When looking at the files created by a single run of Hackager, the important +one is `stats.summary`, which cotains the following fields: + +* ''Num packages'': Number of packges we are testing. +* ''Installable'': Packages we believe we can install. +* ''Uninstallable'': Packages we can't build (i.e., wrong GHC version) +* ''Errored '': Packages Cabal claims can be built but we don't + understand Cabal's output. +* ''Installations'': Total number of packages builds we will perform during + the run. + +Hackager also produces a reverse dependency list for each package and a +histogram of the reverse dependency count for pacakges, storing them in files +of the form `stats.*`. + ## Caution Hackager can cause arbitrary code to run on your machine. For example: - * TemplateHaskell is run at compile time and can execute arbitrary - code + + * TemplateHaskell is run at compile time and can execute arbitrary code * Package configure scripts will be run * Custom Setup.hs programs will be run @@ -91,3 +127,4 @@ ## Licensing This library is BSD-licensed. + diff --git a/hackager.cabal b/hackager.cabal --- a/hackager.cabal +++ b/hackager.cabal @@ -1,5 +1,5 @@ Name: hackager -Version: 1.2.0.1 +Version: 1.3.0.0 Synopsis: Hackage testing tool Description: Hackager is a program for compiling the entirety of Hackage as a way of @@ -40,5 +40,6 @@ directory, filepath, mtl, - process + process, + regex-tdfa diff --git a/src/Build.hs b/src/Build.hs --- a/src/Build.hs +++ b/src/Build.hs @@ -152,24 +152,19 @@ case reverse ls2 of thisP : otherPs | toU thisP == toU pkg -> do addInstallablePackage pkg - mapM_ addInstall otherPs + mapM_ addRevDepCounts otherPs _ -> die ("Installing " ++ show pkg ++ " doesn't end by installing it") - _ | any (noPackagesPrefix `isPrefixOf`) ls - -> addInstalledPackage pkg - - | otherwise - -> do warn $ "Don't understand result for " ++ show pkg - addFailPackage pkg + _ -> do warn $ "Don't understand result for " ++ show pkg + addErrorPackage pkg where toU = map toUpper notUpdated = any (isPrefixOf "Stderr: Run 'cabal update'") listHeaderPrefix = "In order, the following would be installed" - noPackagesPrefix = "No packages to be installed." mangleLine l = case simpleParse . takeWhile (/= ' ') $ l of Nothing -> die ("Unparseable line: " ++ show l) diff --git a/src/BuildManager.hs b/src/BuildManager.hs --- a/src/BuildManager.hs +++ b/src/BuildManager.hs @@ -2,6 +2,7 @@ module BuildManager ( setupBuildDir, getAllHackage, + filterPackages, tryBuildingPackages ) where @@ -10,6 +11,7 @@ import Control.Monad.State import System.Directory import System.FilePath +import Text.Regex.TDFA import Build import BuildTools @@ -44,6 +46,16 @@ let ls = map (takeWhile (' ' /=)) xs ps = uniq $ filter (not . null) ls in return ps + +-- | Filter list of packages according to user specified regular expression. +filterPackages :: [PkgName] -> Hkg [PkgName] +filterPackages pkgs = do + regex <- getRegex + if null regex + then return pkgs + else do + info $ "===> Using package name refex: " ++ regex + return $ filter (\p -> p =~ regex) pkgs -- | Loop over given packages and try to build each of them, recording the -- results. diff --git a/src/HackageMonad.hs b/src/HackageMonad.hs --- a/src/HackageMonad.hs +++ b/src/HackageMonad.hs @@ -2,22 +2,37 @@ -- | Monad for Hackage Test. Just a simple state passing monad with appropriate -- getter and setters. module HackageMonad ( + -- state holder types PkgName, Hkg, HkgState, startState, - getTempPackageConf, getScratchDir, rmScratchDir, rmAllScratch, - + -- configure build paths and tools setRunPath, getRunPath, getCabal, setCabal, getGhc, setGhc, getGhcPkg, setGhcPkg, getCabalFlags, setCabalFlags, getDepFlags, setDepFlags, - getPkgFlags, setPkgFlags, addPkg, getPkgs, + getRegex, setRegex, getPkgFlags, setPkgFlags, + -- setup and retrieve list of packages to test + addPkg, getPkgs, + + -- build scratch / isolated environment + getTempPackageConf, getScratchDir, rmScratchDir, rmAllScratch, + + -- control build parallelism setThreads, getThreads, - addInstall, addInstalledPackage, addInstallablePackage, - addNotInstallablePackage, addFailPackage, getInstallablePackages, + -- stats (what packages do we think we can and can't try to build?) + addInstallablePackage, addNotInstallablePackage, addErrorPackage, + addRevDepCounts, + + -- list of packages we've determined we can attempt to build + getInstallablePackages, + + -- build outcomes buildSucceeded, buildFailed, buildDepsFailed, + -- save results to disk dumpStats, dumpResults, + -- logging utils info, warn, die ) where @@ -55,13 +70,13 @@ st_depFlags :: [String], st_pkgFlags :: [String], st_threads :: Int, + st_regex :: String, st_pkgs :: Set PkgName, -- These are set by the stats-collection pass: - st_installedPackages :: MVar (Set PkgName), st_installablePackages :: MVar (Set PkgName), st_notInstallablePackages :: MVar (Set PkgName), - st_failPackages :: MVar (Set PkgName), + st_errorPackages :: MVar (Set PkgName), st_installCounts :: MVar (Map PkgName Int), -- These are set by the installation pass: @@ -75,7 +90,6 @@ startState :: IO HkgState startState = do - ipkgs <- newMVar Set.empty apkgs <- newMVar Set.empty npkgs <- newMVar Set.empty fpkgs <- newMVar Set.empty @@ -93,11 +107,11 @@ st_depFlags = [], st_pkgFlags = [], st_threads = 1, + st_regex = "", st_pkgs = Set.empty, - st_installedPackages = ipkgs, st_installablePackages = apkgs, st_notInstallablePackages = npkgs, - st_failPackages = fpkgs, + st_errorPackages = fpkgs, st_installCounts = count, st_buildablePackages = bbpkgs, st_buildFailurePackages = bfpkgs, @@ -133,73 +147,74 @@ dir <- getRunPath liftIO . ignoreException $ removeDirectoryRecursive (dir "scratch") +getCabal :: Hkg FilePath +getCabal = gets st_cabal + setCabal :: FilePath -> Hkg () setCabal ci = modify $ \st -> st { st_cabal = ci } -getCabal :: Hkg FilePath -getCabal = gets st_cabal +getGhc :: Hkg FilePath +getGhc = gets st_ghc setGhc :: FilePath -> Hkg () setGhc ghc = modify $ \st -> st { st_ghc = ghc } -getGhc :: Hkg FilePath -getGhc = gets st_ghc +getGhcPkg :: Hkg FilePath +getGhcPkg = gets st_ghcPkg setGhcPkg :: FilePath -> Hkg () setGhcPkg ghcPkg = modify $ \st -> st { st_ghcPkg = ghcPkg } -getGhcPkg :: Hkg FilePath -getGhcPkg = gets st_ghcPkg +getCabalFlags :: Hkg [String] +getCabalFlags = gets st_cabFlags setCabalFlags :: String -> Hkg () setCabalFlags cf = modify $ \st -> st { st_cabFlags = parseFlags cf } -getCabalFlags :: Hkg [String] -getCabalFlags = gets st_cabFlags +getDepFlags :: Hkg [String] +getDepFlags = gets st_depFlags setDepFlags :: String -> Hkg () setDepFlags depFlags = modify $ \st -> st { st_depFlags = parseFlags depFlags } -getDepFlags :: Hkg [String] -getDepFlags = gets st_depFlags +getPkgFlags :: Hkg [String] +getPkgFlags = gets st_pkgFlags setPkgFlags :: String -> Hkg () setPkgFlags pkgFlags = modify $ \st -> st { st_pkgFlags = parseFlags pkgFlags } -getPkgFlags :: Hkg [String] -getPkgFlags = gets st_pkgFlags +getPkgs :: Hkg [String] +getPkgs = gets $ Set.toList . st_pkgs addPkg :: String -> Hkg () addPkg p = modify $ \st -> st { st_pkgs = Set.insert p (st_pkgs st) } -getPkgs :: Hkg [String] -getPkgs = gets $ Set.toList . st_pkgs +getThreads :: Hkg Int +getThreads = gets st_threads setThreads :: Int -> Hkg () setThreads n = modify $ \st -> st { st_threads = n } -getThreads :: Hkg Int -getThreads = gets st_threads +getRegex :: Hkg String +getRegex = gets st_regex +setRegex :: String -> Hkg () +setRegex s = modify $ \st -> st { st_regex = s } + + parseFlags :: String -> [String] parseFlags str = case reads str of [(flags, "")] -> flags _ -> words str -addInstall :: PkgName -> Hkg () -addInstall pn = do +addRevDepCounts :: PkgName -> Hkg () +addRevDepCounts pn = do st <- get ics <- takeMVar $ st_installCounts st let ics' = Map.insertWith (+) pn 1 ics putMVar (st_installCounts st) ics' -addInstalledPackage :: PkgName -> Hkg () -addInstalledPackage pkg = do - st <- get - s <- takeMVar $ st_installedPackages st - putMVar (st_installedPackages st) $ Set.insert pkg s - addInstallablePackage :: PkgName -> Hkg () addInstallablePackage pkg = do st <- get @@ -218,11 +233,11 @@ s <- takeMVar $ st_notInstallablePackages st putMVar (st_notInstallablePackages st) $ Set.insert pkg s -addFailPackage :: PkgName -> Hkg () -addFailPackage pkg = do +addErrorPackage :: PkgName -> Hkg () +addErrorPackage pkg = do st <- get - s <- takeMVar $ st_failPackages st - putMVar (st_failPackages st) $ Set.insert pkg s + s <- takeMVar $ st_errorPackages st + putMVar (st_errorPackages st) $ Set.insert pkg s buildSucceeded :: PkgName -> Hkg () buildSucceeded pkg = do @@ -245,43 +260,34 @@ dumpStats :: Int -> Hkg () dumpStats n = do st <- get - ipkgs <- readMVar $ st_installedPackages st apkgs <- readMVar $ st_installablePackages st npkgs <- readMVar $ st_notInstallablePackages st - fpkgs <- readMVar $ st_failPackages st + fpkgs <- readMVar $ st_errorPackages st count <- readMVar $ st_installCounts st let fullHistogram = sortBy (flip compare) (map swap $ Map.assocs count) - (manyHistogram, fewHistogram) = span ((>= 10) . fst) fullHistogram - total = sum $ map fst fullHistogram - summaryTable = [ ["Num packages" , show n] - , ["Installed packages" , show $ Set.size ipkgs] - , ["Installable packages" , show $ Set.size apkgs] - , ["Uninstallable packages" , show $ Set.size npkgs] - , ["Failed packages" , show $ Set.size fpkgs] - , ["Total reinstallations" , show total] + total = Set.size apkgs + sum (map fst fullHistogram) + summaryTable = [ ["Num packages" , show n] + , ["Installable" , show $ Set.size apkgs] + , ["Uninstallable", show $ Set.size npkgs] + , ["Errored" , show $ Set.size fpkgs] + , ["Installations", show total] ] - name <- getRunPath + rpath <- getRunPath liftIO $ do - writeFile (name "stats.full") - (unlines $ showCompleteHistogram fullHistogram) - writeFile (name "stats.many") - (unlines $ showCompleteHistogram manyHistogram) - writeFile (name "stats.few") - (unlines $ showSummaryHistogram fewHistogram) - writeFile (name "stats.summary") + writeFile (rpath "stats.summary") (unlines $ showTable [rpad, rpad] summaryTable) - writeFile (name "installed-packages") - (unlines $ Set.toList ipkgs) - writeFile (name "installable-packages") + writeFile (rpath "stats.dependency-count") + (unlines $ showCompleteHistogram fullHistogram) + writeFile (rpath "stats.dependency-histogram") + (unlines $ showSummaryHistogram fullHistogram) + writeFile (rpath "packages.installable") (unlines $ Set.toList apkgs) - writeFile (name "uninstallable-packages") + writeFile (rpath "packages.uninstallable") (unlines $ Set.toList npkgs) - writeFile (name "fail-packages") + writeFile (rpath "packages.error") (unlines $ Set.toList fpkgs) - writeFile (name "install-counts") - (unlines $ map show $ Map.assocs count) where showCompleteHistogram hist = showTable [rpad, rpad] @@ -293,8 +299,8 @@ show $ length histogramRow] | histogramRow <- hist' ] in showTable [rpad, rpad] - (["Number of reinstallations", - "Number of packages"] : + (["Reverse Dependencies", + "Number of Packages"] : hist'') dumpResults :: Hkg () @@ -304,13 +310,20 @@ fpkgs <- readMVar $ st_buildFailurePackages st dpkgs <- readMVar $ st_buildDepFailurePackages st rpath <- getRunPath + + let total = Set.size bpkgs + Set.size fpkgs + Set.size dpkgs + summaryTable = [ ["Attempted" , show total] + , ["Succeeded" , show $ Set.size bpkgs] + , ["Failed" , show $ Set.size fpkgs] + , ["Deps Failed", show $ Set.size dpkgs] + ] - liftIO $ writeFile (rpath "buildable") - (unlines $ Set.toList bpkgs) - liftIO $ writeFile (rpath "buildFailed") - (unlines $ Set.toList fpkgs) - liftIO $ writeFile (rpath "buildDepsFailed") - (unlines $ Set.toList dpkgs) + liftIO $ do + writeFile (rpath "build.summary") + (unlines $ showTable [rpad, rpad] summaryTable) + writeFile (rpath "build.success") (unlines $ Set.toList bpkgs) + writeFile (rpath "build.fail") (unlines $ Set.toList fpkgs) + writeFile (rpath "build.depfail") (unlines $ Set.toList dpkgs) takeMVar :: MVar a -> Hkg a takeMVar m = liftIO $ C.takeMVar m diff --git a/src/Record.hs b/src/Record.hs --- a/src/Record.hs +++ b/src/Record.hs @@ -27,10 +27,11 @@ ["--help"] -> liftIO $ recordHelp ExitSuccess _ -> do processArgs args - ps <- getPkgs setupBuildDir - ps' <- case ps of + ps1 <- getPkgs + ps2 <- case ps1 of [] -> getAllHackage - _ -> return ps - tryBuildingPackages ps' + _ -> return ps1 + ps3 <- filterPackages ps2 + tryBuildingPackages ps3 diff --git a/src/RecordOptions.hs b/src/RecordOptions.hs --- a/src/RecordOptions.hs +++ b/src/RecordOptions.hs @@ -21,7 +21,8 @@ ExitFailure _ -> hPutStrLn stderr mapM_ out [ "usage: hackager record -o NAME [-c CABAL] [-g GHC] [-p GHC-PKG] [-a CABAL-FLAGS]" - , " [-d DEP-FLAGS] [-f PKG-FLAGS] [-n THREADS] [PKGS...]" + , " [-d DEP-FLAGS] [-f PKG-FLAGS] [-n THREADS]" + , " [-r SEARCH] [PKGS...]" , "" , " NAME A name by which the results of this hackager run will" , " be referred, e.g. \"ghc-6.12.1\"" @@ -29,12 +30,14 @@ , " GHC The path to the ghc program to use" , " GHC-PKG The path to the ghc-pkg program to use" , " CABAL-FLAGS Flags to pass to cabal during building" - , " e.g. -a [\"--ghc-option=-XFoo\",\"--ghc-option=-XBar\"]" + , " e.g. -a \"[\\\"--ghc-option=-XFoo\\\",\\\"--ghc-option=-XBar\\\"]\"" , " DEP-FLAGS The flags to use when compiling dependencies of a package" - , " e.g. -d [\"--ghc-option=-XFoo\",\"--ghc-option=-XBar\"]" + , " e.g. -d \"[\\\"--ghc-option=-XFoo\\\",\\\"--ghc-option=-XBar\\\"]\"" , " PKG-FLAGS The flags to use when compiling a package" , " e.g. -f [\"--ghc-option=-XFoo\",\"--ghc-option=-XBar\"]" , " THREADS Number of threads to use to build in parallel" + , " SEARCH A regular expression to use for selecting packages," + , " when used, don't specify a package list" , " PKGS A list of packages to build. If not specified all of" , " hackage is built" ] @@ -68,7 +71,7 @@ setGhc ghc processOpt "a" cflags = do - checkNotSet getCabalFlags "cabal flags already set" + checkNotSet getCabalFlags "cabal flag already set" setCabalFlags cflags processOpt "p" ghcpkg = do @@ -78,11 +81,11 @@ setGhcPkg ghcpkg processOpt "d" depflags = do - checkNotSet getDepFlags "dependency flags already set" + checkNotSet getDepFlags "dependency flag already set" setDepFlags depflags processOpt "f" pkgflags = do - checkNotSet getPkgFlags "package flags already set" + checkNotSet getPkgFlags "package flag already set" setPkgFlags pkgflags processOpt "n" threads = do @@ -90,6 +93,10 @@ case n of Just n' -> setThreads n' Nothing -> badflag "invalid thread number" + +processOpt "r" regex = do + checkNotSet getRegex "regex flag already set" + setRegex regex processOpt o _ = badflag $ "Unknown option '-" ++ o ++ "'" diff --git a/src/Report.hs b/src/Report.hs --- a/src/Report.hs +++ b/src/Report.hs @@ -45,19 +45,19 @@ -- check valid input and outputs n1exists <- doesDirectoryExist name1 - unless n1exists $ die ("'" ++ name1 ++ "' doesn't exists") + unless n1exists $ die $ "'" ++ name1 ++ "' doesn't exists" n2exists <- doesDirectoryExist name2 - unless n2exists $ die ("'" ++ name2 ++ "' doesn't exists") + unless n2exists $ die $ "'" ++ name2 ++ "' doesn't exists" exists <- doesDirectoryExist compName - when exists $ die ("The directoy '" ++ compName ++ - "' already exists, won't overwrite") + when exists $ die $ "The directoy '" ++ compName ++ + "' already exists, won't overwrite" - ba1 <- readPkgList (name1 "buildable") - ba2 <- readPkgList (name2 "buildable") - bF1 <- readPkgList (name1 "buildFailed") - bF2 <- readPkgList (name2 "buildFailed") - dF1 <- readPkgList (name1 "buildDepsFailed") - dF2 <- readPkgList (name2 "buildDepsFailed") + ba1 <- readPkgList $ name1 "build.success" + ba2 <- readPkgList $ name2 "build.success" + bF1 <- readPkgList $ name1 "build.fail" + bF2 <- readPkgList $ name2 "build.fail" + dF1 <- readPkgList $ name1 "build.depfail" + dF2 <- readPkgList $ name2 "build.depfail" let all1 = ba1 `Set.union` bF1 `Set.union` dF1 all2 = ba2 `Set.union` bF2 `Set.union` dF2 @@ -83,34 +83,35 @@ nt1_nt2 = nt1 `Set.intersection` nt2 num s = show (Set.size s) - padders = [rpad, rpad, lpad, lpad, lpad, lpad] - table = [["", "", name1, "", "", ""], - ["", "", "Buildable", "Build failed", "Deps failed", "Not tried"], - [name2, "Buildable", num ba1_ba2, num bF1_ba2, num dF1_ba2, num nt1_ba2], - ["", "Build failed", num ba1_bF2, num bF1_bF2, num dF1_bF2, num nt1_bF2], - ["", "Deps failed", num ba1_dF2, num bF1_dF2, num dF1_dF2, num nt1_dF2], - ["", "Not tried", num ba1_nt2, num bF1_nt2, num dF1_nt2, num nt1_nt2]] + num' s = num s ++ " " + padders = [rpad, rpad, lpad, lpad, lpad, lpad] + table = [["", "", name1, "", "", ""], + ["", "", "Built,", "Failed,", "Deps Failed,", "Not Tried"], + [name2, "Built", num' ba1_ba2, num' bF1_ba2, num' dF1_ba2, num nt1_ba2], + ["", "Failed", num' ba1_bF2, num' bF1_bF2, num' dF1_bF2, num nt1_bF2], + ["", "Deps Failed", num' ba1_dF2, num' bF1_dF2, num' dF1_dF2, num nt1_dF2], + ["", "Not Tried", num' ba1_nt2, num' bF1_nt2, num' dF1_nt2, num nt1_nt2]] createDirectory compName mapM_ (writeResultFile compName) - [ ("buildable-buildable" , ba1_ba2) - , ("buildable-buildFailed" , ba1_bF2) - , ("buildable-depsFailed" , ba1_dF2) - , ("buildable-notTried" , ba1_nt2) - , ("buildFailed-buildable" , bF1_ba2) - , ("buildFailed-buildFailed" , bF1_bF2) - , ("buildFailed-depsFailed" , bF1_dF2) - , ("buildFailed-notTried" , bF1_nt2) - , ("depsFailed-buildable" , dF1_ba2) - , ("depsFailed-buildFailed" , dF1_bF2) - , ("depsFailed-depsFailed" , dF1_dF2) - , ("depsFailed-notTried" , dF1_nt2) - , ("notTried-buildable" , nt1_ba2) - , ("notTried-buildFailed" , nt1_bF2) - , ("notTried-depsFailed" , nt1_dF2) - , ("notTried-notTried" , nt1_nt2) + [ ("built-built" , ba1_ba2) + , ("built-failed" , ba1_bF2) + , ("built-depfail" , ba1_dF2) + , ("built-nottried" , ba1_nt2) + , ("fail-built" , bF1_ba2) + , ("fail-failed" , bF1_bF2) + , ("fail-depfail" , bF1_dF2) + , ("fail-nottried" , bF1_nt2) + , ("depfail-built" , dF1_ba2) + , ("depfail-fail" , dF1_bF2) + , ("depfail-depfail" , dF1_dF2) + , ("depfail-nottried" , dF1_nt2) + , ("nottried-built" , nt1_ba2) + , ("nottried-fail" , nt1_bF2) + , ("nottried-depfail" , nt1_dF2) + , ("nottried-nottried", nt1_nt2) ] - writeFile (compName "summary") (unlines $ showTable padders table) + writeFile (compName "results") (unlines $ showTable padders table) mapM_ putStrLn $ showTable padders table -- | Write results to a file