Merge branch 'master' of github.com:haskell/cabal

cabal-install/Distribution/Client/Configure.hs

@@ -82,7 +82,7 @@ configure verbosity packageDBs repos comp conf
         configureCommand (const configFlags) extraArgs
 
     Right installPlan -> case InstallPlan.ready installPlan of
-      [pkg@(ConfiguredPackage (SourcePackage _ _ (LocalUnpackedPackage _)) _ _ _)] ->
+      [pkg@(ConfiguredPackage (SourcePackage _ _ (LocalUnpackedPackage _) _) _ _ _)] ->
         configurePackage verbosity
           (InstallPlan.planPlatform installPlan)
           (InstallPlan.planCompiler installPlan)
@@ -138,7 +138,8 @@ planLocalPackage verbosity comp configFlags configExFlags installedPkgIndex
       localPkg = SourcePackage {
         packageInfoId             = packageId pkg,
         Source.packageDescription = pkg,
-        packageSource             = LocalUnpackedPackage "."
+        packageSource             = LocalUnpackedPackage ".",
+        packageDescrOverride      = Nothing
       }
 
       testsEnabled = fromFlagOrDefault False $ configTests configFlags
@@ -194,7 +195,7 @@ configurePackage :: Verbosity
                  -> [String]
                  -> IO ()
 configurePackage verbosity platform comp scriptOptions configFlags
-  (ConfiguredPackage (SourcePackage _ gpkg _) flags stanzas deps) extraArgs =
+  (ConfiguredPackage (SourcePackage _ gpkg _ _) flags stanzas deps) extraArgs =
 
   setupWrapper verbosity
     scriptOptions (Just pkg) configureCommand configureFlags extraArgs

cabal-install/Distribution/Client/Dependency/Modular/IndexConversion.hs

@@ -92,7 +92,7 @@ convSPI os arch cid = mkIndex . convSPI' os arch cid
 
 -- | Convert a single source package into the solver-specific format.
 convSP :: OS -> Arch -> CompilerId -> SourcePackage -> (PN, I, PInfo)
-convSP os arch cid (SourcePackage (PackageIdentifier pn pv) gpd _pl) =
+convSP os arch cid (SourcePackage (PackageIdentifier pn pv) gpd _ _pl) =
   let i = I pv InRepo
   in  (pn, i, convGPD os arch cid (PI pn i) gpd)
 

cabal-install/Distribution/Client/Dependency/TopDown.hs

@@ -368,7 +368,7 @@ pruneBottomUp platform comp constraints =
                               [ (dep, Constraints.conflicting cs dep)
                               | dep <- missing ]
 
-    configure cs (UnconfiguredPackage (SourcePackage _ pkg _) _ flags stanzas) =
+    configure cs (UnconfiguredPackage (SourcePackage _ pkg _ _) _ flags stanzas) =
       finalizePackageDescription flags (dependencySatisfiable cs)
                                  platform comp [] (enableStanzas stanzas pkg)
     dependencySatisfiable cs =
@@ -397,7 +397,7 @@ configurePackage platform comp available spkg = case spkg of
   InstalledAndSource ipkg apkg -> fmap (InstalledAndSource ipkg)
                                        (configure apkg)
   where
-  configure (UnconfiguredPackage apkg@(SourcePackage _ p _) _ flags stanzas) =
+  configure (UnconfiguredPackage apkg@(SourcePackage _ p _ _) _ flags stanzas) =
     case finalizePackageDescription flags dependencySatisfiable
                                     platform comp [] (enableStanzas stanzas p) of
       Left missing        -> Left missing
