X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=libraries%2FifBuildable.hs;h=3f8813b63d66d7401c582d182f16a0f8e4e6723f;hp=c60e10889c125ce67fa2244a0e6aa275ba56709b;hb=d7d755865a3849be26a468a3fa430ff96c8e9e0c;hpb=1f4784a9ee5d38364aa7f0d8f91a22069b73a6ae

diff --git a/libraries/ifBuildable.hs b/libraries/ifBuildable.hs
index c60e108..3f8813b 100644
--- a/libraries/ifBuildable.hs
+++ b/libraries/ifBuildable.hs
@@ -1,41 +1,36 @@
+-- Returns exitcode 0 if the given package is buildable or is a boot package,
+-- and 1 otherwise.
 
 module Main (main) where
 
 import Control.Monad
-import Data.Maybe
-import Distribution.PackageDescription
-import Distribution.Simple
-import Distribution.Simple.Utils
-import System.Cmd
+import System.Directory
 import System.Environment
 import System.Exit
+import System.IO
 
 main :: IO ()
-main = do let verbosity = 0
-          mustBeBuildables <- getMustBeBuildablePackages
-          dfd <- defaultPackageDesc verbosity
-          pkgDescr <- readPackageDescription verbosity dfd
-          mInfolFile <- defaultHookedPackageDesc
-          info <- case mInfolFile of
-                      Nothing -> return emptyHookedBuildInfo
-                      Just infoFile -> readHookedBuildInfo verbosity infoFile
-          let pkgDescr' = updatePackageDescription info pkgDescr
-              pkg = pkgName (package pkgDescr')
-              mustBeBuildable = pkg `elem` mustBeBuildables
-              buildInfos = map libBuildInfo (maybeToList (library pkgDescr'))
-                        ++ map buildInfo (executables pkgDescr')
-              isBuildable = any buildable buildInfos
-          when (mustBeBuildable || isBuildable) $ do
-              args <- getArgs
-              case args of
-                  prog : progArgs ->
-                      do ec <- rawSystem prog progArgs
-                         exitWith ec
-                  [] ->
-                      error "ifBuildable: No command given"
+main = do args <- getArgs
+          case args of
+              [bootPackagesFile, package] ->
+                  doit bootPackagesFile package
+              _ ->
+                  error "Syntax: ifBuildable <boot-packages-file> <package>"
 
-getMustBeBuildablePackages :: IO [String]
-getMustBeBuildablePackages
- = do xs <- readFile "../core-packages"
-      return $ filter ("readline" /=) $ lines xs
+doit :: FilePath -> String -> IO ()
+doit bootPackagesFile package
+ = do setCurrentDirectory package
+      unbuildable <- doesFileExist "unbuildable"
+      if not unbuildable
+         then exitWith ExitSuccess
+         else do mustBeBuildables <- getMustBeBuildables bootPackagesFile
+                 if package `elem` mustBeBuildables
+                     then exitWith ExitSuccess
+                     else do hPutStrLn stderr "Warning: Package is unbuildable"
+                             exitWith (ExitFailure 1)
+
+getMustBeBuildables :: FilePath -> IO [String]
+getMustBeBuildables bootPackagesFile
+ = do xs <- readFile bootPackagesFile
+      return $ filter ("editline" /=) $ lines xs