Print build plan with maintainers

Stackage/Config.hs

@@ -58,40 +58,28 @@ expectedFailures = fromList $ map PackageName
 -- | List of packages for our stable Hackage. All dependencies will be
 -- included as well. Please indicate who will be maintaining the package
 -- via comments.
-stablePackages :: Map PackageName VersionRange
+stablePackages :: Map PackageName (VersionRange, Maintainer)
 stablePackages = execWriter $ do
-    -- Michael Snoyman michael@snoyman.com
+    mapM_ (add "michael@snoyman.com") $ words
-    addRange "yesod" "< 1.4"
+        "yesod yesod-newsfeed yesod-sitemap yesod-static yesod-test markdown filesystem-conduit mime-mail-ses"
-    add "yesod-newsfeed"
-    add "yesod-sitemap"
-    add "yesod-static"
-    add "yesod-test"
-    add "markdown"
-    add "filesystem-conduit"
-    add "mime-mail-ses"
 
-    -- Neil Mitchell
+    mapM_ (add "Neil Mitchell") $ words
-    add "hoogle"
+        "hoogle hlint"
-    add "hlint"
 
-    -- Alan Zimmerman
+    mapM_ (add "Alan Zimmerman") $ words
-    add "hjsmin"
+        "hjsmin language-javascript"
-    add "language-javascript"
 
-    -- Jasper Van der Jeugt
+    mapM_ (add "Jasper Van der Jeugt") $ words
-    add "blaze-html"
+        "blaze-html blaze-markup stylish-haskell"
-    add "blaze-markup"
-    add "stylish-haskell"
 
-    -- Antoine Latter
+    mapM_ (add "Antoine Latter") $ words
-    add "uuid"
+        "uuid byteorder"
-    add "byteorder"
   where
-    add = flip addRange "-any"
+    add maintainer package = addRange maintainer package "-any"
-    addRange package range =
+    addRange maintainer package range =
         case simpleParse range of
             Nothing -> error $ "Invalid range " ++ show range ++ " for " ++ package
-            Just range' -> tell $ Map.singleton (PackageName package) range'
+            Just range' -> tell $ Map.singleton (PackageName package) (range', Maintainer maintainer)
 
 verbose :: Bool
 verbose =

Stackage/InstallInfo.hs

@@ -3,7 +3,6 @@ module Stackage.InstallInfo
     , iiPackageList
     ) where
 
-import Control.Monad (when)
 import qualified Data.Map                 as Map
 import qualified Data.Set                 as Set
 import           Stackage.Config
@@ -20,24 +19,26 @@ getInstallInfo = do
     let allPackages = Map.union stablePackages $ identsToRanges (hplibs hp)
     let totalCore = extraCore `Set.union` Set.map (\(PackageIdentifier p _) -> p) (hpcore hp)
     pdb <- loadPackageDB totalCore allPackages
-    final <- narrowPackageDB pdb $ Set.fromList $ Map.keys allPackages
+    final <- narrowPackageDB pdb $ Set.fromList $ Map.toList $ Map.map snd $ allPackages
 
-    when verbose $ do
+    putStrLn "Printing build plan to build-plan.log"
-        putStrLn "Basic dependency listing:"
+    writeFile "build-plan.log" $ unlines $ map showDep $ Map.toList final
-        mapM_ (putStrLn . showDep) $ Map.toList final
     return InstallInfo
         { iiCore = totalCore
-        , iiPackages = Map.map fst final
+        , iiPackages = Map.map (\(v, _, m) -> (v, m)) final
         , iiOptionalCore = Map.fromList $ map (\(PackageIdentifier p v) -> (p, v)) $ Set.toList $ hplibs hp
         , iiPackageDB = pdb
         }
 
-showDep :: (PackageName, (Version, [PackageName])) -> String
+showDep :: (PackageName, (Version, [PackageName], Maintainer)) -> String
-showDep (name, (version, deps)) =
+showDep (name, (version, deps, Maintainer m)) =
     concat
         [ unP name
         , "-"
         , showVersion version
+        , " ("
+        , m
+        , ")"
         , ": "
         , unwords $ map unP deps
         ]
@@ -45,4 +46,4 @@ showDep (name, (version, deps)) =
     unP (PackageName p) = p
 
 iiPackageList :: InstallInfo -> [String]
-iiPackageList = map packageVersionString . Map.toList . iiPackages
+iiPackageList = map packageVersionString . Map.toList . Map.map fst . iiPackages

Stackage/LoadDatabase.hs

@@ -35,7 +35,7 @@ import Distribution.Compiler (CompilerFlavor (GHC))
 --
 -- * For other packages, select the maximum version number.
 loadPackageDB :: Set PackageName -- ^ core packages
-              -> Map PackageName VersionRange -- ^ additional deps
+              -> Map PackageName (VersionRange, Maintainer) -- ^ additional deps
               -> IO PackageDB
 loadPackageDB core deps = do
     tarName <- getTarballName
@@ -54,7 +54,7 @@ loadPackageDB core deps = do
                 | p `member` core -> return pdb
                 | otherwise ->
                     case Map.lookup p deps of
-                        Just vrange
+                        Just (vrange, _maintainer)
                             | not $ withinRange v vrange -> return pdb
                         _ ->
                             case Tar.entryContent e of

