darcs patch: Add a unuque identifier for installed packages

Simon Marlow marlowsd at gmail.com
Wed Jul 29 11:42:35 EDT 2009


This is a new version of the installedPackageId patch for review.

The only change since last time is that instead of making up a random 
string for the installedPackageId, we now call

   ghc --abi-hash M1 M2 ...

to get a string representing a hash of the package ABI, where M1, M2 
etc. are the exposed modules of the package.   GHC's --abi-hash flag has 
not been pushed yet; I'm waiting to get the go-ahead on this patch and 
then I can push it all together.

The upshot is that if you compile and install the same package twice, 
without changing anything, there's a reasonable chance you'll get the 
same InstalledPackageId the second time (I say reasonable chance, 
because GHC's ABI hashes are not completely stable).

I can validate GHC with this patch (and related GHC changes), but I 
haven't tested much beyond that.

Cheers,
	Simon
-------------- next part --------------
Wed Jul 29 14:49:54 BST 2009  Simon Marlow <marlowsd at gmail.com>
  * Add a unuque identifier for installed packages
  
  The idea behind this patch is to add a new identifier for
  installed packages.  This lets us decouple the identity of an
  installed package instance from its package name and version.
  The benefits of this are
  
    - We get to detect when a package is broken because its
      dependencies have been recompiled, or because it is being
      used with a different package than it was compiled against.
  
    - We have the possibility of having multiple instances of a
      given <package>-<version> installed at the same time.  In the
      future this might be used for "ways".  It might also be
      useful during the process of upgrading/recompiling packages.
  
  Some commentary on this is at
  
  http://hackage.haskell.org/trac/ghc/wiki/Commentary/Packages
  
  The changes in detail:
  
  D.Package: Add InstalledPackageId type
  
  D.InstalledPackageInfo: Add installedPackageId field, and change
  the type of depends to [InstalledPackageId].
  
  D.S.PackageIndex: add InstalledPackageIndex (a Map from
  InstalledPackageId to InstalledPackageInfo), and change
  brokenPackages and dependencyClosure to operate over it.
  
  D.S.LocalBuildInfo: we now have 
    componentInstalledPackageDeps :: [InstalledPackageId]
  rather than
    componentPackageDeps :: [PackageIdentifier]
  in LocalBuildInfo.  Added the above as a function, rather than a field.
  
  D.S.Register: at registration time, we pick a string for the
  InstalledPackageInfo.  We use a string of the form <packageid>-<hash>,
  where <hash> is the ABI hash of the package, generated by "ghc
  --abi-hash" (if available, or the string "installed" otherwise).  When
  registering with --inplace, because the package might not be built
  yet, we use the string "inplace" for <hash>.
  
  D.S.P.HcPkg: if we read an InstalledPackageInfo from an older
  GHC, we have to fill in the installedPackageId as the
  PackageIdentifier.
  
  The rest of the changes are just compensating for the above.
  
  Note that this patch requires corresponding changes to the GHC
  sources.

New patches:

[Add a unuque identifier for installed packages
Simon Marlow <marlowsd at gmail.com>**20090729134954
 Ignore-this: 779c1daf4857137b026583acda56b417
 
 The idea behind this patch is to add a new identifier for
 installed packages.  This lets us decouple the identity of an
 installed package instance from its package name and version.
 The benefits of this are
 
   - We get to detect when a package is broken because its
     dependencies have been recompiled, or because it is being
     used with a different package than it was compiled against.
 
   - We have the possibility of having multiple instances of a
     given <package>-<version> installed at the same time.  In the
     future this might be used for "ways".  It might also be
     useful during the process of upgrading/recompiling packages.
 
 Some commentary on this is at
 
 http://hackage.haskell.org/trac/ghc/wiki/Commentary/Packages
 
 The changes in detail:
 
 D.Package: Add InstalledPackageId type
 
 D.InstalledPackageInfo: Add installedPackageId field, and change
 the type of depends to [InstalledPackageId].
 
 D.S.PackageIndex: add InstalledPackageIndex (a Map from
 InstalledPackageId to InstalledPackageInfo), and change
 brokenPackages and dependencyClosure to operate over it.
 
 D.S.LocalBuildInfo: we now have 
   componentInstalledPackageDeps :: [InstalledPackageId]
 rather than
   componentPackageDeps :: [PackageIdentifier]
 in LocalBuildInfo.  Added the above as a function, rather than a field.
 
 D.S.Register: at registration time, we pick a string for the
 InstalledPackageInfo.  We use a string of the form <packageid>-<hash>,
 where <hash> is the ABI hash of the package, generated by "ghc
 --abi-hash" (if available, or the string "installed" otherwise).  When
 registering with --inplace, because the package might not be built
 yet, we use the string "inplace" for <hash>.
 
 D.S.P.HcPkg: if we read an InstalledPackageInfo from an older
 GHC, we have to fill in the installedPackageId as the
 PackageIdentifier.
 
 The rest of the changes are just compensating for the above.
 
 Note that this patch requires corresponding changes to the GHC
 sources.
] {
hunk ./Distribution/InstalledPackageInfo.hs 71
          , simpleField, listField, parseLicenseQ
          , showFields, showSingleNamedField, parseFields
          , parseFilePathQ, parseTokenQ, parseModuleNameQ, parsePackageNameQ
-         , showFilePath, showToken, boolField, parseOptVersion, parseQuoted
+         , showFilePath, showToken, boolField, parseOptVersion
          , parseFreeText, showFreeText )
 import Distribution.License     ( License(..) )
 import Distribution.Package
hunk ./Distribution/InstalledPackageInfo.hs 75
-         ( PackageName(..), PackageIdentifier(..)
+         ( PackageName(..), PackageIdentifier(..), InstalledPackageId(..)
          , packageName, packageVersion )
 import qualified Distribution.Package as Package
hunk ./Distribution/InstalledPackageInfo.hs 78
-         ( Package(..), PackageFixedDeps(..) )
+         ( Package(..) )
 import Distribution.ModuleName
          ( ModuleName )
 import Distribution.Version
hunk ./Distribution/InstalledPackageInfo.hs 85
          ( Version(..) )
 import Distribution.Text
          ( Text(disp, parse) )
-import qualified Distribution.Compat.ReadP as ReadP
 
 -- -----------------------------------------------------------------------------
 -- The InstalledPackageInfo type
hunk ./Distribution/InstalledPackageInfo.hs 93
    = InstalledPackageInfo {
         -- these parts are exactly the same as PackageDescription
         package           :: PackageIdentifier,
+        installedPackageId :: InstalledPackageId,
         license           :: License,
         copyright         :: String,
         maintainer        :: String,
hunk ./Distribution/InstalledPackageInfo.hs 114
         extraGHCiLibraries:: [String],    -- overrides extraLibraries for GHCi
         includeDirs       :: [FilePath],
         includes          :: [String],
-        depends           :: [PackageIdentifier],
+        depends           :: [InstalledPackageId],
         hugsOptions       :: [String],
         ccOptions         :: [String],
         ldOptions         :: [String],
hunk ./Distribution/InstalledPackageInfo.hs 127
 
 instance Package.Package          (InstalledPackageInfo_ str) where
    packageId = package
-instance Package.PackageFixedDeps (InstalledPackageInfo_ str) where
-   depends   = depends
 
 type InstalledPackageInfo = InstalledPackageInfo_ ModuleName
 
hunk ./Distribution/InstalledPackageInfo.hs 134
 emptyInstalledPackageInfo
    = InstalledPackageInfo {
         package           = PackageIdentifier (PackageName "") noVersion,
+        installedPackageId = InstalledPackageId "",
         license           = AllRightsReserved,
         copyright         = "",
         maintainer        = "",
hunk ./Distribution/InstalledPackageInfo.hs 196
  , simpleField "version"
                            disp                   parseOptVersion
                            packageVersion         (\ver pkg -> pkg{package=(package pkg){pkgVersion=ver}})
+ , simpleField "id"
+                           disp                   parse
+                           installedPackageId     (\ipid pkg -> pkg{installedPackageId=ipid})
  , simpleField "license"
                            disp                   parseLicenseQ
                            license                (\l pkg -> pkg{license=l})
hunk ./Distribution/InstalledPackageInfo.hs 260
         showFilePath       parseFilePathQ
         includes           (\xs pkg -> pkg{includes=xs})
  , listField   "depends"
-        disp               parsePackageId'
+        disp               parse
         depends            (\xs pkg -> pkg{depends=xs})
  , listField   "hugs-options"
         showToken          parseTokenQ
hunk ./Distribution/InstalledPackageInfo.hs 284
         showFilePath       parseFilePathQ
         haddockHTMLs       (\xs pkg -> pkg{haddockHTMLs=xs})
  ]
-
-parsePackageId' :: ReadP.ReadP [PackageIdentifier] PackageIdentifier
-parsePackageId' = parseQuoted parse ReadP.<++ parse
hunk ./Distribution/Package.hs 50
         PackageIdentifier(..),
         PackageId,
 
-        -- * Package dependencies
+        -- * Installed package identifiers
+        InstalledPackageId(..),
+
+        -- * Package source dependencies
         Dependency(..),
         thisPackageVersion,
         notThisPackageVersion,
hunk ./Distribution/Package.hs 72
 import qualified Distribution.Compat.ReadP as Parse
 import Distribution.Compat.ReadP ((<++))
 import qualified Text.PrettyPrint as Disp
-import Text.PrettyPrint ((<>), (<+>))
+import Text.PrettyPrint ((<>), (<+>), text)
 import qualified Data.Char as Char ( isDigit, isAlphaNum )
 import Data.List ( intersperse )
 
hunk ./Distribution/Package.hs 113
     return (PackageIdentifier n v)
 
 -- ------------------------------------------------------------
--- * Package dependencies
+-- * Installed Package Ids
+-- ------------------------------------------------------------
+
+-- | An InstalledPackageId uniquely identifies a package instance.
+-- There can be at most one package with a given 'InstalledPackageId'
+-- in a package database, or overlay of databases.
+--
+newtype InstalledPackageId = InstalledPackageId String
+ deriving (Read,Show,Eq,Ord)
+
+instance Text InstalledPackageId where
+  disp (InstalledPackageId str) = text str
+
+  parse = InstalledPackageId `fmap` Parse.munch1 abi_char
+   where abi_char c = Char.isAlphaNum c || c `elem` ":-_."
+
+-- ------------------------------------------------------------
+-- * Package source dependencies
 -- ------------------------------------------------------------
 
hunk ./Distribution/Package.hs 133
+-- | describes a source (API) dependency
 data Dependency = Dependency PackageName VersionRange
                   deriving (Read, Show, Eq)
 
hunk ./Distribution/Simple/Build/Macros.hs 24
   ) where
 
 import Distribution.Package
-         ( PackageIdentifier(PackageIdentifier) )
+         ( PackageIdentifier(PackageIdentifier), packageId )
 import Distribution.Version
          ( Version(versionBranch) )
 import Distribution.PackageDescription
hunk ./Distribution/Simple/Build/Macros.hs 30
          ( PackageDescription )
 import Distribution.Simple.LocalBuildInfo
-        ( LocalBuildInfo, externalPackageDeps )
+        ( LocalBuildInfo, externalPackageDeps, getLocalPackageInfo )
 import Distribution.Text
          ( display )
 
hunk ./Distribution/Simple/Build/Macros.hs 49
     ,"  (major1) == ",major1," && (major2) == ",major2," && (minor) <= ",minor
     ,"\n\n"
     ]
-  | pkgid@(PackageIdentifier name version) <- externalPackageDeps lbi
+  | pkgid@(PackageIdentifier name version) <- 
+      map (packageId . getLocalPackageInfo lbi) $ externalPackageDeps lbi
   , let (major1:major2:minor:_) = map show (versionBranch version ++ repeat 0)
         pkgname = map fixchar (display name)
   ]
hunk ./Distribution/Simple/Configure.hs 73
     ( CompilerFlavor(..), Compiler(compilerId), compilerFlavor, compilerVersion
     , showCompilerId, unsupportedExtensions, PackageDB(..), PackageDBStack )
 import Distribution.Package
-    ( PackageName(PackageName), PackageId, PackageIdentifier(PackageIdentifier)
+    ( PackageName(PackageName), PackageIdentifier(PackageIdentifier)
     , packageName, packageVersion, Package(..)
hunk ./Distribution/Simple/Configure.hs 75
-    , Dependency(Dependency), simplifyDependency )
+    , Dependency(Dependency), simplifyDependency
+    , InstalledPackageId(..) )
 import Distribution.InstalledPackageInfo
     ( InstalledPackageInfo, emptyInstalledPackageInfo )
 import qualified Distribution.InstalledPackageInfo as Installed
hunk ./Distribution/Simple/Configure.hs 308
         -- If we later allowed private internal libraries, then here we would
         -- need to pre-scan the conditional data to make a list of all private
         -- libraries that could possibly be defined by the .cabal file.
