diff --git a/TODO.md b/TODO.md
--- a/TODO.md
+++ b/TODO.md
@@ -2,4 +2,5 @@
 
 * Improve error handling when cabal fails (especially 'cabal list')
 * Move to another method than 'cabal list' to get package list
+* Ability to kill when running...
 
diff --git a/hackager.cabal b/hackager.cabal
--- a/hackager.cabal
+++ b/hackager.cabal
@@ -1,5 +1,5 @@
 Name:               hackager
-Version:            1.0.0
+Version:            1.0.1
 Synopsis:           Hackage testing tool
 Description:
     Hackager is a program for compiling the entirety of Hackage as a way of
@@ -23,6 +23,14 @@
 
 Executable hackager
     Main-Is: Hackager.hs
+    Other-Modules: Build
+                   BuildManager
+                   BuildTools
+                   HackageMonad
+                   Record
+                   RecordOptions
+                   Report
+                   Utils
     HS-Source-Dirs: src
     Ghc-Options: -threaded
     Build-Depends: base        >= 2 && < 5,
diff --git a/src/Build.hs b/src/Build.hs
new file mode 100644
--- /dev/null
+++ b/src/Build.hs
@@ -0,0 +1,169 @@
+-- | Operations on a single package.
+module Build (
+        PkgProcessor,
+        buildPkg,
+        statPkg
+    ) where
+
+import Control.Monad.State
+import Data.List
+import Distribution.Package
+import Distribution.Text
+import System.Directory
+import System.FilePath
+
+import BuildTools
+import HackageMonad
+import Utils
+
+-- | Type of a function that processes packages (and can be parallelized)
+type PkgProcessor = Int -> Int -> PkgName -> Hkg ()
+
+-- | Build a single package.
+buildPkg :: PkgProcessor
+buildPkg npkgs i p = do
+    info $ "===> Building package " ++ p ++ " (" ++ show i ++ " of "
+            ++ show npkgs ++ ")"
+
+    tmpPackageConf <- getTempPackageConf p
+    initialisePackageConf tmpPackageConf
+
+    scratchDir <- getScratchDir p
+    liftIO . ignoreException $ removeDirectoryRecursive scratchDir
+
+    name         <- getName
+    depFlags     <- getDepFlags
+    pkgFlags     <- getPkgFlags
+    basicFlags   <- getBasicCabalFlags
+
+    let cabalLog = name </> "logs.build" </> p <.> "cabal.log"
+        deplog   = name </> "logs.build" </> p <.> "depends.log"
+        comFlags = basicFlags ++
+                    [ "--prefix=" ++ scratchDir
+                      -- This is the package database that we
+                      -- want cabal to register into:
+                    , "--package-db=" ++ tmpPackageConf
+                      -- But cabal can't be trusted to put its
+                      -- --package-conf flag after ours, so we need
+                      -- to repeat the package.conf we want to
+                      -- register into again:
+                    , "--ghc-pkg-option=--package-conf=" ++ tmpPackageConf
+                      -- Only we want to display info to the user
+                    ]
+        depArgs = [ "install", p
+                  , "--only-dependencies"
+                  , "--build-log=" ++ deplog
+                  ] ++ comFlags ++ depFlags
+
+    -- try installing package dependencies
+    xDeps <- runCabalResults False depArgs
+    case xDeps of
+        Right _ -> do
+            let summaryName = name </> "logs.build" </> p <.> "summary"
+                logName     = name </> "logs.build" </> p <.> "log"
+                pkgArgs     = [ "install", p
+                              , "--build-summary=" ++ summaryName
+                              , "--build-log=" ++ logName
+                              ]
+                              ++ comFlags ++ pkgFlags
+
+            -- try installing package
+            xPkg <- runCabalResults False pkgArgs
+            case xPkg of
+                Right _       -> buildSucceeded p
+                Left (_, out) -> toFile cabalLog out >>
+                                 buildFailed p
+
+        Left (_, out) -> toFile cabalLog out >>
+                         buildDepsFailed p
+
+    -- clean up
+    rmScratchDir p
+
+  where
+    toFile f strs = liftIO $ appendFile f (concat strs)
+
+-- | Find out what would happen if we installed the package. Running
+-- cabal-install in dry-run mode may tell us:
+-- * The package is uninstallable
+-- * The package is already installed
+-- * The package is installable, and which other packages we would have to
+--   install in order to install it
+-- * Something we don't understand
+statPkg :: PkgProcessor
+statPkg npkgs i pkg = do
+    info $ "===> Getting stats for: " ++ pkg ++ " (" ++ show i ++ " of "
+            ++ show npkgs ++ ")"
+    name <- getName
+    basicFlags <- getBasicCabalFlags
+    fs   <- getPkgFlags
+    let summaryName = name </> "logs.stats" </> pkg <.> "summary"
+        logName     = name </> "logs.stats" </> pkg <.> "log"
+        resultName  = name </> "logs.stats" </> pkg <.> "result"
+        args        = basicFlags ++ fs ++
+                          [ "install", "--dry-run", pkg
+                          , "--build-summary=" ++ summaryName
+                          , "--build-log=" ++ logName
+                          ]
+
+    -- Ideally cabal would have written out some
+    -- sort of log, but it seems not to do so in dry-run
+    -- mode, so we do so ourselves
+    e <- runCabalResults True args
+    case e of
+        Left (ec, ls) -> do
+            let resultsLines = "FAILED"
+                             : ("Exit code: " ++ show ec)
+                             : ls
+            liftIO $ writeFile resultName $ unlines resultsLines
+            addNotInstallablePackage pkg
+            info $ "===> " ++ pkg ++ " is not installable, skipping!"
+            when (notUpdated resultsLines) $
+                die ("===> Errror: You need to run 'cabal update' first!")
+
+        Right ls -> do
+            let resultsLines = "SUCCEEDED" : ls
+            liftIO $ writeFile resultName $ unlines resultsLines
+            case break (listHeaderPrefix `isPrefixOf`) ls of
+                (_, _ : ls1) -> do
+                    ls2 <- mapM mangleLine ls1
+                    case reverse ls2 of
+                        thisP : otherPs | thisP == pkg -> do
+                            addInstallablePackage pkg
+                            mapM_ addInstall 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
+
+  where
+    notUpdated []       = False
+    notUpdated (x : xs) = if "Stderr: Run 'cabal update'" `isPrefixOf` x
+                            then True
+                            else notUpdated xs
+
+    listHeaderPrefix = "In order, the following would be installed"
+    noPackagesPrefix = "No packages to be installed."
+    mangleLine l = case simpleParse l of
+                       Nothing ->
+                           die ("Unparseable line: " ++ show l)
+                       Just (PackageIdentifier (PackageName pn) _) ->
+                           return pn
+
+-- | Get the default cabal flags to use.
+getBasicCabalFlags :: Hkg [String]
+getBasicCabalFlags = do
+    ghc <- getGhc
+    ghcPkg <- getGhcPkg
+    return [ "--remote-build-reporting=none"
+           , "--ghc"
+           , "--with-ghc=" ++ ghc
+           , "--with-ghc-pkg=" ++ ghcPkg
+           ]
+
diff --git a/src/BuildManager.hs b/src/BuildManager.hs
new file mode 100644
--- /dev/null
+++ b/src/BuildManager.hs
@@ -0,0 +1,71 @@
+-- | Handle building a set of packages (usually all of Hackage)
+module BuildManager (
+        getPackages,
+        tryBuildingPackages
+    ) where
+
+import Control.Concurrent
+import Control.Monad
+import Control.Monad.State
+
+import Build
+import BuildTools
+import HackageMonad
+import Utils
+
+-- | Get a list of all packages on hackage.
+getPackages :: Hkg [PkgName]
+getPackages = do
+    info "===> Grabbing a list of all packages on hackage..."
+    m <- runCabalResults False ["list", "--simple-output", "-v0"]
+    -- m: abc 0.0.1
+    --    abc 0.0.2
+    --    dff 0.1.2
+    --    ...
+    case m of
+        Left (_, out) -> die $ "Failed to get package list: " ++ concat out
+        Right xs ->
+            let ls = map (takeWhile (' ' /=)) $ xs
+                ps = uniq $ filter (not . null) ls
+            in return ps
+
+-- | Loop over given packages and try to build each of them, recording the
+-- results.
+tryBuildingPackages :: [PkgName] -> Hkg ()
+tryBuildingPackages ps = do
+    let n = length ps
+    info $ "===> Testing against " ++ show n ++ " packages..."
+    runOnAllPkgs ps statPkg
+    dumpStats n
+    psAll    <- getInstallablePackages
+    runOnAllPkgs psAll buildPkg
+    dumpResults
+    rmTempDir
+    info $ "===> Hackager finished! (" ++ show n ++ " packages tested)"
+
+-- | Run in parallel a PkgProcessor function over the given list
+-- of packages with the specified number of threads.
+runOnAllPkgs :: [PkgName] -> PkgProcessor -> Hkg ()
+runOnAllPkgs pkgs pkgFun = do
+    nthreads <- getThreads
+    mpkgs <- liftIO . newMVar $ zip [1..] pkgs
+    let runner = builder pkgFun (length pkgs) mpkgs
+    children <- replicateM nthreads $ forkChild runner
+    waitForChildren children
+    info ""
+    info ""
+
+-- | Function to go through a package list and build them. Thread safe so can
+-- be forked as child processes.
+builder :: PkgProcessor -> Int -> MVar [(Int, PkgName)] -> Hkg ()
+builder pkgFun n mpkgs = go
+  where
+    go = do
+        pkgs <- liftIO $ takeMVar mpkgs
+        case pkgs of
+            []            -> liftIO (putMVar mpkgs []) >> return ()
+            ((i, p) : ps) -> do
+                liftIO $ putMVar mpkgs ps
+                pkgFun n i p
+                go
+
diff --git a/src/BuildTools.hs b/src/BuildTools.hs
new file mode 100644
--- /dev/null
+++ b/src/BuildTools.hs
@@ -0,0 +1,152 @@
+-- | Various tools and utility functions to do wtih building.
+module BuildTools (
+        die, info, warn,
+        Child, forkChild, waitForChildren,
+        setupDir, initialisePackageConf,
+        runCabal, runCabalResults, runGhcPkg
+    ) where
+
+import Control.Concurrent
+import Control.Monad.State
+import Control.Exception
+import System.Directory
+import System.Exit
+import System.FilePath
+import System.IO
+import System.Process
+
+import HackageMonad
+import Utils
+
+-- | Print message to stdout.
+info :: String -> Hkg ()
+info msg = getIOLock >> liftIO (putStrLn msg) >> releaseIOLock
+
+-- | Print message to stderr.
+warn :: String -> Hkg ()
+warn msg = getIOLock >> liftIO (hPutStrLn stderr msg) >> releaseIOLock
+
+-- | Exit with error message.
+die :: String -> Hkg a
+die err = do
+    getIOLock
+    liftIO $ hPutStrLn stderr err
+    releaseIOLock
+    liftIO $ exitWith (ExitFailure 1)
+
+-- | Children process signal
+type Child = MVar ()
+
+-- | Fork a child and return an MVar that singals when the child is done.
+forkChild :: Hkg () -> Hkg Child
+forkChild hkg = do
+    mvar <- liftIO $ newEmptyMVar
+    st <- get
+    _ <- liftIO $ forkIO (evalStateT hkg st `finally` putMVar mvar ())
+    return mvar
+
+-- | Wait on a list of children to finish processing
+waitForChildren :: [Child] -> Hkg ()
+waitForChildren []                 = return ()
+waitForChildren (child : children) = do
+    liftIO $ takeMVar child
+    waitForChildren children
+
+-- | Setup the needed directory structure
+setupDir:: Hkg ()
+setupDir = do
+    name <- getName
+    exists <- liftIO $ doesDirectoryExist name
+    if exists
+        then die (show name ++ " already exists, not overwriting")
+        else liftIO $ do
+            createDirectory name
+            createDirectory (name </> "logs.stats")
+            createDirectory (name </> "logs.build")
+
+-- | Setup a package database
+initialisePackageConf :: FilePath -> Hkg ()
+initialisePackageConf fp = do
+    liftIO . ignoreException $ removeFile fp
+    liftIO . ignoreException $ removeDirectoryRecursive fp
+    x <- runGhcPkg ["init", fp]
+    case x of
+        ExitSuccess -> return ()
+        _ -> die ("Initialising package database in " ++ show fp ++ " failed")
+
+-- | Run cabal.
+runCabal :: [String] -> Hkg ExitCode
+runCabal args = do
+    cabal <- getCabal
+    x <- liftIO $ rawSystem cabal args
+    return x
+
+-- | Run cabal returning the resulting output or error code
+-- * Bool: Treat any stderr output as evidence that cabal failed
+-- * [String]: The cabal arguments
+runCabalResults :: Bool -> [String] -> Hkg (Either (ExitCode, [String]) [String])
+runCabalResults errFail args = do
+    cabal <- getCabal
+    r <- runCmdGetResults errFail cabal args
+    return r
+
+-- | Run ghc-pkg.
+runGhcPkg :: [String] -> Hkg ExitCode
+runGhcPkg args = do
+    ghcPkg <- getGhcPkg
+    x <- liftIO $ rawSystem ghcPkg args
+    return x
+
+data StdLine = Stdout String | Stderr String
+
+-- | Run a cmd returning the fullresults.
+-- * Bool: Treat any stderr output as evidence the cmd failed
+-- * FilePath: The program to run
+-- * [String]: The program arguments
+runCmdGetResults :: Bool -> FilePath -> [String]
+                 -> Hkg (Either (ExitCode, [String]) [String])
+runCmdGetResults errFail prog args = liftIO $ do
+    (hIn, hOut, hErr, ph) <- runInteractiveProcess prog args Nothing Nothing
+    hClose hIn
+    linesMVar <- newEmptyMVar
+    lineMVar <- newEmptyMVar
+    let getLines h c = do l <- hGetLine h
+                          putMVar lineMVar (Just (c l))
+                          getLines h c
+
+        writeLines :: Int -- how many of stdout and stderr are till open
+                   -> [StdLine] -> IO ()
+        writeLines 0 ls = putMVar linesMVar (reverse ls)
+        writeLines n ls = do mLine <- takeMVar lineMVar
+                             case mLine of
+                                 Just line -> writeLines n (line : ls)
+                                 Nothing   -> writeLines (n - 1) ls
+
+    _ <- forkIO $ (hSetBuffering hOut LineBuffering >>
+                   getLines hOut Stdout `onEndOfFile` return ())
+                   `finally`
+                   putMVar lineMVar Nothing
+
+    _ <- forkIO $ (hSetBuffering hErr LineBuffering >>
+                   getLines hErr Stderr `onEndOfFile` return ())
+                   `finally`
+                   putMVar lineMVar Nothing
+
+    _ <- forkIO $ writeLines 2 []
+
+    ec <- waitForProcess ph
+    ls <- takeMVar linesMVar
+    return $ case (ec, errFail && (any isStderr ls)) of
+                (ExitSuccess, False) -> Right $ map stripResultLine ls
+                _                    -> Left (ec, map mkResultLine ls)
+
+  where
+    isStderr (Stdout _) = False
+    isStderr (Stderr _) = True
+
+    stripResultLine (Stdout l) = l
+    stripResultLine (Stderr l) = l
+
+    mkResultLine (Stdout l) = "Stdout: " ++ l
+    mkResultLine (Stderr l) = "Stderr: " ++ l
+
diff --git a/src/HackageMonad.hs b/src/HackageMonad.hs
new file mode 100644
--- /dev/null
+++ b/src/HackageMonad.hs
@@ -0,0 +1,327 @@
+-- | Monad for Hackage Test. Just a simple state passing monad with appropriate
+-- getter and setters.
+module HackageMonad (
+        PkgName, Hkg, HkgState, startState,
+
+        getTempPackageConf, getScratchDir, rmScratchDir, rmTempDir,
+
+        setName, getName,
+        getCabal, setCabal, getGhc, setGhc, getGhcPkg, setGhcPkg,
+        getDepFlags, setDepFlags, getPkgFlags, setPkgFlags, addPkg, getPkgs,
+        setThreads, getThreads,
+
+        addInstall, addInstalledPackage, addInstallablePackage,
+        addNotInstallablePackage, addFailPackage, getInstallablePackages,
+        buildSucceeded, buildFailed, buildDepsFailed,
+
+        getIOLock, releaseIOLock,
+
+        dumpStats, dumpResults
+    ) where
+
+import Control.Concurrent (MVar, newMVar)
+import qualified Control.Concurrent as C
+import Control.Monad.State
+import Data.Function
+import Data.List
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Set (Set)
+import qualified Data.Set as Set
+import System.Directory
+import System.FilePath
+
+import Utils
+
+type PkgName = String
+
+type Hkg = StateT HkgState IO
+
+-- | The state of Hackager
+data HkgState = HkgState {
+        -- These are set based on the command line flags
+        st_name     :: FilePath,
+        st_dir      :: FilePath,
+        st_cabal    :: FilePath,
+        st_ghc      :: FilePath,
+        st_ghcPkg   :: FilePath,
+        st_depFlags :: [String],
+        st_pkgFlags :: [String],
+        st_threads  :: Int,
+        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_installCounts          :: MVar (Map PkgName Int),
+
+        -- These are set by the installation pass:
+        st_buildablePackages       :: MVar (Set PkgName),
+        st_buildFailurePackages    :: MVar (Set PkgName),
+        st_buildDepFailurePackages :: MVar (Set PkgName),
+
+        -- internal locks for making stdout thread safe
+        st_iolock :: MVar ()
+    }
+
+startState :: IO HkgState
+startState = do
+    ipkgs  <- newMVar Set.empty
+    apkgs  <- newMVar Set.empty
+    npkgs  <- newMVar Set.empty
+    fpkgs  <- newMVar Set.empty
+    count  <- newMVar Map.empty
+    bbpkgs <- newMVar Set.empty
+    bfpkgs <- newMVar Set.empty
+    bdpkgs <- newMVar Set.empty
+    iolock <- newMVar ()
+    return $ HkgState {
+        st_name                    = "",
+        st_dir                     = "",
+        st_cabal                   = "",
+        st_ghc                     = "",
+        st_ghcPkg                  = "",
+        st_depFlags                = [],
+        st_pkgFlags                = [],
+        st_threads                 = 1,
+        st_pkgs                    = Set.empty,
+        st_installedPackages       = ipkgs,
+        st_installablePackages     = apkgs,
+        st_notInstallablePackages  = npkgs,
+        st_failPackages            = fpkgs,
+        st_installCounts           = count,
+        st_buildablePackages       = bbpkgs,
+        st_buildFailurePackages    = bfpkgs,
+        st_buildDepFailurePackages = bdpkgs,
+        st_iolock                  = iolock
+    }
+
+------------------------------------------------
+-- Helpers
+
+setName :: FilePath -> Hkg ()
+setName name = do
+    dir <- liftIO getCurrentDirectory
+    modify $ \st -> st { st_name = name, st_dir = dir </> name }
+
+getName :: Hkg FilePath
+getName = get >>= \st -> return $ st_name st
+
+getDir :: Hkg FilePath
+getDir = get >>= \st -> return $ st_dir st
+
+getTempPackageConf :: PkgName -> Hkg FilePath
+getTempPackageConf p = getDir >>= \dir -> return
+    $ dir </> "scratch" </> p <.> "package.conf"
+
+getScratchDir :: PkgName -> Hkg FilePath
+getScratchDir p = getDir >>= \dir -> return $ dir </> "scratch" </> p
+
+rmScratchDir :: PkgName -> Hkg ()
+rmScratchDir p = do
+    dir <- getDir
+    liftIO . ignoreException $
+        removeDirectoryRecursive (dir </> "scratch" </> p)
+
+rmTempDir :: Hkg ()
+rmTempDir = do
+    dir <- getDir
+    liftIO . ignoreException $ removeDirectoryRecursive (dir </> "scratch")
+
+setCabal :: FilePath -> Hkg ()
+setCabal ci = modify $ \st -> st { st_cabal = ci }
+
+getCabal :: Hkg FilePath
+getCabal = get >>= \st -> return $ st_cabal st
+
+setGhc :: FilePath -> Hkg ()
+setGhc ghc = modify $ \st -> st { st_ghc = ghc }
+
+getGhc :: Hkg FilePath
+getGhc = get >>= \st -> return $ st_ghc st
+
+setGhcPkg :: FilePath -> Hkg ()
+setGhcPkg ghcPkg = modify $ \st -> st {st_ghcPkg = ghcPkg }
+
+getGhcPkg :: Hkg FilePath
+getGhcPkg = get >>= \st -> return $ st_ghcPkg st
+
+setDepFlags :: String -> Hkg ()
+setDepFlags depFlags = modify $ \st -> st { st_depFlags = parseFlags depFlags }
+
+getDepFlags :: Hkg [String]
+getDepFlags = get >>= \st -> return $ st_depFlags st
+
+setPkgFlags :: String -> Hkg ()
+setPkgFlags pkgFlags = modify $ \st -> st { st_pkgFlags = parseFlags pkgFlags }
+
+getPkgFlags :: Hkg [String]
+getPkgFlags = get >>= \st -> return $ st_pkgFlags st
+
+addPkg :: String -> Hkg ()
+addPkg p = modify $ \st -> st {st_pkgs = Set.insert p (st_pkgs st) }
+
+getPkgs :: Hkg [String]
+getPkgs = do
+    st <- get
+    return $ Set.toList (st_pkgs st)
+
+setThreads :: Int -> Hkg ()
+setThreads n = modify $ \st -> st { st_threads = n }
+
+getThreads :: Hkg Int
+getThreads = get >>= \st -> return $ st_threads st
+
+parseFlags :: String -> [String]
+parseFlags str =
+    case reads str of
+        [(flags, "")] -> flags
+        _             -> words str
+
+addInstall :: PkgName -> Hkg ()
+addInstall 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
+    s <- takeMVar $ st_installablePackages st
+    putMVar (st_installablePackages st) $ Set.insert pkg s
+
+getInstallablePackages :: Hkg [PkgName]
+getInstallablePackages = do
+    st <- get
+    s <- takeMVar $ st_installablePackages st
+    return $ Set.toList s
+
+addNotInstallablePackage :: PkgName -> Hkg ()
+addNotInstallablePackage pkg = do
+    st <- get
+    s <- takeMVar $ st_notInstallablePackages st
+    putMVar (st_notInstallablePackages st) $ Set.insert pkg s 
+
+addFailPackage :: PkgName -> Hkg ()
+addFailPackage pkg = do
+    st <- get
+    s <- takeMVar $ st_failPackages st
+    putMVar (st_failPackages st) $ Set.insert pkg s
+
+buildSucceeded :: PkgName -> Hkg ()
+buildSucceeded pkg = do
+    st <- get
+    s <- takeMVar $ st_buildablePackages st
+    putMVar (st_buildablePackages st) $ Set.insert pkg s
+
+buildFailed :: PkgName -> Hkg ()
+buildFailed pkg = do
+    st <- get
+    s <- takeMVar $ st_buildFailurePackages st
+    putMVar (st_buildFailurePackages st) $ Set.insert pkg s
+
+buildDepsFailed :: PkgName -> Hkg ()
+buildDepsFailed pkg = do
+    st <- get
+    s <- takeMVar $ st_buildDepFailurePackages st
+    putMVar (st_buildDepFailurePackages st) $ Set.insert pkg s
+
+getIOLock :: Hkg ()
+getIOLock = do
+    st <- get
+    _ <- takeMVar $ st_iolock st
+    return ()
+
+releaseIOLock :: Hkg ()
+releaseIOLock = do
+    st <- get
+    putMVar (st_iolock st) ()
+
+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
+    count <- readMVar $ st_installCounts st
+
+    let fullHistogram = reverse $ sort $ 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]
+                       ]
+
+    name <- getName
+    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")
+                  (unlines $ showTable [rpad, rpad] summaryTable)
+        writeFile (name </> "installed-packages")
+                  (unlines $ Set.toList ipkgs)
+        writeFile (name </> "installable-packages")
+                  (unlines $ Set.toList apkgs)
+        writeFile (name </> "uninstallable-packages")
+                  (unlines $ Set.toList npkgs)
+        writeFile (name </> "fail-packages")
+                  (unlines $ Set.toList fpkgs)
+        writeFile (name </> "install-counts")
+                  (unlines $ map show $ Map.assocs count)
+
+  where
+    showCompleteHistogram hist = showTable [rpad, rpad]
+                                           [ [show count, pkg]
+                                           | (count, pkg) <- hist ]
+    showSummaryHistogram hist =
+        let hist' = groupBy (on (==) fst) hist
+            hist'' = [ [show $ fst $ head histogramRow,
+                        show $ length histogramRow]
+                     | histogramRow <- hist' ]
+        in showTable [rpad, rpad]
+                     (["Number of reinstallations",
+                       "Number of packages"] :
+                      hist'')
+
+dumpResults :: Hkg ()
+dumpResults = do
+    st <- get
+    bpkgs <- readMVar $ st_buildablePackages st
+    fpkgs <- readMVar $ st_buildFailurePackages st
+    dpkgs <- readMVar $ st_buildDepFailurePackages st
+
+    liftIO $ writeFile (st_name st </> "buildable")
+                       (unlines $ Set.toList bpkgs)
+    liftIO $ writeFile (st_name st </> "buildFailed")
+                       (unlines $ Set.toList fpkgs)
+    liftIO $ writeFile (st_name st </> "buildDepsFailed")
+                       (unlines $ Set.toList dpkgs)
+
+takeMVar :: MVar a -> Hkg a
+takeMVar m = liftIO $ C.takeMVar m
+
+putMVar :: MVar a -> a -> Hkg ()
+putMVar m v = liftIO $ C.putMVar m v
+
+readMVar :: MVar a -> Hkg a
+readMVar m = liftIO $ C.readMVar m
+
diff --git a/src/Record.hs b/src/Record.hs
new file mode 100644
--- /dev/null
+++ b/src/Record.hs
@@ -0,0 +1,37 @@
+-- | Record tool. Build all of hackage.
+module Record (
+        record,
+        recordHelp
+    ) where
+
+import Control.Monad.State
+import System.Exit
+import System.IO
+
+import BuildManager
+import BuildTools
+import HackageMonad
+import RecordOptions
+
+-- | Run the recording tool.
+record :: [String] -> IO ()
+record args = do
+    st <- startState
+    evalStateT (recordST args) st
+
+-- | Hackage Test (Monad).
+recordST :: [String] -> Hkg ()
+recordST args = do
+    liftIO $ hSetBuffering stdout NoBuffering
+    case args of
+        [        ] -> liftIO $ recordHelp (ExitFailure 1)
+        ["--help"] -> liftIO $ recordHelp ExitSuccess
+        _ -> do
+            processArgs args
+            ps <- getPkgs
+            setupDir
+            ps' <- case ps of
+                    [] -> getPackages
+                    _  -> return ps
+            tryBuildingPackages ps'
+
diff --git a/src/RecordOptions.hs b/src/RecordOptions.hs
new file mode 100644
--- /dev/null
+++ b/src/RecordOptions.hs
@@ -0,0 +1,149 @@
+-- | Parse all the option flags for the record command.
+module RecordOptions (
+        recordHelp,
+        processArgs
+    ) where
+
+import Control.Monad.State
+import Data.Char (isDigit)
+import System.Directory
+import System.Exit
+import System.IO
+
+import BuildTools
+import HackageMonad
+
+-- | Print usage information and exit
+recordHelp :: ExitCode -> IO ()
+recordHelp exitCode = do
+    let out = case exitCode of
+                    ExitSuccess   -> putStrLn
+                    ExitFailure 1 -> putStrLn
+                    ExitFailure _ -> hPutStrLn stderr
+    mapM_ out
+        [ "usage: hackager record -o NAME [-c CABAL] [-g GHC] [-p GHC-PKG] [-d DEP-FLAGS]"
+        , "                       [-f PKG-FLAGS] [-n THREADS] [PKGS...]"
+        , ""
+        , "    NAME         A name by which the results of this hackager run will"
+        , "                 be referred, e.g. \"ghc-6.12.1\""
+        , "    CABAL        The path to the cabal program to use"
+        , "    GHC          The path to the ghc program to use"
+        , "    GHC-PKG      The path to the ghc-pkg program to use"
+        , "    DEP-FLAGS    The flags to use when compiling dependencies of a package"
+        , "                 e.g. \"--ghc-option=-XFoo\""
+        , "    PKG-FLAGS    The flags to use when compiling a package"
+        , "                 e.g. \"--ghc-option=-XBar\""
+        , "    THREADS      Number of threads to use to build in parallel"
+        , "    PKGS         A list of packages to build. If not specified all of"
+        , "                 hackage is built"
+        ]
+    exitWith exitCode
+
+-- | Parse all the option flags for the record command.
+processArgs :: [String] -> Hkg ()
+processArgs []               = validateFlags
+processArgs (('-':x):y:args) = processOpt x y >> processArgs args
+processArgs args             = parsePackages args >> validateFlags
+
+-- | Parse an individual option flag
+processOpt :: String -> String -> Hkg ()
+processOpt "o" name = do
+    checkNotSet getName "output directory is already set"
+    checkNotOption name "the output directory is invalid"
+    exists <- liftIO $ doesDirectoryExist name
+    when exists $ die "The specified output directory already exists"
+    setName name
+
+processOpt "c" cabal = do
+    checkNotSet getCabal "cabal program is already set"
+    checkNotOption cabal "cabal program is invalid"
+    checkExecutable cabal "cabal"
+    setCabal cabal
+
+processOpt "g" ghc = do
+    checkNotSet getGhc "ghc program is already set"
+    checkNotOption ghc "ghc program is invalid"
+    checkExecutable ghc "ghc"
+    setGhc ghc
+
+processOpt "p" ghcpkg = do
+    checkNotSet getGhcPkg "ghc-pkg program is already set"
+    checkNotOption ghcpkg "ghc-pkg is invalid"
+    checkExecutable ghcpkg "ghc-pkg"
+    setGhcPkg ghcpkg
+
+processOpt "d" depflags = do
+    checkNotSet getDepFlags "dependency flags already set"
+    setDepFlags depflags
+
+processOpt "f" pkgflags = do
+    checkNotSet getPkgFlags "package flags already set"
+    setPkgFlags pkgflags
+
+processOpt "n" threads = do
+    let n = toInt threads
+    case n of
+        Just n' -> setThreads n'
+        Nothing -> badflag "invalid thread number"
+
+processOpt o _ = badflag $ "Unknown option '-" ++ o ++ "'"
+
+-- | Parse the package list at the end
+parsePackages :: [String] -> Hkg ()
+parsePackages []     = return ()
+parsePackages (x:xs) = do
+    checkNotOption x $ "package '" ++ x ++ "' is not a valid package name"
+    addPkg x
+    parsePackages xs
+
+-- | Validate all the flags needed have been set and are valid
+validateFlags :: Hkg ()
+validateFlags = do
+    n <- getName
+    when (n == "") $ badflag "output directory not set"
+    setExecutable getCabal setCabal "cabal"
+    setExecutable getGhc setGhc "ghc"
+    setExecutable getGhcPkg setGhcPkg "ghc-pkg"
+
+-- | Set the executable to what's on the PATH if not set
+setExecutable :: Hkg FilePath -> (FilePath -> Hkg ()) -> String -> Hkg ()
+setExecutable getx setx name = do
+    x <- getx
+    when (x == "") $ do
+        ci <- liftIO $ findExecutable name
+        case ci of
+            Nothing  -> badflag $ "can't find " ++ name ++ " executable"
+            Just ci' -> setx ci'
+
+-- | Make sure a file exists and is executable
+checkExecutable :: String -> String -> Hkg ()
+checkExecutable f prog = do
+    b <- liftIO $ doesFileExist f
+    when (not b) $ badflag $ prog ++ " executable doesn't exist"
+    p <- liftIO $ getPermissions f
+    when (not $ executable p) $ badflag $ prog ++ " file is not executable"
+
+-- | Make sure a flag hasn't been set before
+checkNotSet :: Hkg [a] -> String -> Hkg ()
+checkNotSet getter errmsg = do
+    val <- getter
+    case val of
+        [] -> return ()
+        _  -> badflag errmsg
+
+-- | Check that a value isn't an option
+checkNotOption :: String -> String -> Hkg ()
+checkNotOption ('-':_) errmsg = badflag errmsg
+checkNotOption _ _            = return ()
+
+-- | Parse a string to an int
+toInt :: String -> Maybe Int
+toInt str | all isDigit str = Just $ read str
+          | otherwise       = Nothing
+
+-- | Throw an error message in the face of a bad flag
+badflag :: String -> Hkg ()
+badflag errmsg = liftIO $ do
+    hPutStrLn stderr errmsg
+    recordHelp (ExitFailure 129)
+
diff --git a/src/Report.hs b/src/Report.hs
new file mode 100644
--- /dev/null
+++ b/src/Report.hs
@@ -0,0 +1,129 @@
+-- | Reporting tool. Perform a comparision of two Hackage Test runs.
+module Report (
+        report,
+        reportHelp
+    ) where
+
+import Control.Monad
+import Data.Set (Set)
+import qualified Data.Set as Set
+import System.Directory
+import System.Exit
+import System.FilePath
+import System.IO
+
+import HackageMonad (PkgName)
+import Utils
+
+-- | Run the reporting tool.
+report :: [String] -> IO ()
+report args = do
+    case args of
+        [name1, name2] -> generate name1 name2
+        ["--help"    ] -> reportHelp ExitSuccess
+        [            ] -> reportHelp (ExitFailure 1)
+        _              -> reportHelp (ExitFailure 1)
+
+-- | Print usage information and exit
+reportHelp :: ExitCode -> IO ()
+reportHelp exitCode = do
+    mapM_ putStrLn
+        [ "usage: hackager report <name1> <name2>"
+        , ""
+        , "    name1    The name of the first result"
+        , "    name2    The name of the second result"
+        , ""
+        , "The two results are then compared with each other, the output"
+        , "is placed in the folder 'compare---<name1>---<name2>'"
+        ]
+    exitWith exitCode
+
+-- | Generate a Hackager comparison report
+generate :: String -> String -> IO ()
+generate name1 name2 = do
+    let compName = "compare---" ++ name1 ++ "---" ++ name2
+
+    -- check valid input and outputs
+    n1exists <- doesDirectoryExist name1
+    when (not n1exists) $ die ("'" ++ name1 ++ "' doesn't exists")
+    n2exists <- doesDirectoryExist name2
+    when (not n2exists) $ die ("'" ++ name2 ++ "' doesn't exists")
+    exists <- doesDirectoryExist compName
+    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")
+
+    let all1 = ba1 `Set.union` bF1 `Set.union` dF1
+        all2 = ba2 `Set.union` bF2 `Set.union` dF2
+        -- Work out what was not tried by one build or the other
+        nt1 = all2 `Set.difference` all1
+        nt2 = all1 `Set.difference` all2
+
+        ba1_ba2 = ba1 `Set.intersection` ba2
+        ba1_bF2 = ba1 `Set.intersection` bF2
+        ba1_dF2 = ba1 `Set.intersection` dF2
+        ba1_nt2 = ba1 `Set.intersection` nt2
+        bF1_ba2 = bF1 `Set.intersection` ba2
+        bF1_bF2 = bF1 `Set.intersection` bF2
+        bF1_dF2 = bF1 `Set.intersection` dF2
+        bF1_nt2 = bF1 `Set.intersection` nt2
+        dF1_ba2 = dF1 `Set.intersection` ba2
+        dF1_bF2 = dF1 `Set.intersection` bF2
+        dF1_dF2 = dF1 `Set.intersection` dF2
+        dF1_nt2 = dF1 `Set.intersection` nt2
+        nt1_ba2 = nt1 `Set.intersection` ba2
+        nt1_bF2 = nt1 `Set.intersection` bF2
+        nt1_dF2 = nt1 `Set.intersection` dF2
+        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]]
+
+    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)
+        ]
+    writeFile (compName </> "summary") (unlines $ showTable padders table)
+    mapM_ putStrLn $ showTable padders table
+
+-- | Write results to a file
+writeResultFile :: FilePath -> (FilePath, Set PkgName) -> IO ()
+writeResultFile dir (f, set) = writeFile (dir </> f) (unlines $ Set.toList set)
+
+-- | Read a list of packages from the file specified
+readPkgList :: FilePath -> IO (Set PkgName)
+readPkgList fp = do xs <- readFile fp
+                    return $ Set.fromList $ lines xs
+
+-- | Exit with an error
+die :: String -> IO a
+die err = do hPutStrLn stderr err
+             exitWith (ExitFailure 1)
+
diff --git a/src/Utils.hs b/src/Utils.hs
new file mode 100644
--- /dev/null
+++ b/src/Utils.hs
@@ -0,0 +1,49 @@
+-- | Utility functions.
+module Utils (
+        catchIO, ignoreException, onEndOfFile,
+        showTable, uniq, swap, lpad, rpad
+    ) where
+
+import Control.Exception
+import Data.List
+import Prelude hiding (catch)
+import System.IO.Error hiding (catch)
+
+-- | Handle an IO exception.
+catchIO :: IO a -> (IOException -> IO a) -> IO a
+catchIO = catch
+
+-- | Ignore any IO exception that arises.
+ignoreException :: IO () -> IO ()
+ignoreException io = io `catchIO` \_ -> return ()
+
+-- | Perform some IO and execute the second argument on an EOF exception.
+onEndOfFile :: IO a -> IO a -> IO a
+onEndOfFile io io' =
+    io `catch` \e -> if isEOFError e then io' else throwIO e
+
+-- | Filter out adjacent duplicate elements.
+uniq :: Eq a => [a] -> [a]
+uniq (x : y : xs)
+  | x == y    = uniq (x : xs)
+uniq (x : xs) = x : uniq xs
+uniq []       = []
+
+-- | Swap elements of a tuple.
+swap :: (a, b) -> (b, a)
+swap (x, y) = (y, x)
+
+-- | Show output in a tabular format.
+showTable :: [Int -> String -> String] -> [[String]] -> [String]
+showTable padders xss =
+    let lengths = map (maximum . map length) $ transpose xss
+    in map (concat . intersperse " " . zipWith3 id padders lengths) xss
+
+-- | Pad the string with spaces before it.
+lpad :: Int -> String -> String
+lpad n s = replicate (n - length s) ' ' ++ s
+
+-- | Pad the string with spaces after it.
+rpad :: Int -> String -> String
+rpad n s = s ++ replicate (n - length s) ' '
+