From 7c4b1aa1d8fcd66511f3b97f702515b8d389174f Mon Sep 17 00:00:00 2001
From: Duncan Coutts <duncan@haskell.org>
Date: Sat, 21 Jun 2008 01:37:27 +0000
Subject: [PATCH] Add compat InstalledPackageInfo types for older GHCs We need
 these types for their Read instances so that we can still read older GHCs
 package db files when we make changes to the current InstalledPackageInfo
 type, or the types contained in it, like PackageIdentifier or License.

---
 Cabal.cabal                       |   2 +
 Distribution/Simple/GHC.hs        |  25 ++++-
 Distribution/Simple/GHC/IPI641.hs | 122 +++++++++++++++++++++++
 Distribution/Simple/GHC/IPI642.hs | 155 ++++++++++++++++++++++++++++++
 Makefile                          |   2 +-
 5 files changed, 301 insertions(+), 5 deletions(-)
 create mode 100644 Distribution/Simple/GHC/IPI641.hs
 create mode 100644 Distribution/Simple/GHC/IPI642.hs

diff --git a/Cabal.cabal b/Cabal.cabal
index c8302e97df..c57d89379d 100644
--- a/Cabal.cabal
+++ b/Cabal.cabal
@@ -97,5 +97,7 @@ Library
         Distribution.GetOpt,
         Distribution.Compat.TempFile
         Distribution.Simple.GHC.Makefile
+        Distribution.Simple.GHC.IPI641
+        Distribution.Simple.GHC.IPI642
 
   Extensions: CPP
diff --git a/Distribution/Simple/GHC.hs b/Distribution/Simple/GHC.hs
index 41bca9228b..107005cba9 100644
--- a/Distribution/Simple/GHC.hs
+++ b/Distribution/Simple/GHC.hs
@@ -49,6 +49,8 @@ module Distribution.Simple.GHC (
  ) where
 
 import Distribution.Simple.GHC.Makefile
+import qualified Distribution.Simple.GHC.IPI641 as IPI641
+import qualified Distribution.Simple.GHC.IPI642 as IPI642
 import Distribution.Simple.Setup ( MakefileFlags(..),
                                    fromFlag, fromFlagOrDefault)
 import Distribution.PackageDescription
@@ -324,11 +326,26 @@ getInstalledPackages' verbosity packagedbs conf = do
           (SpecificPackageDB specific, _)  -> return $ Just specific
           _ -> die "cannot read ghc-pkg package listing"
     pkgFiles' <- mapM dbFile packagedbs