-        let internalPackageSet = PackageIndex.fromList [ emptyInstalledPackageInfo {
-                  Installed.package = packageId pkg_descr0
+        let pid = packageId pkg_descr0
+            internalPackageSet = PackageIndex.fromList [ emptyInstalledPackageInfo {
+                  Installed.installedPackageId = InstalledPackageId $ display $ pid,
+                  Installed.package = pid
               } ]
         maybeInstalledPackageSet <- getInstalledPackages (lessVerbose verbosity) comp
                                       packageDbs programsConfig'
hunk ./Distribution/Simple/Configure.hs 315
+
         -- The merge of the internal and installed packages
hunk ./Distribution/Simple/Configure.hs 317
-        let maybePackageSet = (`PackageIndex.merge` internalPackageSet)
-                                                    `fmap` maybeInstalledPackageSet
+        let maybePackageSet = fmap (PackageIndex.merge internalPackageSet) $
+                              maybeInstalledPackageSet
 
         (pkg_descr0', flags) <-
                 case finalizePackageDescription
hunk ./Distribution/Simple/Configure.hs 364
                   -- note that these bogus packages have no other dependencies
                 }
               | bogusPackageId <- bogusDependencies ]
+
+            configDependencies =
+                 mapM (configDependency verbosity internalPackageSet
+                       installedPackageSet) $
+                 buildDepends pkg_descr
+
         allPkgDeps <- case flavor of
hunk ./Distribution/Simple/Configure.hs 371
-          GHC -> mapM (configDependency verbosity internalPackageSet installedPackageSet) (buildDepends pkg_descr)
-          JHC -> mapM (configDependency verbosity internalPackageSet installedPackageSet) (buildDepends pkg_descr)
-          LHC -> mapM (configDependency verbosity internalPackageSet installedPackageSet) (buildDepends pkg_descr)
+          GHC -> configDependencies
+          JHC -> configDependencies
+          LHC -> configDependencies
           _   -> return bogusDependencies
 
         let (internalPkgDeps, externalPkgDeps) = partition (isInternalPackage pkg_descr) allPkgDeps
hunk ./Distribution/Simple/Configure.hs 385
                ++ "package. To use this feature the package must specify at "
                ++ "least 'cabal-version: >= 1.8'."
 
+        let installedPackageIndex =
+               PackageIndex.listToInstalledPackageIndex $
+               PackageIndex.allPackages packageSet
+
+            getInstalledPkg pkgid =
+              case PackageIndex.lookupPackageId packageSet pkgid of
+                Nothing  -> error ("getInstalledPkgId: " ++ display pkgid)
+                Just ipi -> ipi
+
+            allDepIPIs :: [InstalledPackageInfo]
+            allDepIPIs = map getInstalledPkg allPkgDeps
+
+            externalDepIPIs :: [InstalledPackageInfo]
+            externalDepIPIs = map getInstalledPkg externalPkgDeps
+
         packageDependsIndex <-
hunk ./Distribution/Simple/Configure.hs 401
-          case PackageIndex.dependencyClosure packageSet externalPkgDeps of
+          case PackageIndex.dependencyClosure installedPackageIndex
+                  (map Installed.installedPackageId externalDepIPIs) of
             Left packageDependsIndex -> return packageDependsIndex
             Right broken ->
               die $ "The following installed packages are broken because other"
hunk ./Distribution/Simple/Configure.hs 415
                             | (pkg, deps) <- broken ]
 
         let pseudoTopPkg = emptyInstalledPackageInfo {
+                Installed.installedPackageId = InstalledPackageId (display (packageId pkg_descr)),
                 Installed.package = packageId pkg_descr,
hunk ./Distribution/Simple/Configure.hs 417
-                Installed.depends = allPkgDeps
+                Installed.depends = map Installed.installedPackageId allDepIPIs
               }
         case PackageIndex.dependencyInconsistencies
hunk ./Distribution/Simple/Configure.hs 420
-           . PackageIndex.insert pseudoTopPkg
+           . PackageIndex.addToInstalledPackageIndex pseudoTopPkg
            $ packageDependsIndex of
           [] -> return ()
           inconsistencies ->
hunk ./Distribution/Simple/Configure.hs 470
         let configLib lib = configComponent (libBuildInfo lib)
             configExe exe = (exeName exe, configComponent(buildInfo exe))
             configComponent bi = ComponentLocalBuildInfo {
-              componentPackageDeps =
+              componentInstalledPackageDeps =
                 if newPackageDepsBehaviour pkg_descr'
hunk ./Distribution/Simple/Configure.hs 472
-                  then selectDependencies bi allPkgDeps
-                  else allPkgDeps
+                  then map Installed.installedPackageId $ selectDependencies bi allDepIPIs
+                  else map Installed.installedPackageId $ allDepIPIs
             }
hunk ./Distribution/Simple/Configure.hs 475
-            selectDependencies :: BuildInfo -> [PackageId] -> [PackageId]
+            selectDependencies :: BuildInfo -> [InstalledPackageInfo]
+                               -> [InstalledPackageInfo]
             selectDependencies bi pkgs =
                 [ pkg | pkg <- pkgs, packageName pkg `elem` names ]
               where
hunk ./Distribution/Simple/Configure.hs 547
           in pkg_descr{ library     = modifyLib        `fmap` library pkg_descr
                       , executables = modifyExecutable  `map` executables pkg_descr}
 
-
 -- -----------------------------------------------------------------------------
 -- Configuring package dependencies
 
hunk ./Distribution/Simple/GHC.hs 67
         configure, getInstalledPackages,
         buildLib, buildExe,
         installLib, installExe,
+        libAbiHash,
         ghcOptions,
         ghcVerbosityOptions
  ) where
hunk ./Distribution/Simple/GHC.hs 86
 import Distribution.Simple.PackageIndex
 import qualified Distribution.Simple.PackageIndex as PackageIndex
 import Distribution.Simple.LocalBuildInfo
-         ( LocalBuildInfo(..), ComponentLocalBuildInfo(..) )
+         ( LocalBuildInfo(..), ComponentLocalBuildInfo(..),
+           componentPackageDeps )
 import Distribution.Simple.InstallDirs
 import Distribution.Simple.BuildPaths
 import Distribution.Simple.Utils
hunk ./Distribution/Simple/GHC.hs 473
   createDirectoryIfMissingVerbose verbosity True libTargetDir
   -- TODO: do we need to put hs-boot files into place for mutually recurive modules?
   let ghcArgs =
-             ["-package-name", display pkgid ]
+             "--make"
+          :  ["-package-name", display pkgid ]
           ++ constructGHCCmdLine lbi libBi clbi libTargetDir verbosity
           ++ map display (libModules lib)
       ghcArgsProf = ghcArgs
hunk ./Distribution/Simple/GHC.hs 573
               "-o", sharedLibFilePath ]
             ++ dynamicObjectFiles
             ++ ["-package-name", display pkgid ]
-            ++ (concat [ ["-package", display pkg] | pkg <- componentPackageDeps clbi ])
+            ++ (concat [ ["-package", display pkg] | pkg <- componentPackageDeps lbi clbi ])
             ++ ["-l"++extraLib | extraLib <- extraLibs libBi]
             ++ ["-L"++extraLibDir | extraLibDir <- extraLibDirs libBi]
 
hunk ./Distribution/Simple/GHC.hs 632
 
   let cObjs = map (`replaceExtension` objExtension) (cSources exeBi)
   let binArgs linkExe profExe =
