git.iko.soy/stackage
on master help sign in
Check for version conflicts ourselves.

This was done by cabal-install previously. But doing it ourselves, we gain a few things: * Found out about problems faster. * Get a complete list of problems, including tests. * Much more user-friendly output.

commita609f1fc0cc7b312ec746ffa47a6ad6c1504f488 authorMichael Snoyman <michael@snoyman.com> dateSun 9 Dec 2012, 18:58 (14 years ago) parent42621ab
4 files changed+63−13
compare with master
unifiedsplit
Stackage/InstallInfo.hs+41−4 Stackage/LoadDatabase.hs+3−3 Stackage/NarrowDatabase.hs+8−3 Stackage/Types.hs+11−3
Stackage/InstallInfo.hs+41−4
@@ -3,9 +3,12 @@ module Stackage.InstallInfo
33 , iiPackageList
44 ) where
55
6+import Control.Arrow ((&&&))
7+import Control.Monad (forM_)
68import qualified Data.Map as Map
79import qualified Data.Set as Set
810import Data.Version (showVersion)
11+import Distribution.Version (withinRange)
912import Stackage.Config
1013import Stackage.HaskellPlatform
1114import Stackage.LoadDatabase
@@ -32,17 +35,29 @@ getInstallInfo settings = do
3235
3336 putStrLn "Printing build plan to build-plan.log"
3437 writeFile "build-plan.log" $ unlines $ map showDep $ Map.toList final
38+
39+ case checkBadVersions settings final of
40+ badVersions
41+ | Map.null badVersions -> return ()
42+ | otherwise -> do
43+ forM_ (Map.toList badVersions) $ \(PackageName user, badDeps) -> do
44+ putStrLn $ user ++ " cannot use: "
45+ mapM_ (putStrLn . packageVersionString) $ Map.toList badDeps
46+ putStrLn ""
47+
48+ error "Conflicting build plan, exiting"
49+
3550 return InstallInfo
3651 { iiCore = totalCore
37− , iiPackages = Map.map (\(v, _, m) -> (v, m)) final
52+ , iiPackages = Map.map (biVersion &&& biMaintainer) final
3853 , iiOptionalCore = Map.fromList $ map (\(PackageIdentifier p v) -> (p, v)) $ Set.toList $ hplibs hp
3954 , iiPackageDB = pdb
4055 }
4156
42−showDep :: (PackageName, (Version, [PackageName], Maintainer)) -> String
43−showDep (name, (version, deps, Maintainer m)) =
57+showDep :: (PackageName, BuildInfo) -> String
58+showDep (PackageName name, (BuildInfo version deps (Maintainer m) _)) =
4459 concat
45− [ unP name
60+ [ name
4661 , "-"
4762 , showVersion version
4863 , " ("
@@ -56,3 +71,25 @@ showDep (name, (version, deps, Maintainer m)) =
5671
5772iiPackageList :: InstallInfo -> [String]
5873iiPackageList = map packageVersionString . Map.toList . Map.map fst . iiPackages
74+
75+-- | Check for internal mismatches in required and actual package versions.
76+checkBadVersions :: BuildSettings
77+ -> Map PackageName BuildInfo
78+ -> Map PackageName (Map PackageName Version)
79+checkBadVersions settings buildPlan =
80+ Map.filter (not . Map.null) $ Map.map getBadVersions $ Map.filterWithKey unexpectedFailure buildPlan
81+ where
82+ unexpectedFailure name _ = name `Set.notMember` expectedFailures settings
83+
84+ getBadVersions :: BuildInfo -> Map PackageName Version
85+ getBadVersions = Map.unions . map (uncurry checkPackage) . Map.toList . biDeps
86+
87+ checkPackage :: PackageName -> VersionRange -> Map PackageName Version
88+ checkPackage name vr =
89+ case Map.lookup name buildPlan of
90+ -- Can't find the dependency. Could be part of core, so just ignore
91+ -- it.
92+ Nothing -> Map.empty
93+ Just bi
94+ | biVersion bi `withinRange` vr -> Map.empty
95+ | otherwise -> Map.singleton name $ biVersion bi
Stackage/LoadDatabase.hs+3−3
@@ -30,7 +30,7 @@ import Distribution.PackageDescription (Condition (..),
3030import Distribution.PackageDescription.Parse (ParseResult (ParseOk),
3131 parsePackageDescription)
3232import Distribution.System (buildArch, buildOS)
33−import Distribution.Version (withinRange)
33+import Distribution.Version (withinRange, unionVersionRanges)
3434import Stackage.Config
3535import Stackage.Types
3636import Stackage.Util
@@ -101,8 +101,8 @@ loadPackageDB core deps = do
101101 goBI f x = buildTools $ f $ condTreeData x
102102 depName (Dependency p _) = p
103103 go gpd tree
104− = Set.unions
105− $ Set.fromList (map (\(Dependency p _) -> p) $ condTreeConstraints tree)
104+ = Map.unionsWith unionVersionRanges
105+ $ Map.fromList (map (\(Dependency p vr) -> (p, vr)) $ condTreeConstraints tree)
106106 : map (go gpd) (mapMaybe (checkCond gpd) $ condTreeComponents tree)
107107
108108 checkCond gpd (cond, tree, melse)
Stackage/NarrowDatabase.hs+8−3
@@ -9,7 +9,7 @@ import Stackage.Types
99-- their dependencies.
1010narrowPackageDB :: PackageDB
1111 -> Set (PackageName, Maintainer)
12− -> IO (Map PackageName (Version, [PackageName], Maintainer))
12+ -> IO (Map PackageName BuildInfo)
1313narrowPackageDB (PackageDB pdb) =
1414 loop Map.empty . Set.map (\(name, maintainer) -> ([], name, maintainer))
1515 where
@@ -23,8 +23,13 @@ narrowPackageDB (PackageDB pdb) =
2323 | otherwise -> loop result toProcess'
2424 Just pi -> do
2525 let users' = p:users
26− result' = Map.insert p (piVersion pi, users, maintainer) result
27− loop result' $ Set.foldl' (addDep users' result' maintainer) toProcess' $ piDeps pi
26+ result' = Map.insert p BuildInfo
27+ { biVersion = piVersion pi
28+ , biUsers = users
29+ , biMaintainer = maintainer
30+ , biDeps = piDeps pi
31+ } result
32+ loop result' $ Set.foldl' (addDep users' result' maintainer) toProcess' $ Map.keysSet $ piDeps pi
2833 addDep users result maintainer toProcess p =
2934 case Map.lookup p result of
3035 Nothing -> Set.insert (users, p, maintainer) toProcess
Stackage/Types.hs+11−3
@@ -13,7 +13,7 @@ import Distribution.Package as X (PackageIdentifier (..),
1313import Distribution.Version as X (VersionRange (..))
1414
1515newtype PackageDB = PackageDB (Map PackageName PackageInfo)
16− deriving (Show, Eq, Ord)
16+ deriving (Show, Eq)
1717
1818instance Monoid PackageDB where
1919 mempty = PackageDB mempty
@@ -26,11 +26,19 @@ instance Monoid PackageDB where
2626
2727data PackageInfo = PackageInfo
2828 { piVersion :: Version
29− , piDeps :: Set PackageName
29+ , piDeps :: Map PackageName VersionRange
3030 , piHasTests :: Bool
3131 , piBuildTools :: Set PackageName
3232 }
33− deriving (Show, Eq, Ord)
33+ deriving (Show, Eq)
34+
35+-- | Information on a package we're going to build.
36+data BuildInfo = BuildInfo
37+ { biVersion :: Version
38+ , biUsers :: [PackageName]
39+ , biMaintainer :: Maintainer
40+ , biDeps :: Map PackageName VersionRange
41+ }
3442
3543data HaskellPlatform = HaskellPlatform
3644 { hpcore :: Set PackageIdentifier