mirror of
https://github.com/commercialhaskell/stackage.git
synced 2026-01-20 11:11:58 +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
|
, bpPackageList
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad (forM_)
|
import Control.Monad (forM_, unless)
|
||||||
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 qualified Distribution.Text
|
import qualified Distribution.Text
|
||||||
import Distribution.Version (simplifyVersionRange, withinRange)
|
import Distribution.Version (simplifyVersionRange, withinRange)
|
||||||
|
import Stackage.GhcPkg
|
||||||
import Stackage.HaskellPlatform
|
import Stackage.HaskellPlatform
|
||||||
import Stackage.LoadDatabase
|
import Stackage.LoadDatabase
|
||||||
import Stackage.NarrowDatabase
|
import Stackage.NarrowDatabase
|
||||||
import Stackage.Types
|
import Stackage.Types
|
||||||
import Stackage.Util
|
import Stackage.Util
|
||||||
import Stackage.GhcPkg
|
import System.Exit (exitFailure)
|
||||||
|
|
||||||
dropExcluded :: SelectSettings
|
dropExcluded :: SelectSettings
|
||||||
-> Map PackageName (VersionRange, Maintainer)
|
-> Map PackageName (VersionRange, Maintainer)
|
||||||
@ -42,17 +43,23 @@ getInstallInfo settings = do
|
|||||||
| requireHaskellPlatform settings = Map.union (stablePackages settings) $ identsToRanges (hplibs hp)
|
| requireHaskellPlatform settings = Map.union (stablePackages settings) $ identsToRanges (hplibs hp)
|
||||||
| otherwise = stablePackages settings
|
| otherwise = stablePackages settings
|
||||||
allPackages = dropExcluded settings allPackages'
|
allPackages = dropExcluded settings allPackages'
|
||||||
|
mapM_ print $ Map.keys allPackages
|
||||||
let totalCore = extraCore settings `Set.union` Set.map (\(PackageIdentifier p _) -> p) core
|
let totalCore = extraCore settings `Set.union` Set.map (\(PackageIdentifier p _) -> p) core
|
||||||
|
|
||||||
putStrLn "Loading package database"
|
putStrLn "Loading package database"
|
||||||
pdb <- loadPackageDB settings coreMap totalCore allPackages
|
pdb <- loadPackageDB settings coreMap totalCore allPackages
|
||||||
|
|
||||||
putStrLn "Narrowing package database"
|
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"
|
putStrLn "Printing build plan to build-plan.log"
|
||||||
writeFile "build-plan.log" $ unlines $ map showDep $ Map.toList final
|
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"
|
putStrLn "Checking for bad versions"
|
||||||
case checkBadVersions settings coreMap pdb final of
|
case checkBadVersions settings coreMap pdb final of
|
||||||
badVersions
|
badVersions
|
||||||
|
|||||||
@ -14,15 +14,9 @@ narrowPackageDB :: SelectSettings
|
|||||||
-> Set PackageName -- ^ core packages to be excluded from installation
|
-> Set PackageName -- ^ core packages to be excluded from installation
|
||||||
-> PackageDB
|
-> PackageDB
|
||||||
-> Set (PackageName, Maintainer)
|
-> Set (PackageName, Maintainer)
|
||||||
-> IO (Map PackageName BuildInfo)
|
-> IO (Map PackageName BuildInfo, Set String)
|
||||||
narrowPackageDB settings core (PackageDB pdb) packageSet = do
|
narrowPackageDB settings core (PackageDB pdb) packageSet =
|
||||||
(res, errs) <- runWriterT $ loop Map.empty $ Set.map (\(name, maintainer) -> ([], name, maintainer)) packageSet
|
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
|
|
||||||
where
|
where
|
||||||
loop result toProcess =
|
loop result toProcess =
|
||||||
case Set.minView toProcess of
|
case Set.minView toProcess of
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user