Drop support for single-file style package databases

Historically the package db format was a single text file in Read/Show
format containing [InstalledPackageInfo]. For several years now the
default format has been a directory with one file per package, plus a
binary cache.

The old format cannot be supported under the new scheme where the
compiler will not depend on the Cabal library (because it will not
have access to the InstalledPackageInfo type) so we must drop support.
It would still technically be possible to support a single text file
style db (but containing a different type), but there does not seem to
be any compelling reason to do so.

(Part of preparitory work for removing the compiler's dep on Cabal)

2 files changed, 16 insertions, 69 deletions

diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs
index 702c0493b7..8bb56fdab7 100644
--- a/compiler/main/Packages.lhs
+++ b/compiler/main/Packages.lhs
@@ -74,7 +74,6 @@ import System.Directory
 import System.FilePath as FilePath
 import qualified System.FilePath.Posix as FilePath.Posix
 import Control.Monad
-import Data.Char (isSpace)
 import Data.List as List
 import Data.Map (Map)
 import Data.Monoid hiding ((<>))
@@ -391,16 +390,13 @@ readPackageConfig dflags conf_file = do
 
        else do
             isfile <- doesFileExist conf_file
-            when (not isfile) $
-              throwGhcExceptionIO $ InstallationError $
-                "can't find a package database at " ++ conf_file
-            debugTraceMsg dflags 2 (text "Using package config file:" <+> text conf_file)
-            str <- readFile conf_file
-            case reads str of
-                [(configs, rest)]
-                    | all isSpace rest -> return (map installedPackageInfoToPackageConfig configs)
-                _ -> throwGhcExceptionIO $ InstallationError $
-                        "invalid package database file " ++ conf_file
+            if isfile
+               then throwGhcExceptionIO $ InstallationError $
+                      "ghc no longer supports single-file style package databases (" ++
+                      conf_file ++
+                      ") use 'ghc-pkg init' to create the database with the correct format."
+               else throwGhcExceptionIO $ InstallationError $
+                      "can't find a package database at " ++ conf_file
 
   let
       top_dir = topDir dflags
diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs
index 554640e7e5..3825e4eb52 100644
--- a/utils/ghc-pkg/Main.hs
+++ b/utils/ghc-pkg/Main.hs
@@ -46,6 +46,7 @@ import System.Exit ( exitWith, ExitCode(..) )
 import System.Environment ( getArgs, getProgName, getEnv )
 import System.IO
 import System.IO.Error
+import GHC.IO.Exception (IOErrorType(InappropriateType))
 import Data.List
 import Control.Concurrent
 
@@ -672,9 +673,12 @@ readParseDatabase verbosity mb_user_conf use_cache path
   | otherwise
   = do e <- tryIO $ getDirectoryContents path
        case e of
-         Left _   -> do
-              pkgs <- parseMultiPackageConf verbosity path
-              mkPackageDB pkgs
+         Left err
+           | ioeGetErrorType err == InappropriateType ->
+              die ("ghc no longer supports single-file style package databases ("
+                ++ path ++ ") use 'ghc-pkg init' to create the database with "
+                ++ "the correct format.")
+           | otherwise -> ioError err
          Right fs
            | not use_cache -> ignore_cache (const $ return ())
            | otherwise -> do
@@ -741,15 +745,6 @@ myReadBinPackageDB filepath = do
   b <- B.hGet h (fromIntegral sz)
   hClose h
   return $ Bin.runGet Bin.get b
-
-parseMultiPackageConf :: Verbosity -> FilePath -> IO [InstalledPackageInfo]
-parseMultiPackageConf verbosity file = do
-  when (verbosity > Normal) $ infoLn ("reading package database: " ++ file)
-  str <- readUTF8File file
-  let pkgs = map convertPackageInfoIn $ read str
-  Exception.evaluate pkgs
-    `catchError` \e->
-       die ("error while parsing " ++ file ++ ": " ++ show e)
   
 parseSingletonPackageConf :: Verbosity -> FilePath -> IO InstalledPackageInfo
 parseSingletonPackageConf verbosity file = do
@@ -982,12 +977,8 @@ data DBOp = RemovePackage InstalledPackageInfo
 changeDB :: Verbosity -> [DBOp] -> PackageDB -> IO ()
 changeDB verbosity cmds db = do
   let db' = updateInternalDB db cmds
-  isfile <- doesFileExist (location db)
-  if isfile
-     then writeNewConfig verbosity (location db') (packages db')
-     else do
-       createDirectoryIfMissing True (location db)
-       changeDBDir verbosity cmds db'
+  createDirectoryIfMissing True (location db)
+  changeDBDir verbosity cmds db'
 
 updateInternalDB :: PackageDB -> [DBOp] -> PackageDB
 updateInternalDB db cmds = db{ packages = foldl do_cmd (packages db) cmds }
@@ -1397,46 +1388,6 @@ closure pkgs db_stack = go pkgs db_stack
 brokenPackages :: [InstalledPackageInfo] -> [InstalledPackageInfo]
 brokenPackages pkgs = snd (closure [] pkgs)
 
--- -----------------------------------------------------------------------------
--- Manipulating package.conf files
-
-type InstalledPackageInfoString = InstalledPackageInfo_ String
-
-convertPackageInfoOut :: InstalledPackageInfo -> InstalledPackageInfoString
-convertPackageInfoOut
-    (pkgconf@(InstalledPackageInfo { exposedModules = e,
-                                     reexportedModules = r,
-                                     hiddenModules = h })) =
-        pkgconf{ exposedModules = map display e,
-                 reexportedModules = map (fmap display) r,
-                 hiddenModules  = map display h }
-
-convertPackageInfoIn :: InstalledPackageInfoString -> InstalledPackageInfo
-convertPackageInfoIn
-    (pkgconf@(InstalledPackageInfo { exposedModules = e,
-                                     reexportedModules = r,
-                                     hiddenModules = h })) =
-        pkgconf{ exposedModules = map convert e,
-                 reexportedModules = map (fmap convert) r,
-                 hiddenModules  = map convert h }
-    where convert = fromJust . simpleParse
-
-writeNewConfig :: Verbosity -> FilePath -> [InstalledPackageInfo] -> IO ()
-writeNewConfig verbosity filename ipis = do
-  when (verbosity >= Normal) $
-      info "Writing new package config file... "
-  createDirectoryIfMissing True $ takeDirectory filename
-  let shown = concat $ intersperse ",\n "
-                     $ map (show . convertPackageInfoOut) ipis
-      fileContents = "[" ++ shown ++ "\n]"
-  writeFileUtf8Atomic filename fileContents
-    `catchIO` \e ->
-      if isPermissionError e
-      then die (filename ++ ": you don't have permission to modify this file")
-      else ioError e
-  when (verbosity >= Normal) $
-      infoLn "done."
-
 -----------------------------------------------------------------------------
 -- Sanity-check a new package config, and automatically build GHCi libs
 -- if requested.