d7ccf74 · stackage · git.iko.soy

Stackage/Config.hs+18−30

compare with master

unifiedsplit

@@ -58,40 +58,28 @@ expectedFailures = fromList $ map PackageName

58-- | List of packages for our stable Hackage. All dependencies will be

59-- included as well. Please indicate who will be maintaining the package

60-- via comments.

61−stablePackages :: Map PackageName VersionRange

61+stablePackages :: Map PackageName (VersionRange, Maintainer)

62stablePackages = execWriter $ do

63− -- Michael Snoyman michael@snoyman.com

63+ mapM_ (add "michael@snoyman.com") $ words

64− addRange "yesod" "< 1.4"

64+ "yesod yesod-newsfeed yesod-sitemap yesod-static yesod-test markdown filesystem-conduit mime-mail-ses"

65− add "yesod-newsfeed"

65+

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

66+ mapM_ (add "Neil Mitchell") $ words

74− add "hoogle"

67+ "hoogle hlint"

75− add "hlint"

68+

76−

77− -- Alan Zimmerman

69+ mapM_ (add "Alan Zimmerman") $ words

78− add "hjsmin"

79− add "language-javascript"

70+ "hjsmin language-javascript"

80−

71+

81− -- Jasper Van der Jeugt

72+ mapM_ (add "Jasper Van der Jeugt") $ words

82− add "blaze-html"

83− add "blaze-markup"

84− add "stylish-haskell"

73+ "blaze-html blaze-markup stylish-haskell"

85−

74+

86− -- Antoine Latter

75+ mapM_ (add "Antoine Latter") $ words

87− add "uuid"

88− add "byteorder"

76+ "uuid byteorder"

89 where

77 where

90− add = flip addRange "-any"

78+ add maintainer package = addRange maintainer package "-any"

91− addRange package range =

79+ addRange maintainer package range =

92 case simpleParse range of

80 case simpleParse range of

93 Nothing -> error $ "Invalid range " ++ show range ++ " for " ++ package

81 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)

95

83

96verbose :: Bool

84verbose :: Bool

97verbose =

85verbose =

Stackage/InstallInfo.hs+10−9

@@ -3,7 +3,6 @@ module Stackage.InstallInfo

3 , iiPackageList

4 ) where

5

6−import Control.Monad (when)

7import qualified Data.Map as Map

6import qualified Data.Map as Map

8import qualified Data.Set as Set

7import qualified Data.Set as Set

9import Stackage.Config

8import Stackage.Config

@@ -20,24 +19,26 @@ getInstallInfo = do

20 let allPackages = Map.union stablePackages $ identsToRanges (hplibs hp)

19 let allPackages = Map.union stablePackages $ identsToRanges (hplibs hp)

21 let totalCore = extraCore `Set.union` Set.map (\(PackageIdentifier p _) -> p) (hpcore hp)

20 let totalCore = extraCore `Set.union` Set.map (\(PackageIdentifier p _) -> p) (hpcore hp)

22 pdb <- loadPackageDB totalCore allPackages

21 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

24

23

25− when verbose $ do

24+ putStrLn "Printing build plan to build-plan.log"

26− putStrLn "Basic dependency listing:"

27− mapM_ (putStrLn . showDep) $ Map.toList final

25+ writeFile "build-plan.log" $ unlines $ map showDep $ Map.toList final

28 return InstallInfo

26 return InstallInfo

29 { iiCore = totalCore

27 { iiCore = totalCore

30− , iiPackages = Map.map fst final

28+ , iiPackages = Map.map (\(v, _, m) -> (v, m)) final

31 , iiOptionalCore = Map.fromList $ map (\(PackageIdentifier p v) -> (p, v)) $ Set.toList $ hplibs hp

29 , iiOptionalCore = Map.fromList $ map (\(PackageIdentifier p v) -> (p, v)) $ Set.toList $ hplibs hp

32 , iiPackageDB = pdb

30 , iiPackageDB = pdb

33 }

31 }

34

32

35−showDep :: (PackageName, (Version, [PackageName])) -> String

33+showDep :: (PackageName, (Version, [PackageName], Maintainer)) -> String

36−showDep (name, (version, deps)) =

34+showDep (name, (version, deps, Maintainer m)) =

37 concat

35 concat

38 [ unP name

36 [ unP name

39 , "-"

37 , "-"

40 , showVersion version

38 , showVersion version

39+ , " ("

40+ , m

41+ , ")"

41 , ": "

42 , ": "

42 , unwords $ map unP deps

43 , unwords $ map unP deps

43 ]

44 ]

@@ -45,4 +46,4 @@ showDep (name, (version, deps)) =

45 unP (PackageName p) = p

46 unP (PackageName p) = p

46

47

47iiPackageList :: InstallInfo -> [String]

48iiPackageList :: 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))

35--

36-- * For other packages, select the maximum version number.

37loadPackageDB :: Set PackageName -- ^ core packages

38− -> Map PackageName VersionRange -- ^ additional deps

