Use ghc-local types for packages, rather than Cabal types

Also start using the new package db file format properly, by using the
ghc-specific section.

This is the main patch in the series for removing the compiler's dep
on the Cabal lib.

6 files changed, 360 insertions, 120 deletions

diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs
index 86d7b268d0..f581f9f59a 100644
--- a/compiler/ghci/Linker.lhs
+++ b/compiler/ghci/Linker.lhs
@@ -65,8 +65,6 @@ import System.FilePath
 import System.IO
 import System.Directory hiding (findFile)
 
-import Distribution.Package hiding (depends, mkPackageKey, PackageKey)
-
 import Exception
 \end{code}
 
@@ -1119,7 +1117,7 @@ linkPackage dflags pkg
             objs       = [ obj  | Object obj     <- classifieds ]
             archs      = [ arch | Archive arch   <- classifieds ]
 
-        maybePutStr dflags ("Loading package " ++ display (sourcePackageId pkg) ++ " ... ")
+        maybePutStr dflags ("Loading package " ++ sourcePackageIdString pkg ++ " ... ")
 
         -- See comments with partOfGHCi
         when (packageName pkg `notElem` partOfGHCi) $ do
@@ -1135,7 +1133,7 @@ linkPackage dflags pkg
         maybePutStr dflags "linking ... "
         ok <- resolveObjs
         if succeeded ok then maybePutStrLn dflags "done."
-              else throwGhcExceptionIO (InstallationError ("unable to load package `" ++ display (sourcePackageId pkg) ++ "'"))
+              else throwGhcExceptionIO (InstallationError ("unable to load package `" ++ sourcePackageIdString pkg ++ "'"))
 
 -- we have already searched the filesystem; the strings passed to load_dyn
 -- can be passed directly to loadDLL.  They are either fully-qualified
@@ -1149,7 +1147,7 @@ load_dyn dll = do r <- loadDLL dll
                     Just err -> throwGhcExceptionIO (CmdLineError ("can't load .so/.DLL for: "
                                                               ++ dll ++ " (" ++ err ++ ")" ))
 
-loadFrameworks :: Platform -> InstalledPackageInfo_ ModuleName -> IO ()
+loadFrameworks :: Platform -> PackageConfig -> IO ()
 loadFrameworks platform pkg
     = if platformUsesFrameworks platform
       then mapM_ load frameworks
diff --git a/compiler/main/Finder.lhs b/compiler/main/Finder.lhs
index f9c7e2eee0..8b9a5e9547 100644
--- a/compiler/main/Finder.lhs
+++ b/compiler/main/Finder.lhs
@@ -42,7 +42,6 @@ import UniqFM
 import Maybes           ( expectJust )
 import Exception        ( evaluate )
 
-import Distribution.Text
 import Data.IORef       ( IORef, writeIORef, readIORef, atomicModifyIORef )
 import System.Directory
 import System.FilePath
@@ -616,17 +615,17 @@ cantFindErr cannot_find _ dflags mod_name find_result
         | otherwise =
                hang (ptext (sLit "Locations searched:")) 2 $ vcat (map text files)
 
-    pkg_hidden pkg =
-        ptext (sLit "It is a member of the hidden package") <+> quotes (ppr pkg)
-        <> dot $$ cabal_pkg_hidden_hint pkg
-    cabal_pkg_hidden_hint pkg
+    pkg_hidden pkgid =
+        ptext (sLit "It is a member of the hidden package") <+> quotes (ppr pkgid)
+        --FIXME: we don't really want to show the package key here we should
+        -- show the source package id or installed package id if it's ambiguous
+        <> dot $$ cabal_pkg_hidden_hint pkgid
+    cabal_pkg_hidden_hint pkgid
      | gopt Opt_BuildingCabalPackage dflags
-        = case simpleParse (packageKeyString pkg) of
-          Just pid ->
-              ptext (sLit "Perhaps you need to add") <+>
-              quotes (text (display (pkgName pid))) <+>
+        = let pkg = expectJust "cabal_pkg_hidden_hint" (lookupPackage dflags pkgid)
+           in ptext (sLit "Perhaps you need to add") <+>
+              quotes (ppr (packageName pkg)) <+>
               ptext (sLit "to the build-depends in your .cabal file.")
-          Nothing -> empty
      | otherwise = empty
 
     mod_hidden pkg =
