diff --git a/Stackage/Config.hs b/Stackage/Config.hs index 89c6d47e..574ed62e 100644 --- a/Stackage/Config.hs +++ b/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 - addRange "yesod" "< 1.4" - add "yesod-newsfeed" - add "yesod-sitemap" - add "yesod-static" - add "yesod-test" - add "markdown" - add "filesystem-conduit" - add "mime-mail-ses" + mapM_ (add "michael@snoyman.com") $ words + "yesod yesod-newsfeed yesod-sitemap yesod-static yesod-test markdown filesystem-conduit mime-mail-ses" - -- Neil Mitchell - add "hoogle" - add "hlint" + mapM_ (add "Neil Mitchell") $ words + "hoogle hlint" - -- Alan Zimmerman - add "hjsmin" - add "language-javascript" + mapM_ (add "Alan Zimmerman") $ words + "hjsmin language-javascript" - -- Jasper Van der Jeugt - add "blaze-html" - add "blaze-markup" - add "stylish-haskell" + mapM_ (add "Jasper Van der Jeugt") $ words + "blaze-html blaze-markup stylish-haskell" - -- Antoine Latter - add "uuid" - add "byteorder" + mapM_ (add "Antoine Latter") $ words + "uuid byteorder" where - add = flip addRange "-any" - addRange package range = + add maintainer package = addRange maintainer package "-any" + 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 = diff --git a/Stackage/InstallInfo.hs b/Stackage/InstallInfo.hs index d35b2aac..42b04485 100644 --- a/Stackage/InstallInfo.hs +++ b/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 "Basic dependency listing:" - mapM_ (putStrLn . showDep) $ Map.toList final + putStrLn "Printing build plan to build-plan.log" + writeFile "build-plan.log" $ unlines $ map 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 (name, (version, deps)) = +showDep :: (PackageName, (Version, [PackageName], Maintainer)) -> String +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 diff --git a/Stackage/LoadDatabase.hs b/Stackage/LoadDatabase.hs index 0f179334..d71b161c 100644 --- a/Stackage/LoadDatabase.hs +++ b/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 diff --git a/Stackage/NarrowDatabase.hs b/Stackage/NarrowDatabase.hs index 7b92a2ad..3cc7ca8d 100644 --- a/Stackage/NarrowDatabase.hs +++ b/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 - -> IO (Map PackageName (Version, [PackageName])) + -> Set (PackageName, Maintainer) + -> 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 - loop result' $ Set.foldl' (addDep users' result') toProcess' $ piDeps pi - addDep users result toProcess p = + result' = Map.insert p (piVersion pi, users, maintainer) result + loop result' $ Set.foldl' (addDep users' result' maintainer) toProcess' $ piDeps pi + 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 diff --git a/Stackage/Tarballs.hs b/Stackage/Tarballs.hs index 7cd1b3be..e08fd2df 100644 --- a/Stackage/Tarballs.hs +++ b/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 diff --git a/Stackage/Test.hs b/Stackage/Test.hs index 675b831c..cf41f4ba 100644 --- a/Stackage/Test.hs +++ b/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 testdir prevPassed pair@(packageName, _) = do +runTestSuite :: FilePath -> Bool -> (PackageName, (Version, Maintainer)) -> IO Bool +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) diff --git a/Stackage/Types.hs b/Stackage/Types.hs index 76bac501..0f5b8477 100644 --- a/Stackage/Types.hs +++ b/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) diff --git a/Stackage/Util.hs b/Stackage/Util.hs index 9bb344b0..9a62073a 100644 --- a/Stackage/Util.hs +++ b/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]