hackager 1.2.0.1 → 1.3.0.0
raw patch · 9 files changed
+233/−166 lines, 9 filesdep +regex-tdfa
Dependencies added: regex-tdfa
Files
- LICENSE +25/−25
- README.md +53/−16
- hackager.cabal +3/−2
- src/Build.hs +3/−8
- src/BuildManager.hs +12/−0
- src/HackageMonad.hs +84/−71
- src/Record.hs +5/−4
- src/RecordOptions.hs +13/−6
- src/Report.hs +35/−34
LICENSE view
@@ -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.
README.md view
@@ -1,9 +1,10 @@ # Hackager [](https://hackage.haskell.org/package/hackager) [](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.+
hackager.cabal view
@@ -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
src/Build.hs view
@@ -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)
src/BuildManager.hs view
@@ -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.
src/HackageMonad.hs view
@@ -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
src/Record.hs view
@@ -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
src/RecordOptions.hs view
@@ -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 ++ "'"
src/Report.hs view
@@ -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