diff --git a/compiler/main/PackageConfig.hs b/compiler/main/PackageConfig.hs
index 864980be9d..09ff0659b3 100644
--- a/compiler/main/PackageConfig.hs
+++ b/compiler/main/PackageConfig.hs
@@ -10,39 +10,103 @@ module PackageConfig (
         -- $package_naming
 
         -- * PackageKey
-        mkPackageKey, packageConfigId,
+        packageConfigId,
 
         -- * The PackageConfig type: information about a package
         PackageConfig,
-        InstalledPackageInfo_(..), display,
+        InstalledPackageInfo(..),
+        InstalledPackageId(..),
+        SourcePackageId(..),
+        PackageName(..),
         Version(..),
-        PackageIdentifier(..),
         defaultPackageConfig,
-        packageConfigToInstalledPackageInfo,
-        installedPackageInfoToPackageConfig
+        installedPackageIdString,
+        sourcePackageIdString,
+        packageNameString,
+        showInstalledPackageInfo,
     ) where
 
 #include "HsVersions.h"
 
-import Distribution.InstalledPackageInfo
-import Distribution.ModuleName
-import Distribution.Package hiding (PackageKey, mkPackageKey)
-import qualified Distribution.Package as Cabal
-import Distribution.Text
-import Distribution.Version
+import GHC.PackageDb
+import qualified Data.ByteString.Char8 as BS
+import Data.Version
 
-import Maybes
+import Outputable
 import Module
 
 -- -----------------------------------------------------------------------------
--- Our PackageConfig type is just InstalledPackageInfo from Cabal. Later we
--- might need to extend it with some GHC-specific stuff, but for now it's fine.
+-- Our PackageConfig type is the InstalledPackageInfo from bin-package-db,
+-- which is similar to a subset of the InstalledPackageInfo type from Cabal.
 
-type PackageConfig = InstalledPackageInfo_ Module.ModuleName
+type PackageConfig = InstalledPackageInfo
+                       InstalledPackageId
+                       SourcePackageId
+                       PackageName
+                       Module.PackageKey
+                       Module.ModuleName
+
+newtype InstalledPackageId = InstalledPackageId String deriving (Eq, Ord, Show)
+newtype SourcePackageId    = SourcePackageId String    deriving (Eq, Ord, Show)
+newtype PackageName        = PackageName String        deriving (Eq, Ord, Show)
+
+instance BinaryStringRep InstalledPackageId where
+  fromStringRep = InstalledPackageId . BS.unpack
+  toStringRep   (InstalledPackageId s) = BS.pack s
+
+instance BinaryStringRep SourcePackageId where
+  fromStringRep = SourcePackageId . BS.unpack
+  toStringRep   (SourcePackageId s) = BS.pack s
+
+instance BinaryStringRep PackageName where
+  fromStringRep = PackageName . BS.unpack
+  toStringRep   (PackageName s) = BS.pack s
+
+instance BinaryStringRep PackageKey where
+  fromStringRep = Module.stringToPackageKey . BS.unpack
+  toStringRep   = BS.pack . Module.packageKeyString
+
+instance BinaryStringRep Module.ModuleName where
+  fromStringRep = Module.mkModuleName . BS.unpack
+  toStringRep   = BS.pack . Module.moduleNameString  
+
+instance Outputable InstalledPackageId where
+  ppr (InstalledPackageId str) = text str
+
+instance Outputable SourcePackageId where
+  ppr (SourcePackageId str) = text str
+
+instance Outputable PackageName where
+  ppr (PackageName str) = text str
 
 defaultPackageConfig :: PackageConfig
 defaultPackageConfig = emptyInstalledPackageInfo
 
+installedPackageIdString :: PackageConfig -> String
+installedPackageIdString pkg = str
+  where
+    InstalledPackageId str = installedPackageId pkg
+
+sourcePackageIdString :: PackageConfig -> String
+sourcePackageIdString pkg = str
+  where
+    SourcePackageId str = sourcePackageId pkg
+
+packageNameString :: PackageConfig -> String
+packageNameString pkg = str
+  where
+    PackageName str = packageName pkg
+
+showInstalledPackageInfo :: PackageConfig -> String
+showInstalledPackageInfo = show
+
+instance Show ModuleName where
+  show = moduleNameString
+
+instance Show PackageKey where
+  show = packageKeyString
+
+
 -- -----------------------------------------------------------------------------
 -- PackageKey (package names, versions and dep hash)
 
@@ -54,35 +118,7 @@ defaultPackageConfig = emptyInstalledPackageInfo
 -- wired-in packages like @base@ & @rts@, we don't necessarily know what the
 -- version is, so these are handled specially; see #wired_in_packages#.
 