-    sequence [ withFileContents file $ \content ->
-                  case reads content of
-                    [(pkgs, _)] -> return (db, pkgs)
-                    _ -> die $ "cannot read ghc package database " ++ file
+    sequence [ withFileContents file $ \content -> do
+                  pkgs <- readPackages file content
+                  return (db, pkgs)
              | (db , Just file) <- zip packagedbs pkgFiles' ]
+  where
+    -- Depending on the version of ghc we use a different type's Read
+    -- instance to parse the package file and then convert.
+    -- It's a bit yuck. But that's what we get for using Read/Show.
+    readPackages
+      | ghcVersion >= Version [6,4,2] []
+      = \file content -> case reads content of
+          [(pkgs, _)] -> return (map IPI642.toCurrent pkgs)
+          _           -> failToRead file
+      | otherwise
+      = \file content -> case reads content of
+          [(pkgs, _)] -> return (map IPI641.toCurrent pkgs)
+          _           -> failToRead file
+    Just ghcProg = lookupProgram ghcProgram conf
+    Just ghcVersion = programVersion ghcProg
+    failToRead file = die $ "cannot read ghc package database " ++ file
 
 -- -----------------------------------------------------------------------------
 -- Building
diff --git a/Distribution/Simple/GHC/IPI641.hs b/Distribution/Simple/GHC/IPI641.hs
new file mode 100644
index 0000000000..3fa1b847de
--- /dev/null
+++ b/Distribution/Simple/GHC/IPI641.hs
@@ -0,0 +1,122 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Distribution.Simple.GHC.IPI641
+-- Copyright   :  (c) The University of Glasgow 2004
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  alpha
+-- Portability :  portable
+--
+
+{- All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of the University nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
+
+module Distribution.Simple.GHC.IPI641 (
+    InstalledPackageInfo,
+    toCurrent,
+  ) where
+
+import qualified Distribution.InstalledPackageInfo as Current
+
+import Distribution.Simple.GHC.IPI642
+         ( PackageIdentifier, convertPackageId
+         , License, convertLicense, convertModuleName )
+
+-- | This is the InstalledPackageInfo type used by ghc-6.4 and 6.4.1. 
+--
+-- It's here purely for the 'Read' instance so that we can read the package
+-- database used by those ghc versions. It is a little hacky to read the
+-- package db directly, but we do need the info and until ghc-6.9 there was
+-- no better method.
+--
+-- In ghc-6.4.2 the format changed a bit. See "Distribution.Simple.GHC.IPI642"
+--
+data InstalledPackageInfo = InstalledPackageInfo {
+    package           :: PackageIdentifier,
+    license           :: License,
+    copyright         :: String,
+    maintainer        :: String,
+    author            :: String,
+    stability         :: String,
+    homepage          :: String,
+    pkgUrl            :: String,
+    description       :: String,
+    category          :: String,
+    exposed           :: Bool,
+    exposedModules    :: [String],
+    hiddenModules     :: [String],
+    importDirs        :: [FilePath],
+    libraryDirs       :: [FilePath],
+    hsLibraries       :: [String],
+    extraLibraries    :: [String],
+    includeDirs       :: [FilePath],
+    includes          :: [String],
+    depends           :: [PackageIdentifier],
+    hugsOptions       :: [String],
+    ccOptions         :: [String],
+    ldOptions         :: [String],
+    frameworkDirs     :: [FilePath],
+    frameworks        :: [String],
+    haddockInterfaces :: [FilePath],
+    haddockHTMLs      :: [FilePath]
+  }
+  deriving Read
+
+toCurrent :: InstalledPackageInfo -> Current.InstalledPackageInfo
+toCurrent ipi@InstalledPackageInfo{} = Current.InstalledPackageInfo {
+    Current.package            = convertPackageId (package ipi),
+    Current.license            = convertLicense (license ipi),
+    Current.copyright          = copyright ipi,
+    Current.maintainer         = maintainer ipi,
+    Current.author             = author ipi,
+    Current.stability          = stability ipi,
+    Current.homepage           = homepage ipi,
+    Current.pkgUrl             = pkgUrl ipi,
+    Current.description        = description ipi,
+    Current.category           = category ipi,
+    Current.exposed            = exposed ipi,
+    Current.exposedModules     = map convertModuleName (exposedModules ipi),
+    Current.hiddenModules      = map convertModuleName (hiddenModules ipi),
+    Current.importDirs         = importDirs ipi,
+    Current.libraryDirs        = libraryDirs ipi,
+    Current.hsLibraries        = hsLibraries ipi,
+    Current.extraLibraries     = extraLibraries ipi,
+    Current.extraGHCiLibraries = [],
+    Current.includeDirs        = includeDirs ipi,
+    Current.includes           = includes ipi,
+    Current.depends            = map convertPackageId (depends ipi),
+    Current.hugsOptions        = hugsOptions ipi,
+    Current.ccOptions          = ccOptions ipi,
+    Current.ldOptions          = ldOptions ipi,
+    Current.frameworkDirs      = frameworkDirs ipi,
+    Current.frameworks         = frameworks ipi,
+    Current.haddockInterfaces  = haddockInterfaces ipi,
+    Current.haddockHTMLs       = haddockHTMLs ipi
+  }
diff --git a/Distribution/Simple/GHC/IPI642.hs b/Distribution/Simple/GHC/IPI642.hs
new file mode 100644
index 0000000000..8eda5ea89a
--- /dev/null
+++ b/Distribution/Simple/GHC/IPI642.hs
@@ -0,0 +1,155 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Distribution.Simple.GHC.IPI642
+-- Copyright   :  (c) The University of Glasgow 2004
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  alpha
+-- Portability :  portable
+--
+
+{- All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of the University nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
+
+module Distribution.Simple.GHC.IPI642 (
+    InstalledPackageInfo,
+    toCurrent,
+
+    -- Don't use these, they're only for conversion purposes
+    PackageIdentifier, convertPackageId,
+    License, convertLicense,
+    convertModuleName
+  ) where
+
+import qualified Distribution.InstalledPackageInfo as Current
+import qualified Distribution.Package as Current hiding (depends)
+import qualified Distribution.License as Current
+
+import Distribution.Version (Version)
+
+-- | This is the InstalledPackageInfo type used by ghc-6.4.2 and later.
+--
+-- It's here purely for the 'Read' instance so that we can read the package
+-- database used by those ghc versions. It is a little hacky to read the
+-- package db directly, but we do need the info and until ghc-6.9 there was
+-- no better method.
+--
+-- In ghc-6.4.1 and before the format was slightly different.
+-- See "Distribution.Simple.GHC.IPI642"
+--
+data InstalledPackageInfo = InstalledPackageInfo {
+    package           :: PackageIdentifier,
+    license           :: License,
+    copyright         :: String,
+    maintainer        :: String,
+    author            :: String,
+    stability         :: String,
+    homepage          :: String,
+    pkgUrl            :: String,
+    description       :: String,
+    category          :: String,
+    exposed           :: Bool,
+    exposedModules    :: [String],
+    hiddenModules     :: [String],
+    importDirs        :: [FilePath],
+    libraryDirs       :: [FilePath],
+    hsLibraries       :: [String],
+    extraLibraries    :: [String],
+    extraGHCiLibraries:: [String],
+    includeDirs       :: [FilePath],
+    includes          :: [String],
+    depends           :: [PackageIdentifier],
+    hugsOptions       :: [String],
+    ccOptions         :: [String],
+    ldOptions         :: [String],
+    frameworkDirs     :: [FilePath],
+    frameworks        :: [String],
+    haddockInterfaces :: [FilePath],
+    haddockHTMLs      :: [FilePath]
+  }
+  deriving Read
+
+data PackageIdentifier = PackageIdentifier {
+    pkgName    :: String,
+    pkgVersion :: Version
+  }
+  deriving Read
+
+data License = GPL | LGPL | BSD3 | BSD4
+             | PublicDomain | AllRightsReserved | OtherLicense
+  deriving Read
+
+convertPackageId :: PackageIdentifier -> Current.PackageIdentifier
+convertPackageId PackageIdentifier { pkgName = n, pkgVersion = v } =
+  Current.PackageIdentifier (Current.PackageName n) v
+
+convertModuleName :: String -> String
+convertModuleName s = s
+
+convertLicense :: License -> Current.License
+convertLicense GPL  = Current.GPL
+convertLicense LGPL = Current.LGPL
+convertLicense BSD3 = Current.BSD3
+convertLicense BSD4 = Current.BSD4
+convertLicense PublicDomain = Current.PublicDomain
+convertLicense AllRightsReserved = Current.AllRightsReserved
+convertLicense OtherLicense = Current.OtherLicense
+
+toCurrent :: InstalledPackageInfo -> Current.InstalledPackageInfo
+toCurrent ipi@InstalledPackageInfo{} = Current.InstalledPackageInfo {
+    Current.package            = convertPackageId (package ipi),
+    Current.license            = convertLicense (license ipi),
+    Current.copyright          = copyright ipi,
+    Current.maintainer         = maintainer ipi,
+    Current.author             = author ipi,
+    Current.stability          = stability ipi,
+    Current.homepage           = homepage ipi,
+    Current.pkgUrl             = pkgUrl ipi,
+    Current.description        = description ipi,
+    Current.category           = category ipi,
+    Current.exposed            = exposed ipi,
+    Current.exposedModules     = map convertModuleName (exposedModules ipi),
+    Current.hiddenModules      = map convertModuleName (hiddenModules ipi),
+    Current.importDirs         = importDirs ipi,
+    Current.libraryDirs        = libraryDirs ipi,
+    Current.hsLibraries        = hsLibraries ipi,
+    Current.extraLibraries     = extraLibraries ipi,
+    Current.extraGHCiLibraries = extraGHCiLibraries ipi,
+    Current.includeDirs        = includeDirs ipi,
+    Current.includes           = includes ipi,
+    Current.depends            = map convertPackageId (depends ipi),
+    Current.hugsOptions        = hugsOptions ipi,
+    Current.ccOptions          = ccOptions ipi,
+    Current.ldOptions          = ldOptions ipi,
+    Current.frameworkDirs      = frameworkDirs ipi,
+    Current.frameworks         = frameworks ipi,
+    Current.haddockInterfaces  = haddockInterfaces ipi,
+    Current.haddockHTMLs       = haddockHTMLs ipi
+  }
diff --git a/Makefile b/Makefile
index 5ef33df198..b8e5d74d8f 100644
--- a/Makefile
+++ b/Makefile
@@ -13,7 +13,7 @@ all: build
 
 # build the library itself
 
-SOURCES=Distribution/*.hs Distribution/Simple/*.hs Distribution/PackageDescription/*.hs
+SOURCES=Distribution/*.hs Distribution/Simple/*.hs Distribution/PackageDescription/*.hs Distribution/Simple/GHC/*.hs
 CONFIG_STAMP=dist/setup-config
 BUILD_STAMP=dist/build/libHSCabal-$(VERSION).a
 HADDOCK_STAMP=dist/doc/html/Cabal/index.html
-- 
GitLab