[commit: packages/Cabal] ghc-head: Revert the old behaviour of listBuildTreeRefs. (f10c214)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/Cabal

On branch  : ghc-head
Link       : http://git.haskell.org/?p=packages/Cabal.git;a=commit;h=f10c2145dd63086aff4bb082d83547fd87450e46

>---------------------------------------------------------------

commit f10c2145dd63086aff4bb082d83547fd87450e46
Author: Mikhail Glushenkov <the.dead.shall.rise at gmail.com>
Date:   Mon Apr 29 17:05:52 2013 +0200

    Revert the old behaviour of listBuildTreeRefs.
    
    Also make it possible to list ignored build tree refs (those present in the
    index file but not in the source package DB).


>---------------------------------------------------------------

f10c2145dd63086aff4bb082d83547fd87450e46
 cabal-install/Distribution/Client/Sandbox.hs       |    8 ++++--
 cabal-install/Distribution/Client/Sandbox/Index.hs |   30 ++++++++++++++++++--
 .../Distribution/Client/Sandbox/Timestamp.hs       |   12 ++++----
 cabal-install/Main.hs                              |    4 +--
 4 files changed, 41 insertions(+), 13 deletions(-)

diff --git a/cabal-install/Distribution/Client/Sandbox.hs b/cabal-install/Distribution/Client/Sandbox.hs
index 8573f12..0079c9b 100644
--- a/cabal-install/Distribution/Client/Sandbox.hs
+++ b/cabal-install/Distribution/Client/Sandbox.hs
@@ -248,7 +248,8 @@ doAddSource verbosity buildTreeRefs sandboxDir pkgEnv = do
   -- If we're running 'sandbox add-source' for the first time for this compiler,
   -- we need to create an initial timestamp record.
   (comp, platform, _) <- configCompilerAux . savedConfigureFlags $ savedConfig
-  maybeAddCompilerTimestampRecord sandboxDir (compilerId comp) platform indexFile
+  maybeAddCompilerTimestampRecord verbosity sandboxDir indexFile
+    (compilerId comp) platform
 
   withAddTimestamps sandboxDir $ do
     -- FIXME: path canonicalisation is done in addBuildTreeRefs, but we do it
@@ -337,7 +338,7 @@ sandboxListSources verbosity _sandboxFlags globalFlags = do
                            (globalConfigFile globalFlags)
   indexFile             <- tryGetIndexFilePath (pkgEnvSavedConfig pkgEnv)
 
-  refs <- Index.listBuildTreeRefs indexFile
+  refs <- Index.listBuildTreeRefs verbosity Index.ListIgnored indexFile
   when (null refs) $
     notice verbosity $ "Index file '" ++ indexFile
     ++ "' has no references to local build trees."
@@ -427,7 +428,8 @@ reinstallAddSourceDeps verbosity config numJobsFlag sandboxDir globalFlags = do
       globalFlags'   = savedGlobalFlags      config `mappend` globalFlags
 
   indexFile            <- tryGetIndexFilePath config
-  buildTreeRefs        <- Index.listBuildTreeRefs indexFile
+  buildTreeRefs        <- Index.listBuildTreeRefs verbosity
+                          Index.DontListIgnored indexFile
   retVal               <- newIORef NoDepsReinstalled
 
   unless (null buildTreeRefs) $ do