--- | Turn a Cabal 'PackageIdentifier' into a GHC 'PackageKey'
-mkPackageKey :: Cabal.PackageKey -> PackageKey
-mkPackageKey = stringToPackageKey . display
-
 -- | Get the GHC 'PackageKey' right out of a Cabalish 'PackageConfig'
 packageConfigId :: PackageConfig -> PackageKey
-packageConfigId = mkPackageKey . packageKey
-
--- | Turn a 'PackageConfig', which contains GHC 'Module.ModuleName's into a Cabal specific
--- 'InstalledPackageInfo' which contains Cabal 'Distribution.ModuleName.ModuleName's
-packageConfigToInstalledPackageInfo :: PackageConfig -> InstalledPackageInfo
-packageConfigToInstalledPackageInfo
-    (pkgconf@(InstalledPackageInfo { exposedModules = e,
-                                     reexportedModules = r,
-                                     hiddenModules = h })) =
-        pkgconf{ exposedModules = map convert e,
-                 reexportedModules = map (fmap convert) r,
-                 hiddenModules  = map convert h }
-    where convert :: Module.ModuleName -> Distribution.ModuleName.ModuleName
-          convert = (expectJust "packageConfigToInstalledPackageInfo") . simpleParse . moduleNameString
-
--- | Turn an 'InstalledPackageInfo', which contains Cabal 'Distribution.ModuleName.ModuleName's
--- into a GHC specific 'PackageConfig' which contains GHC 'Module.ModuleName's
-installedPackageInfoToPackageConfig :: InstalledPackageInfo_ String -> PackageConfig
-installedPackageInfoToPackageConfig
-    (pkgconf@(InstalledPackageInfo { exposedModules = e,
-                                     reexportedModules = r,
-                                     hiddenModules = h })) =
-        pkgconf{ exposedModules = map mkModuleName e,
-                 reexportedModules = map (fmap mkModuleName) r,
-                 hiddenModules  = map mkModuleName h }
+packageConfigId = packageKey
 
diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs
index ae2669edcd..cf9ab09f67 100644
--- a/compiler/main/Packages.lhs
+++ b/compiler/main/Packages.lhs
@@ -49,6 +49,7 @@ where
 
 #include "HsVersions.h"
 
+import GHC.PackageDb
 import PackageConfig
 import DynFlags
 import Config           ( cProjectVersion )
@@ -61,11 +62,6 @@ import Outputable
 import Maybes
 
 import System.Environment ( getEnv )
-import GHC.PackageDb (readPackageDbForGhcPkg)
-import Distribution.InstalledPackageInfo
-import Distribution.InstalledPackageInfo.Binary ()
-import Distribution.Package hiding (depends, PackageKey, mkPackageKey)
-import Distribution.ModuleExport
 import FastString
 import ErrUtils         ( debugTraceMsg, putMsg, MsgDoc )
 import Exception
@@ -285,7 +281,7 @@ lookupPackage' :: PackageConfigMap -> PackageKey -> Maybe PackageConfig
 lookupPackage' = lookupUFM
 
 -- | Search for packages with a given package ID (e.g. \"foo-0.1\")
-searchPackageId :: DynFlags -> PackageId -> [PackageConfig]
+searchPackageId :: DynFlags -> SourcePackageId -> [PackageConfig]
 searchPackageId dflags pid = filter ((pid ==) . sourcePackageId)
                                (listPackageConfigMap dflags)
 
@@ -386,10 +382,11 @@ readPackageConfig dflags conf_file = do
     if isdir
        then do let filename = conf_file </> "package.cache"
                debugTraceMsg dflags 2 (text "Using binary package database:" <+> text filename)
-               conf <- readPackageDbForGhcPkg filename
+               readPackageDbForGhc filename
+{-
                -- TODO readPackageDbForGhc ^^ instead
                return (map installedPackageInfoToPackageConfig conf)
-
+-}
        else do
             isfile <- doesFileExist conf_file
             if isfile
@@ -478,7 +475,7 @@ mungePackagePaths top_dir pkgroot pkg =
 -- then we are no longer able to match against package keys e.g. from when
 -- a user passes in a package flag.
 calcKey :: PackageConfig -> PackageKey
-calcKey p | pk <- display (pkgName (sourcePackageId p))
+calcKey p | pk <- packageNameString p
           , pk `elem` wired_in_pkgids
                       = stringToPackageKey pk
           | otherwise = packageConfigId p
@@ -558,22 +555,22 @@ selectPackages matches pkgs unusable
 -- version, or just the name if it is unambiguous.
 matchingStr :: String -> PackageConfig -> Bool
 matchingStr str p
-        =  str == display (sourcePackageId p)
-        || str == display (pkgName (sourcePackageId p))
+        =  str == sourcePackageIdString p
+        || str == packageNameString p
 
 matchingId :: String -> PackageConfig -> Bool
-matchingId str p =  InstalledPackageId str == installedPackageId p
+matchingId str p =  str == installedPackageIdString p
 
 matchingKey :: String -> PackageConfig -> Bool
-matchingKey str p = str == display (packageKey p)
+matchingKey str p = str == packageKeyString (packageConfigId p)
 
 matching :: PackageArg -> PackageConfig -> Bool
 matching (PackageArg str) = matchingStr str
 matching (PackageIdArg str) = matchingId str
 matching (PackageKeyArg str) = matchingKey str
 
-sortByVersion :: [InstalledPackageInfo_ m] -> [InstalledPackageInfo_ m]
-sortByVersion = sortBy (flip (comparing (pkgVersion.sourcePackageId)))
+sortByVersion :: [PackageConfig] -> [PackageConfig]
+sortByVersion = sortBy (flip (comparing packageVersion))
 
 comparing :: Ord a => (t -> a) -> t -> t -> Ordering
 comparing f a b = f a `compare` f b
@@ -600,7 +597,7 @@ packageFlagErr dflags flag reasons
                       -- ToDo: this admonition seems a bit dodgy
                       text "(use -v for more information)")
         ppr_reasons = vcat (map ppr_reason reasons)