@@ -481,7 +481,7 @@ topologicalSortNumbering installedPkgIndex sourcePkgIndex =
       ++ [ ((), packageName pkg, nub deps)
          | pkgs@(pkg:_) <- PackageIndex.allPackagesByName sourcePkgIndex
          , let deps = [ depName
-                      | SourcePackage _ pkg' _ <- pkgs
+                      | SourcePackage _ pkg' _ _ <- pkgs
                       , Dependency depName _ <-
                           buildDepends (flattenPackageDescription pkg') ] ]
 
@@ -517,7 +517,7 @@ selectNeededSubset installedPkgIndex sourcePkgIndex = select mempty mempty
                         | pkg <- moreInstalled
                         , dep <- depends pkg ]
                      ++ [ name
-                        | SourcePackage _ pkg _ <- moreSource
+                        | SourcePackage _ pkg _ _ <- moreSource
                         , Dependency name _ <-
                             buildDepends (flattenPackageDescription pkg) ]
         installedPkgIndex'' = foldl' (flip PackageIndex.insert)

cabal-install/Distribution/Client/IndexUtils.hs

@@ -175,8 +175,11 @@ readRepoIndex verbosity repo =
         packageInfoId      = pkgid,
         packageDescription = packageDesc pkgEntry,
         packageSource      = case pkgEntry of
-          NormalPackage _ _ _      -> RepoTarballPackage repo pkgid Nothing
-          BuildTreeRef  _ path _ _ -> LocalUnpackedPackage path
+          NormalPackage _ _ _ _    -> RepoTarballPackage repo pkgid Nothing
+          BuildTreeRef  _ _ path _ -> LocalUnpackedPackage path,
+        packageDescrOverride = case pkgEntry of
+          NormalPackage _ _ pkgtxt _ -> Just pkgtxt
+          _                          -> Nothing
       }
       where
         pkgid = packageId pkgEntry
@@ -231,19 +234,18 @@ whenCacheOutOfDate origFile cacheFile action = do
 --
 
 -- | An index entry is either a normal package, or a local build tree reference.
-data PackageEntry = NormalPackage PackageId GenericPackageDescription BlockNo
-                  | BuildTreeRef PackageId FilePath GenericPackageDescription
-                    BlockNo
+data PackageEntry = NormalPackage PackageId GenericPackageDescription ByteString BlockNo
+                  | BuildTreeRef  PackageId GenericPackageDescription FilePath   BlockNo
 
 type MkPackageEntry = IO PackageEntry
 
 instance Package PackageEntry where
-  packageId (NormalPackage pkgid _ _   ) = pkgid
-  packageId (BuildTreeRef  pkgid _ _ _ ) = pkgid
+  packageId (NormalPackage pkgid _ _ _) = pkgid
+  packageId (BuildTreeRef  pkgid _ _ _) = pkgid
 
 packageDesc :: PackageEntry -> GenericPackageDescription
-packageDesc (NormalPackage _   descr _ ) = descr
-packageDesc (BuildTreeRef  _ _ descr _ ) = descr
+packageDesc (NormalPackage _ descr _ _) = descr
+packageDesc (BuildTreeRef  _ descr _ _) = descr
 
 -- | Read a compressed \"00-index.tar.gz\" file into a 'PackageIndex'.
 --
@@ -302,7 +304,7 @@ extractPkg entry blockNo = case Tar.entryContent entry of
      | takeExtension fileName == ".cabal"
     -> case splitDirectories (normalise fileName) of
         [pkgname,vers,_] -> case simpleParse vers of
-          Just ver -> Just $ return (NormalPackage pkgid descr blockNo)
+          Just ver -> Just $ return (NormalPackage pkgid descr content blockNo)
             where
               pkgid  = PackageIdentifier (PackageName pkgname) ver
               parsed = parsePackageDescription . fromUTF8 . BS.Char8.unpack
@@ -320,7 +322,7 @@ extractPkg entry blockNo = case Tar.entryContent entry of
         let path   = byteStringToFilePath content
         cabalFile <- findPackageDesc path
         descr     <- PackageDesc.Parse.readPackageDescription normal cabalFile
-        return $ BuildTreeRef (packageId descr) path descr blockNo
+        return $ BuildTreeRef (packageId descr) descr path blockNo
 
   _ -> Nothing
 
@@ -358,7 +360,7 @@ updatePackageIndexCacheFile indexFile cacheFile = do
     mkCache pkgs prefs =
         [ CachePreference pref          | pref <- prefs ]
      ++ [ CachePackageId pkgid blockNo
-        | (NormalPackage pkgid _ blockNo) <- pkgs ]
+        | (NormalPackage pkgid _ _ blockNo) <- pkgs ]
      ++ [ CacheBuildTreeRef blockNo
         | (BuildTreeRef _ _ _ blockNo) <- pkgs]
 
@@ -392,9 +394,11 @@ packageIndexFromCache mkPkg hnd = accum mempty []
       -- The magic here is that we use lazy IO to read the .cabal file
       -- from the index tarball if it turns out that we need it.
       -- Most of the time we only need the package id.
-      pkg <- unsafeInterleaveIO $ do
-        getEntryContent blockno >>= readPackageDescription
-      let srcpkg = mkPkg (NormalPackage pkgid pkg blockno)
+      ~(pkg, pkgtxt) <- unsafeInterleaveIO $ do
+        pkgtxt <- getEntryContent blockno
+        pkg    <- readPackageDescription pkgtxt
+        return (pkg, pkgtxt)
+      let srcpkg = mkPkg (NormalPackage pkgid pkg pkgtxt blockno)
       accum (srcpkg:srcpkgs) prefs entries
 
     accum srcpkgs prefs (CacheBuildTreeRef blockno : entries) = do
