Commit 69e9f6e4 authored by Duncan Coutts's avatar Duncan Coutts Committed by Edward Z. Yang
Browse files

Simplify conversion in binary serialisation of ghc-pkg db

We can serialise directly, without having to convert some fields to
string first.

(Part of preparitory work for removing the compiler's dep on Cabal)
parent b2affa0f
......@@ -22,8 +22,10 @@ module Distribution.InstalledPackageInfo.Binary (
import Distribution.Version
import Distribution.Package hiding (depends)
import Distribution.License
import Distribution.ModuleName as ModuleName
import Distribution.ModuleExport
import Distribution.InstalledPackageInfo as IPI
import Distribution.Text (display)
import Data.Binary as Bin
import Control.Exception as Exception
......@@ -164,6 +166,10 @@ instance Binary Version where
deriving instance Binary PackageName
deriving instance Binary InstalledPackageId
instance Binary ModuleName where
put = put . display
get = fmap ModuleName.fromString get
instance Binary m => Binary (ModuleExport m) where
put (ModuleExport a b c d) = do put a; put b; put c; put d
get = do a <- get; b <- get; c <- get; d <- get;
......
......@@ -706,8 +706,7 @@ readParseDatabase verbosity mb_user_conf use_cache path
when (verbosity > Normal) $
infoLn ("using cache: " ++ cache)
pkgs <- myReadBinPackageDB cache
let pkgs' = map convertPackageInfoIn pkgs
mkPackageDB pkgs'
mkPackageDB pkgs
else do
when (verbosity >= Normal) $ do
warn ("WARNING: cache is out of date: "
......@@ -735,7 +734,7 @@ readParseDatabase verbosity mb_user_conf use_cache path
-- bytestring 0.9.0.x (fixed in 0.9.1.x) where the file wasn't closed
-- after it has been completely read, leading to a sharing violation
-- later.
myReadBinPackageDB :: FilePath -> IO [InstalledPackageInfoString]
myReadBinPackageDB :: FilePath -> IO [InstalledPackageInfo]
myReadBinPackageDB filepath = do
h <- openBinaryFile filepath ReadMode
sz <- hFileSize h
......@@ -1021,7 +1020,7 @@ updateDBCache verbosity db = do
let filename = location db </> cachefilename
when (verbosity > Normal) $
infoLn ("writing cache " ++ filename)
writeBinaryFileAtomic filename (map convertPackageInfoOut (packages db))
writeBinaryFileAtomic filename (packages db)
`catchIO` \e ->
if isPermissionError e
then die (filename ++ ": you don't have permission to modify this file")
......
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