-        ppr_reason (p, reason) = pprReason (pprIPkg p <+> text "is") reason
+        ppr_reason (p, reason) = pprReason (ppr (installedPackageId p) <+> text "is") reason
 
 pprFlag :: PackageFlag -> SDoc
 pprFlag flag = case flag of
@@ -637,7 +634,7 @@ findWiredInPackages dflags pkgs = do
   --
   let
         matches :: PackageConfig -> String -> Bool
-        pc `matches` pid = display (pkgName (sourcePackageId pc)) == pid
+        pc `matches` pid = packageNameString pc == pid
 
         -- find which package corresponds to each wired-in package
         -- delete any other packages with the same name
@@ -664,14 +661,14 @@ findWiredInPackages dflags pkgs = do
                                  <> text wired_pkg
                                  <> ptext (sLit " not found.")
                           return Nothing
-                pick :: InstalledPackageInfo_ ModuleName
+                pick :: PackageConfig
                      -> IO (Maybe InstalledPackageId)
                 pick pkg = do
                         debugTraceMsg dflags 2 $
                             ptext (sLit "wired-in package ")
                                  <> text wired_pkg
                                  <> ptext (sLit " mapped to ")
-                                 <> pprIPkg pkg
+                                 <> ppr (installedPackageId pkg)
                         return (Just (installedPackageId pkg))
 
 
@@ -693,12 +690,11 @@ findWiredInPackages dflags pkgs = do
         -}
 
         updateWiredInDependencies pkgs = map upd_pkg pkgs
-          where upd_pkg p
-                  | installedPackageId p `elem` wired_in_ids
-                  = let pid = (sourcePackageId p) { pkgVersion = Version [] [] }
-                    in p { packageKey = OldPackageKey pid }
+          where upd_pkg pkg
+                  | installedPackageId pkg `elem` wired_in_ids
+                  = pkg { packageKey = stringToPackageKey (packageNameString pkg) }
                   | otherwise
-                  = p
+                  = pkg
 
   return $ updateWiredInDependencies pkgs
 
@@ -719,9 +715,9 @@ pprReason pref reason = case reason of
   MissingDependencies deps ->
       pref <+>
       ptext (sLit "unusable due to missing or recursive dependencies:") $$
-        nest 2 (hsep (map (text.display) deps))
+        nest 2 (hsep (map ppr deps))
   ShadowedBy ipid ->
-      pref <+> ptext (sLit "shadowed by package ") <> text (display ipid)
+      pref <+> ptext (sLit "shadowed by package ") <> ppr ipid
 
 reportUnusable :: DynFlags -> UnusablePackages -> IO ()
 reportUnusable dflags pkgs = mapM_ report (Map.toList pkgs)
@@ -730,7 +726,7 @@ reportUnusable dflags pkgs = mapM_ report (Map.toList pkgs)
        debugTraceMsg dflags 2 $
          pprReason
            (ptext (sLit "package") <+>
-            text (display ipid) <+> text "is") reason
+            ppr ipid <+> text "is") reason
 
 -- ----------------------------------------------------------------------------
 --
