Faster cabal update

Contributed by Hideyuki Tanaka.

Author: tibbe

cabal-install/Distribution/Client/Update.hs

@@ -21,6 +21,8 @@ import Distribution.Client.FetchUtils
 import qualified Distribution.Client.PackageIndex as PackageIndex
 import Distribution.Client.IndexUtils
          ( getSourcePackages, updateRepoIndexCache )
+import Distribution.Client.Utils
+         ( writeFileAtomic )
 import qualified Paths_cabal_install
          ( version )
 
@@ -29,12 +31,11 @@ import Distribution.Package
 import Distribution.Version
          ( anyVersion, withinRange )
 import Distribution.Simple.Utils
-         ( warn, notice, writeFileAtomic )
+         ( warn, notice )
 import Distribution.Verbosity
          ( Verbosity )
 
 import qualified Data.ByteString.Lazy       as BS
-import qualified Data.ByteString.Lazy.Char8 as BS.Char8
 import Distribution.Client.GZipUtils (maybeDecompress)
 import qualified Data.Map as Map
 import System.FilePath (dropExtension)
@@ -57,8 +58,7 @@ updateRepo verbosity repo = case repoKind repo of
     notice verbosity $ "Downloading the latest package list from "
                     ++ remoteRepoName remoteRepo
     indexPath <- downloadIndex verbosity remoteRepo (repoLocalDir repo)
-    writeFileAtomic (dropExtension indexPath) . BS.Char8.unpack
-                                              . maybeDecompress
+    writeFileAtomic (dropExtension indexPath) . maybeDecompress
                                             =<< BS.readFile indexPath
     updateRepoIndexCache verbosity repo
 

cabal-install/Distribution/Client/Utils.hs

@@ -2,18 +2,23 @@
 
 module Distribution.Client.Utils ( MergeResult(..)
                                  , mergeBy, duplicates, duplicatesBy
-                                 , moreRecentFile, inDir, numberOfProcessors )
+                                 , moreRecentFile, inDir, numberOfProcessors
+                                 , writeFileAtomic )
        where
 
 import Data.List
          ( sortBy, groupBy )
 import Foreign.C.Types ( CInt(..) )
 import System.Directory
          ( doesFileExist, getModificationTime
-         , getCurrentDirectory, setCurrentDirectory )
+         , getCurrentDirectory, setCurrentDirectory
+         , renameFile, removeFile )
+import System.FilePath ( splitFileName, (<.>) )
+import System.IO ( openBinaryTempFile, hClose )
 import System.IO.Unsafe ( unsafePerformIO )
 import qualified Control.Exception as Exception
-         ( finally )
+         ( bracketOnError, finally )
+import qualified Data.ByteString.Lazy as BS
 
 -- | Generic merging utility. For sorted input lists this is a full outer join.
 --
@@ -72,3 +77,22 @@ foreign import ccall "getNumberOfProcessors" c_getNumberOfProcessors :: IO CInt
 -- program, so unsafePerformIO is safe here.
 numberOfProcessors :: Int
 numberOfProcessors = fromEnum $ unsafePerformIO c_getNumberOfProcessors
+
+-- | Writes a file atomically.
+--
+-- The file is either written sucessfully or an IO exception is raised and
+-- the original file is left unchanged.
+--
+-- On windows it is not possible to delete a file that is open by a process.
+-- This case will give an IO exception but the atomic property is not affected.
+--
+writeFileAtomic :: FilePath -> BS.ByteString -> IO ()
+writeFileAtomic targetPath content = do
+  let (targetDir, targetFile) = splitFileName targetPath
+  Exception.bracketOnError
+    (openBinaryTempFile targetDir $ targetFile <.> "tmp")
+    (\(tmpPath, handle) -> hClose handle >> removeFile tmpPath)
+    (\(tmpPath, handle) -> do
+        BS.hPut handle content
+        hClose handle
+        renameFile tmpPath targetPath)