git.iko.soy/stackage
on master help sign in
Print build plan with maintainers
commitd7ccf7406df8e7fb79cb76fc0ceea10d3e9da856 authorMichael Snoyman <michael@snoyman.com> dateMon 26 Nov 2012, 16:02 (14 years ago) parent1ae9332
8 files changed+50−57
compare with master
unifiedsplit
Stackage/Config.hs+18−30 Stackage/InstallInfo.hs+10−9 Stackage/LoadDatabase.hs+2−2 Stackage/NarrowDatabase.hs+8−8 Stackage/Tarballs.hs+1−1 Stackage/Test.hs+4−4 Stackage/Types.hs+5−1 Stackage/Util.hs+2−2
Stackage/Config.hs+18−30
@@ -58,40 +58,28 @@ expectedFailures = fromList $ map PackageName
5858-- | List of packages for our stable Hackage. All dependencies will be
5959-- included as well. Please indicate who will be maintaining the package
6060-- via comments.
61−stablePackages :: Map PackageName VersionRange
61+stablePackages :: Map PackageName (VersionRange, Maintainer)
6262stablePackages = execWriter $ do
63− -- Michael Snoyman michael@snoyman.com
64− addRange "yesod" "< 1.4"
65− add "yesod-newsfeed"
66− add "yesod-sitemap"
67− add "yesod-static"
68− add "yesod-test"
69− add "markdown"
70− add "filesystem-conduit"
71− add "mime-mail-ses"
72−
73− -- Neil Mitchell
74− add "hoogle"
75− add "hlint"
76−
77− -- Alan Zimmerman
78− add "hjsmin"
79− add "language-javascript"
80−
81− -- Jasper Van der Jeugt
82− add "blaze-html"
83− add "blaze-markup"
84− add "stylish-haskell"
85−
86− -- Antoine Latter
87− add "uuid"
88− add "byteorder"
63+ mapM_ (add "michael@snoyman.com") $ words
64+ "yesod yesod-newsfeed yesod-sitemap yesod-static yesod-test markdown filesystem-conduit mime-mail-ses"
65+
66+ mapM_ (add "Neil Mitchell") $ words
67+ "hoogle hlint"
68+
69+ mapM_ (add "Alan Zimmerman") $ words
70+ "hjsmin language-javascript"
71+
72+ mapM_ (add "Jasper Van der Jeugt") $ words
73+ "blaze-html blaze-markup stylish-haskell"
74+
75+ mapM_ (add "Antoine Latter") $ words
76+ "uuid byteorder"
8977 where
90− add = flip addRange "-any"
91− addRange package range =
78+ add maintainer package = addRange maintainer package "-any"
79+ addRange maintainer package range =
9280 case simpleParse range of
9381 Nothing -> error $ "Invalid range " ++ show range ++ " for " ++ package
94− Just range' -> tell $ Map.singleton (PackageName package) range'
82+ Just range' -> tell $ Map.singleton (PackageName package) (range', Maintainer maintainer)
9583
9684verbose :: Bool
9785verbose =
Stackage/InstallInfo.hs+10−9
@@ -3,7 +3,6 @@ module Stackage.InstallInfo
33 , iiPackageList
44 ) where
55
6−import Control.Monad (when)
76import qualified Data.Map as Map
87import qualified Data.Set as Set
98import Stackage.Config
@@ -20,24 +19,26 @@ getInstallInfo = do
2019 let allPackages = Map.union stablePackages $ identsToRanges (hplibs hp)
2120 let totalCore = extraCore `Set.union` Set.map (\(PackageIdentifier p _) -> p) (hpcore hp)
2221 pdb <- loadPackageDB totalCore allPackages
23− final <- narrowPackageDB pdb $ Set.fromList $ Map.keys allPackages
22+ final <- narrowPackageDB pdb $ Set.fromList $ Map.toList $ Map.map snd $ allPackages
2423
25− when verbose $ do
26− putStrLn "Basic dependency listing:"
27− mapM_ (putStrLn . showDep) $ Map.toList final
24+ putStrLn "Printing build plan to build-plan.log"
25+ writeFile "build-plan.log" $ unlines $ map showDep $ Map.toList final
2826 return InstallInfo
2927 { iiCore = totalCore
30− , iiPackages = Map.map fst final
28+ , iiPackages = Map.map (\(v, _, m) -> (v, m)) final
3129 , iiOptionalCore = Map.fromList $ map (\(PackageIdentifier p v) -> (p, v)) $ Set.toList $ hplibs hp
3230 , iiPackageDB = pdb
3331 }
3432
35−showDep :: (PackageName, (Version, [PackageName])) -> String
36−showDep (name, (version, deps)) =
33+showDep :: (PackageName, (Version, [PackageName], Maintainer)) -> String
34+showDep (name, (version, deps, Maintainer m)) =
3735 concat
3836 [ unP name
3937 , "-"
4038 , showVersion version
39+ , " ("
40+ , m
41+ , ")"
4142 , ": "
4243 , unwords $ map unP deps
4344 ]
@@ -45,4 +46,4 @@ showDep (name, (version, deps)) =
4546 unP (PackageName p) = p
4647
4748iiPackageList :: InstallInfo -> [String]
48−iiPackageList = map packageVersionString . Map.toList . iiPackages
49+iiPackageList = map packageVersionString . Map.toList . Map.map fst . iiPackages
Stackage/LoadDatabase.hs+2−2
@@ -35,7 +35,7 @@ import Distribution.Compiler (CompilerFlavor (GHC))
3535--
3636-- * For other packages, select the maximum version number.
3737loadPackageDB :: Set PackageName -- ^ core packages
38− -> Map PackageName VersionRange -- ^ additional deps
38+ -> Map PackageName (VersionRange, Maintainer) -- ^ additional deps
3939 -> IO PackageDB
4040loadPackageDB core deps = do
4141 tarName <- getTarballName
@@ -54,7 +54,7 @@ loadPackageDB core deps = do
5454 | p `member` core -> return pdb
5555 | otherwise ->
5656 case Map.lookup p deps of
57− Just vrange
57+ Just (vrange, _maintainer)
5858 | not $ withinRange v vrange -> return pdb
5959 _ ->
6060 case Tar.entryContent e of
Stackage/NarrowDatabase.hs+8−8
@@ -8,24 +8,24 @@ import Stackage.Types
88-- | Narrow down the database to only the specified packages and all of
99-- their dependencies.
1010narrowPackageDB :: PackageDB
11− -> Set PackageName
12− -> IO (Map PackageName (Version, [PackageName]))
11+ -> Set (PackageName, Maintainer)
12+ -> IO (Map PackageName (Version, [PackageName], Maintainer))
1313narrowPackageDB (PackageDB pdb) =
14− loop Map.empty . Set.map ((,) [])
14+ loop Map.empty . Set.map (\(name, maintainer) -> ([], name, maintainer))
1515 where
1616 loop result toProcess =
1717 case Set.minView toProcess of
1818 Nothing -> return result
19− Just ((users, p), toProcess') ->
19+ Just ((users, p, maintainer), toProcess') ->
2020 case Map.lookup p pdb of
2121 Nothing
2222 | null users -> error $ "Unknown package: " ++ show p
2323 | otherwise -> loop result toProcess'
2424 Just pi -> do
2525 let users' = p:users
26− result' = Map.insert p (piVersion pi, users) result
27− loop result' $ Set.foldl' (addDep users' result') toProcess' $ piDeps pi
28− addDep users result toProcess p =
26+ result' = Map.insert p (piVersion pi, users, maintainer) result
27+ loop result' $ Set.foldl' (addDep users' result' maintainer) toProcess' $ piDeps pi
28+ addDep users result maintainer toProcess p =
2929 case Map.lookup p result of
30− Nothing -> Set.insert (users, p) toProcess
30+ Nothing -> Set.insert (users, p, maintainer) toProcess
3131 Just{} -> toProcess
Stackage/Tarballs.hs+1−1
@@ -36,7 +36,7 @@ makeTarballs ii = do
3636 Nothing -> (stable, extra)
3737 Just (package, version) ->
3838 case Map.lookup package $ iiPackages ii of
39− Just version'
39+ Just (version', _maintainer)
4040 | version == version' -> (stable . (e:), extra)
4141 | otherwise -> (stable, extra)
4242 Nothing
Stackage/Test.hs+4−4
@@ -41,8 +41,8 @@ fixEnv :: FilePath -> (String, String) -> (String, String)
4141fixEnv bin (p@"PATH", x) = (p, bin ++ pathSep : x)
4242fixEnv _ x = x
4343
44−runTestSuite :: FilePath -> Bool -> (PackageName, Version) -> IO Bool
45−runTestSuite testdir prevPassed pair@(packageName, _) = do
44+runTestSuite :: FilePath -> Bool -> (PackageName, (Version, Maintainer)) -> IO Bool
45+runTestSuite testdir prevPassed (packageName, (version, Maintainer maintainer)) = do
4646 -- Set up a new environment that includes the cabal-dev/bin folder in PATH.
4747 env' <- getEnvironment
4848 bin <- canonicalizePath "cabal-dev/bin"
@@ -77,11 +77,11 @@ runTestSuite testdir prevPassed pair@(packageName, _) = do
7777 then do
7878 removeFile logfile
7979 when expectedFailure $ putStrLn $ package ++ " passed, but I didn't think it would."
80− else unless expectedFailure $ putStrLn $ "Test suite failed: " ++ package
80+ else unless expectedFailure $ putStrLn $ "Test suite failed: " ++ package ++ "(" ++ maintainer ++ ")"
8181 rm_r dir
8282 return $! prevPassed && (passed || expectedFailure)
8383 where
8484 logfile = testdir </> package <.> "log"
8585 dir = testdir </> package
8686 getHandle mode = withBinaryFile logfile mode
87− package = packageVersionString pair
87+ package = packageVersionString (packageName, version)
Stackage/Types.hs+5−1
@@ -42,10 +42,14 @@ instance Monoid HaskellPlatform where
4242
4343data InstallInfo = InstallInfo
4444 { iiCore :: Set PackageName
45− , iiPackages :: Map PackageName Version
45+ , iiPackages :: Map PackageName (Version, Maintainer)
4646 , iiOptionalCore :: Map PackageName Version
4747 -- ^ This is intended to hold onto packages which might be automatically
4848 -- provided in the global package database. In practice, this would be
4949 -- Haskell Platform packages provided by distributions.
5050 , iiPackageDB :: PackageDB
5151 }
52+
53+-- | Email address of a Stackage maintainer.
54+newtype Maintainer = Maintainer { unMaintainer :: String }
55+ deriving (Show, Eq, Ord)
Stackage/Util.hs+2−2
@@ -15,11 +15,11 @@ import System.Directory (doesDirectoryExist,
1515import System.Directory (getAppUserDataDirectory)
1616import System.FilePath ((</>))
1717
18−identsToRanges :: Set PackageIdentifier -> Map PackageName VersionRange
18+identsToRanges :: Set PackageIdentifier -> Map PackageName (VersionRange, Maintainer)
1919identsToRanges =
2020 Map.unions . map go . Set.toList
2121 where
22− go (PackageIdentifier package version) = Map.singleton package $ thisVersion version
22+ go (PackageIdentifier package version) = Map.singleton package (thisVersion version, Maintainer "Haskell Platform")
2323
2424packageVersionString :: (PackageName, Version) -> String
2525packageVersionString (PackageName p, v) = concat [p, "-", showVersion v]