haskell/stackage
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage.git synced 2026-02-09 12:57:30 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Better bad version output

Browse Source
This commit is contained in:
Michael Snoyman 2012-12-09 19:14:31 +02:00
parent a609f1fc0c
commit 71228518a8
1 changed files with 26 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
Stackage/InstallInfo.hs
View File

@ -8,7 +8,8 @@ import Control.Monad (forM_)
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Set as Set import qualified Data.Set as Set
import Data.Version (showVersion) import Data.Version (showVersion)
import Distribution.Version (withinRange) import qualified Distribution.Text
import Distribution.Version (withinRange, simplifyVersionRange)
import Stackage.Config import Stackage.Config
import Stackage.HaskellPlatform import Stackage.HaskellPlatform
import Stackage.LoadDatabase import Stackage.LoadDatabase
@ -40,9 +41,15 @@ getInstallInfo settings = do
badVersions badVersions
| Map.null badVersions -> return () | Map.null badVersions -> return ()
| otherwise -> do | otherwise -> do
forM_ (Map.toList badVersions) $ \(PackageName user, badDeps) -> do forM_ (Map.toList badVersions) $ \(user, badDeps) -> do
putStrLn $ user ++ " cannot use: " putStrLn $ user ++ " cannot use: "
mapM_ (putStrLn . packageVersionString) $ Map.toList badDeps forM_ (Map.toList badDeps) $ \(name, (version, range)) -> do
putStrLn $ concat
[ "- "
, packageVersionString (name, version)
, " -- "
, Distribution.Text.display $ simplifyVersionRange range
]
putStrLn "" putStrLn ""
error "Conflicting build plan, exiting" error "Conflicting build plan, exiting"
@ -75,16 +82,26 @@ iiPackageList = map packageVersionString . Map.toList . Map.map fst . iiPackages
-- | Check for internal mismatches in required and actual package versions. -- | Check for internal mismatches in required and actual package versions.
checkBadVersions :: BuildSettings checkBadVersions :: BuildSettings
-> Map PackageName BuildInfo -> Map PackageName BuildInfo
-> Map PackageName (Map PackageName Version) -> Map String (Map PackageName (Version, VersionRange))
checkBadVersions settings buildPlan = checkBadVersions settings buildPlan =
Map.filter (not . Map.null) $ Map.map getBadVersions $ Map.filterWithKey unexpectedFailure buildPlan Map.unions $ map getBadVersions $ Map.toList $ Map.filterWithKey unexpectedFailure buildPlan
where where
unexpectedFailure name _ = name `Set.notMember` expectedFailures settings unexpectedFailure name _ = name `Set.notMember` expectedFailures settings
getBadVersions :: BuildInfo -> Map PackageName Version getBadVersions :: (PackageName, BuildInfo) -> Map String (Map PackageName (Version, VersionRange))
getBadVersions = Map.unions . map (uncurry checkPackage) . Map.toList . biDeps getBadVersions (name, bi)
| Map.null badVersions = Map.empty
| otherwise = Map.singleton display badVersions
where
badVersions = Map.unions $ map (uncurry checkPackage) $ Map.toList $ biDeps bi
display = concat
[ packageVersionString (name, biVersion bi)
, " ("
, unMaintainer $ biMaintainer bi
, ")"
]
checkPackage :: PackageName -> VersionRange -> Map PackageName Version checkPackage :: PackageName -> VersionRange -> Map PackageName (Version, VersionRange)
checkPackage name vr = checkPackage name vr =
case Map.lookup name buildPlan of case Map.lookup name buildPlan of
-- Can't find the dependency. Could be part of core, so just ignore -- Can't find the dependency. Could be part of core, so just ignore
@ -92,4 +109,4 @@ checkBadVersions settings buildPlan =
Nothing -> Map.empty Nothing -> Map.empty
Just bi Just bi
| biVersion bi `withinRange` vr -> Map.empty | biVersion bi `withinRange` vr -> Map.empty
| otherwise -> Map.singleton name $ biVersion bi | otherwise -> Map.singleton name (biVersion bi, vr)