38+ -> Map PackageName (VersionRange, Maintainer) -- ^ additional deps

39 -> IO PackageDB

40loadPackageDB core deps = do

41 tarName <- getTarballName

@@ -54,7 +54,7 @@ loadPackageDB core deps = do

54 | p `member` core -> return pdb

55 | otherwise ->

56 case Map.lookup p deps of

57− Just vrange

57+ Just (vrange, _maintainer)

58 | not $ withinRange v vrange -> return pdb

59 _ ->

60 case Tar.entryContent e of

Stackage/NarrowDatabase.hs+8−8

@@ -8,24 +8,24 @@ import Stackage.Types

8-- | Narrow down the database to only the specified packages and all of

9-- their dependencies.

10narrowPackageDB :: PackageDB

11− -> Set PackageName

11+ -> Set (PackageName, Maintainer)

12− -> IO (Map PackageName (Version, [PackageName]))

12+ -> IO (Map PackageName (Version, [PackageName], Maintainer))

13narrowPackageDB (PackageDB pdb) =

14− loop Map.empty . Set.map ((,) [])

14+ loop Map.empty . Set.map (\(name, maintainer) -> ([], name, maintainer))

15 where

16 loop result toProcess =

17 case Set.minView toProcess of

18 Nothing -> return result

19− Just ((users, p), toProcess') ->

19+ Just ((users, p, maintainer), toProcess') ->

20 case Map.lookup p pdb of

21 Nothing

22 | null users -> error $ "Unknown package: " ++ show p

23 | otherwise -> loop result toProcess'

24 Just pi -> do

25 let users' = p:users

26− result' = Map.insert p (piVersion pi, users) result

26+ result' = Map.insert p (piVersion pi, users, maintainer) result

27− loop result' $ Set.foldl' (addDep users' result') toProcess' $ piDeps pi

27+ loop result' $ Set.foldl' (addDep users' result' maintainer) toProcess' $ piDeps pi

28− addDep users result toProcess p =

28+ addDep users result maintainer toProcess p =

29 case Map.lookup p result of

30− Nothing -> Set.insert (users, p) toProcess

30+ Nothing -> Set.insert (users, p, maintainer) toProcess

31 Just{} -> toProcess

Stackage/Tarballs.hs+1−1

@@ -36,7 +36,7 @@ makeTarballs ii = do

36 Nothing -> (stable, extra)

37 Just (package, version) ->

38 case Map.lookup package $ iiPackages ii of

39− Just version'

39+ Just (version', _maintainer)

40 | version == version' -> (stable . (e:), extra)

41 | otherwise -> (stable, extra)

42 Nothing

Stackage/Test.hs+4−4

@@ -41,8 +41,8 @@ fixEnv :: FilePath -> (String, String) -> (String, String)

41fixEnv bin (p@"PATH", x) = (p, bin ++ pathSep : x)

42fixEnv _ x = x

43

44−runTestSuite :: FilePath -> Bool -> (PackageName, Version) -> IO Bool

44+runTestSuite :: FilePath -> Bool -> (PackageName, (Version, Maintainer)) -> IO Bool

45−runTestSuite testdir prevPassed pair@(packageName, _) = do

45+runTestSuite testdir prevPassed (packageName, (version, Maintainer maintainer)) = do

46 -- Set up a new environment that includes the cabal-dev/bin folder in PATH.

47 env' <- getEnvironment

48 bin <- canonicalizePath "cabal-dev/bin"

@@ -77,11 +77,11 @@ runTestSuite testdir prevPassed pair@(packageName, _) = do

77 then do

78 removeFile logfile

79 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 ++ ")"

81 rm_r dir

82 return $! prevPassed && (passed || expectedFailure)

83 where

84 logfile = testdir </> package <.> "log"

85 dir = testdir </> package

86 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

42

43data InstallInfo = InstallInfo

44 { iiCore :: Set PackageName

45− , iiPackages :: Map PackageName Version

45+ , iiPackages :: Map PackageName (Version, Maintainer)

46 , iiOptionalCore :: Map PackageName Version

47 -- ^ This is intended to hold onto packages which might be automatically

48 -- provided in the global package database. In practice, this would be

49 -- Haskell Platform packages provided by distributions.

50 , iiPackageDB :: PackageDB

51 }

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,

15import System.Directory (getAppUserDataDirectory)

16import System.FilePath ((</>))

17

18−identsToRanges :: Set PackageIdentifier -> Map PackageName VersionRange

18+identsToRanges :: Set PackageIdentifier -> Map PackageName (VersionRange, Maintainer)

19identsToRanges =

20 Map.unions . map go . Set.toList

21 where

22− go (PackageIdentifier package version) = Map.singleton package $ thisVersion version

22+ go (PackageIdentifier package version) = Map.singleton package (thisVersion version, Maintainer "Haskell Platform")

23

24packageVersionString :: (PackageName, Version) -> String

25packageVersionString (PackageName p, v) = concat [p, "-", showVersion v]