-             (if linkExe
+             "--make"
+          :  (if linkExe
                  then ["-o", targetDir </> exeNameReal]
                  else ["-c"])
           ++ constructGHCCmdLine lbi exeBi clbi exeDir verbosity
hunk ./Distribution/Simple/GHC.hs 698
         return [ pref </> ModuleName.toFilePath x <.> wanted_obj_ext
                | x <- libModules lib ]
 
+libAbiHash :: Verbosity -> PackageDescription -> LocalBuildInfo
+           -> Library -> ComponentLocalBuildInfo -> IO String
+libAbiHash verbosity pkg_descr lbi lib clbi = do
+  libBi <- hackThreadedFlag verbosity
+             (compiler lbi) (withProfLib lbi) (libBuildInfo lib)
+  let
+      ghcArgs =
+             "--abi-hash"
+          :  ["-package-name", display (packageId pkg_descr) ]
+          ++ constructGHCCmdLine lbi libBi clbi (buildDir lbi) verbosity
+          ++ map display (exposedModules lib)
+  --
+  rawSystemProgramStdoutConf verbosity ghcProgram (withPrograms lbi) ghcArgs
+
 
 constructGHCCmdLine
         :: LocalBuildInfo
hunk ./Distribution/Simple/GHC.hs 721
         -> Verbosity
         -> [String]
 constructGHCCmdLine lbi bi clbi odir verbosity =
-        ["--make"]
-     ++ ghcVerbosityOptions verbosity
+        ghcVerbosityOptions verbosity
         -- Unsupported extensions have already been checked by configure
      ++ ghcOptions lbi bi clbi odir
 
hunk ./Distribution/Simple/GHC.hs 752
      ++ [ "-odir",  odir, "-hidir", odir ]
      ++ (if compilerVersion c >= Version [6,8] []
            then ["-stubdir", odir] else [])
-     ++ (concat [ ["-package", display pkg] | pkg <- componentPackageDeps clbi ])
+     ++ (concat [ ["-package", display pkg] | pkg <- componentPackageDeps lbi clbi ])
      ++ (case withOptimization lbi of
            NoOptimisation      -> []
            NormalOptimisation  -> ["-O"]
hunk ./Distribution/Simple/GHC.hs 792
 ghcCcOptions lbi bi clbi odir
      =  ["-I" ++ dir | dir <- PD.includeDirs bi]
      ++ ghcPackageDbOptions (withPackageDB lbi)
-     ++ concat [ ["-package", display pkg] | pkg <- componentPackageDeps clbi ]
+     ++ concat [ ["-package", display pkg] | pkg <- componentPackageDeps lbi clbi ]
      ++ ["-optc" ++ opt | opt <- PD.ccOptions bi]
      ++ (case withOptimization lbi of
            NoOptimisation -> []
hunk ./Distribution/Simple/GHC/IPI641.hs 46
   ) where
 
 import qualified Distribution.InstalledPackageInfo as Current
+import qualified Distribution.Package as Current hiding (depends)
+import Distribution.Text (display)
 
 import Distribution.Simple.GHC.IPI642
          ( PackageIdentifier, convertPackageId
hunk ./Distribution/Simple/GHC/IPI641.hs 93
   }
   deriving Read
 
+mkInstalledPackageId :: Current.PackageIdentifier -> Current.InstalledPackageId
+mkInstalledPackageId = Current.InstalledPackageId . display
+
 toCurrent :: InstalledPackageInfo -> Current.InstalledPackageInfo
 toCurrent ipi at InstalledPackageInfo{} = Current.InstalledPackageInfo {
hunk ./Distribution/Simple/GHC/IPI641.hs 98
+    Current.installedPackageId = mkInstalledPackageId (convertPackageId (package ipi)),
     Current.package            = convertPackageId (package ipi),
     Current.license            = convertLicense (license ipi),
     Current.copyright          = copyright ipi,
hunk ./Distribution/Simple/GHC/IPI641.hs 119
     Current.extraGHCiLibraries = [],
     Current.includeDirs        = includeDirs ipi,
     Current.includes           = includes ipi,
-    Current.depends            = map convertPackageId (depends ipi),
+    Current.depends            = map (mkInstalledPackageId.convertPackageId) (depends ipi),
     Current.hugsOptions        = hugsOptions ipi,
     Current.ccOptions          = ccOptions ipi,
     Current.ldOptions          = ldOptions ipi,
hunk ./Distribution/Simple/GHC/IPI642.hs 56
 
 import Distribution.Version (Version)
 import Distribution.ModuleName (ModuleName)
-import Distribution.Text (simpleParse)
+import Distribution.Text (simpleParse,display)
 
 import Data.Maybe
 
hunk ./Distribution/Simple/GHC/IPI642.hs 116
 convertPackageId PackageIdentifier { pkgName = n, pkgVersion = v } =
   Current.PackageIdentifier (Current.PackageName n) v
 
+mkInstalledPackageId :: Current.PackageIdentifier -> Current.InstalledPackageId
+mkInstalledPackageId = Current.InstalledPackageId . display
+
 convertModuleName :: String -> ModuleName
 convertModuleName s = fromJust $ simpleParse s
 
hunk ./Distribution/Simple/GHC/IPI642.hs 133
 
 toCurrent :: InstalledPackageInfo -> Current.InstalledPackageInfo
 toCurrent ipi at InstalledPackageInfo{} = Current.InstalledPackageInfo {
+    Current.installedPackageId = mkInstalledPackageId (convertPackageId (package ipi)),
     Current.package            = convertPackageId (package ipi),
     Current.license            = convertLicense (license ipi),
     Current.copyright          = copyright ipi,
hunk ./Distribution/Simple/GHC/IPI642.hs 154
     Current.extraGHCiLibraries = extraGHCiLibraries ipi,
     Current.includeDirs        = includeDirs ipi,
     Current.includes           = includes ipi,
-    Current.depends            = map convertPackageId (depends ipi),
+    Current.depends            = map (mkInstalledPackageId.convertPackageId) (depends ipi),
     Current.hugsOptions        = hugsOptions ipi,
     Current.ccOptions          = ccOptions ipi,
     Current.ldOptions          = ldOptions ipi,
hunk ./Distribution/Simple/Haddock.hs 82
 import Distribution.Simple.BuildPaths ( haddockName,
                                         hscolourPref, autogenModulesDir,
                                         )
-import Distribution.Simple.PackageIndex (dependencyClosure, allPackages)
+import Distribution.Simple.PackageIndex (dependencyClosure)
 import qualified Distribution.Simple.PackageIndex as PackageIndex
hunk ./Distribution/Simple/Haddock.hs 84
-         ( lookupPackageId )
 import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
          ( InstalledPackageInfo_(..) )
hunk ./Distribution/Simple/Haddock.hs 86
+import Distribution.InstalledPackageInfo
+         ( InstalledPackageInfo )
 import Distribution.Simple.Utils
          ( die, warn, notice, intercalate, setupMessage
          , createDirectoryIfMissingVerbose, withTempFile, copyFileVerbose
hunk ./Distribution/Simple/Haddock.hs 416
                     Left x -> return x
                     Right _ -> die "Can't find transitive deps for haddock"
   interfaces <- sequence
-    [ case interfaceAndHtmlPath pkgid of
-        Nothing -> return (pkgid, Nothing)
+    [ case interfaceAndHtmlPath ipkg of
+        Nothing -> return (Left (packageId ipkg))
         Just (interface, html) -> do
           exists <- doesFileExist interface
           if exists
hunk ./Distribution/Simple/Haddock.hs 421
-            then return (pkgid, Just (interface, html))
-            else return (pkgid, Nothing)
-    | pkgid <- map InstalledPackageInfo.package $ allPackages transitiveDeps ]
+            then return (Right (interface, html))
+            else return (Left (packageId ipkg))
+    | ipkg <- PackageIndex.allInstalledPackages transitiveDeps ]
 
hunk ./Distribution/Simple/Haddock.hs 425
-  let missing = [ pkgid | (pkgid, Nothing) <- interfaces ]
+  let missing = [ pkgid | Left pkgid <- interfaces ]
       warning = "The documentation for the following packages are not "
              ++ "installed. No links will be generated to these packages: "
              ++ intercalate ", " (map display missing)
hunk ./Distribution/Simple/Haddock.hs 430
       flags = [ (interface, if null html then Nothing else Just html)
-              | (_, Just (interface, html)) <- interfaces ]
+              | Right (interface, html) <- interfaces ]
 
   return (flags, if null missing then Nothing else Just warning)
 
hunk ./Distribution/Simple/Haddock.hs 435
   where
-    interfaceAndHtmlPath :: PackageIdentifier -> Maybe (FilePath, FilePath)
-    interfaceAndHtmlPath pkgId = do
-      pkg <- PackageIndex.lookupPackageId (installedPkgs lbi) pkgId
+    interfaceAndHtmlPath :: InstalledPackageInfo -> Maybe (FilePath, FilePath)
+    interfaceAndHtmlPath pkg = do
       interface <- listToMaybe (InstalledPackageInfo.haddockInterfaces pkg)
       html <- case htmlTemplate of
         Nothing -> listToMaybe (InstalledPackageInfo.haddockHTMLs pkg)
hunk ./Distribution/Simple/Haddock.hs 445
 
       where expandTemplateVars = fromPathTemplate . substPathTemplate env
             env = (PrefixVar, prefix (installDirTemplates lbi))
-                : initialPathTemplateEnv pkgId (compilerId (compiler lbi))
+                : initialPathTemplateEnv (packageId pkg) (compilerId (compiler lbi))
 
 -- --------------------------------------------------------------------------
 -- hscolour support
hunk ./Distribution/Simple/JHC.hs 59
 import Distribution.Simple.PackageIndex (PackageIndex)
 import qualified Distribution.Simple.PackageIndex as PackageIndex
 import Distribution.Simple.LocalBuildInfo
-         ( LocalBuildInfo(..), ComponentLocalBuildInfo(..) )
+         ( LocalBuildInfo(..), ComponentLocalBuildInfo(..),
+           componentPackageDeps )
 import Distribution.Simple.BuildPaths
                                 ( autogenModulesDir, exeExtension )
 import Distribution.Simple.Compiler
hunk ./Distribution/Simple/JHC.hs 175
      ++ concat [["-i", l] | l <- nub (hsSourceDirs bi)]
      ++ ["-i", autogenModulesDir lbi]
      ++ ["-optc" ++ opt | opt <- PD.ccOptions bi]
-     ++ (concat [ ["-p", display pkg] | pkg <- componentPackageDeps clbi ])
+     ++ (concat [ ["-p", display pkg] | pkg <- componentPackageDeps lbi clbi ])
 
 jhcPkgConf :: PackageDescription -> String
 jhcPkgConf pd =
hunk ./Distribution/Simple/LHC.hs 85
 import qualified Distribution.Simple.PackageIndex as PackageIndex
 import Distribution.ParseUtils  ( ParseResult(..) )
 import Distribution.Simple.LocalBuildInfo
-         ( LocalBuildInfo(..), ComponentLocalBuildInfo(..) )
+         ( LocalBuildInfo(..), ComponentLocalBuildInfo(..),
+           componentPackageDeps )
 import Distribution.Simple.InstallDirs
 import Distribution.Simple.BuildPaths
 import Distribution.Simple.Utils
hunk ./Distribution/Simple/LHC.hs 457
               "-o", sharedLibFilePath ]
             ++ ghcSharedObjArgs
             ++ ["-package-name", display pkgid ]
-            ++ (concat [ ["-package", display pkg] | pkg <- componentPackageDeps clbi ])
+            ++ (concat [ ["-package", display pkg] | pkg <- componentPackageDeps lbi clbi ])
             ++ ["-l"++extraLib | extraLib <- extraLibs libBi]
             ++ ["-L"++extraLibDir | extraLibDir <- extraLibDirs libBi]
 
hunk ./Distribution/Simple/LHC.hs 627
      ++ [ "-odir",  odir, "-hidir", odir ]
      ++ (if compilerVersion c >= Version [6,8] []
            then ["-stubdir", odir] else [])
-     ++ (concat [ ["-package", display pkg] | pkg <- componentPackageDeps clbi ])
+     ++ (concat [ ["-package", display pkg] | pkg <- componentPackageDeps lbi clbi ])
      ++ (case withOptimization lbi of
            NoOptimisation      -> []
            NormalOptimisation  -> ["-O"]
hunk ./Distribution/Simple/LHC.hs 666
 ghcCcOptions lbi bi clbi odir
      =  ["-I" ++ dir | dir <- PD.includeDirs bi]
      ++ ghcPackageDbOptions (withPackageDB lbi)
-     ++ concat [ ["-package", display pkg] | pkg <- componentPackageDeps clbi ]
+     ++ concat [ ["-package", display pkg] | pkg <- componentPackageDeps lbi clbi ]
      ++ ["-optc" ++ opt | opt <- PD.ccOptions bi]
      ++ (case withOptimization lbi of
            NoOptimisation -> []
hunk ./Distribution/Simple/LocalBuildInfo.hs 53
         withLibLBI,
         withExeLBI,
         ComponentLocalBuildInfo(..),
+        componentPackageDeps,
+        getLocalPackageInfo,
         isInternalPackage,
         -- * Installation directories
         module Distribution.Simple.InstallDirs,
hunk ./Distribution/Simple/LocalBuildInfo.hs 71
 import Distribution.PackageDescription
          ( PackageDescription(..), withLib, Library, withExe
          , Executable(exeName) )
-import Distribution.Package (PackageId, Package(..))
+import Distribution.Package
+         ( PackageId, Package(..), InstalledPackageId(..) )
 import Distribution.Simple.Compiler
          ( Compiler(..), PackageDBStack, OptimisationLevel )
hunk ./Distribution/Simple/LocalBuildInfo.hs 75
-import Distribution.Simple.PackageIndex (PackageIndex)
-import Distribution.InstalledPackageInfo (InstalledPackageInfo)
+import Distribution.Simple.PackageIndex
+         ( InstalledPackageIndex, lookupInstalledPackage )
+import Distribution.InstalledPackageInfo
+         ( InstalledPackageInfo )
 import Distribution.Simple.Utils
          ( die )
 
hunk ./Distribution/Simple/LocalBuildInfo.hs 98
                 -- ^ Where to put the result of the Hugs build.
         libraryConfig       :: Maybe ComponentLocalBuildInfo,
         executableConfigs   :: [(String, ComponentLocalBuildInfo)],
-        installedPkgs :: PackageIndex InstalledPackageInfo,
+        installedPkgs :: InstalledPackageIndex,
                 -- ^ All the info about all installed packages.
         pkgDescrFile  :: Maybe FilePath,
                 -- ^ the filename containing the .cabal file, if available
hunk ./Distribution/Simple/LocalBuildInfo.hs 124
     -- specifies a set of build dependencies that must be satisfied in terms of
     -- version ranges. This field fixes those dependencies to the specific
     -- versions available on this machine for this compiler.
-    componentPackageDeps :: [PackageId]
+    componentInstalledPackageDeps :: [InstalledPackageId]
   }
   deriving (Read, Show)
 
hunk ./Distribution/Simple/LocalBuildInfo.hs 128
+componentPackageDeps :: LocalBuildInfo -> ComponentLocalBuildInfo -> [PackageId]
+componentPackageDeps lbi =
+  map (packageId.getLocalPackageInfo lbi) . componentInstalledPackageDeps
+
+getLocalPackageInfo :: LocalBuildInfo -> InstalledPackageId
+                    -> InstalledPackageInfo
+getLocalPackageInfo lbi ipid@(InstalledPackageId s)  =
+  case lookupInstalledPackage (installedPkgs lbi) ipid of
+    Nothing  -> error ("getLocalPackageInfo: unknown InstalledPackageId: " ++ s)
+    Just ipi -> ipi
+
 -- | External package dependencies for the package as a whole, the union of the
 -- individual 'targetPackageDeps'.
hunk ./Distribution/Simple/LocalBuildInfo.hs 141
-externalPackageDeps :: LocalBuildInfo -> [PackageId]
+externalPackageDeps :: LocalBuildInfo -> [InstalledPackageId]
 externalPackageDeps lbi = nub $
   -- TODO:  what about non-buildable components?
hunk ./Distribution/Simple/LocalBuildInfo.hs 144
-     maybe [] componentPackageDeps (libraryConfig lbi)
-  ++ concatMap (componentPackageDeps . snd) (executableConfigs lbi)
+     maybe [] componentInstalledPackageDeps (libraryConfig lbi)
+  ++ concatMap (componentInstalledPackageDeps . snd) (executableConfigs lbi)
 
 -- |If the package description has a library section, call the given
 --  function with the library build info as argument.  Extended version of
hunk ./Distribution/Simple/NHC.hs 57
 import Distribution.ModuleName (ModuleName)
 import qualified Distribution.ModuleName as ModuleName
 import Distribution.Simple.LocalBuildInfo
-        ( LocalBuildInfo(..), ComponentLocalBuildInfo(..) )
+        ( LocalBuildInfo(..), ComponentLocalBuildInfo(..), 
+          componentPackageDeps )
 import Distribution.Simple.BuildPaths
         ( mkLibName, objExtension, exeExtension )
 import Distribution.Simple.Compiler
hunk ./Distribution/Simple/NHC.hs 160
     ++ maybe [] (hcOptions NHC . libBuildInfo)
                            (library pkg_descr)
     ++ concat [ ["-package", display (packageName pkg) ]
-              | pkg <- componentPackageDeps clbi ]
+              | pkg <- componentPackageDeps lbi clbi ]
     ++ inFiles
 {-
   -- build any C sources
hunk ./Distribution/Simple/NHC.hs 225
     ++ maybe [] (hcOptions NHC . libBuildInfo)
                            (library pkg_descr)
     ++ concat [ ["-package", display (packageName pkg) ]
-              | pkg <- componentPackageDeps clbi ]
+              | pkg <- componentPackageDeps lbi clbi ]
     ++ inFiles
     ++ [exeName exe]
 
hunk ./Distribution/Simple/PackageIndex.hs 50
   allPackagesByName,
 
   -- ** Special queries
-  brokenPackages,
-  dependencyClosure,
   reverseDependencyClosure,
   topologicalOrder,
   reverseTopologicalOrder,
hunk ./Distribution/Simple/PackageIndex.hs 56
   dependencyInconsistencies,
   dependencyCycles,
   dependencyGraph,
+
+  -- * The index of installed packages
+  InstalledPackageIndex,
+  listToInstalledPackageIndex,
+  lookupInstalledPackageByName,
+  addToInstalledPackageIndex,
+  lookupInstalledPackage,
+  allInstalledPackages,
+  brokenPackages,
+  dependencyClosure
+
   ) where
 
 import Prelude hiding (lookup)
hunk ./Distribution/Simple/PackageIndex.hs 80
 #if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ < 606)
 import Data.List (groupBy, sortBy, nub, find, isPrefixOf, tails)
 #else
-import Data.List (groupBy, sortBy, nub, find, isInfixOf)
+import Data.List (groupBy, sortBy, find, isInfixOf)
 #endif
 import Data.Monoid (Monoid(..))
 import Data.Maybe (isNothing, fromMaybe)
hunk ./Distribution/Simple/PackageIndex.hs 88
 import Distribution.Package
          ( PackageName(..), PackageIdentifier(..)
          , Package(..), packageName, packageVersion
-         , Dependency(Dependency), PackageFixedDeps(..) )
+         , Dependency(Dependency), PackageFixedDeps(..)
+         , InstalledPackageId(..) )
+import Distribution.InstalledPackageInfo
+         ( InstalledPackageInfo, installedPackageId, package )
+import qualified Distribution.InstalledPackageInfo as IPI
 import Distribution.Version
          ( Version, withinRange )
hunk ./Distribution/Simple/PackageIndex.hs 95
-import Distribution.Simple.Utils (lowercase, equating, comparing)
+import Distribution.Simple.Utils (lowercase, comparing)
 
 #if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ < 606)
 import Text.Read
hunk ./Distribution/Simple/PackageIndex.hs 370
   , pkg <- pkgs ]
   where lsearchterm = lowercase searchterm
 
+-- | Find if there are any cycles in the dependency graph. If there are no
+-- cycles the result is @[]@.
+--
+-- This actually computes the strongly connected components. So it gives us a
+-- list of groups of packages where within each group they all depend on each
+-- other, directly or indirectly.
+--
+dependencyCycles :: PackageFixedDeps pkg
+                 => PackageIndex pkg
+                 -> [[pkg]]
+dependencyCycles index =
+  [ vs | Graph.CyclicSCC vs <- Graph.stronglyConnComp adjacencyList ]
+  where
+    adjacencyList = [ (pkg, packageId pkg, depends pkg)
+                    | pkg <- allPackages index ]
+
+-----------------------------------------------------------------------------
+-- The Installed Package index
+-----------------------------------------------------------------------------
+
+-- | This is a mapping from 'InstalledPackageId' to 'InstalledPackageInfo'.
+-- Since an 'InstalledPackageId' uniquely identifies a package, there
+-- is a single 'InstalledPackageInfo' for each 'InstalledPackageId'.
+newtype InstalledPackageIndex
+      = InstalledPackageIndex (Map InstalledPackageId InstalledPackageInfo)
+#if !defined(__GLASGOW_HASKELL__) || (__GLASGOW_HASKELL__ >= 606)
+  deriving (Show, Read)
+#else
+#error Todo: Show instance for InstalledPackageIndex
+#endif
+
+instance Monoid InstalledPackageIndex where
+  mempty  = InstalledPackageIndex Map.empty
+  mappend (InstalledPackageIndex ix1) (InstalledPackageIndex ix2) = 
+    InstalledPackageIndex (ix1 `Map.union` ix2)
+
+listToInstalledPackageIndex :: [InstalledPackageInfo] -> InstalledPackageIndex
+listToInstalledPackageIndex ipis = 
+  InstalledPackageIndex $ Map.fromList $
+      [ (installedPackageId p, p) | p <- ipis ]
+
+addToInstalledPackageIndex
+   :: InstalledPackageInfo -> InstalledPackageIndex -> InstalledPackageIndex
+addToInstalledPackageIndex info (InstalledPackageIndex ix)
+  = InstalledPackageIndex (Map.insert (installedPackageId info) info ix)
+
+lookupInstalledPackage :: InstalledPackageIndex -> InstalledPackageId 
+                       -> Maybe InstalledPackageInfo
+lookupInstalledPackage (InstalledPackageIndex ix) ipid = Map.lookup ipid ix
+
+
+lookupInstalledPackageByName :: InstalledPackageIndex -> PackageName
+                             -> [InstalledPackageInfo]
+lookupInstalledPackageByName ix name = 
+  filter ((== name) . packageName . package) (allInstalledPackages ix)
+
+allInstalledPackages :: InstalledPackageIndex -> [InstalledPackageInfo]
+allInstalledPackages (InstalledPackageIndex ix) = Map.elems ix
+
 --
 -- * Special queries
 --
