diff options
author | Duncan Coutts <duncan@well-typed.com> | 2014-08-19 01:00:54 +0100 |
---|---|---|
committer | Edward Z. Yang <ezyang@cs.stanford.edu> | 2014-08-29 12:39:03 +0100 |
commit | 69e9f6e48f938ce62a885a9086392ffd6a579c29 (patch) | |
tree | e8e7e36ed09ed814e4e9849ab0ca489f0306ba7e | |
parent | b2affa0f213f08acd1c0bb0f2a5e8b2a70272a0b (diff) | |
download | haskell-69e9f6e48f938ce62a885a9086392ffd6a579c29.tar.gz |
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)
-rw-r--r-- | libraries/bin-package-db/Distribution/InstalledPackageInfo/Binary.hs | 6 | ||||
-rw-r--r-- | utils/ghc-pkg/Main.hs | 7 |
2 files changed, 9 insertions, 4 deletions
diff --git a/libraries/bin-package-db/Distribution/InstalledPackageInfo/Binary.hs b/libraries/bin-package-db/Distribution/InstalledPackageInfo/Binary.hs index baf8a05159..9fd27f64df 100644 --- a/libraries/bin-package-db/Distribution/InstalledPackageInfo/Binary.hs +++ b/libraries/bin-package-db/Distribution/InstalledPackageInfo/Binary.hs @@ -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; diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index c88b814a71..554640e7e5 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -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") |