From 22403efd0cafc410c5e51fb7aa76f07f4ffbd73a Mon Sep 17 00:00:00 2001
From: Simon Marlow <marlowsd@gmail.com>
Date: Thu, 8 Jan 2009 09:56:28 +0000
Subject: [PATCH] Fix #2873: should fail if a package DB desn't exist We
 allowed non-existence before because the user DB is allowed
 to not exist, so now we have an explicit exception for that
 case.

---
 utils/ghc-pkg/Main.hs |   30 +++++++++++++++---------------
 1 file changed, 15 insertions(+), 15 deletions(-)

diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs
index 39f7eeb..2cbbc27 100644
--- a/utils/ghc-pkg/Main.hs
+++ b/utils/ghc-pkg/Main.hs
@@ -475,20 +475,23 @@ getPkgDatabases modify my_flags = do
              in
                 return (flag_stack, to_modify)
 
-  db_stack <- mapM readParseDatabase final_stack
+  db_stack <- mapM (readParseDatabase mb_user_conf) final_stack
   return (db_stack, to_modify)
 
-readParseDatabase :: PackageDBName -> IO (PackageDBName,PackageDB)
-readParseDatabase filename = do
-  str <- readFile filename `catchIO` \_ -> return emptyPackageConfig
-  let packages = map convertPackageInfoIn $ read str
-  Exception.evaluate packages
-    `catchError` \e->
-        die ("error while parsing " ++ filename ++ ": " ++ show e)
-  return (filename,packages)
-
-emptyPackageConfig :: String
-emptyPackageConfig = "[]"
+readParseDatabase :: Maybe (PackageDBName,Bool)
+                  -> PackageDBName
+                  -> IO (PackageDBName,PackageDB)
+readParseDatabase mb_user_conf filename
+  -- the user database (only) is allowed to be non-existent
+  | Just (user_conf,False) <- mb_user_conf, filename == user_conf
+  = return (filename, [])
+  | otherwise
+  = do str <- readFile filename
+       let packages = map convertPackageInfoIn $ read str
+       Exception.evaluate packages
+         `catchError` \e->
+            die ("error while parsing " ++ filename ++ ": " ++ show e)
+       return (filename,packages)
 
 -- -----------------------------------------------------------------------------
 -- Registering
@@ -1145,9 +1148,6 @@ isInfixOf               :: (Eq a) => [a] -> [a] -> Bool
 isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack)
 #endif
 
-catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a
-catchIO = Exception.catch
-
 #if mingw32_HOST_OS || mingw32_TARGET_OS
 throwIOIO :: Exception.IOException -> IO a
 throwIOIO = Exception.throwIO
-- 
1.7.10.4