Simplify conversion in binary serialisation of ghc-pkg db
authorDuncan Coutts <duncan@well-typed.com>
Tue, 19 Aug 2014 00:00:54 +0000 (01:00 +0100)
committerEdward Z. Yang <ezyang@cs.stanford.edu>
Fri, 29 Aug 2014 11:39:03 +0000 (12:39 +0100)
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)

libraries/bin-package-db/Distribution/InstalledPackageInfo/Binary.hs
utils/ghc-pkg/Main.hs

index baf8a05..9fd27f6 100644 (file)
@@ -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;
index c88b814..554640e 100644 (file)
@@ -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")