@@ -787,7 +783,7 @@ shadowPackages pkgs preferred
       | otherwise
       = (shadowed, pkgmap')
       where
-        pkgid = mkFastString (display (sourcePackageId pkg))
+        pkgid = mkFastString (sourcePackageIdString pkg)
         pkgmap' = addToUFM pkgmap pkgid pkg
 
 -- -----------------------------------------------------------------------------
@@ -920,7 +916,7 @@ mkPackageState dflags pkgs0 preload0 this_package = do
   -- or is empty if we have -hide-all-packages
   --
   let preferLater pkg pkg' =
-        case comparing (pkgVersion.sourcePackageId) pkg pkg' of
+        case comparing packageVersion pkg pkg' of
             GT -> pkg
             _  -> pkg'
       calcInitial m pkg = addToUFM_C preferLater m (fsPackageName pkg) pkg
@@ -1048,8 +1044,11 @@ mkModuleToPkgConfGeneric emptyMap sing setOrigins addListTo
     es e =
      [(m, sing pk  m  pkg  (fromExposedModules e)) | m <- exposed_mods] ++
      [(m, sing pk' m' pkg' (fromReexportedModules e pkg))
-     | ModuleExport{ exportName = m
-                   , exportCachedTrueOrig = Just (ipid', m')} <- reexported_mods
+     | ModuleExport {
+         exportModuleName         = m,
+         exportOriginalPackageId  = ipid',
+         exportOriginalModuleName = m'
+       } <- reexported_mods
      , let pk' = expectJust "mkModuleToPkgConf" (Map.lookup ipid' ipid_map)
            pkg' = pkg_lookup pk' ]
 
@@ -1105,9 +1104,6 @@ mkModuleToPkgConfAll =
           merge m (k, v) = Map.insertWith (Map.unionWith mappend) k v m
           setOrigins m os = fmap (const os) m
 
-pprIPkg :: PackageConfig -> SDoc
-pprIPkg p = text (display (installedPackageId p))
-
 -- -----------------------------------------------------------------------------
 -- Extracting information from the packages in scope
 
@@ -1387,7 +1383,7 @@ packageKeyPackageIdString :: DynFlags -> PackageKey -> String
 packageKeyPackageIdString dflags pkg_key
     | pkg_key == mainPackageKey = "main"
     | otherwise = maybe "(unknown)"
-                      (display . sourcePackageId)
+                      sourcePackageIdString
                       (lookupPackage dflags pkg_key)
 
 -- | Will the 'Name' come from a dynamically linked library?
@@ -1430,11 +1426,10 @@ isDllName dflags _this_pkg this_mod name
 dumpPackages :: DynFlags -> IO ()
 dumpPackages = dumpPackages' showInstalledPackageInfo
 
-dumpPackages' :: (InstalledPackageInfo -> String) -> DynFlags -> IO ()
+dumpPackages' :: (PackageConfig -> String) -> DynFlags -> IO ()
 dumpPackages' showIPI dflags
   = do putMsg dflags $
-             vcat (map (text . showIPI
-                             . packageConfigToInstalledPackageInfo)
+             vcat (map (text . showIPI)
                        (listPackageConfigMap dflags))
 
 -- | Show simplified package info on console, if verbosity == 4.
@@ -1458,7 +1453,6 @@ pprModuleMap dflags =
         | otherwise = ppr m' <+> parens (ppr o)
 
 fsPackageName :: PackageConfig -> FastString
-fsPackageName pkg = case packageName (sourcePackageId pkg) of
-    PackageName n -> mkFastString n
+fsPackageName = mkFastString . packageNameString
 
 \end{code}
diff --git a/libraries/bin-package-db/GHC/PackageDb.hs b/libraries/bin-package-db/GHC/PackageDb.hs
index 0ed508524b..08dabd2791 100644
--- a/libraries/bin-package-db/GHC/PackageDb.hs
+++ b/libraries/bin-package-db/GHC/PackageDb.hs
@@ -1,8 +1,6 @@
-{-# LANGUAGE CPP, RecordWildCards, NamedFieldPuns #-}
-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
-#if __GLASGOW_HASKELL__ >= 701
-{-# LANGUAGE Trustworthy #-}
-#endif
+{-# LANGUAGE CPP #-}
+-- This module deliberately defines orphan instances for now (Binary Version).
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  GHC.PackageDb
@@ -38,12 +36,16 @@
 -- this library avoids depending on Cabal.
 -- 
 module GHC.PackageDb (
-       GhcPackageInfo(..),
+       InstalledPackageInfo(..),
+       ModuleExport(..),
+       BinaryStringRep(..),
+       emptyInstalledPackageInfo,
        readPackageDbForGhc,
        readPackageDbForGhcPkg,
        writePackageDb
   ) where
 
+import Data.Version (Version(..))
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Char8 as BS.Char8
 import qualified Data.ByteString.Lazy as BS.Lazy
@@ -63,22 +65,89 @@ import System.Directory
 -- | This is a subset of Cabal's 'InstalledPackageInfo', with just the bits
 -- that GHC is interested in.
 --
-data GhcPackageInfo = GhcPackageInfo {
-       --TODO
+data InstalledPackageInfo instpkgid srcpkgid srcpkgname pkgkey modulename
+   = InstalledPackageInfo {
+       installedPackageId :: instpkgid,
+       sourcePackageId    :: srcpkgid,
+       packageName        :: srcpkgname,
+       packageVersion     :: Version,
+       packageKey         :: pkgkey,
+       depends            :: [instpkgid],
+       importDirs         :: [FilePath],
+       hsLibraries        :: [String],
+       extraLibraries     :: [String],
+       extraGHCiLibraries :: [String],
+       libraryDirs        :: [FilePath],
+       frameworks         :: [String],
+       frameworkDirs      :: [FilePath],
+       ldOptions          :: [String],
+       ccOptions          :: [String],
+       includes           :: [String],
+       includeDirs        :: [FilePath],
+       haddockInterfaces  :: [FilePath],
+       haddockHTMLs       :: [FilePath],
+       exposedModules     :: [modulename],
+       hiddenModules      :: [modulename],
+       reexportedModules  :: [ModuleExport instpkgid modulename],
+       exposed            :: Bool,
+       trusted            :: Bool
+     }
+  deriving (Eq, Show)
+
+class BinaryStringRep a where
+  fromStringRep :: BS.ByteString -> a
+  toStringRep   :: a -> BS.ByteString
+
+data ModuleExport instpkgid modulename
+   = ModuleExport {
+       exportModuleName         :: modulename,
+       exportOriginalPackageId  :: instpkgid,
+       exportOriginalModuleName :: modulename
      }
   deriving (Eq, Show)
 
+emptyInstalledPackageInfo :: (BinaryStringRep a, BinaryStringRep b, BinaryStringRep c, BinaryStringRep d)
+                          => InstalledPackageInfo a b c d e
+emptyInstalledPackageInfo =
+  InstalledPackageInfo {
+       installedPackageId = fromStringRep BS.empty,
+       sourcePackageId    = fromStringRep BS.empty,
+       packageName        = fromStringRep BS.empty,
+       packageVersion     = Version [] [],
+       packageKey         = fromStringRep BS.empty,
+       depends            = [],
+       importDirs         = [],
+       hsLibraries        = [],
+       extraLibraries     = [],
+       extraGHCiLibraries = [],
+       libraryDirs        = [],
+       frameworks         = [],
+       frameworkDirs      = [],
+       ldOptions          = [],
+       ccOptions          = [],
+       includes           = [],
+       includeDirs        = [],
+       haddockInterfaces  = [],
+       haddockHTMLs       = [],
+       exposedModules     = [],
+       hiddenModules      = [],
+       reexportedModules  = [],
+       exposed            = False,
+       trusted            = False
+  }
 
 -- | Read the part of the package DB that GHC is interested in.
 --
-readPackageDbForGhc :: FilePath -> IO [GhcPackageInfo]
+readPackageDbForGhc :: (BinaryStringRep a, BinaryStringRep b, BinaryStringRep c,
+                        BinaryStringRep d, BinaryStringRep e) =>
+                       FilePath -> IO [InstalledPackageInfo a b c d e]
 readPackageDbForGhc file =
     decodeFromFile file getDbForGhc
   where
     getDbForGhc = do
       _version    <- getHeader
       _ghcPartLen <- get :: Get Word32
-      ghcPart     <- get :: Get [GhcPackageInfo]
+      ghcPart     <- get
       -- the next part is for ghc-pkg, but we stop here.
       return ghcPart
 
@@ -99,7 +168,9 @@ readPackageDbForGhcPkg file =
 
 -- | Write the whole of the package DB, both parts.
 --
-writePackageDb :: Binary pkgs => FilePath -> [GhcPackageInfo] -> pkgs -> IO ()
+writePackageDb :: (Binary pkgs, BinaryStringRep a, BinaryStringRep b,
+                   BinaryStringRep c, BinaryStringRep d, BinaryStringRep e) =>
+                  FilePath -> [InstalledPackageInfo a b c d e] -> pkgs -> IO ()
 writePackageDb file ghcPkgs ghcPkgPart =
     writeFileAtomic file (runPut putDbForGhcPkg)
   where
@@ -197,10 +268,104 @@ writeFileAtomic targetPath content = do
         )
 
 
-instance Binary GhcPackageInfo where
-  put (GhcPackageInfo {-TODO-}) = do
-    return ()
+instance (BinaryStringRep a, BinaryStringRep b, BinaryStringRep c,
+          BinaryStringRep d, BinaryStringRep e) =>
+         Binary (InstalledPackageInfo a b c d e) where
+  put (InstalledPackageInfo
+         installedPackageId sourcePackageId packageName packageVersion packageKey
+         depends importDirs
+         hsLibraries extraLibraries extraGHCiLibraries libraryDirs
+         frameworks frameworkDirs
+         ldOptions ccOptions
+         includes includeDirs
+         haddockInterfaces haddockHTMLs
+         exposedModules hiddenModules reexportedModules
+         exposed trusted) = do
+    put (toStringRep installedPackageId)
+    put (toStringRep sourcePackageId)
+    put (toStringRep packageName)
+    put packageVersion
+    put (toStringRep packageKey)
+    put (map toStringRep depends)
+    put importDirs
+    put hsLibraries
+    put extraLibraries
+    put extraGHCiLibraries
+    put libraryDirs
+    put frameworks
+    put frameworkDirs
+    put ldOptions
+    put ccOptions
+    put includes
+    put includeDirs
+    put haddockInterfaces
+    put haddockHTMLs
+    put (map toStringRep exposedModules)
+    put (map toStringRep hiddenModules)
+    put reexportedModules
+    put exposed
+    put trusted
+
+  get = do
+    installedPackageId <- get
+    sourcePackageId    <- get
+    packageName        <- get
+    packageVersion     <- get
+    packageKey         <- get
+    depends            <- get
+    importDirs         <- get
+    hsLibraries        <- get
+    extraLibraries     <- get
+    extraGHCiLibraries <- get
+    libraryDirs        <- get
+    frameworks         <- get
+    frameworkDirs      <- get
+    ldOptions          <- get
+    ccOptions          <- get
+    includes           <- get
+    includeDirs        <- get
+    haddockInterfaces  <- get
+    haddockHTMLs       <- get
+    exposedModules     <- get
+    hiddenModules      <- get
+    reexportedModules  <- get
+    exposed            <- get
+    trusted            <- get
+    return (InstalledPackageInfo
+              (fromStringRep installedPackageId)
+              (fromStringRep sourcePackageId)
+              (fromStringRep packageName) packageVersion
+              (fromStringRep packageKey)
+              (map fromStringRep depends)
+              importDirs
+              hsLibraries extraLibraries extraGHCiLibraries libraryDirs
+              frameworks frameworkDirs
+              ldOptions ccOptions
+              includes includeDirs
+              haddockInterfaces haddockHTMLs
+              (map fromStringRep exposedModules)
+              (map fromStringRep hiddenModules)
+              reexportedModules
+              exposed trusted)
 
+instance Binary Version where
+  put (Version a b) = do
+    put a
+    put b
   get = do
-    return (GhcPackageInfo {-TODO-})
+    a <- get
+    b <- get
+    return (Version a b)
 
+instance (BinaryStringRep a, BinaryStringRep b) => Binary (ModuleExport a b) where
+  put (ModuleExport a b c) = do
+    put (toStringRep a)
+    put (toStringRep b)
+    put (toStringRep c)
+  get = do
+    a <- get
+    b <- get
+    c <- get
+    return (ModuleExport (fromStringRep a)
+                         (fromStringRep b)
+                         (fromStringRep c))
diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs
index 06205e3349..05d448833b 100644
--- a/utils/ghc-pkg/Main.hs
+++ b/utils/ghc-pkg/Main.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP, TypeSynonymInstances, FlexibleInstances #-}
 -----------------------------------------------------------------------------
 --
 -- (c) The University of Glasgow 2004-2009.
@@ -13,7 +13,9 @@ import Version ( version, targetOS, targetARCH )
 import qualified GHC.PackageDb as GhcPkg
 import Distribution.InstalledPackageInfo.Binary()
 import qualified Distribution.Simple.PackageIndex as PackageIndex
-import Distribution.ModuleName hiding (main)
+import qualified Distribution.Package as Cabal
+import qualified Distribution.ModuleName as ModuleName
+import Distribution.ModuleName (ModuleName)
 import Distribution.InstalledPackageInfo as Cabal
 import Distribution.Compat.ReadP
 import Distribution.ParseUtils
@@ -51,6 +53,7 @@ import GHC.IO.Exception (IOErrorType(InappropriateType))
 import Data.List
 import Control.Concurrent
 
+import qualified Data.ByteString.Char8 as BS
 import qualified Data.Binary as Bin
 import qualified Data.Binary.Get as Bin
 
@@ -1008,8 +1011,8 @@ updateDBCache verbosity db = do
       pkgsCabalFormat :: [InstalledPackageInfo]
       pkgsCabalFormat = packages db
 
-      pkgsGhcCacheFormat :: [GhcPkg.GhcPackageInfo]
-      pkgsGhcCacheFormat = [] -- TODO: for the moment
+      pkgsGhcCacheFormat :: [PackageCacheFormat]
+      pkgsGhcCacheFormat = map convertPackageInfoToCacheFormat pkgsCabalFormat
 
   when (verbosity > Normal) $
       infoLn ("writing cache " ++ filename)
@@ -1023,6 +1026,51 @@ updateDBCache verbosity db = do
   setFileTimes (location db) (accessTime status) (modificationTime status)
 #endif
 
+type PackageCacheFormat = GhcPkg.InstalledPackageInfo String String String String ModuleName
+
+convertPackageInfoToCacheFormat :: InstalledPackageInfo -> PackageCacheFormat
+convertPackageInfoToCacheFormat pkg =
+    GhcPkg.InstalledPackageInfo {
+       GhcPkg.installedPackageId = display (installedPackageId pkg),
+       GhcPkg.sourcePackageId    = display (sourcePackageId pkg),
+       GhcPkg.packageName        = display (packageName pkg),
+       GhcPkg.packageVersion     = packageVersion pkg,
+       GhcPkg.packageKey         = display (packageKey pkg),
+       GhcPkg.depends            = map display (depends pkg),
+       GhcPkg.importDirs         = importDirs pkg,
+       GhcPkg.hsLibraries        = hsLibraries pkg,
+       GhcPkg.extraLibraries     = extraLibraries pkg,
+       GhcPkg.extraGHCiLibraries = extraGHCiLibraries pkg,
+       GhcPkg.libraryDirs        = libraryDirs pkg,
+       GhcPkg.frameworks         = frameworks pkg,
+       GhcPkg.frameworkDirs      = frameworkDirs pkg,
+       GhcPkg.ldOptions          = ldOptions pkg,
+       GhcPkg.ccOptions          = ccOptions pkg,
+       GhcPkg.includes           = includes pkg,
+       GhcPkg.includeDirs        = includeDirs pkg,
+       GhcPkg.haddockInterfaces  = haddockInterfaces pkg,
+       GhcPkg.haddockHTMLs       = haddockHTMLs pkg,
+       GhcPkg.exposedModules     = exposedModules pkg,
+       GhcPkg.hiddenModules      = hiddenModules pkg,
+       GhcPkg.reexportedModules  = [ GhcPkg.ModuleExport m ipid' m'
+                                   | ModuleExport {
+                                       exportName = m,
+                                       exportCachedTrueOrig = Just (InstalledPackageId ipid', m')
+                                     } <- reexportedModules pkg
+                                   ],
+       GhcPkg.exposed            = exposed pkg,
+       GhcPkg.trusted            = trusted pkg
+    }
+
+instance GhcPkg.BinaryStringRep ModuleName where
+  fromStringRep = ModuleName.fromString . BS.unpack
+  toStringRep   = BS.pack . display
+
+instance GhcPkg.BinaryStringRep String where
+  fromStringRep = BS.unpack
+  toStringRep   = BS.pack
+
+
 -- -----------------------------------------------------------------------------
 -- Exposing, Hiding, Trusting, Distrusting, Unregistering are all similar
 
@@ -1631,8 +1679,8 @@ checkModules pkg = do
   where
     findModule modl =
       -- there's no interface file for GHC.Prim
-      unless (modl == fromString "GHC.Prim") $ do
-      let files = [ toFilePath modl <.> extension
+      unless (modl == ModuleName.fromString "GHC.Prim") $ do
+      let files = [ ModuleName.toFilePath modl <.> extension
                   | extension <- ["hi", "p_hi", "dyn_hi" ] ]
       m <- liftIO $ doesFileExistOnPath files (importDirs pkg)
       when (isNothing m) $