X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=utils%2Fghc-pkg%2FMain.hs;h=0f0b9ec0540ce2b499949dc13f96a56a4f259597;hb=09d76f81a7b77139901a73f9f241d26a5bdd3796;hp=7f727d7966496db668b09bbaf2a8f62cdfe27098;hpb=eed437cdefb952e6c70e58012b23d436e74710af;p=ghc-hetmet.git

diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs
index 7f727d7..0f0b9ec 100644
--- a/utils/ghc-pkg/Main.hs
+++ b/utils/ghc-pkg/Main.hs
@@ -375,7 +375,16 @@ getPkgDatabases modify my_flags = do
         [] -> do mb_dir <- getExecDir "/bin/ghc-pkg.exe"
                  case mb_dir of
                         Nothing  -> die err_msg
-                        Just dir -> return (dir </> "package.conf")
+                        Just dir ->
+                            do let path1 = dir </> "package.conf"
+                                   path2 = dir </> ".." </> ".." </> ".."
+                                               </> "inplace-datadir"
+                                               </> "package.conf"
+                               exists1 <- doesFileExist path1
+                               exists2 <- doesFileExist path2
+                               if exists1 then return path1
+                                   else if exists2 then return path2
+                                   else die "Can't find package.conf"
         fs -> return (last fs)
 
   let global_conf_dir = global_conf ++ ".d"
@@ -626,7 +635,7 @@ doDump = mapM_ putStrLn . intersperse "---" . map showInstalledPackageInfo
 findPackages :: PackageDBStack -> PackageArg -> IO [InstalledPackageInfo]
 findPackages db_stack pkgarg
   = case [ p | p <- all_pkgs, pkgarg `matchesPkg` p ] of
-        []  -> die ("cannot find package " ++ pkg_msg pkgarg)
+        []  -> dieWith 2 ("cannot find package " ++ pkg_msg pkgarg)
         ps -> return ps
   where
         all_pkgs = allPackagesInStack db_stack
@@ -1017,11 +1026,14 @@ bye :: String -> IO a
 bye s = putStr s >> exitWith ExitSuccess
 
 die :: String -> IO a
-die s = do
+die = dieWith 1
+
+dieWith :: Int -> String -> IO a
+dieWith ec s = do
   hFlush stdout
   prog <- getProgramName
   hPutStrLn stderr (prog ++ ": " ++ s)
-  exitWith (ExitFailure 1)
+  exitWith (ExitFailure ec)
 
 dieOrForceAll :: Force -> String -> IO ()
 dieOrForceAll ForceAll s = ignoreError s