@@ -404,7 +408,7 @@ packageIndexFromCache mkPkg hnd = accum mempty []
       path <- liftM byteStringToFilePath . getEntryContent $ blockno
       pkg  <- do cabalFile <- findPackageDesc path
                  PackageDesc.Parse.readPackageDescription normal cabalFile
-      let srcpkg = mkPkg (BuildTreeRef (packageId pkg) path pkg blockno)
+      let srcpkg = mkPkg (BuildTreeRef (packageId pkg) pkg path blockno)
       accum (srcpkg:srcpkgs) prefs entries
 
     accum srcpkgs prefs (CachePreference pref : entries) =

cabal-install/Distribution/Client/Install.hs

@@ -96,7 +96,7 @@ import qualified Distribution.Simple.Setup as Cabal
          ( installCommand, InstallFlags(..), emptyInstallFlags
          , emptyTestFlags, testCommand, Flag(..) )
 import Distribution.Simple.Utils
-         ( rawSystemExit, comparing )
+         ( rawSystemExit, comparing, writeFileAtomic )
 import Distribution.Simple.InstallDirs as InstallDirs
          ( PathTemplate, fromPathTemplate, toPathTemplate, substPathTemplate
          , initialPathTemplateEnv, installDirsTemplateEnv )
@@ -781,13 +781,13 @@ performInstallations verbosity
 
   executeInstallPlan verbosity jobControl useLogFile installPlan $ \cpkg ->
     installConfiguredPackage platform compid configFlags
-                             cpkg $ \configFlags' src pkg ->
+                             cpkg $ \configFlags' src pkg pkgoverride ->
       fetchSourcePackage verbosity fetchLimit src $ \src' ->
         installLocalPackage verbosity buildLimit (packageId pkg) src' $ \mpath ->
           installUnpackedPackage verbosity buildLimit installLock numJobs
                                  (setupScriptOptions installedPkgIndex cacheLock)
                                  miscOptions configFlags' installFlags haddockFlags
-                                 compid pkg mpath useLogFile
+                                 compid pkg pkgoverride mpath useLogFile
 
   where
     platform = InstallPlan.planPlatform installPlan
@@ -956,16 +956,17 @@ executeInstallPlan verbosity jobCtl useLogFile plan0 installPkg =
 installConfiguredPackage :: Platform -> CompilerId
                          ->  ConfigFlags -> ConfiguredPackage
                          -> (ConfigFlags -> PackageLocation (Maybe FilePath)
-                                         -> PackageDescription -> a)
+                                         -> PackageDescription
+                                         -> PackageDescriptionOverride -> a)
                          -> a
 installConfiguredPackage platform comp configFlags
-  (ConfiguredPackage (SourcePackage _ gpkg source) flags stanzas deps)
+  (ConfiguredPackage (SourcePackage _ gpkg source pkgoverride) flags stanzas deps)
   installPkg = installPkg configFlags {
     configConfigurationsFlags = flags,
     configConstraints = map thisPackageVersion deps,
     configBenchmarks = toFlag False,
     configTests = toFlag (TestStanzas `elem` stanzas)
-  } source pkg
+  } source pkg pkgoverride
   where
     pkg = case finalizePackageDescription flags
            (const True)
@@ -1051,13 +1052,25 @@ installUnpackedPackage
   -> HaddockFlags
   -> CompilerId
   -> PackageDescription
+  -> PackageDescriptionOverride
   -> Maybe FilePath -- ^ Directory to change to before starting the installation.
   -> UseLogFile -- ^ File to log output to (if any)
   -> IO BuildResult
 installUnpackedPackage verbosity buildLimit installLock numJobs
                        scriptOptions miscOptions
                        configFlags installConfigFlags haddockFlags
-                       compid pkg workingDir useLogFile =
+                       compid pkg pkgoverride workingDir useLogFile = do
+
+  -- Override the .cabal file if necessary
+  case pkgoverride of
+    Nothing     -> return ()
+    Just pkgtxt -> do
+      let descFilePath = fromMaybe "." workingDir
+                     </> display (packageName pkgid) <.> "cabal"
+      info verbosity $
+        "Updating " ++ display (packageName pkgid) <.> "cabal"
+                    ++ " with the latest revision from the index."
+      writeFileAtomic descFilePath pkgtxt
 
   -- Configure phase
   onFailure ConfigureFailed $ withJobLimit buildLimit $ do

cabal-install/Distribution/Client/InstallSymlink.hs

