From d11a073352b508701cbe5f19e8fecafe25e28b7a Mon Sep 17 00:00:00 2001
From: "Ivan.Miljenovic" <Ivan.Miljenovic@gmail.com>
Date: Thu, 29 Jul 2010 13:45:07 +0000
Subject: [PATCH] Rather than using brokenPackages from Cabal, just parse
 "ghc-pkg check --simple-output" The rationale for this is that brokenPackages
 doesn't work for packages that have include directories missing (e.g.
 dev-haskell/gtk, but x11-libs/gtk+ gets upgraded).  "ghc-pkg check" already
 takes this into account, so rather than trying to duplicate this
 functionality just parse what it spits out.

---
 Distribution/Gentoo/GHC.hs | 47 ++++++++++++++++----------------------
 1 file changed, 20 insertions(+), 27 deletions(-)

diff --git a/Distribution/Gentoo/GHC.hs b/Distribution/Gentoo/GHC.hs
index f8e4d95..4e96537 100644
--- a/Distribution/Gentoo/GHC.hs
+++ b/Distribution/Gentoo/GHC.hs
@@ -21,24 +21,16 @@ import Distribution.Gentoo.Util
 import Distribution.Gentoo.Packages
 
 -- Cabal imports
-import Distribution.Simple.PackageIndex( PackageIndex
-                                        , brokenPackages
-                                        , reverseDependencyClosure)
-import Distribution.Simple.GHC(getInstalledPackages, configure)
-import Distribution.Simple.Program( ProgramConfiguration
-                                  , defaultProgramConfiguration)
-import Distribution.Simple.Compiler(PackageDB(GlobalPackageDB))
-import Distribution.Simple.Utils(rawSystemStdout)
+import Distribution.Simple.Utils(rawSystemStdInOut)
 import Distribution.Verbosity(silent)
 import Distribution.Package(PackageIdentifier, packageId)
-import Distribution.InstalledPackageInfo( InstalledPackageInfo_
-                                        , installedPackageId)
-import Distribution.Text(display)
+import Distribution.InstalledPackageInfo(InstalledPackageInfo_)
+import Distribution.Text(display, simpleParse)
 
 -- Other imports
 import Data.Char(isDigit)
 import Data.Either(partitionEithers)
-import Data.Maybe(fromJust)
+import Data.Maybe(fromJust, mapMaybe)
 import qualified Data.Map as Map
 import Data.Map(Map)
 import qualified Data.ByteString.Char8 as BS
@@ -54,7 +46,11 @@ import Control.Monad(foldM, liftM, unless)
 
 -- Get only the first line of output
 rawSysStdOutLine     :: FilePath -> [String] -> IO String
-rawSysStdOutLine app = liftM (head . lines) . rawSystemStdout silent app
+rawSysStdOutLine app = liftM (head . lines) . rawCommand app
+
+rawCommand          :: FilePath -> [String] -> IO String
+rawCommand cmd args = do (out,_,_) <- rawSystemStdInOut silent cmd args Nothing False
+                         return out
 
 -- Get the first line of output from calling GHC with the given
 -- arguments.
@@ -74,6 +70,14 @@ ghcVersion = liftM (dropWhile (not . isDigit)) $ ghcRawOut ["--version"]
 ghcLibDir :: IO FilePath
 ghcLibDir = canonicalizePath =<< ghcRawOut ["--print-libdir"]
 
+ghcPkgRawOut      :: [String] -> IO String
+ghcPkgRawOut args = ghcPkgLoc >>= flip rawCommand args
+
+-- Cheat with using fromJust since we know that ghc-pkg must be in $PATH
+-- somewhere, probably /usr/bin.
+ghcPkgLoc :: IO FilePath
+ghcPkgLoc = liftM fromJust $ findExecutable "ghc-pkg"
+
 -- Return the Gentoo .conf files found in this GHC libdir
 confFiles     :: FilePath -> IO [FilePath]
 confFiles dir = do let gDir = dir </> "gentoo"
@@ -187,7 +191,7 @@ brokenPkgs = do putStrLn "Searching for Haskell libraries with broken dependenci
 
 -- .conf files from broken packages of this GHC version
 brokenConfs :: IO ([PackageIdentifier], [FilePath])
-brokenConfs = do brkn <- getBroken
+brokenConfs = do brkn <- getBroken -- getBroken
                  -- Check if we actually have to go look up files and
                  -- do IO.
                  if null brkn
@@ -219,23 +223,12 @@ addConf cmp conf = do cnts <- readFile conf
                         [([],_)] -> return cmp
                         rd       -> do let nm = cfNm rd
                                        return $ Map.insert nm conf cmp
-
   where
     -- It's not InstalledPackageInfo, as it can't read the modules
     cfNm :: [([InstalledPackageInfo_ String], String)] -> PackageIdentifier
     cfNm = packageId . head . fst . head
 
--- Obtain GHC info about installed libs, etc.
-configureGHC :: IO ProgramConfiguration
-configureGHC = liftM snd
-               $ configure silent Nothing Nothing defaultProgramConfiguration
-
--- Return all packages registered with GHC
-pkgIndex :: IO PackageIndex
-pkgIndex = configureGHC >>= getInstalledPackages silent [GlobalPackageDB]
-
 -- Return the closure of all packages affected by breakage
 getBroken :: IO [PackageIdentifier]
-getBroken = do ind <- pkgIndex
-               let broken = map (installedPackageId . fst) $ brokenPackages ind
-               return $ map packageId $ reverseDependencyClosure ind broken
+getBroken = liftM (mapMaybe simpleParse . words)
+            $ ghcPkgRawOut ["check", "--simple-output"]