[commit: ghc] master: Drop support for single-file style package databases (557c8b8)
git at git.haskell.org
git at git.haskell.org
Fri Aug 29 14:03:45 UTC 2014
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/557c8b8c3591ae908c1309afd53e0d8db096f43a/ghc
>---------------------------------------------------------------
commit 557c8b8c3591ae908c1309afd53e0d8db096f43a
Author: Duncan Coutts <duncan at well-typed.com>
Date: Tue Aug 19 13:23:56 2014 +0100
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)
>---------------------------------------------------------------
557c8b8c3591ae908c1309afd53e0d8db096f43a
compiler/main/Packages.lhs | 18 +++++--------
utils/ghc-pkg/Main.hs | 67 +++++++---------------------------------------
2 files changed, 16 insertions(+), 69 deletions(-)
diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs
index 702c049..8bb56fd 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 554640e..3825e4e 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
@@ -742,15 +746,6 @@ myReadBinPackageDB filepath = do
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
when (verbosity > Normal) $ infoLn ("reading package config: " ++ file)
@@ -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.
More information about the ghc-commits
mailing list