@@ -133,7 +133,7 @@ symlinkBinaries configFlags installFlags plan =
       , PackageDescription.buildable (PackageDescription.buildInfo exe) ]
 
     pkgDescription :: ConfiguredPackage -> PackageDescription
-    pkgDescription (ConfiguredPackage (SourcePackage _ pkg _) flags stanzas _) =
+    pkgDescription (ConfiguredPackage (SourcePackage _ pkg _ _) flags stanzas _) =
       case finalizePackageDescription flags
              (const True)
              platform compilerId [] (enableStanzas stanzas pkg) of

cabal-install/Distribution/Client/Setup.hs

@@ -491,13 +491,15 @@ instance Monoid ReportFlags where
 
 data UnpackFlags = UnpackFlags {
       unpackDestDir :: Flag FilePath,
-      unpackVerbosity :: Flag Verbosity
+      unpackVerbosity :: Flag Verbosity,
+      unpackPristine :: Flag Bool
     }
 
 defaultUnpackFlags :: UnpackFlags
 defaultUnpackFlags = UnpackFlags {
     unpackDestDir = mempty,
-    unpackVerbosity = toFlag normal
+    unpackVerbosity = toFlag normal,
+    unpackPristine  = toFlag False
    }
 
 unpackCommand :: CommandUI UnpackFlags
@@ -514,14 +516,21 @@ unpackCommand = CommandUI {
          "where to unpack the packages, defaults to the current directory."
          unpackDestDir (\v flags -> flags { unpackDestDir = v })
          (reqArgFlag "PATH")
+
+       , option [] ["pristine"]
+           ("Unpack the original pristine tarball, rather than updating the "
+           ++ ".cabal file with the latest revision from the package archive.")
+           unpackPristine (\v flags -> flags { unpackPristine = v })
+           trueArg
        ]
   }
 
 instance Monoid UnpackFlags where
   mempty = defaultUnpackFlags
   mappend a b = UnpackFlags {
-     unpackDestDir = combine unpackDestDir
-    ,unpackVerbosity = combine unpackVerbosity
+    unpackDestDir   = combine unpackDestDir,
+    unpackVerbosity = combine unpackVerbosity,
+    unpackPristine  = combine unpackPristine
   }
     where combine field = field a `mappend` field b
 

cabal-install/Distribution/Client/Targets.hs

@@ -472,9 +472,10 @@ readPackageTarget verbosity target = case target of
         pkg <- readPackageDescription verbosity =<< findPackageDesc dir
         return $ PackageTargetLocation $
                    SourcePackage {
-                     packageInfoId      = packageId pkg,
-                     packageDescription = pkg,
-                     packageSource      = fmap Just location
+                     packageInfoId        = packageId pkg,
+                     packageDescription   = pkg,
+                     packageSource        = fmap Just location,
+                     packageDescrOverride = Nothing
                    }
 
       LocalTarballPackage tarballFile ->
@@ -497,9 +498,10 @@ readPackageTarget verbosity target = case target of
         Just pkg ->
           return $ PackageTargetLocation $
                      SourcePackage {
-                       packageInfoId      = packageId pkg,
-                       packageDescription = pkg,
-                       packageSource      = fmap Just location
+                       packageInfoId        = packageId pkg,
+                       packageDescription   = pkg,
+                       packageSource        = fmap Just location,
+                       packageDescrOverride = Nothing
                      }
 
     extractTarballPackageCabalFile :: FilePath -> String

cabal-install/Distribution/Client/Types.hs

@@ -29,6 +29,7 @@ import Distribution.Version
 
 import Data.Map (Map)
 import Network.URI (URI)
+import Data.ByteString.Lazy (ByteString)
 import Distribution.Compat.Exception
          ( SomeException )
 
@@ -94,12 +95,17 @@ instance PackageFixedDeps ConfiguredPackage where
 -- | A package description along with the location of the package sources.
 --
 data SourcePackage = SourcePackage {
-    packageInfoId      :: PackageId,
-    packageDescription :: GenericPackageDescription,
-    packageSource      :: PackageLocation (Maybe FilePath)
+    packageInfoId        :: PackageId,
+    packageDescription   :: GenericPackageDescription,
+    packageSource        :: PackageLocation (Maybe FilePath),
+    packageDescrOverride :: PackageDescriptionOverride
   }
   deriving Show
 
+-- | We sometimes need to override the .cabal file in the tarball with
+-- the newer one from the package index.
+type PackageDescriptionOverride = Maybe ByteString
+
 instance Package SourcePackage where packageId = packageInfoId
 
 data OptionalStanza