Stackage/NarrowDatabase.hs

@@ -8,24 +8,24 @@ import           Stackage.Types
 -- | Narrow down the database to only the specified packages and all of
 -- their dependencies.
 narrowPackageDB :: PackageDB
-                -> Set PackageName
+                -> Set (PackageName, Maintainer)
-                -> IO (Map PackageName (Version, [PackageName]))
+                -> IO (Map PackageName (Version, [PackageName], Maintainer))
 narrowPackageDB (PackageDB pdb) =
-    loop Map.empty . Set.map ((,) [])
+    loop Map.empty . Set.map (\(name, maintainer) -> ([], name, maintainer))
   where
     loop result toProcess =
         case Set.minView toProcess of
             Nothing -> return result
-            Just ((users, p), toProcess') ->
+            Just ((users, p, maintainer), toProcess') ->
                 case Map.lookup p pdb of
                     Nothing
                         | null users -> error $ "Unknown package: " ++ show p
                         | otherwise -> loop result toProcess'
                     Just pi -> do
                         let users' = p:users
-                            result' = Map.insert p (piVersion pi, users) result
+                            result' = Map.insert p (piVersion pi, users, maintainer) result
-                        loop result' $ Set.foldl' (addDep users' result') toProcess' $ piDeps pi
+                        loop result' $ Set.foldl' (addDep users' result' maintainer) toProcess' $ piDeps pi
-    addDep users result toProcess p =
+    addDep users result maintainer toProcess p =
         case Map.lookup p result of
-            Nothing -> Set.insert (users, p) toProcess
+            Nothing -> Set.insert (users, p, maintainer) toProcess
             Just{} -> toProcess

Stackage/Tarballs.hs

@@ -36,7 +36,7 @@ makeTarballs ii = do
                 Nothing -> (stable, extra)
                 Just (package, version) ->
                     case Map.lookup package $ iiPackages ii of
-                        Just version'
+                        Just (version', _maintainer)
                             | version == version' -> (stable . (e:), extra)
                             | otherwise -> (stable, extra)
                         Nothing

Stackage/Test.hs

@@ -41,8 +41,8 @@ fixEnv :: FilePath -> (String, String) -> (String, String)
 fixEnv bin (p@"PATH", x) = (p, bin ++ pathSep : x)
 fixEnv _ x = x
 
-runTestSuite :: FilePath -> Bool -> (PackageName, Version) -> IO Bool
+runTestSuite :: FilePath -> Bool -> (PackageName, (Version, Maintainer)) -> IO Bool
-runTestSuite testdir prevPassed pair@(packageName, _) = do
+runTestSuite testdir prevPassed (packageName, (version, Maintainer maintainer)) = do
     -- Set up a new environment that includes the cabal-dev/bin folder in PATH.
     env' <- getEnvironment
     bin <- canonicalizePath "cabal-dev/bin"
@@ -77,11 +77,11 @@ runTestSuite testdir prevPassed pair@(packageName, _) = do
         then do
             removeFile logfile
             when expectedFailure $ putStrLn $ package ++ " passed, but I didn't think it would."
-        else unless expectedFailure $ putStrLn $ "Test suite failed: " ++ package
+        else unless expectedFailure $ putStrLn $ "Test suite failed: " ++ package ++ "(" ++ maintainer ++ ")"
     rm_r dir
     return $! prevPassed && (passed || expectedFailure)
   where
     logfile = testdir </> package <.> "log"
     dir = testdir </> package
     getHandle mode = withBinaryFile logfile mode
-    package = packageVersionString pair
+    package = packageVersionString (packageName, version)

Stackage/Types.hs

@@ -42,10 +42,14 @@ instance Monoid HaskellPlatform where
 
 data InstallInfo = InstallInfo
     { iiCore     :: Set PackageName
-    , iiPackages :: Map PackageName Version
+    , iiPackages :: Map PackageName (Version, Maintainer)
     , iiOptionalCore :: Map PackageName Version
       -- ^ This is intended to hold onto packages which might be automatically
       -- provided in the global package database. In practice, this would be
       -- Haskell Platform packages provided by distributions.
     , iiPackageDB :: PackageDB
     }
+
+-- | Email address of a Stackage maintainer.
+newtype Maintainer = Maintainer { unMaintainer :: String }
+    deriving (Show, Eq, Ord)

Stackage/Util.hs

@@ -15,11 +15,11 @@ import           System.Directory        (doesDirectoryExist,
 import           System.Directory        (getAppUserDataDirectory)
 import           System.FilePath         ((</>))
 
-identsToRanges :: Set PackageIdentifier -> Map PackageName VersionRange
+identsToRanges :: Set PackageIdentifier -> Map PackageName (VersionRange, Maintainer)
 identsToRanges =
     Map.unions . map go . Set.toList
   where
-    go (PackageIdentifier package version) = Map.singleton package $ thisVersion version
+    go (PackageIdentifier package version) = Map.singleton package (thisVersion version, Maintainer "Haskell Platform")
 
 packageVersionString :: (PackageName, Version) -> String
 packageVersionString (PackageName p, v) = concat [p, "-", showVersion v]