diff --git a/cabal-install/Distribution/Client/Sandbox/Index.hs b/cabal-install/Distribution/Client/Sandbox/Index.hs
index 044a95d..07dd458 100644
--- a/cabal-install/Distribution/Client/Sandbox/Index.hs
+++ b/cabal-install/Distribution/Client/Sandbox/Index.hs
@@ -11,6 +11,7 @@ module Distribution.Client.Sandbox.Index (
     createEmpty,
     addBuildTreeRefs,
     removeBuildTreeRefs,
+    ListIgnoredBuildTreeRefs(..),
     listBuildTreeRefs,
     validateIndexPath,
 
@@ -18,6 +19,11 @@ module Distribution.Client.Sandbox.Index (
   ) where
 
 import qualified Distribution.Client.Tar as Tar
+import Distribution.Client.IndexUtils ( getSourcePackages )
+import Distribution.Client.PackageIndex ( allPackages )
+import Distribution.Client.Types ( Repo(..), LocalRepo(..)
+                                 , SourcePackageDb(..)
+                                 , SourcePackage(..), PackageLocation(..) )
 import Distribution.Client.Utils ( byteStringToFilePath, filePathToByteString
                                  , makeAbsoluteToCwd, tryCanonicalizePath )
 
@@ -160,14 +166,32 @@ removeBuildTreeRefs verbosity path l' = do
         Nothing    -> True
         (Just pth) -> pth `notElem` l
 
+-- | A build tree ref can become ignored if the user later adds a build tree ref
+-- with the same package ID. We display ignored build tree refs when the user
+-- runs 'cabal sandbox list-sources', but do not look at their timestamps in
+-- 'reinstallAddSourceDeps'.
+data ListIgnoredBuildTreeRefs = ListIgnored | DontListIgnored
+
 -- | List the local build trees that are referred to from the index.
-listBuildTreeRefs :: FilePath -> IO [FilePath]
-listBuildTreeRefs path = do
+listBuildTreeRefs :: Verbosity -> ListIgnoredBuildTreeRefs -> FilePath
+                     -> IO [FilePath]
+listBuildTreeRefs verbosity listIgnored path = do
   checkIndexExists path
-  buildTreeRefs <- readBuildTreePathsFromFile path
+  buildTreeRefs <-
+    case listIgnored of
+      DontListIgnored -> do
+        let repo = Repo { repoKind = Right LocalRepo
+                        , repoLocalDir = takeDirectory path }
+        pkgIndex <- fmap packageIndex . getSourcePackages verbosity $ [repo]
+        return [ pkgPath | (LocalUnpackedPackage pkgPath) <-
+                    map packageSource . allPackages $ pkgIndex ]
+
+      ListIgnored -> readBuildTreePathsFromFile path
+
   _ <- evaluate (length buildTreeRefs)
   return buildTreeRefs
 
+
 -- | Check that the package index file exists and exit with error if it does not.
 checkIndexExists :: FilePath -> IO ()
 checkIndexExists path = do
diff --git a/cabal-install/Distribution/Client/Sandbox/Timestamp.hs b/cabal-install/Distribution/Client/Sandbox/Timestamp.hs
index dd6dd65..a9b6b3c 100644
--- a/cabal-install/Distribution/Client/Sandbox/Timestamp.hs
+++ b/cabal-install/Distribution/Client/Sandbox/Timestamp.hs
@@ -45,7 +45,8 @@ import Distribution.Text                             (display)
 import Distribution.Verbosity                        (Verbosity)
 
 import Distribution.Client.Utils                     (inDir, tryCanonicalizePath)
-import Distribution.Client.Sandbox.Index             (listBuildTreeRefs)
+import Distribution.Client.Sandbox.Index
+       (ListIgnoredBuildTreeRefs(..), listBuildTreeRefs)
 
 import Distribution.Compat.Exception                 (catchIO)
 import Distribution.Compat.Time                      (EpochTime, getCurTime,
@@ -135,11 +136,12 @@ removeTimestamps l pathsToRemove = foldr removeTimestamp [] l
       else t : rest
 
 -- | If a timestamp record for this compiler doesn't exist, add a new one.
-maybeAddCompilerTimestampRecord :: FilePath -> CompilerId -> Platform
-                                   -> FilePath
+maybeAddCompilerTimestampRecord :: Verbosity -> FilePath -> FilePath
+                                   -> CompilerId -> Platform
                                    -> IO ()
-maybeAddCompilerTimestampRecord sandboxDir compId platform indexFile = do
-  buildTreeRefs <- listBuildTreeRefs indexFile
+maybeAddCompilerTimestampRecord verbosity sandboxDir indexFile
+                                compId platform = do
+  buildTreeRefs <- listBuildTreeRefs verbosity DontListIgnored indexFile
   withTimestampFile sandboxDir $ \timestampRecords -> do
     let key = timestampRecordKey compId platform
     case lookup key timestampRecords of
diff --git a/cabal-install/Main.hs b/cabal-install/Main.hs
index 7f0c2f9..940422d 100644
--- a/cabal-install/Main.hs
+++ b/cabal-install/Main.hs
@@ -241,8 +241,8 @@ configureAction (configFlags, configExFlags) extraArgs globalFlags = do
     -- If we've switched to a new compiler, we need to add a timestamp record
     -- for this compiler to the timestamp file.
     indexFile     <- tryGetIndexFilePath config
-    maybeAddCompilerTimestampRecord sandboxDir
-      (compilerId comp) platform indexFile
+    maybeAddCompilerTimestampRecord verbosity sandboxDir indexFile
+      (compilerId comp) platform
 
   maybeWithSandboxDirOnSearchPath useSandbox $
     configure verbosity