hunk ./Distribution/Simple/PackageIndex.hs 437
 --
 -- Returns such packages along with the dependencies that they're missing.
 --
-brokenPackages :: PackageFixedDeps pkg
-               => PackageIndex pkg
-               -> [(pkg, [PackageIdentifier])]
+brokenPackages :: InstalledPackageIndex
+               -> [(InstalledPackageInfo, [InstalledPackageId])]
 brokenPackages index =
   [ (pkg, missing)
hunk ./Distribution/Simple/PackageIndex.hs 441
-  | pkg  <- allPackages index
-  , let missing = [ pkg' | pkg' <- depends pkg
-                         , isNothing (lookupPackageId index pkg') ]
+  | pkg  <- allInstalledPackages index
+  , let missing = [ pkg' | pkg' <- IPI.depends pkg
+                         , isNothing (lookupInstalledPackage index pkg') ]
   , not (null missing) ]
 
hunk ./Distribution/Simple/PackageIndex.hs 446
+
 -- | Tries to take the transative closure of the package dependencies.
 --
 -- If the transative closure is complete then it returns that subset of the
hunk ./Distribution/Simple/PackageIndex.hs 455
 -- * Note that if the result is @Right []@ it is because at least one of
 -- the original given 'PackageIdentifier's do not occur in the index.
 --
-dependencyClosure :: PackageFixedDeps pkg
-                  => PackageIndex pkg
-                  -> [PackageIdentifier]
-                  -> Either (PackageIndex pkg)
-                            [(pkg, [PackageIdentifier])]
+dependencyClosure :: InstalledPackageIndex
+                  -> [InstalledPackageId]
+                  -> Either InstalledPackageIndex
+                            [(InstalledPackageInfo, [InstalledPackageId])]
 dependencyClosure index pkgids0 = case closure mempty [] pkgids0 of
   (completed, []) -> Left completed
   (completed, _)  -> Right (brokenPackages completed)
hunk ./Distribution/Simple/PackageIndex.hs 464
   where
     closure completed failed []             = (completed, failed)
-    closure completed failed (pkgid:pkgids) = case lookupPackageId index pkgid of
+    closure completed failed (pkgid:pkgids) = case lookupInstalledPackage index pkgid of
       Nothing   -> closure completed (pkgid:failed) pkgids
hunk ./Distribution/Simple/PackageIndex.hs 466
-      Just pkg  -> case lookupPackageId completed (packageId pkg) of
+      Just pkg  -> case lookupInstalledPackage completed (installedPackageId pkg) of
         Just _  -> closure completed  failed pkgids
         Nothing -> closure completed' failed pkgids'
hunk ./Distribution/Simple/PackageIndex.hs 469
-          where completed' = insert pkg completed
-                pkgids'    = depends pkg ++ pkgids
+          where completed' = addToInstalledPackageIndex pkg completed
+                pkgids'    = IPI.depends pkg ++ pkgids
 
 -- | Takes the transative closure of the packages reverse dependencies.
 --
hunk ./Distribution/Simple/PackageIndex.hs 476
 -- * The given 'PackageIdentifier's must be in the index.
 --
-reverseDependencyClosure :: PackageFixedDeps pkg
-                         => PackageIndex pkg
-                         -> [PackageIdentifier]
-                         -> [pkg]
+reverseDependencyClosure :: InstalledPackageIndex
+                         -> [InstalledPackageId]
+                         -> [InstalledPackageInfo]
 reverseDependencyClosure index =
     map vertexToPkg
   . concatMap Tree.flatten
hunk ./Distribution/Simple/PackageIndex.hs 490
     reverseDepGraph = Graph.transposeG depGraph
     noSuchPkgId = error "reverseDependencyClosure: package is not in the graph"
 
-topologicalOrder :: PackageFixedDeps pkg => PackageIndex pkg -> [pkg]
+topologicalOrder :: InstalledPackageIndex -> [InstalledPackageInfo]
 topologicalOrder index = map toPkgId
                        . Graph.topSort
                        $ graph
hunk ./Distribution/Simple/PackageIndex.hs 496
   where (graph, toPkgId, _) = dependencyGraph index
 
-reverseTopologicalOrder :: PackageFixedDeps pkg => PackageIndex pkg -> [pkg]
+reverseTopologicalOrder :: InstalledPackageIndex -> [InstalledPackageInfo]
 reverseTopologicalOrder index = map toPkgId
                               . Graph.topSort
                               . Graph.transposeG
hunk ./Distribution/Simple/PackageIndex.hs 503
                               $ graph
   where (graph, toPkgId, _) = dependencyGraph index
 
--- | Given a package index where we assume we want to use all the packages
--- (use 'dependencyClosure' if you need to get such a index subset) find out
--- if the dependencies within it use consistent versions of each package.
--- Return all cases where multiple packages depend on different versions of
--- some other package.
---
--- Each element in the result is a package name along with the packages that
--- depend on it and the versions they require. These are guaranteed to be
--- distinct.
---
-dependencyInconsistencies :: PackageFixedDeps pkg
-                          => PackageIndex pkg
-                          -> [(PackageName, [(PackageIdentifier, Version)])]
-dependencyInconsistencies index =
-  [ (name, inconsistencies)
-  | (name, uses) <- Map.toList inverseIndex
-  , let inconsistencies = duplicatesBy uses
-        versions = map snd inconsistencies
-  , reallyIsInconsistent name (nub versions) ]
-
-  where inverseIndex = Map.fromListWith (++)
-          [ (packageName dep, [(packageId pkg, packageVersion dep)])
-          | pkg <- allPackages index
-          , dep <- depends pkg ]
-
-        duplicatesBy = (\groups -> if length groups == 1
-                                     then []
-                                     else concat groups)
-                     . groupBy (equating snd)
-                     . sortBy (comparing snd)
-
-        reallyIsInconsistent :: PackageName -> [Version] -> Bool
-        reallyIsInconsistent _    []       = False
-        reallyIsInconsistent name [v1, v2] =
-          case (mpkg1, mpkg2) of
-            (Just pkg1, Just pkg2) -> pkgid1 `notElem` depends pkg2
-                                   && pkgid2 `notElem` depends pkg1
-            _ -> True
-          where
-            pkgid1 = PackageIdentifier name v1
-            pkgid2 = PackageIdentifier name v2
-            mpkg1 = lookupPackageId index pkgid1
-            mpkg2 = lookupPackageId index pkgid2
-
-        reallyIsInconsistent _ _ = True
-
--- | Find if there are any cycles in the dependency graph. If there are no
--- cycles the result is @[]@.
---
--- This actually computes the strongly connected components. So it gives us a
--- list of groups of packages where within each group they all depend on each
--- other, directly or indirectly.
---
-dependencyCycles :: PackageFixedDeps pkg
-                 => PackageIndex pkg
-                 -> [[pkg]]
-dependencyCycles index =
-  [ vs | Graph.CyclicSCC vs <- Graph.stronglyConnComp adjacencyList ]
-  where
-    adjacencyList = [ (pkg, packageId pkg, depends pkg)
-                    | pkg <- allPackages index ]
-
 -- | Builds a graph of the package dependencies.
 --
 -- Dependencies on other packages that are not in the index are discarded.
hunk ./Distribution/Simple/PackageIndex.hs 508
 -- You can check if there are any such dependencies with 'brokenPackages'.
 --
-dependencyGraph :: PackageFixedDeps pkg
-                => PackageIndex pkg
+dependencyGraph :: InstalledPackageIndex
                 -> (Graph.Graph,
hunk ./Distribution/Simple/PackageIndex.hs 510
-                    Graph.Vertex -> pkg,
-                    PackageIdentifier -> Maybe Graph.Vertex)
-dependencyGraph index = (graph, vertexToPkg, pkgIdToVertex)
+                    Graph.Vertex -> InstalledPackageInfo,
+                    InstalledPackageId -> Maybe Graph.Vertex)
+dependencyGraph index = (graph, vertex_to_pkg, id_to_vertex)
   where
     graph = Array.listArray bounds
hunk ./Distribution/Simple/PackageIndex.hs 515
-              [ [ v | Just v <- map pkgIdToVertex (depends pkg) ]
+              [ [ v | Just v <- map id_to_vertex (IPI.depends pkg) ]
               | pkg <- pkgs ]
hunk ./Distribution/Simple/PackageIndex.hs 517
-    vertexToPkg vertex = pkgTable ! vertex
-    pkgIdToVertex = binarySearch 0 topBound
+
+    pkgs             = sortBy (comparing packageId) (allInstalledPackages index)
+    vertices         = zip (map installedPackageId pkgs) [0..]
+    vertex_map       = Map.fromList vertices
+    id_to_vertex pid = Map.lookup pid vertex_map
+
+    vertex_to_pkg vertex = pkgTable ! vertex
 
     pkgTable   = Array.listArray bounds pkgs
hunk ./Distribution/Simple/PackageIndex.hs 526
-    pkgIdTable = Array.listArray bounds (map packageId pkgs)
-    pkgs = sortBy (comparing packageId) (allPackages index)
     topBound = length pkgs - 1
     bounds = (0, topBound)
 
hunk ./Distribution/Simple/PackageIndex.hs 529
-    binarySearch a b key
-      | a > b     = Nothing
-      | otherwise = case compare key (pkgIdTable ! mid) of
-          LT -> binarySearch a (mid-1) key
-          EQ -> Just mid
-          GT -> binarySearch (mid+1) b key
-      where mid = (a + b) `div` 2
+-- | Given a package index where we assume we want to use all the packages
+-- (use 'dependencyClosure' if you need to get such a index subset) find out
+-- if the dependencies within it use consistent versions of each package.
+-- Return all cases where multiple packages depend on different versions of
+-- some other package.
+--
+-- Each element in the result is a package name along with the packages that
+-- depend on it and the versions they require. These are guaranteed to be
+-- distinct.
+--
+dependencyInconsistencies :: InstalledPackageIndex
+                          -> [(PackageName, [(PackageIdentifier, Version)])]
+dependencyInconsistencies index =
+  [ (name, [ (pid,packageVersion dep) | (dep,pids) <- uses, pid <- pids])
+  | (name, ipid_map) <- Map.toList inverseIndex
+  , let uses = Map.elems ipid_map
+  , reallyIsInconsistent (map fst uses) ]
+
+  where -- for each PackageName, 
+        --   for each package with that name,
+        --     the InstalledPackageInfo and the package Ids of packages
+        --     that depend on it.
+        inverseIndex :: Map PackageName 
+                            (Map InstalledPackageId 
+                                 (InstalledPackageInfo, [PackageIdentifier]))
+        inverseIndex = Map.fromListWith (Map.unionWith (\(a,b) (_,b') -> (a,b++b')))
+          [ (packageName dep, 
+             Map.fromList [(ipid,(dep,[packageId pkg]))])
+          | pkg <- allInstalledPackages index
+          , ipid <- IPI.depends pkg
+          , Just dep <- [lookupInstalledPackage index ipid]
+          ]
+
+        reallyIsInconsistent :: [InstalledPackageInfo] -> Bool
+        reallyIsInconsistent []       = False
+        reallyIsInconsistent [_p]     = False
+        reallyIsInconsistent [p1, p2] =
+             installedPackageId p1 `notElem` IPI.depends p2
+          && installedPackageId p2 `notElem` IPI.depends p1
+        reallyIsInconsistent _ = True
hunk ./Distribution/Simple/PreProcess.hs 70
 import qualified Distribution.InstalledPackageInfo as Installed
          ( InstalledPackageInfo_(..) )
 import qualified Distribution.Simple.PackageIndex as PackageIndex
-         ( topologicalOrder, lookupPackageName, insert )
 import Distribution.Simple.Compiler
          ( CompilerFlavor(..), Compiler(..), compilerFlavor, compilerVersion )
 import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..))
hunk ./Distribution/Simple/PreProcess.hs 402
     -- OS X (it's ld is a tad stricter than gnu ld). Thus we remove the
     -- ldOptions for GHC's rts package:
     hackRtsPackage index =
-      case PackageIndex.lookupPackageName index (PackageName "rts") of
-        [rts] -> PackageIndex.insert rts { Installed.ldOptions = [] } index
+      case PackageIndex.lookupInstalledPackageByName index (PackageName "rts") of
+        [rts] -> PackageIndex.addToInstalledPackageIndex rts { Installed.ldOptions = [] } index
         _ -> error "No (or multiple) ghc rts package is registered!!"
 
 getLdOptions :: BuildInfo -> [String]
hunk ./Distribution/Simple/Program/HcPkg.hs 30
   ) where
 
 import Distribution.Package
-         ( PackageId )
+         ( PackageId, packageId, InstalledPackageId(..) )
 import Distribution.InstalledPackageInfo
hunk ./Distribution/Simple/Program/HcPkg.hs 32
-         ( InstalledPackageInfo
+         ( InstalledPackageInfo, InstalledPackageInfo_(..)
          , showInstalledPackageInfo, parseInstalledPackageInfo )
 import Distribution.ParseUtils
          ( ParseResult(..) )
hunk ./Distribution/Simple/Program/HcPkg.hs 127
 
   where
     parsePackages str =
-      let parsed = map parseInstalledPackageInfo (splitPkgs str)
+      let parsed = map parseIPI (splitPkgs str)
        in case [ msg | ParseFailed msg <- parsed ] of
             []   -> Left [ pkg | ParseOk _ pkg <- parsed ]
             msgs -> Right msgs
hunk ./Distribution/Simple/Program/HcPkg.hs 132
 
+    parseIPI s
+     | case programVersion hcPkg of
+          Nothing -> False
+          Just v  -> v < Version [6,11] [] = do
+                  ipi <- parseInstalledPackageInfo s
+                  return (fixInstalledPackageId ipi)
+     | otherwise =
+        parseInstalledPackageInfo s
+
     splitPkgs :: String -> [String]
     splitPkgs = map unlines . splitWith ("---" ==) . lines
       where
hunk ./Distribution/Simple/Program/HcPkg.hs 150
                            _:ws -> splitWith p ws
           where (ys,zs) = break p xs
 
+-- Older GHCs did not have the installedPackageId field, so we fill it
+-- as (display (packageId p)).
+fixInstalledPackageId :: InstalledPackageInfo -> InstalledPackageInfo
+fixInstalledPackageId p
+  | null ipid_str = p { installedPackageId = 
+                        InstalledPackageId (display (packageId p)) }
+  | otherwise     = p
+  where InstalledPackageId ipid_str = installedPackageId p
 
 --------------------------
 -- The program invocations
hunk ./Distribution/Simple/Register.hs 63
     registerPackage,
     inplaceInstalledPackageInfo,
     absoluteInstalledPackageInfo,
-    generalInstalledPackageInfo,
+    generalInstalledPackageInfo
   ) where
 
 import Distribution.Simple.LocalBuildInfo
hunk ./Distribution/Simple/Register.hs 70
          ( LocalBuildInfo(..), ComponentLocalBuildInfo(..)
          , InstallDirs(..), absoluteInstallDirs )
 import Distribution.Simple.BuildPaths (haddockName)
+import qualified Distribution.Simple.GHC as GHC
 import Distribution.Simple.Compiler
hunk ./Distribution/Simple/Register.hs 72
-         ( CompilerFlavor(..), compilerFlavor
+         ( compilerVersion, CompilerFlavor(..), compilerFlavor
          , PackageDB(..), registrationPackageDB )
 import Distribution.Simple.Program
          ( ConfiguredProgram, runProgramInvocation
hunk ./Distribution/Simple/Register.hs 86
 import Distribution.PackageDescription
          ( PackageDescription(..), Library(..), BuildInfo(..), hcOptions )
 import Distribution.Package
-         ( Package(..), packageName )
+         ( Package(..), packageName, InstalledPackageId(..) )
 import Distribution.InstalledPackageInfo
          ( InstalledPackageInfo, InstalledPackageInfo_(InstalledPackageInfo)
          , showInstalledPackageInfo )
hunk ./Distribution/Simple/Register.hs 98
          ( OS(..), buildOS )
 import Distribution.Text
          ( display )
+import Distribution.Version ( Version(..) )
 import Distribution.Verbosity as Verbosity
          ( Verbosity, normal )
 import Distribution.Compat.CopyFile
hunk ./Distribution/Simple/Register.hs 143
     verbosity = fromFlag (regVerbosity regFlags)
 
     writeRegistrationFile = do
-      installedPkgInfo <- generateRegistrationInfo
+      installedPkgInfo <- generateRegistrationInfo verbosity
                             pkg lib lbi clbi inplace distPref
       notice verbosity ("Creating package registration file: " ++ regFile)
       writeFileAtomic regFile (showInstalledPackageInfo installedPkgInfo ++ "\n")
hunk ./Distribution/Simple/Register.hs 164
     verbosity = fromFlag (regVerbosity regFlags)
 
 
-generateRegistrationInfo :: PackageDescription
+generateRegistrationInfo :: Verbosity
+                         -> PackageDescription
                          -> Library
                          -> LocalBuildInfo
                          -> ComponentLocalBuildInfo
hunk ./Distribution/Simple/Register.hs 172
                          -> Bool
                          -> FilePath
                          -> IO InstalledPackageInfo
-generateRegistrationInfo pkg lib lbi clbi inplace distPref = do
+generateRegistrationInfo verbosity pkg lib lbi clbi inplace distPref = do
   --TODO: eliminate pwd!
   pwd <- getCurrentDirectory
hunk ./Distribution/Simple/Register.hs 175
+
+  let comp = compiler lbi
+  ipid_suffix <-
+     if inplace
+        then return "inplace"
+        else if compilerFlavor comp == GHC &&
+                compilerVersion comp >= Version [6,11] []
+                then GHC.libAbiHash verbosity pkg lbi lib clbi
+                else return "installed"
+
+  let ipid = InstalledPackageId (display (packageId pkg) ++ '-':ipid_suffix)
+
   let installedPkgInfo
         | inplace   = inplaceInstalledPackageInfo pwd distPref
                         pkg lib lbi clbi
hunk ./Distribution/Simple/Register.hs 192
         | otherwise = absoluteInstalledPackageInfo
                         pkg lib lbi clbi
-  return installedPkgInfo
+  return installedPkgInfo{ IPI.installedPackageId = ipid }
+
+
 
 
 registerPackage :: Verbosity
hunk ./Distribution/Simple/Register.hs 228
   -> PackageDB
   -> IO ()
 registerPackageGHC verbosity pkg lib lbi clbi distPref inplace packageDb = do
-  installedPkgInfo <- generateRegistrationInfo
+  installedPkgInfo <- generateRegistrationInfo verbosity
                         pkg lib lbi clbi inplace distPref
   let Just ghcPkg = lookupProgram ghcPkgProgram (withPrograms lbi)
   HcPkg.reregister verbosity ghcPkg packageDb (Right installedPkgInfo)
hunk ./Distribution/Simple/Register.hs 235
 
 
 registerPackageLHC verbosity pkg lib lbi clbi distPref inplace packageDb = do
-  installedPkgInfo <- generateRegistrationInfo
+  installedPkgInfo <- generateRegistrationInfo verbosity
                         pkg lib lbi clbi inplace distPref
   let Just lhcPkg = lookupProgram lhcPkgProgram (withPrograms lbi)
   HcPkg.reregister verbosity lhcPkg packageDb (Right installedPkgInfo)
hunk ./Distribution/Simple/Register.hs 243
 
 registerPackageHugs verbosity pkg lib lbi clbi distPref inplace _packageDb = do
   when inplace $ die "--inplace is not supported with Hugs"
-  installedPkgInfo <- generateRegistrationInfo
+  installedPkgInfo <- generateRegistrationInfo verbosity
                         pkg lib lbi clbi inplace distPref
   let installDirs = absoluteInstallDirs pkg lbi NoCopyDest
   createDirectoryIfMissingVerbose verbosity True (libdir installDirs)
hunk ./Distribution/Simple/Register.hs 262
                          -> PackageDB
                          -> IO ()
 writeHcPkgRegisterScript verbosity hcPkg pkg lib lbi clbi distPref inplace packageDb = do
-  installedPkgInfo <- generateRegistrationInfo
+  installedPkgInfo <- generateRegistrationInfo verbosity
                         pkg lib lbi clbi inplace distPref
 
   let invocation  = HcPkg.reregisterInvocation hcPkg Verbosity.normal
hunk ./Distribution/Simple/Register.hs 295
   -> InstalledPackageInfo
 generalInstalledPackageInfo adjustRelIncDirs pkg lib clbi installDirs =
   InstalledPackageInfo {
+    IPI.installedPackageId = InstalledPackageId (display (packageId pkg)),
     IPI.package            = packageId   pkg,
     IPI.license            = license     pkg,
     IPI.copyright          = copyright   pkg,
hunk ./Distribution/Simple/Register.hs 318
     IPI.extraGHCiLibraries = [],
     IPI.includeDirs        = absinc ++ adjustRelIncDirs relinc,
     IPI.includes           = includes bi,
-    IPI.depends            = componentPackageDeps clbi,
+    IPI.depends            = componentInstalledPackageDeps clbi,
     IPI.hugsOptions        = hcOptions Hugs bi,
     IPI.ccOptions          = [], -- Note. NOT ccOptions bi!
                                  -- We don't want cc-options to be propagated
hunk ./Distribution/Simple/Register.hs 387
     bi = libBuildInfo lib
     installDirs = absoluteInstallDirs pkg lbi NoCopyDest
 
-
 -- -----------------------------------------------------------------------------
 -- Unregistration
 
}

Context:

[Pass GHC >= 6.11 the -fbuilding-cabal-package flag
Ian Lynagh <igloo at earth.li>**20090726181405] 
[Bump version to 1.7.3 due to recent API changes
Duncan Coutts <duncan at haskell.org>**20090707095901] 
[Simplify and generalise installDirsTemplateEnv 
Duncan Coutts <duncan at haskell.org>**20090705205411
 Take a set of templates rather than file paths.
] 
[Rename and export substituteInstallDirTemplates
Duncan Coutts <duncan at haskell.org>**20090705205257
 This does the mutual substituition of the installation
 directory templates into each other.
] 
[Follow the change in GHC's split-objs directory naming
Ian Lynagh <igloo at earth.li>**20090723234430] 
[Fix a "warn-unused-do-bind" warning
Ian Lynagh <igloo at earth.li>**20090710212059] 
[Don't use the Stdout variant of rawSystemProgramConf to call gcc
Ian Lynagh <igloo at earth.li>**20090710210802
 We ignore the output anyway
] 
[Don't ask for the output of running ld, as we ignore it anyway
Ian Lynagh <igloo at earth.li>**20090710210445] 
[Fix some "warn-unused-do-bind" warnings where we want to ignore the value
Ian Lynagh <igloo at earth.li>**20090710210407] 
[Fix unused import warnings
Ian Lynagh <igloo at earth.li>**20090707133559] 
[Remove unused imports
Ian Lynagh <igloo at earth.li>**20090707115824] 
[Follow changes in haddock
Ian Lynagh <igloo at earth.li>**20090705193610
 The --verbose flag is now called --verbosity
] 
[Undo a simplification in the type of absoluteInstallDirs
Duncan Coutts <duncan at haskell.org>**20090705154155
 Existing Setup scripts use it so we can't change it. Fixes #563.
] 
[Describe the autoconfUserHooks option more accurately in the user guide
Duncan Coutts <duncan at haskell.org>**20090614191400] 
[Fix && entity refs in doc xml
Duncan Coutts <duncan at haskell.org>**20090614191230] 
[documentation update: add a description of the syntax for 'compiler' fields in .cabal files
Brent Yorgey <byorgey at cis.upenn.edu>**20090610194550] 
[use Haskell 98 import syntax
Ross Paterson <ross at soi.city.ac.uk>**20090610174619
 Ignore-this: 26774087968e247b41d69350c015bc30
] 
[fix typo of exitcode
Ross Paterson <ross at soi.city.ac.uk>**20090610174541
 Ignore-this: e21da0e6178e69694011e5286b382d72
] 
[Rearrange the PathTemplateEnv stuff and export more pieces
Duncan Coutts <duncan at haskell.org>**20090607224721] 
[Rewrite the Register module
Duncan Coutts <duncan at haskell.org>**20090607182821
 It was getting increasingly convoluted and incomprehensible.
 Now uses the Program.HcPkg and Program.Scripts modules.
] 
[Simplify OSX ranlib madness
Duncan Coutts <duncan at haskell.org>**20090607180717] 
[Use new Program.Ld and Program.Ar in GHC module
Duncan Coutts <duncan at haskell.org>**20090607180534] 
[Use the new HcPkg module in the GHC getInstalledPackages function
Duncan Coutts <duncan at haskell.org>**20090607180442] 
[Add specialised modules for handling ar and ld
Duncan Coutts <duncan at haskell.org>**20090607180257] 
[Add improved xargs style function
Duncan Coutts <duncan at haskell.org>**20090607180214
 More flexible and based on the ProgramInvocation stuff
] 
[Pass verbosity to hc-pkg
Duncan Coutts <duncan at haskell.org>**20090607180146] 
[Use a better api for registering libs in the internal package db
Duncan Coutts <duncan at haskell.org>**20090607125436] 
[Add new Program modules
Duncan Coutts <duncan at haskell.org>**20090607121301] 
[New module for handling calling the hc-pkg program
Duncan Coutts <duncan at haskell.org>**20090607120650] 
[New module to write program invocations as shell scripts or batch files
Duncan Coutts <duncan at haskell.org>**20090607120520
 For tasks like registering where we call hc-pkg, this allows us to
 produce a single program invocation and then either run it directly
 or write it out as a script.
] 
[Re-export the program invocation stuff from the Program module
Duncan Coutts <duncan at haskell.org>**20090607120404] 
[Fix rawSystemStdin util function
Duncan Coutts <duncan at haskell.org>**20090607120324
 Close the input after pushing it. Return any error message.
] 
[Split the Program module up a bit
Duncan Coutts <duncan at haskell.org>**20090607101246
 Add an explicit intermediate ProgramInvocation data type.
] 
[Do not pass Maybe LocalBuildInfo to clean hook
Duncan Coutts <duncan at haskell.org>**20090604203830
 It is a bad idea for clean to do anything different depending
 on whether the package was configured already or not. The
 actual cleaning code did not use the LocalBuildInfo so this
 only changes in the UserHooks interface. No Setup.hs scripts
 actually make of this parameter for the clean hook.
 Part of ticket #133.
] 
[Simplify checkPackageProblems function
Duncan Coutts <duncan at haskell.org>**20090604203709
 Since we now always have a GenericPackageDescription
] 
[Change UserHooks.confHook to use simply GenericPackageDescription
Duncan Coutts <duncan at haskell.org>**20090604203400
 Rather than Either GenericPackageDescription PackageDescription
 In principle this is an interface change that could break Setup.hs
 scripts but in practise the few scripts that use confHook just pass
 the arguments through and so are not sensitve to the type change.
] 
[Change UserHooks.readDesc to use GenericPackageDescription
Duncan Coutts <duncan at haskell.org>**20090604202837
 Also changes Simple.defaultMainNoRead to use GenericPackageDescription.
 This is an API change that in principle could break Setup.hs scripts
 but in practise there are no Setup.hs scripts that use either.
] 
[Help Cabal find gcc/ld on Windows
Simon Marlow <marlowsd at gmail.com>**20090626140250
 Ignore-this: bad21fe3047bc6e23165160c88dd53d9
 the layout changed in the new GHC build system
] 
[TAG 2009-06-25
Ian Lynagh <igloo at earth.li>**20090625160144] 
[clean up createTempDirectory, using System.Posix or System.Directory
Simon Marlow <marlowsd at gmail.com>**20090625105648
 Ignore-this: 732aac57116c308198a8aaa2f67ec475
 rather than low-level System.Posix.Internals operations which are
 about to go away.
] 
[follow change in System.Posix.Internals.c_open
Simon Marlow <marlowsd at gmail.com>**20090622133654
 Ignore-this: d2c775473d6dfb1dcca40f51834a2d26
] 
[update to work with the new GHC IO library internals (fdToHandle)
Simon Marlow <marlowsd at gmail.com>**20090612095346
 Ignore-this: 2697bd2b64b3231ab4d9bb13490c124f
] 
[Put a "%expect 0" directive in the .y file of a test
Ian Lynagh <igloo at earth.li>**20090608204035] 
[Pass a verbosity flag to ghc-pkg
Ian Lynagh <igloo at earth.li>**20090605143244] 
[When build calls register, pass the verbosity level too
Ian Lynagh <igloo at earth.li>**20090605142718] 
[Fix unlit
Ian Lynagh <igloo at earth.li>**20090605130801
 The arguments to isPrefixOf were the wrong way round. We want to see if
 the line starts "\\begin{code}", not if the line is a prefix of that string.
] 
[Tweak a comment so that it doesn't confuse haddock
Ian Lynagh <igloo at earth.li>**20090605130728] 
[Bump version due to recent changes
Duncan Coutts <duncan at haskell.org>**20090603101833] 
[Ticket #89 final: Regression tests for new dependency behaviour.
rubbernecking.trumpet.stephen at blacksapphire.com**20090601215651
 Ignore-this: 52e04d50f1d045a14706096413c19a85
] 
[Make message "refers to a library which is defined within the same.." more grammatical
rubbernecking.trumpet.stephen at blacksapphire.com**20090601214918
 Ignore-this: 3887c33ff39105f3483ca97a7f05f3eb
] 
[Remove a couple unused imports.
Duncan Coutts <duncan at haskell.org>**20090601192932] 
[Ban upwardly open version ranges in dependencies on base
Duncan Coutts <duncan at haskell.org>**20090601191629
 Fixes ticket #435. This is an approximation. It will ban most
 but not all cases where a package specifies no upper bound.
 There should be no false positives however, that is cases that
 really are always bounded above that the check flags up.
 Doing a fully precise test needs a little more work.
] 
[Split requireProgram into two different functions
Duncan Coutts <duncan at haskell.org>**20090601174846
 Now requireProgram doesn't take a version range and does not check
 the program version (indeed it doesn't need to have one). The new
 function requireProgramVersion takes a required program version
 range and returns the program version. Also update callers.
 Also fixes the check that GHC has a version number.
] 
[Ignore a byte order mark (BOM) when reading UTF8 text files
Duncan Coutts <duncan at haskell.org>**20090531225008
 Yes of course UTF8 text files should not use the BOM but
 notepad.exe does anyway. Fixes ticket #533.
] 
[executables can now depend on a library in the same package.
Duncan Coutts <duncan at haskell.org>**20090531220720
 Fixes ticket #89. The library gets registered into an inplace
 package db file which is used when building the executables.
 Based partly on an original patch by Stephen Blackheath.
] 
[Always build ar files with indexes
Duncan Coutts <duncan at haskell.org>**20090531193412
 Since we have to be able to use these inplace we always need
 the index it's not enough to just make the index on installing.
 This particularly affects OSX.
] 
[Make rendering the ghc package db stack more lenient
Duncan Coutts <duncan at haskell.org>**20090531192545
 Allow the user package db to appear after a specific one.
 No reason not to and makes some things in cabal-install more convenient.
] 
[Simplify version ranges in configure messages and errors
Duncan Coutts <duncan at haskell.org>**20090531192426
 Part of #369
] 
[Add and export simplifyDependency
Duncan Coutts <duncan at haskell.org>**20090531192332
 Just uses simplifyVersionRange on the version range in the dep
] 
[Use the PackageDbStack in the local build info and compiler modules
Duncan Coutts <duncan at haskell.org>**20090531153124
 This lets us pass a whole stack of package databases to the compiler.
 This is more flexible than passing just one and working out what
 other dbs that implies. This also lets us us more than one specific
 package db, which we need for the inplace package db use case.
] 
[Simplify version ranges before printing in configure error message
Duncan Coutts <duncan at haskell.org>**20090530213922
 Part of ticket #369. Now instead of:
   setup: At least the following dependencies are missing:
   base <3 && <4 && <3 && <3 && <4
 we get:
   setup: At least the following dependencies are missing:
   base <3
] 
[Bump version to 1.7.1 due to recent changes
Duncan Coutts <duncan at haskell.org>**20090530211320] 
[Minor renaming
Duncan Coutts <duncan at haskell.org>**20090530202312
 Part of one of Stephen Blackheath's patches
] 
[Improve an internal error message slightly
Duncan Coutts <duncan at haskell.org>**20090530205540] 
[Detect intra-package build-depends
Duncan Coutts <duncan at haskell.org>**20090530204447
 Based on an original patch by Stephen Blackheath
 With this change build-depends on a library within the same package
 are detected. Such deps are not full handled yet so for the moment
 they are explicitly banned, however this is another step towards
 actually supporting such dependencies. In particular deps on
 internal libs are resolved to the internal one in preference to any
 existing external version of the same lib.
] 
[Use accurate per-component package deps
Duncan Coutts <duncan at haskell.org>**20090530202350
 Based on an original patch by Stephen Blackheath
 Previously each component got built using the union of all package
 deps of all components in the entire package. Now we use exactly the
 deps specified for that component. To prevent breaking old packages
 that rely on the sloppy behaviour, package will only get the new
 behaviour if they specify they need at least cabal-version: >= 1.7.1
] 
[Add *LBI variants of withLib and withExe that give corresponding build info
rubbernecking.trumpet.stephen at blacksapphire.com**20090528113232
 Ignore-this: 6856385f1c210e33c352da4a0b6e876a
] 
[Register XmlSyntax and RegularPatterns as known extensions in Language.Haskell.Extension
Niklas Broberg <d00nibro at chalmers.se>**20090529102848
 Ignore-this: 32aacd8aeef9402a1fdf3966a213db7d
 
 Concrete XML syntax is used in the Haskell Server Pages extension 
 language, and a description can be found in the paper "Haskell Server 
 Pages through Dynamic Loading" by Niklas Broberg, published in Haskell 
 Workshop '05.
 
 Regular expression pattern matching is described in the paper "Regular 
 Expression Patterns" by Niklas Broberg, Andreas Farre and Josef 
 Svenningsson, published in ICFP '04.
] 
[Resolve merge conflict with dynlibPref patch
Duncan Coutts <duncan at haskell.org>**20090528115249
 The dynlibPref patch accidentally was only pushed to ghc's branch.
] 
[Use componentPackageDeps, remove packageDeps, add externalPackageDeps
Duncan Coutts <duncan at haskell.org>**20090527225016
 So now when building, we actually use per-component set of package deps.
 There's no actual change in behaviour yet as we're still setting each of
 the componentPackageDeps to the union of all the package deps.
] 
[Pass ComponentLocalBuildInfo to the buildLib/Exe
Duncan Coutts <duncan at haskell.org>**20090527210731
 Not yet used
] 
[Simplify writeInstalledConfig slightly
Duncan Coutts <duncan at haskell.org>**20090527204755] 
[No need to drop dist/installed-pkg-config after every build
Duncan Coutts <duncan at haskell.org>**20090527204500
 We generate this file if necessary when registering.
] 
[Make absoluteInstallDirs only take the package id
Duncan Coutts <duncan at haskell.org>**20090527203112
 It doesn't need the entire PackageDescription
] 
[Rejig calls to per-compiler build functions
Duncan Coutts <duncan at haskell.org>**20090527195146
 So it's now a bit clearer what is going on in the generic build code
 Also shift info calls up to generic code
] 
[Split nhc and hugs's build action into buildLib and buildExe
Duncan Coutts <duncan at haskell.org>**20090527194206] 
[Split JHC's build into buildLib and buildExe
Duncan Coutts <duncan at haskell.org>**20090527192036] 
[Sync LHC module from GHC module
Duncan Coutts <duncan at haskell.org>**20090527191615] 
[Give withLib and withExe sensible types
Duncan Coutts <duncan at haskell.org>**20090527185634] 
[Fix types of libModules and exeModules
Duncan Coutts <duncan at haskell.org>**20090527185108
 Take a Library/Executable rather than a PackageDescription
 Means we're more precise in using it, just passing the info we need.
] 
[Split ghc's build action into buildLib and buildExe
Duncan Coutts <duncan at haskell.org>**20090527183250] 
[Remove unused ghc-only executable wrapper feature
Duncan Coutts <duncan at haskell.org>**20090527183245
 Some kind of shell script wrapper feature might be useful,
 but we should design it properly.
] 
[Fixup .cabal file with the removed modules and files
Duncan Coutts <duncan at haskell.org>**20090527182344] 
[Fix warnings about unused definitions and imports
Duncan Coutts <duncan at haskell.org>**20090527175253] 
[Remove the makefile generation feature
Duncan Coutts <duncan at haskell.org>**20090527175002
 It was an ugly hack and ghc no longer uses it.
] 
[Add new ComponentLocalBuildInfo
Duncan Coutts <duncan at haskell.org>**20090527174418
 We want to have each component have it's own dependencies,
 rather than using the union of deps of the whole package.
] 
[Ticket #89 part 2: Dependency-related test cases and a simple test harness
rubbernecking.trumpet.stephen at blacksapphire.com**20090526133509
 Ignore-this: 830dd56363c34d8edff65314cd8ccb2
 The purpose of these tests is mostly to pin down some existing behaviour to
 ensure it doesn't get broken by the ticket #89 changes.
] 
[Ticket #89 part 1: add targetBuildDepends field to PackageDescription's target-specific BuildInfos
rubbernecking.trumpet.stephen at blacksapphire.com**20090526133729
 Ignore-this: 96572adfad12ef64a51dce2f7c5f738
 This provides dependencies specifically for each library and executable target.
 buildDepends is calculated as the union of the individual targetBuildDepends,
 giving a result that's exactly equivalent to the old behaviour.
] 
[LHC: register the external core files.
Lemmih <lemmih at gmail.com>**20090521021511
 Ignore-this: d4e484d7b8e541c3ec4cb35ba8aba4d0
] 
[Update the support for LHC.
Lemmih <lemmih at gmail.com>**20090515211659
 Ignore-this: 2884d3eca0596a441e3b3c008e16fd6f
] 
[Print a more helpful message when haddock's ghc version doesn't match
Duncan Coutts <duncan at haskell.org>**20090422093240
 Eg now says something like:
 cabal: Haddock's internal GHC version must match the configured GHC version.
 The GHC version is 6.8.2 but haddock is using GHC version 6.10.1
] 
[use -D__HADDOCK__ only when preprocessing for haddock < 2
Andrea Vezzosi <sanzhiyan at gmail.com>**20090302015137
 Ignore-this: d186a5dbebe6d7fdc64e6414493c6271
 haddock-2.x doesn't define any additional macros.
] 
[Make die use an IOError that gets handled at the top level
Duncan Coutts <duncan at haskell.org>**20090301195143
 Rather than printing the error there and then and throwing an
 exit exception. The top handler now catches IOErrors and
 formats and prints them before throwing an exit exception.
 Fixes ticket #512.
] 
[rewrite of Distribution.Simple.Haddock
Andrea Vezzosi <sanzhiyan at gmail.com>**20090219153738
 Ignore-this: 5b465b2b0f5ee001caa0cb19355d6fce
 In addition to (hopefully) making clear what's going on
 we now do the additional preprocessing for all the versions of haddock 
 (but not for hscolour) and we run cpp before moving the files.
] 
[fix imports for non-GHC
Ross Paterson <ross at soi.city.ac.uk>**20090221164939
 Ignore-this: 12756e3863e312352d5f6c69bba63b92
] 
[Fix user guide docs about --disable-library-vanilla
Duncan Coutts <duncan at haskell.org>**20090219165539
 It is not default. Looks like it was a copy and paste error.
] 
[Specify a temp output file for the header/lib checks
Duncan Coutts <duncan at haskell.org>**20090218233928
 Otherwise we litter the current dir with a.out and *.o files.
] 
[Final changelog updates for 1.6.0.2
Duncan Coutts <duncan at haskell.org>**20090218222106] 
[Use more cc options when checking for header files and libs
Duncan Coutts <duncan at haskell.org>**20090218110520
 Use -I. to simulate the search path that gets used when we tell ghc
 to -#include something. Also use the include dirs and cc options of
 dependent packages. These two changes fix about 3 packages each.
] 
[Validate the docbook xml before processing.
Duncan Coutts <duncan at haskell.org>**20090213134136
 Apparently xsltproc does not validate against the dtd.
 This should stop errors creaping back in.
] 
[Make documentation validate
Samuel Bronson <naesten at gmail.com>**20090212235057] 
[Folly the directions for docbook-xsl
Samuel Bronson <naesten at gmail.com>**20090213022615
 As it says in http://docbook.sourceforge.net/release/xsl/current/README:
 
   - Use the base canonical URI in combination with one of the
     pathnames below. For example, for "chunked" HTML, output:
 
     http://docbook.sourceforge.net/release/xsl/current/html/chunk.xsl
 
] 
[Fix compat functions for setting file permissions on windows
Duncan Coutts <duncan at haskell.org>**20090205224415
 Spotted by Dominic Steinitz
] 
[Only print message about ignoring -threaded if its actually present
Duncan Coutts <duncan at haskell.org>**20090206174707] 
[Don't build ghci lib if we're not making vanilla libs
Duncan Coutts <duncan at haskell.org>**20090206173914
 As the .o files will not exist.
] 
[Correct docdir -> mandir in InstallDirs
Samuel Bronson <naesten at gmail.com>**20090203043338] 
[Fix message suggesting the --executables flag
Samuel Bronson <naesten at gmail.com>**20090201010708] 
[Remove #ifdefery for windows, renameFile now works properly
Duncan Coutts <duncan at haskell.org>**20090202004450
 It's even atomic on windows so we don't need the workaround.
] 
[Make withTempDirectory create a new secure temp dir
Duncan Coutts <duncan at haskell.org>**20090201233318
 Rather than taking a specific dir to create.
 Update the one use of the function.
] 
[Add createTempDirectory to Compat.TempFile module
Duncan Coutts <duncan at haskell.org>**20090201233213
 Also clean up imports
] 
[Improve the error message for missing foreign libs and make it fatal
Duncan Coutts <duncan at haskell.org>**20090131184813
 The check should now be accurate enough that we can make it an
 error rather than just a warning.
] 
[Use the cc, cpp and ld options when checking foreign headers and libs
Duncan Coutts <duncan at haskell.org>**20090131184016
 In partiular this is needed for packages that use ./configure
 scripts to write .buildinfo files since they typically do not
 split the cpp/cc/ldoptions into the more specific fields.
] 
[Do the check for foreign libs after running configure
Duncan Coutts <duncan at haskell.org>**20090131182213
 This lets us pick up build info discovered by the ./configure script
] 
[move imports outside ifdef GHC
Ross Paterson <ross at soi.city.ac.uk>**20090130153505] 
[Document most of the new file utility functions
Duncan Coutts <duncan at haskell.org>**20090130151640] 
[#262 iterative tests for foreign dependencies
Gleb Alexeyev <gleb.alexeev at gmail.com>**20090130120228
 Optimize for succesful case. First try all libs and includes in one command, 
 proceed with further tests only if the first test fails. The same goes for libs 
 and headers: look for an offending one only when overall test fails.
 
] 
[Misc minor comment and help message changes
Duncan Coutts <duncan at haskell.org>**20090129233455] 
[Deprecate smartCopySources and copyDirectoryRecursiveVerbose
Duncan Coutts <duncan at haskell.org>**20090129233234
 Also use simplified implementation in terms of recently added functions.
] 
[Switch copyFileVerbose to use compat copyFile
Duncan Coutts <duncan at haskell.org>**20090129233125
 All remaining uses of it do not require copying permissions
] 
[Let the setFileExecutable function work with hugs too
Duncan Coutts <duncan at haskell.org>**20090129232948] 
[Switch hugs wrapper code to use setFileExecutable
Duncan Coutts <duncan at haskell.org>**20090129232542
 instead of get/setPermissions which don't really work properly.
] 
[Switch last uses of copyFile to copyFileVerbose
Duncan Coutts <duncan at haskell.org>**20090129232429] 
[Stop using smartCopySources or copyDirectoryRecursiveVerbose
Duncan Coutts <duncan at haskell.org>**20090129231656
 Instead if copyDirectoryRecursiveVerbose use installDirectoryContents
 and for smartCopySources use findModuleFiles and installExecutableFiles
 In both cases the point is so that we use functions for installing
 files rather than functions to copy files.
] 
[Use installOrdinaryFile and installExecutableFile in various places
Duncan Coutts <duncan at haskell.org>**20090129231321
 instead of copyFileVerbose
] 
[Make the Compat.CopyFile module with with old and new ghc
Duncan Coutts <duncan at haskell.org>**20090129225423] 
[Add a bunch of utility functions for installing files
Duncan Coutts <duncan at haskell.org>**20090129180243
 We want to separate the functions that do ordinary file copies
 from the functions that install files because in the latter
 case we have to do funky things with file permissions.
] 
[Use setFileExecutable instead of copyPermissions
Duncan Coutts <duncan at haskell.org>**20090129180130
 This lets us get rid of the Compat.Permissions module
] 
[Export setFileOrdinary and setFileExecutable from Compat.CopyFile
Duncan Coutts <duncan at haskell.org>**20090129173413] 
[Warn if C dependencies not found (kind of fixes #262)
gleb.alexeev at gmail.com**20090126185832
 
 This is just a basic check - generate a sample program and check if it compiles and links with relevant flags. Error messages (warning messages, 
 actually) could use some improvement.
] 
[Pass include directories to LHC
Samuel Bronson <naesten at gmail.com>**20090127220021] 
[Add Distribution.Compat.CopyFile module
Duncan Coutts <duncan at haskell.org>**20090128181115
 This is to work around the file permissions problems with the
 standard System.Directory.copyFile function. When installing
 files we do not want to copy permissions or attributes from the
 source files. On unix we want to use specific permissions and
 on windows we want to inherit default permissions. On unix:
 copyOrdinaryFile   sets the permissions to -rw-r--r--
 copyExecutableFile sets the permissions to -rwxr-xr-x
] 
[Remove unused support for installing dynamic exe files
Duncan Coutts <duncan at haskell.org>**20090128170421
 No idea why this was ever added, they've never been built.
] 
[Check for ghc-options: -threaded in libraries
Duncan Coutts <duncan at haskell.org>**20090125161226
 It's totally unnecessary and messes up profiling in older ghc versions.
] 
[Filter ghc-options -threaded for libs too
Duncan Coutts <duncan at haskell.org>**20090125145035] 
[New changelog entries for 1.7.x
Duncan Coutts <duncan at haskell.org>**20090123175645] 
[Update changelog for 1.6.0.2
Duncan Coutts <duncan at haskell.org>**20090123175629] 
[Fix openNewBinaryFile on Windows with ghc-6.6
Duncan Coutts <duncan at haskell.org>**20090122172100
 fdToHandle calls fdGetMode which does not work with ghc-6.6 on
 windows, the workaround is not to call fdToHandle, but call
 openFd directly. Bug reported by Alistair Bayley, ticket #473.
] 
[filter -threaded when profiling is on
Duncan Coutts <duncan at haskell.org>**20090122014425
 Fixes #317. Based on a patch by gleb.alexeev at gmail.com
] 
[Move installDataFiles out of line to match installIncludeFiles
Duncan Coutts <duncan at haskell.org>**20090122005318] 
[Fix installIncludeFiles to create target directories properly
Duncan Coutts <duncan at haskell.org>**20090122004836
 Previously for 'install-includes: subdir/blah.h' we would not
 create the subdir in the target location.
] 
[Typo in docs for source-repository
Joachim Breitner <mail at joachim-breitner.de>**20090121220747] 
[Make 'ghc-options: -O0' a warning rather than an error
Duncan Coutts <duncan at haskell.org>**20090118141949] 
[Improve runE parse error message
Duncan Coutts <duncan at haskell.org>**20090116133214
 Only really used in parsing config files derived from command line flags.
] 
[The Read instance for License and InstalledPackageInfo is authoritative
Duncan Coutts <duncan at haskell.org>**20090113234229
 It is ghc's optimised InstalledPackageInfo parser that needs updating.
 
 rolling back:
 
 Fri Dec 12 18:36:22 GMT 2008  Ian Lynagh <igloo at earth.li>
   * Fix Show/Read for License
   We were ending up with things like
       InstalledPackageInfo {
           ...
           license = LGPL Nothing,
           ...
       }
   i.e. "LGPL Nothing" rather than "LGPL", which we couldn't then read.
 
     M ./Distribution/License.hs -2 +14
] 
[Swap the order of global usage messages
Duncan Coutts <duncan at haskell.org>**20090113191810
 Put the more important one first.
] 
[Enable the global command usage to be set
Duncan Coutts <duncan at haskell.org>**20090113181303
 extend it rather than overriding it.
 Also rearrange slightly the default global --help output.
] 
[Use dynlibdir = libdir for the moment
Duncan Coutts <duncan at well-typed.com>**20090519134115
 It will need more thought about how much control the user needs
 and what the default shared libs management scheme should be.
] 
[Tweak new build system
Ian Lynagh <igloo at earth.li>**20090404204426] 
[GHC new build system fixes
Ian Lynagh <igloo at earth.li>**20090329153151] 
[Add ghc.mk for the new GHC build system
Ian Lynagh <igloo at earth.li>**20090324211819] 
[Allow --with-ghc to be specified when running Cabal
Ian Lynagh <igloo at earth.li>**20090225172249] 
[Ban ghc-options: --make
Duncan Coutts <duncan at haskell.org>**20081223170621
 I dunno, some people...
] 
[Update changelog for 1.6.0.2 release
Duncan Coutts <duncan at haskell.org>**20081211142202] 
[Make the compiler PackageDB stuff more flexible
Duncan Coutts <duncan at haskell.org>**20081211141649
 We support using multiple package dbs, however the method for
 specifying them is very limited. We specify a single package db
 and that implicitly specifies any other needed dbs. For example
 the user or a specific db require the global db too. We now
 represent that stack explicitly. The user interface still uses
 the single value method and we convert internally.
] 
[On Windows, if gcc isn't where we expect it then keep looking
Ian Lynagh <igloo at earth.li>**20090109153507] 
[Fix Show/Read for License
Ian Lynagh <igloo at earth.li>**20081212183622
 We were ending up with things like
     InstalledPackageInfo {
         ...
         license = LGPL Nothing,
         ...
     }
 i.e. "LGPL Nothing" rather than "LGPL", which we couldn't then read.
] 
[Un-deprecate Distribution.ModuleName.simple for now
Ian Lynagh <igloo at earth.li>**20081212164540
 Distribution/Simple/PreProcess.hs uses it, so this causes build failures
 with -Werror.
] 
[Use the first three lhc version digits
Duncan Coutts <duncan at haskell.org>**20081211224048
 Rather than two, and do it in a simpler way.
] 
[Remove obsolete test code
Duncan Coutts <duncan at haskell.org>**20081211142054] 
[Update the VersionInterval properties which now all pass
Duncan Coutts <duncan at haskell.org>**20081210145653] 
[Eliminate NoLowerBound, Versions do have a lower bound of 0.
Duncan Coutts <duncan at haskell.org>**20081210145433
 This eliminates the duplicate representation of ">= 0" vs "-any"
 and makes VersionIntervals properly canonical.
] 
[Update and extend the Version quickcheck properties
Duncan Coutts <duncan at haskell.org>**20081210143251
 One property fails. The failure reveals that the VersionInterval type
 is not quite a canonical representation of the VersionRange semantics.
 This is because the lowest Version is [0] and not -infinity, so for
 example the intervals (.., 0] and [0,0] are equivalent.
] 
[Add documentation for VersionRange functions
Duncan Coutts <duncan at haskell.org>**20081210140632
 With properties.
] 
[Export withinVersion and deprecate betweenVersionsInclusive
Duncan Coutts <duncan at haskell.org>**20081210140411] 
[Add checking of Version validity to the VersionIntervals invariant
Duncan Coutts <duncan at haskell.org>**20081210134100
 Version numbers have to be a non-empty sequence of non-negataive ints.
] 
[Fix implementation of withinIntervals
Duncan Coutts <duncan at haskell.org>**20081210000141] 
[Fix configCompilerAux to consider user-supplied program flags
Duncan Coutts <duncan at haskell.org>**20081209193320
 This fixes a bug in cabal-install
] 
[Add ModuleName.fromString and deprecate ModuleName.simple
Duncan Coutts <duncan at haskell.org>**20081209151232
 Also document the functions in the ModuleName module.
] 
[Check for absolute, outside-of-tree and dist/ paths
Duncan Coutts <duncan at haskell.org>**20081208234312] 
[Export more VersionIntervals operations
Duncan Coutts <duncan at haskell.org>**20081208222420
 and check internal invariants
] 
[Check for use of cc-options: -O
Duncan Coutts <duncan at haskell.org>**20081208182047] 
[Fake support for NamedFieldPuns in ghc-6.8
Duncan Coutts <duncan at haskell.org>**20081208180018
 Implement it in terms of the -XRecordPuns which was accidentally
 added in ghc-6.8 and deprecates in 6.10 in favor of NamedFieldPuns
 So this is for compatability so we can tell package authors always
 to use NamedFieldPuns instead.
] 
[Make getting ghc supported language extensions its own function
Duncan Coutts <duncan at haskell.org>**20081208175815] 
[Check for use of deprecated extensions
Duncan Coutts <duncan at haskell.org>**20081208175441] 
[Add a list of deprecated extenstions
Duncan Coutts <duncan at haskell.org>**20081208175337
 Along with possibly another extension that replaces it.
] 
[Change the checking of new language extensions
Duncan Coutts <duncan at haskell.org>**20081207202315
 Check for new language extensions added in Cabal-1.2 and also 1.6.
 Simplify the checking of -X ghc flags. Now always suggest using
 the extensions field, as we separately warn about new extenssons.
] 
[Tweak docs for VersionRange and VersionIntervals
Duncan Coutts <duncan at haskell.org>**20081207184749] 
[Correct and simplify checkVersion
Duncan Coutts <duncan at haskell.org>**20081205232845] 
[Make users of VersionIntervals use the new view function
Duncan Coutts <duncan at haskell.org>**20081205232707] 
[Make VersionIntervals an abstract type
Duncan Coutts <duncan at haskell.org>**20081205232041
 Provide asVersionIntervals as the view function for a VersionRange
 This will let us enforce the internal data invariant
] 
[Slight clarity improvement in compiler language extension handling
Duncan Coutts <duncan at haskell.org>**20081205210747] 
[Slightly simplify the maintenance burden of adding new language extensions
Duncan Coutts <duncan at haskell.org>**20081205210543] 
[Distributing a package with no synopsis and no description is inexcusable
Duncan Coutts <duncan at haskell.org>**20081205160719
 Previously if one or the other or both were missing we only warned.
 Now if neither are given it's an error. We still warn about either
 missing.
] 
[Add Test.Laws module for checking class laws
Duncan Coutts <duncan at haskell.org>**20081204144238
 For Functor, Monoid and Traversable.
] 
[Add QC Arbitrary instances for Version and VersionRange
Duncan Coutts <duncan at haskell.org>**20081204144204] 
[Remove accidentally added bianry file
Duncan Coutts <duncan at haskell.org>**20081203000824] 
[Fix #396 and add let .Haddock find autogen modules
Andrea Vezzosi <sanzhiyan at gmail.com>**20081201114853] 
[Add checks for new and unknown licenses
Duncan Coutts <duncan at haskell.org>**20081202172742] 
[Add MIT and versioned GPL and LGPL licenses
Duncan Coutts <duncan at haskell.org>**20081202171033
 Since Cabal-1.4 we've been able to parse versioned licenses
 and unknown licenses without the parser falling over.
] 
[Don't nub lists of dependencies
Duncan Coutts <duncan at haskell.org>**20081202162259
 It's pretty meaningless since it's only a syntactic check.
 The proper thing is to maintain a dependency set or to
 simplify dependencies before printing them.
] 
[Fix the date in the LICENSE file
Duncan Coutts <duncan at haskell.org>**20081202161457] 
[Fix the version number in the makefile
Duncan Coutts <duncan at haskell.org>**20081202161441] 
[Use VersionRange abstractly
Duncan Coutts <duncan at haskell.org>**20081202160321] 
[Do the cabal version check properly.
Duncan Coutts <duncan at haskell.org>**20081202155410
 Instead of matching on the actual expression ">= x.y" we use the
 sematic view of the version range so we can do it precisely.
 Also use foldVersionRange to simplify a couple functions.
] 
[Drop support for ghc-6.4 era OPTIONS pragmas
Duncan Coutts <duncan at haskell.org>**20081202154744
 It's still possible to build with ghc-6.4 but you have to pass
 extra flags like "ghc --make -cpp -fffi Setup.hs" We could not
 keep those OPTIONS pragmas and make it warning-free with ghc-6.10.
 See http://hackage.haskell.org/trac/ghc/ticket/2800 for details.
] 
[Almost make the VersionRange type abstract
Duncan Coutts <duncan at haskell.org>**20081202154307
 Export constructor functions and deprecate all the real constructors
 We should not be pattern matching on this type because it's just
 syntax. For meaningful questions we should be matching on the
 VersionIntervals type which represents the semantics.
] 
[Change isAnyVersion to be a semantic rather than syntactic test
Duncan Coutts <duncan at haskell.org>**20081202142123
 Also add simplify and isNoVersion.
] 
[Add VersionIntervals, a view of VersionRange
Duncan Coutts <duncan at haskell.org>**20081202141040
 as a sequence of non-overlapping intervals. This provides a canonical
 representation for the semantics of a VersionRange. This makes several
 operations easier.
] 
[Fix pretty-printing of version wildcards, was missing leading ==
Duncan Coutts <duncan at haskell.org>**20081202135949] 
[Add a fold function for the VersionRange
Duncan Coutts <duncan at haskell.org>**20081202135845
 Use it to simplify the eval / withinRange function
] 
[Improve the error on invalid file globs slightly
Duncan Coutts <duncan at haskell.org>**20081202135335] 
[Use commaSep everywhere in the Check module
Duncan Coutts <duncan at haskell.org>**20081202135208] 
[Fix message in the extra-source-files field check
Duncan Coutts <duncan at haskell.org>**20081202135000] 
[Add checks for file glob syntax
Duncan Coutts <duncan at haskell.org>**20081202133954
 It requires cabal-version: >= 1.6 to be specified
] 
[Add check for use of "build-depends: foo == 1.*" syntax
Duncan Coutts <duncan at haskell.org>**20081202131459
 It requires Cabal-1.6 or later.
] 
[Distinguish version wild cards in the VersionRange AST
Duncan Coutts <duncan at haskell.org>**20081128170513
 Rather than encoding them in existing constructors.
 This will enable us to check that uses of the new syntax
 are flagged in .cabal files with cabal-version: >= 1.6
] 
[Fix comment in LHC module
Duncan Coutts <duncan at haskell.org>**20081123100710
 Yes, LHC really does use ghc-pkg (with a different package.conf)
] 
[Use the new bug-reports and source-repository info in the .cabal file
Duncan Coutts <duncan at haskell.org>**20081123100041] 
[Simplify build-depends and base3/4 flags
Duncan Coutts <duncan at haskell.org>**20081123100003] 
[Simplify default global libdir for LHC
Duncan Coutts <duncan at haskell.org>**20081123095802
 So it uses libdir=$prefix/lib rather than libdir=/usr/local/lib
] 
[Simplify the compat exceptions stuff
Duncan Coutts <duncan at haskell.org>**20081123095737] 
[Fix warnings in the LHC module
Duncan Coutts <duncan at haskell.org>**20081122224011] 
[Distribution/Simple/GHC.hs: remove tabs for whitespace to eliminate warnings in cabal-install
gwern0 at gmail.com**20081122190011
 Ignore-this: 2fd54090af86e67e25e51ade42992b53
] 
[Warn about use of tabs
Duncan Coutts <duncan at haskell.org>**20081122154134] 
[Bump Cabal HEAD version to 1.7.x development series
Duncan Coutts <duncan at haskell.org>**20081122145817
 Support for LHC is the first divergence between 1.7
 and the stable 1.6.x series.
] 
[Update changelog for 1.6.0.x fixes
Duncan Coutts <duncan at haskell.org>**20081122145758] 
[LHC: Don't use --no-user-package-conf. It doesn't work with ghc-6.8.
Lemmih <lemmih at gmail.com>**20081122012341
 Ignore-this: 88a837b38cf3e897cc5ed4bb22046cee
] 
[Semi-decent lhc support.
Lemmih <lemmih at gmail.com>**20081121034138] 
[Escape ld-options with the -optl prefix when passing them to ghc
Duncan Coutts <duncan at haskell.org>**20081103151931
 Fixes ticket #389
] 
[Simplify previous pkg-config fix
Duncan Coutts <duncan at haskell.org>**20081101200309] 
[Fix bug where we'd try to configure an empty set of pkg-config packages
Duncan Coutts <duncan at haskell.org>**20081101195512
 This happened when the lib used pkg-config but the exe did not.
 It cropped up in hsSqlite3-0.0.5.
] 
[Ensure that the lib target directory is present when installing
Duncan Coutts <duncan at haskell.org>**20081017004437
 Variant on a patch from Bryan O'Sullivan
] 
[Release kind is now rc
Duncan Coutts <duncan at haskell.org>**20081011183201] 
[TAG 1.6.0.1
Duncan Coutts <duncan at haskell.org>**20081011182516] 
[Bump version to 1.6.0.1
Duncan Coutts <duncan at haskell.org>**20081011182459] 
[Do not use the new meta-data fields yet
Duncan Coutts <duncan at haskell.org>**20081011182307
 Avoid chicken and egg problem. We cannot upload Cabsl-1.6 to
 hackage until hackage is using Cabal-1.6 if it uses features
 that are introduced in 1.6. So just comment them out for now.
] 
[Export a compat function for older Setup.hs scripts
Duncan Coutts <duncan at haskell.org>**20081011182131
 Makes it possible for alex and happy to work with cabal-1.2 -> 1.6
] 
[Fix instructions in README for building with 6.6 and filepath
Duncan Coutts <duncan at haskell.org>**20081011002819] 
[Update release procedure in Makefile
Duncan Coutts <duncan at haskell.org>**20081010181445
 Building the haddock docs requires building first. Arguably this is
 a Cabal bug. It should probably generate the "autogen" files for
 haddock and not just for build.
] 
[TAG 1.6.0.0
Duncan Coutts <duncan at haskell.org>**20081010061435] 
[Bump version number to 1.6.0.0
Duncan Coutts <duncan at haskell.org>**20081010052409] 
[Update changelog
Duncan Coutts <duncan at haskell.org>**20081010052354] 
[Remove the releaseNotes file
Duncan Coutts <duncan at haskell.org>**20081010052101
 It did not actually contain any release notes and just
 duplicated information in the README which was confusing.
] 
[Merge the info from the releaseNotes file into the README file
Duncan Coutts <duncan at haskell.org>**20081010052020] 
[Fix haddock comment for haddock-0.8
Duncan Coutts <duncan at haskell.org>**20081010050913] 
[Fix parsing of ld,cc,cpp-options for flags containing ','
Duncan Coutts <duncan at haskell.org>**20081010050829
 The ',' character is not used as a separator and is allowed
 within flag tokens. Fixes at least HsPerl5.
] 
[Update versions in regression check script
Duncan Coutts <duncan at haskell.org>**20081009223429] 
[Bump devel version number to 1.5.6
Duncan Coutts <duncan at haskell.org>**20081009223350
 To make easier to track recent Cabal / cabal-install changes
] 
[Update changelog
Duncan Coutts <duncan at haskell.org>**20081009223330] 
[Update the README
Duncan Coutts <duncan at haskell.org>**20081009221851] 
[Make sdist work for libs that use the Paths_pkgname module
Duncan Coutts <duncan at haskell.org>**20081009214507
 Do it by just filtering that module out of the package
 description before running sdist etc. This isn't lovely
 because it steals that module name from the module namespace
 but at least it now works. Thanks to Jean-Philippe Bernardy
 for the first iteration of this patch.
] 
[xargs -s breaks solaris
Duncan Coutts <duncan at haskell.org>**20081008185041
 Hopefully we can figure out a better fix for recent cygwin
 versions of xargs which are apparently broken.
 
 rolling back:
 
 Wed Oct  8 08:44:10 PDT 2008  Clemens Fruhwirth <clemens at endorphin.org>
   * Also respect the max. command line size in Makefile driven builds
 
     M ./Distribution/Simple/GHC.hs -7 +13
     M ./Distribution/Simple/GHC/Makefile.hs -1 +1
     M ./Distribution/Simple/GHC/Makefile.in -1 +1
] 
[Make auto-generated *_paths.hs module warning-free.
Thomas Schilling <nominolo at googlemail.com>**20081106142734
 
 On newer GHCs using {-# OPTIONS_GHC -fffi #-} gives a warning which
 can lead to a compile failure when -Werror is activated.  We therefore
 emit this option if we know that the LANGUAGE pragma is supported 
 (ghc >= 6.6.1).
] 
[Add GHC 6.10.1's extensions to the list in Language.Haskell.Extension
Ian Lynagh <igloo at earth.li>**20081019141408] 
[Also respect the max. command line size in Makefile driven builds
Clemens Fruhwirth <clemens at endorphin.org>**20081008154410] 
[Add a few type sigs to help hugs and as documentation
Duncan Coutts <duncan at haskell.org>**20081007214120
 Thanks to Dimitry and Ross for identifying the problem.
] 
[add missing exeExtension when stripping an executable
Simon Marlow <marlowsd at gmail.com>**20081007134757] 
[Add -no-auto-link-packages also to Makefile driven build
Clemens Fruhwirth <clemens at endorphin.org>**20081007095454] 
[Also install dynamically linked executable (when present)
Clemens Fruhwirth <clemens at endorphin.org>**20081006095107] 
[Use "-no-auto-link-packages" when using GHC to link
Ian Lynagh <igloo at earth.li>**20081004111103
 When making packages like ghc-prim we need GHC to not automatically
 try to link with base and haskell98.
] 
[Relax dependencyInconsistencies to allow the base-3,4 thing
Duncan Coutts <duncan at haskell.org>**20081002074142
 Previously we said a package graph was inconsistent if two
 dependencies on the same package name specified different
 versions. Now we say that two such dependencies on different
 versions are ok if there is a direct dependency between those
 two package versions. So if your package graph ends up with
 both base 3 and base 4 in it, then that's ok because base 3
 directly depends on base 4, so we declare it not to be an
 inconsistency. This removes the scary warnings at configure
 time (fixing ticket #366) and also adjusts the invariant and
 assertion of the InstallPlan ADT in cabal-install.
] 
[Document the bug-reports field
Duncan Coutts <duncan at haskell.org>**20081001042635] 
[Add bug-reports field to Cabal.cabal
Duncan Coutts <duncan at haskell.org>**20081001035605] 
[Add bug-reports url field
Duncan Coutts <duncan at haskell.org>**20081001035516
 Ticket #323
] 
[Update the package description a bit
Duncan Coutts <duncan at haskell.org>**20081001034350] 
[Specify a source repository for Cabal in Cabal.cabal
Duncan Coutts <duncan at haskell.org>**20081001034325] 
[Document the source-repository stuff
Duncan Coutts <duncan at haskell.org>**20081001033928] 
[Add some checks on the repository sections
Duncan Coutts <duncan at haskell.org>**20081001033755] 
[Use unknown rather than specific other repo kinds
Duncan Coutts <duncan at haskell.org>**20081001033637
 We can still add more as necessary
] 
[Add support for specifying source repos in .cabal files
Duncan Coutts <duncan at haskell.org>**20080930222708
 Ticket #58. Does not yet include checking.
] 
[Simplify parsing sections in the .cabal file
Duncan Coutts <duncan at haskell.org>**20080930215509
 Allow flags, lib and exes in any order and handle unknown sections better.
] 
[Treat "cabal --flag command" as "cabal command --flag"
Duncan Coutts <duncan at haskell.org>**20080928070627
 eg "cabal -v configure" to mean "cabal configure -v"
 For flags that are not recognised as global flags,
 pass them on to the sub-command.
] 
[Fix how Cabal makes the value for __GLASGOW_HASKELL__
Ian Lynagh <igloo at earth.li>**20080920212207
 6.10.x was giving us 601 rather than 610.
] 
[Rename --distdir flag to --builddir
Duncan Coutts <duncan at haskell.org>**20080920180326
 Old aliases kept for compatibility
] 
[Update the version number in the Makefile
Ian Lynagh <igloo at earth.li>**20080920175306] 
[Correct the version number in the Makefile
Ian Lynagh <igloo at earth.li>**20080920175105] 
[Update build-deps
Ian Lynagh <igloo at earth.li>**20080920175053] 
[Fix building with GHC 6.6
Ian Lynagh <igloo at earth.li>**20080920162927] 
[TAG 1.5.5
Duncan Coutts <duncan at haskell.org>**20080919142307] 
[Bump version number to 1.5.5
Duncan Coutts <duncan at haskell.org>**20080919140130
 Ready to make the 1.6 branch
] 
[TAG 6.10 branch has been forked
Ian Lynagh <igloo at earth.li>**20080919123438] 
Patch bundle hash:
cfdd2d2ab2baf267b2f12e030d27374a69784d79


More information about the cabal-devel mailing list