Add a workaround to allow older cabal-install to use ghc-7.10
authorDuncan Coutts <duncan@well-typed.com>
Mon, 9 Feb 2015 19:46:06 +0000 (13:46 -0600)
committerAustin Seipp <austin@well-typed.com>
Tue, 10 Feb 2015 03:07:26 +0000 (21:07 -0600)
Summary:
This should smooth the upgrade process for people and help with testing
the 7.10 RCs. Otherwise people need to first install cabal-install-1.22
before they can use 7.10.

The problem is that older cabal still used file-style package dbs for
the inplace package db when building packages. The workaround is that
both ghc and ghc-pkg will notice when cabal tells them to use a file
style db e.g. "dist/package.conf.inplace" and, so long as that db is
empty (ie content is []) then they'll instead us a dir style db with
the same name but ".d" appended, so in this example that would be
"dist/package.conf.inplace.d". We have to use a separate dir rather
than transparently upgrading because old Cabal really assumes the path
is a file, and if it encounters a dir it will fail.

This seems to be enough for older Cabal to work, and may well be enough
for other scripts that create dbs using "echo [] > package.conf".

Test Plan:
validate and check new and old cabal can sucessfully install things,
including packages that have internal deps (ie using the inplace db)

Reviewers: hvr, tibbe, austin

Reviewed By: tibbe, austin

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D628

compiler/main/Packages.hs
utils/ghc-pkg/Main.hs

index 28f2f2d..db48d99 100644 (file)
@@ -367,13 +367,15 @@ readPackageConfig dflags conf_file = do
 
   proto_pkg_configs <-
     if isdir
-       then do let filename = conf_file </> "package.cache"
-               debugTraceMsg dflags 2 (text "Using binary package database:" <+> text filename)
-               readPackageDbForGhc filename
+       then readDirStylePackageConfig conf_file
        else do
             isfile <- doesFileExist conf_file
             if isfile
-               then throwGhcExceptionIO $ InstallationError $
+               then do
+                 mpkgs <- tryReadOldFileStylePackageConfig
+                 case mpkgs of
+                   Just pkgs -> return pkgs
+                   Nothing   -> throwGhcExceptionIO $ InstallationError $
                       "ghc no longer supports single-file style package " ++
                       "databases (" ++ conf_file ++
                       ") use 'ghc-pkg init' to create the database with " ++
@@ -388,6 +390,31 @@ readPackageConfig dflags conf_file = do
       pkg_configs2 = setBatchPackageFlags dflags pkg_configs1
   --
   return pkg_configs2
+  where
+    readDirStylePackageConfig conf_dir = do
+      let filename = conf_dir </> "package.cache"
+      debugTraceMsg dflags 2 (text "Using binary package database:" <+> text filename)
+      readPackageDbForGhc filename
+
+    -- Single-file style package dbs have been deprecated for some time, but
+    -- it turns out that Cabal was using them in one place. So this is a
+    -- workaround to allow older Cabal versions to use this newer ghc.
+    -- We check if the file db contains just "[]" and if so, we look for a new
+    -- dir-style db in conf_file.d/, ie in a dir next to the given file.
+    -- We cannot just replace the file with a new dir style since Cabal still
+    -- assumes it's a file and tries to overwrite with 'writeFile'.
+    -- ghc-pkg also cooperates with this workaround.
+    tryReadOldFileStylePackageConfig = do
+      content <- readFile conf_file `catchIO` \_ -> return ""
+      if take 2 content == "[]"
+        then do
+          let conf_dir = conf_file <.> "d"
+          direxists <- doesDirectoryExist conf_dir
+          if direxists
+             then do debugTraceMsg dflags 2 (text "Ignoring old file-style db and trying:" <+> text conf_dir)
+                     liftM Just (readDirStylePackageConfig conf_dir)
+             else return (Just []) -- ghc-pkg will create it when it's updated
+        else return Nothing
 
 setBatchPackageFlags :: DynFlags -> [PackageConfig] -> [PackageConfig]
 setBatchPackageFlags dflags pkgs = maybeDistrustAll pkgs
