Misc fixes here and there

cabal-install/Distribution/Client/IndexUtils.hs

@@ -129,8 +129,6 @@ convert index' = PackageIndex.fromList
 --
 -- This is a higher level wrapper used internally in cabal-install.
 --
--- FIXME: 'getSourcePackages' has a lazy IO bug that leads to a 'resource busy'
--- error when opening the "index-00.tar" file for a second time.
 getSourcePackages :: Verbosity -> [Repo] -> IO SourcePackageDb
 getSourcePackages verbosity [] = do
   warn verbosity $ "No remote package servers have been specified. Usually "
@@ -228,7 +226,8 @@ whenCacheOutOfDate origFile cacheFile action = do
     else do
       origTime  <- getModificationTime origFile
       cacheTime <- getModificationTime cacheFile
-      unless (cacheTime >= origTime) action
+      -- FIXME: Revert back to >= when we'll add finer-resolution mtime utils.
+      unless (cacheTime > origTime) action
 
 
 ------------------------------------------------------------------------
@@ -372,9 +371,9 @@ readPackageIndexCacheFile :: Package pkg
                           -> FilePath
                           -> IO (PackageIndex pkg, [Dependency])
 readPackageIndexCacheFile mkPkg indexFile cacheFile = do
-  indexHnd <- openFile indexFile ReadMode
   cache    <- liftM readIndexCache (BSS.readFile cacheFile)
-  packageIndexFromCache mkPkg indexHnd cache
+  withFile indexFile ReadMode $ \indexHnd ->
+    packageIndexFromCache mkPkg indexHnd cache
 
 
 packageIndexFromCache :: Package pkg

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
@@ -333,15 +334,20 @@ sandboxDeleteSource verbosity buildTreeRefs _sandboxFlags globalFlags = do
 sandboxListSources :: Verbosity -> SandboxFlags -> GlobalFlags
                       -> IO ()
 sandboxListSources verbosity _sandboxFlags globalFlags = do
-  (_sandboxDir, pkgEnv) <- tryLoadSandboxConfig verbosity
+  (sandboxDir, pkgEnv) <- tryLoadSandboxConfig verbosity
                            (globalConfigFile globalFlags)
   indexFile             <- tryGetIndexFilePath (pkgEnvSavedConfig pkgEnv)
 
-  refs <- Index.listBuildTreeRefs indexFile
+  refs <- Index.listBuildTreeRefs verbosity Index.ListIgnored indexFile
   when (null refs) $
-    info verbosity $ "Index file '" ++ indexFile
+    notice verbosity $ "Index file '" ++ indexFile
     ++ "' has no references to local build trees."
-  mapM_ putStrLn refs
+  when (not . null $ refs) $ do
+    notice verbosity $ "Source dependencies registered "
+      ++ "in the current sandbox ('" ++ sandboxDir ++ "'):\n\n"
+    mapM_ putStrLn refs
+    notice verbosity $ "\nTo unregister source dependencies, "
+                       ++ "use the 'sandbox delete-source' command."
 
 -- | Invoke the @hc-pkg@ tool with provided arguments, restricted to the
 -- sandbox.
@@ -427,7 +433,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

cabal-install/Distribution/Client/Sandbox/Index.hs

@@ -11,13 +11,19 @@ module Distribution.Client.Sandbox.Index (
     createEmpty,
     addBuildTreeRefs,
     removeBuildTreeRefs,
+    ListIgnoredBuildTreeRefs(..),
     listBuildTreeRefs,
     validateIndexPath,
 
     defaultIndexFileName
   ) 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

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
@@ -267,6 +269,7 @@ isDepModified verbosity now (packageDir, timestamp) = do
       when (modTime > now) $
         warn verbosity $ "File '" ++ dep
                          ++ "' has a modification time that is in the future."
+      -- FIXME: Revert back to >= when we'll add finer-resolution mtime utils.
       if modTime > timestamp
         then do
           debug verbosity ("Dependency has a modified source file: " ++ dep)

cabal-install/Distribution/Compat/Time.hs

@@ -16,6 +16,10 @@ import System.Time (ClockTime(..), getClockTime
 -- | The number of seconds since the UNIX epoch
 type EpochTime = Int64
 
+-- FIXME: 'getModificationTime' has a very low (second-level) resolution in all
+-- released GHCs, which is bad for our purposes.
+-- See hackage.haskell.org/trac/ghc/ticket/7473
+-- We should copy the file modification utils that Shake uses.
 getModTime :: FilePath -> IO EpochTime
 getModTime path =  do
 #if MIN_VERSION_directory(1,2,0)

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