Commit 557c8b8c authored by Duncan Coutts's avatar Duncan Coutts Committed by Edward Z. Yang

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)
parent 69e9f6e4
......@@ -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
......
......@@ -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.
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment