Merge pull request #97 from etrepum/add-source-index-invalidation

more correct fix for add-source cache invalidation
creswick · Feb 21, 2013 · 38b9d5c · 38b9d5c
2 parents b1995ef + 4d45ad9
commit 38b9d5c
Show file tree

Hide file tree

Showing 3 changed files with 15 additions and 9 deletions.
diff --git a/src/Distribution/Dev/AddSource.hs b/src/Distribution/Dev/AddSource.hs
@@ -50,6 +50,7 @@ import System.Directory                      ( getDirectoryContents
                                              , setCurrentDirectory
                                              , createDirectoryIfMissing
                                              , getTemporaryDirectory
+                                             , removeFile
                                              )
 import System.Exit                           ( ExitCode(..) )
 import System.FilePath                       ( takeExtension, takeBaseName
@@ -71,7 +72,7 @@ import qualified Distribution.Verbosity      as V
 import Distribution.Dev.Command ( CommandActions(..), CommandResult(..) )
 import Distribution.Dev.Flags   ( Config, getVerbosity )
 import Distribution.Dev.Sandbox ( resolveSandbox, localRepoPath
-                                , Sandbox, indexTar, indexTarBase
+                                , Sandbox, indexTar, indexTarBase, indexCache
                                 )
 
 import Distribution.Simple.Utils ( debug, notice )
@@ -120,6 +121,7 @@ addSources flgs fns = do
                  return CommandOk
 
 -- |Atomically write an index tarball in the supplied directory
+-- and invalidates the cache
 writeIndex :: Sandbox a -- ^The local repository path
            -> [T.Entry] -- ^The index entries
            -> IO ()
@@ -130,6 +132,10 @@ writeIndex sandbox ents =
                          hFlush h
                          return fn
        renameFile newIndexName $ indexTar sandbox
+       removeFile (indexCache sandbox) `Ex.catch` \e ->
+         if isDoesNotExistError e
+         then return ()
+         else ioError e
     where
       pth = localRepoPath sandbox
       withTmpIndex = Ex.bracket (openTempFile pth indexTarBase) (hClose . snd)

diff --git a/src/Distribution/Dev/Sandbox.hs b/src/Distribution/Dev/Sandbox.hs
@@ -6,6 +6,8 @@ module Distribution.Dev.Sandbox
     , UnknownVersion
     , cabalConf
     , getVersion
+    , indexCache
+    , indexCacheBase
     , indexTar
     , indexTarBase
     , localRepoPath
@@ -121,6 +123,12 @@ resolveSandbox cfg = do
   newSandbox v relSandbox
 
 -- |The name of the cabal-install package index
+indexCacheBase :: FilePath
+indexCacheBase = "00-index.cache"
+
+indexCache :: Sandbox a -> FilePath
+indexCache sb = localRepoPath sb </> indexCacheBase
+
 indexTarBase :: FilePath
 indexTarBase = "00-index.tar"
 

diff --git a/test/RunTests.hs b/test/RunTests.hs
@@ -162,14 +162,6 @@ addSourceStaysSandboxed v cabalDev dirName =
       -- with an empty package index
       withCabalDev assertExitsFailure ["install", pkgStr]
 
-      -- XXX: https://github.com/haskell/cabal/issues/1213
-      -- Workaround for a cabal-install bug where the index cache
-      -- may be considered valid when it isn't due to a race condition
-      -- with the modification time.
-      let cacheFile = indexTar sb `replaceExtension` "cache"
-      cacheExists <- doesFileExist cacheFile
-      when cacheExists $ removeFile cacheFile
-
       withCabalDev assertExitsSuccess ["add-source", packageDir]
 
       -- Do the installation. Now this library should be registered