mirror of
https://github.com/commercialhaskell/stackage.git
synced 2026-01-12 07:18:31 +01:00
Write build-plan even if there are disallowed packages
This commit is contained in:
parent
2f26c5778f
commit
0e7fcd5852
@ -4,18 +4,19 @@ module Stackage.InstallInfo
|
||||
, bpPackageList
|
||||
) where
|
||||
|
||||
import Control.Monad (forM_)
|
||||
import Control.Monad (forM_, unless)
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Set as Set
|
||||
import Data.Version (showVersion)
|
||||
import qualified Distribution.Text
|
||||
import Distribution.Version (simplifyVersionRange, withinRange)
|
||||
import Stackage.GhcPkg
|
||||
import Stackage.HaskellPlatform
|
||||
import Stackage.LoadDatabase
|
||||
import Stackage.NarrowDatabase
|
||||
import Stackage.Types
|
||||
import Stackage.Util
|
||||
import Stackage.GhcPkg
|
||||
import System.Exit (exitFailure)
|
||||
|
||||
dropExcluded :: SelectSettings
|
||||
-> Map PackageName (VersionRange, Maintainer)
|
||||
@ -42,17 +43,23 @@ getInstallInfo settings = do
|
||||
| requireHaskellPlatform settings = Map.union (stablePackages settings) $ identsToRanges (hplibs hp)
|
||||
| otherwise = stablePackages settings
|
||||
allPackages = dropExcluded settings allPackages'
|
||||
mapM_ print $ Map.keys allPackages
|
||||
let totalCore = extraCore settings `Set.union` Set.map (\(PackageIdentifier p _) -> p) core
|
||||
|
||||
putStrLn "Loading package database"
|
||||
pdb <- loadPackageDB settings coreMap totalCore allPackages
|
||||
|
||||
putStrLn "Narrowing package database"
|
||||
final <- narrowPackageDB settings totalCore pdb $ Set.fromList $ Map.toList $ Map.map snd $ allPackages
|
||||
(final, errs) <- narrowPackageDB settings totalCore 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
|
||||
|
||||
unless (Set.null errs) $ do
|
||||
putStrLn "Build plan requires some disallowed packages"
|
||||
mapM_ putStrLn $ Set.toList errs
|
||||
exitFailure
|
||||
|
||||
putStrLn "Checking for bad versions"
|
||||
case checkBadVersions settings coreMap pdb final of
|
||||
badVersions
|
||||
|
||||
@ -14,15 +14,9 @@ narrowPackageDB :: SelectSettings
|
||||
-> Set PackageName -- ^ core packages to be excluded from installation
|
||||
-> PackageDB
|
||||
-> Set (PackageName, Maintainer)
|
||||
-> IO (Map PackageName BuildInfo)
|
||||
narrowPackageDB settings core (PackageDB pdb) packageSet = do
|
||||
(res, errs) <- runWriterT $ loop Map.empty $ Set.map (\(name, maintainer) -> ([], name, maintainer)) packageSet
|
||||
if Set.null errs
|
||||
then return res
|
||||
else do
|
||||
putStrLn "Build plan requires some disallowed packages"
|
||||
mapM_ putStrLn $ Set.toList errs
|
||||
exitFailure
|
||||
-> IO (Map PackageName BuildInfo, Set String)
|
||||
narrowPackageDB settings core (PackageDB pdb) packageSet =
|
||||
runWriterT $ loop Map.empty $ Set.map (\(name, maintainer) -> ([], name, maintainer)) packageSet
|
||||
where
|
||||
loop result toProcess =
|
||||
case Set.minView toProcess of
|
||||
|
||||
Loading…
Reference in New Issue
Block a user