mirror of
https://github.com/commercialhaskell/stackage.git
synced 2026-01-12 07:18:31 +01:00
a609f1fc0c
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.
96 lines
3.7 KiB
Haskell
96 lines
3.7 KiB
Haskell
module Stackage.InstallInfo
|
|
( getInstallInfo
|
|
, iiPackageList
|
|
) where
|
|
|
|
import Control.Arrow ((&&&))
|
|
import Control.Monad (forM_)
|
|
import qualified Data.Map as Map
|
|
import qualified Data.Set as Set
|
|
import Data.Version (showVersion)
|
|
import Distribution.Version (withinRange)
|
|
import Stackage.Config
|
|
import Stackage.HaskellPlatform
|
|
import Stackage.LoadDatabase
|
|
import Stackage.NarrowDatabase
|
|
import Stackage.Types
|
|
import Stackage.Util
|
|
|
|
dropExcluded :: BuildSettings
|
|
-> Map PackageName (VersionRange, Maintainer)
|
|
-> Map PackageName (VersionRange, Maintainer)
|
|
dropExcluded bs m0 =
|
|
Set.foldl' (flip Map.delete) m0 (excludedPackages bs)
|
|
|
|
getInstallInfo :: BuildSettings -> IO InstallInfo
|
|
getInstallInfo settings = do
|
|
hp <- loadHaskellPlatform settings
|
|
let allPackages'
|
|
| requireHaskellPlatform settings = Map.union (stablePackages settings) $ identsToRanges (hplibs hp)
|
|
| otherwise = stablePackages settings
|
|
allPackages = dropExcluded settings allPackages'
|
|
let totalCore = extraCore settings `Set.union` Set.map (\(PackageIdentifier p _) -> p) (hpcore hp)
|
|
pdb <- loadPackageDB totalCore allPackages
|
|
final <- narrowPackageDB pdb $ Set.fromList $ Map.toList $ Map.map snd $ allPackages
|
|
|
|
putStrLn "Printing build plan to build-plan.log"
|
|
writeFile "build-plan.log" $ unlines $ map showDep $ Map.toList final
|
|
|
|
case checkBadVersions settings final of
|
|
badVersions
|
|
| Map.null badVersions -> return ()
|
|
| otherwise -> do
|
|
forM_ (Map.toList badVersions) $ \(PackageName user, badDeps) -> do
|
|
putStrLn $ user ++ " cannot use: "
|
|
mapM_ (putStrLn . packageVersionString) $ Map.toList badDeps
|
|
putStrLn ""
|
|
|
|
error "Conflicting build plan, exiting"
|
|
|
|
return InstallInfo
|
|
{ iiCore = totalCore
|
|
, iiPackages = Map.map (biVersion &&& biMaintainer) final
|
|
, iiOptionalCore = Map.fromList $ map (\(PackageIdentifier p v) -> (p, v)) $ Set.toList $ hplibs hp
|
|
, iiPackageDB = pdb
|
|
}
|
|
|
|
showDep :: (PackageName, BuildInfo) -> String
|
|
showDep (PackageName name, (BuildInfo version deps (Maintainer m) _)) =
|
|
concat
|
|
[ name
|
|
, "-"
|
|
, showVersion version
|
|
, " ("
|
|
, m
|
|
, ")"
|
|
, ": "
|
|
, unwords $ map unP deps
|
|
]
|
|
where
|
|
unP (PackageName p) = p
|
|
|
|
iiPackageList :: InstallInfo -> [String]
|
|
iiPackageList = map packageVersionString . Map.toList . Map.map fst . iiPackages
|
|
|
|
-- | Check for internal mismatches in required and actual package versions.
|
|
checkBadVersions :: BuildSettings
|
|
-> Map PackageName BuildInfo
|
|
-> Map PackageName (Map PackageName Version)
|
|
checkBadVersions settings buildPlan =
|
|
Map.filter (not . Map.null) $ Map.map getBadVersions $ Map.filterWithKey unexpectedFailure buildPlan
|
|
where
|
|
unexpectedFailure name _ = name `Set.notMember` expectedFailures settings
|
|
|
|
getBadVersions :: BuildInfo -> Map PackageName Version
|
|
getBadVersions = Map.unions . map (uncurry checkPackage) . Map.toList . biDeps
|
|
|
|
checkPackage :: PackageName -> VersionRange -> Map PackageName Version
|
|
checkPackage name vr =
|
|
case Map.lookup name buildPlan of
|
|
-- Can't find the dependency. Could be part of core, so just ignore
|
|
-- it.
|
|
Nothing -> Map.empty
|
|
Just bi
|
|
| biVersion bi `withinRange` vr -> Map.empty
|
|
| otherwise -> Map.singleton name $ biVersion bi
|