index 0493866..b2815b8 100644 (file)
@@ -680,10 +680,18 @@ readParseDatabase verbosity mb_user_conf modify use_cache path
   = do e <- tryIO $ getDirectoryContents path
        case e of
          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.")
+           | ioeGetErrorType err == InappropriateType -> do
+              -- We provide a limited degree of backwards compatibility for
+              -- old single-file style db:
+              mdb <- tryReadParseOldFileStyleDatabase verbosity
+                       mb_user_conf modify use_cache path
+              case mdb of
+                Just db -> return db
+                Nothing ->
+                  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 ())
@@ -823,6 +831,67 @@ mungePackagePaths top_dir pkgroot pkg =
 
 
 -- -----------------------------------------------------------------------------
+-- Workaround for old single-file style package dbs
+
+-- Single-file style package dbs have been deprecated for some time, but
+-- it turns out that Cabal was using them in one place. So this code is for a
+-- workaround to allow older Cabal versions to use this newer ghc.
+
+-- We check if the file db contains just "[]" and if so, we look for a new
+-- dir-style db in path.d/, ie in a dir next to the given file.
+-- We cannot just replace the file with a new dir style since Cabal still
+-- assumes it's a file and tries to overwrite with 'writeFile'.
+
+-- ghc itself also cooperates in this workaround
+
+tryReadParseOldFileStyleDatabase :: Verbosity -> Maybe (FilePath, Bool)
+                                 -> Bool -> Bool -> FilePath
+                                 -> IO (Maybe PackageDB)
+tryReadParseOldFileStyleDatabase verbosity mb_user_conf modify use_cache path = do
+  -- assumes we've already established that path exists and is not a dir
+  content <- readFile path `catchIO` \_ -> return ""
+  if take 2 content == "[]"
+    then do
+      path_abs <- absolutePath path
+      let path_dir = path <.> "d"
+      warn $ "Warning: ignoring old file-style db and trying " ++ path_dir
+      direxists <- doesDirectoryExist path_dir
+      if direxists
+         then do db <- readParseDatabase verbosity mb_user_conf
+                                   modify use_cache path_dir
+                 -- but pretend it was at the original location
+                 return $ Just db {
+                   location         = path,
+                   locationAbsolute = path_abs
+                 }
+         else   return $ Just PackageDB {
+                   location         = path,
+                   locationAbsolute = path_abs,
+                   packages         = []
+                 }
+
+    -- if the path is not a file, or is not an empty db then we fail
+    else return Nothing
+
+adjustOldFileStylePackageDB :: PackageDB -> IO PackageDB
+adjustOldFileStylePackageDB db = do
+  -- assumes we have not yet established if it's an old style or not
+  mcontent <- liftM Just (readFile (location db)) `catchIO` \_ -> return Nothing
+  case fmap (take 2) mcontent of
+    -- it is an old style and empty db, so look for a dir kind in location.d/
+    Just "[]" -> return db {
+                   location         = location db <.> "d",
+                   locationAbsolute = locationAbsolute db <.> "d"
+                 }
+    -- it is old style but not empty, we have to bail
+    Just  _   -> die $ "ghc no longer supports single-file style package "
+                    ++ "databases (" ++ location db ++ ") use 'ghc-pkg init'"
+                    ++ "to create the database with the correct format."
+    -- probably not old style, carry on as normal
+    Nothing   -> return db
+
+
+-- -----------------------------------------------------------------------------
 -- Creating a new package DB
 
 initPackageDB :: FilePath -> Verbosity -> [Flag] -> IO ()
@@ -941,8 +1010,9 @@ data DBOp = RemovePackage InstalledPackageInfo
 changeDB :: Verbosity -> [DBOp] -> PackageDB -> IO ()
 changeDB verbosity cmds db = do
   let db' = updateInternalDB db cmds
-  createDirectoryIfMissing True (location db)
-  changeDBDir verbosity cmds db'
+  db'' <- adjustOldFileStylePackageDB db'
+  createDirectoryIfMissing True (location db'')
+  changeDBDir verbosity cmds db''
 
 updateInternalDB :: PackageDB -> [DBOp] -> PackageDB
 updateInternalDB db cmds = db{ packages = foldl do_cmd (packages db) cmds }