From 0e7fcd58525164125512a01ac166ee836763cf80 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Sun, 2 Jun 2013 14:36:45 +0300
Subject: [PATCH] Write build-plan even if there are disallowed packages

---
 Stackage/InstallInfo.hs    | 13 ++++++++++---
 Stackage/NarrowDatabase.hs | 12 +++---------
 2 files changed, 13 insertions(+), 12 deletions(-)

diff --git a/Stackage/InstallInfo.hs b/Stackage/InstallInfo.hs
index 77419e7d..ebcf1a2f 100644
--- a/Stackage/InstallInfo.hs
+++ b/Stackage/InstallInfo.hs
@@ -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
diff --git a/Stackage/NarrowDatabase.hs b/Stackage/NarrowDatabase.hs
index 6c3fccd3..444f24ca 100644
--- a/Stackage/NarrowDatabase.hs
+++ b/Stackage/NarrowDatabase.hs
@@ -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