Move 'writeFileAtomic' from D.C.Utils to D.S.Utils.

Cabal/Cabal.cabal

@@ -37,6 +37,8 @@ Flag base4
 Flag base3
     Description: Choose the new smaller, split-up base package.
 
+Flag bytestring-in-base
+
 Library
   build-depends:   base       >= 2   && < 5,
                    filepath   >= 1   && < 1.4
@@ -49,6 +51,10 @@ Library
                    containers >= 0.1 && < 0.6,
                    array      >= 0.1 && < 0.5,
                    pretty     >= 1   && < 1.2
+  if flag(bytestring-in-base)
+    Build-Depends: base >= 2.0 && < 2.2
+  else
+    Build-Depends: base < 2.0 || >= 3.0, bytestring >= 0.9
 
   if !os(windows)
     Build-Depends: unix       >= 2.0 && < 2.7

Cabal/Distribution/PackageDescription/Parse.hs

@@ -74,6 +74,7 @@ import Data.Monoid ( Monoid(..) )
 import Data.List  (nub, unfoldr, partition, (\\))
 import Control.Monad (liftM, foldM, when, unless)
 import System.Directory (doesFileExist)
+import qualified Data.ByteString.Lazy.Char8 as BS.Char8
 
 import Distribution.Text
          ( Text(disp, parse), display, simpleParse )
@@ -1168,7 +1169,8 @@ ppCustomField :: (String,String) -> Doc
 ppCustomField (name,val) = text name <> colon <+> showFreeText val
 
 writeHookedBuildInfo :: FilePath -> HookedBuildInfo -> IO ()
-writeHookedBuildInfo fpath = writeFileAtomic fpath . showHookedBuildInfo
+writeHookedBuildInfo fpath = writeFileAtomic fpath . BS.Char8.pack
+                             . showHookedBuildInfo
 
 showHookedBuildInfo :: HookedBuildInfo -> String
 showHookedBuildInfo (mb_lib_bi, ex_bis) = render $

Cabal/Distribution/Simple/Configure.hs

@@ -151,6 +151,8 @@ import Text.PrettyPrint
     ( comma, punctuate, render, nest, sep )
 import Distribution.Compat.Exception ( catchExit, catchIO )
 
+import qualified Data.ByteString.Lazy.Char8 as BS.Char8
+
 tryGetConfigStateFile :: (Read a) => FilePath -> IO (Either String a)
 tryGetConfigStateFile filename = do
   exists <- doesFileExist filename
@@ -214,7 +216,7 @@ writePersistBuildConfig :: FilePath -> LocalBuildInfo -> IO ()
 writePersistBuildConfig distPref lbi = do
   createDirectoryIfMissing False distPref
   writeFileAtomic (localBuildInfoFile distPref)
-                  (showHeader pkgid ++ '\n' : show lbi)
+                  (BS.Char8.pack $ showHeader pkgid ++ '\n' : show lbi)
   where
     pkgid   = packageId (localPkgDescr lbi)
 

Cabal/Distribution/Simple/Hugs.hs

@@ -119,6 +119,8 @@ import System.Exit
          ( ExitCode(ExitSuccess) )
 import Distribution.Compat.Exception
 
+import qualified Data.ByteString.Lazy.Char8 as BS.Char8
+
 -- -----------------------------------------------------------------------------
 -- Configuring
 
@@ -597,7 +599,7 @@ install verbosity lbi libDir installProgDir binDir targetProgDir buildPref (prog
                              let args = hugsOptions ++ [targetName, "\"$@\""]
                              in unlines ["#! /bin/sh",
                                          unwords ("runhugs" : args)]
-        writeFileAtomic exeFile script
+        writeFileAtomic exeFile (BS.Char8.pack script)
         setFileExecutable exeFile
 
 hugsInstallSuffixes :: [String]

Cabal/Distribution/Simple/JHC.hs

@@ -89,6 +89,8 @@ import Data.List                ( nub )
 import Data.Char                ( isSpace )
 import Data.Maybe               ( fromMaybe )
 
+import qualified Data.ByteString.Lazy.Char8 as BS.Char8
+
 
 -- -----------------------------------------------------------------------------
 -- Configuring
@@ -161,7 +163,7 @@ buildLib verbosity pkg_descr lbi lib clbi = do
   let pkgid = display (packageId pkg_descr)
       pfile = buildDir lbi </> "jhc-pkg.conf"
       hlfile= buildDir lbi </> (pkgid ++ ".hl")
-  writeFileAtomic pfile $ jhcPkgConf pkg_descr
+  writeFileAtomic pfile . BS.Char8.pack $ jhcPkgConf pkg_descr
   rawSystemProgram verbosity jhcProg $
      ["--build-hl="++pfile, "-o", hlfile] ++
      args ++ map display (libModules lib)
@@ -218,4 +220,3 @@ installExe verb dest build_dir (progprefix,progsuffix) _ exe = do
         out   = (progprefix ++ exe_name ++ progsuffix) </> exeExtension
     createDirectoryIfMissingVerbose verb True dest
     installExecutableFile verb (build_dir </> src) (dest </> out)
-

Cabal/Distribution/Simple/Register.hs

@@ -113,7 +113,7 @@ import Data.Maybe
          ( isJust, fromMaybe, maybeToList )
 import Data.List
          ( partition, nub )
-
+import qualified Data.ByteString.Lazy.Char8 as BS.Char8
 
 -- -----------------------------------------------------------------------------
 -- Registration
@@ -377,7 +377,7 @@ unregister pkg lbi regFlags = do
                          packageDb pkgid
       in if genScript
            then writeFileAtomic unregScriptFileName
-                  (invocationAsSystemScript buildOS invocation)
+                  (BS.Char8.pack $ invocationAsSystemScript buildOS invocation)
             else runProgramInvocation verbosity invocation
     Hugs -> do
         _ <- tryIO $ removeDirectoryRecursive (libdir installDirs)

Cabal/Distribution/Simple/Utils.hs

@@ -147,6 +147,8 @@ import Data.Char as Char
     ( toLower, chr, ord )
 import Data.Bits
     ( Bits((.|.), (.&.), shiftL, shiftR) )
+import qualified Data.ByteString.Lazy as BS
+import qualified Data.ByteString.Lazy.Char8 as BS.Char8
 
 import System.Directory
     ( getDirectoryContents, doesDirectoryExist, doesFileExist, removeFile
@@ -163,7 +165,8 @@ import System.FilePath
 import System.Directory
     ( createDirectory, renameFile, removeDirectoryRecursive )
 import System.IO
-    ( Handle, openFile, openBinaryFile, IOMode(ReadMode), hSetBinaryMode
+    ( Handle, openFile, openBinaryFile, openBinaryTempFile
+    , IOMode(ReadMode), hSetBinaryMode
     , hGetContents, stderr, stdout, hPutStr, hFlush, hClose )
 import System.IO.Error as IO.Error
     ( isDoesNotExistError, isAlreadyExistsError
@@ -200,9 +203,9 @@ import Distribution.Compat.CopyFile
          ( copyFile, copyOrdinaryFile, copyExecutableFile
          , setFileOrdinary, setFileExecutable, setDirOrdinary )
 import Distribution.Compat.TempFile
-         ( openTempFile, openNewBinaryFile, createTempDirectory )
+         ( openTempFile, createTempDirectory )
 import Distribution.Compat.Exception
-         ( IOException, throwIOIO, tryIO, catchIO, catchExit, onException )
+         ( IOException, throwIOIO, tryIO, catchIO, catchExit )
 import Distribution.Verbosity
 
 #ifdef VERSION_base
@@ -918,21 +921,16 @@ withFileContents name action =
 -- 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 -> String -> IO ()
-writeFileAtomic targetFile content = do
-  (tmpFile, tmpHandle) <- openNewBinaryFile targetDir template
-  do  hPutStr tmpHandle content
-      hClose tmpHandle
-      renameFile tmpFile targetFile
-   `onException` do hClose tmpHandle
-                    removeFile tmpFile
-  where
-    template = targetName <.> "tmp"
-    targetDir | null targetDir_ = currentDir
-              | otherwise       = targetDir_
-    --TODO: remove this when takeDirectory/splitFileName is fixed
-    --      to always return a valid dir
-    (targetDir_,targetName) = splitFileName targetFile
+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)
 
 -- | Write a file but only if it would have new content. If we would be writing
 -- the same as the existing content then leave the file as is so that we do not
@@ -944,9 +942,10 @@ rewriteFile path newContent =
     existingContent <- readFile path
     _ <- evaluate (length existingContent)
     unless (existingContent == newContent) $
-      writeFileAtomic path newContent
+      writeFileAtomic path (BS.Char8.pack newContent)
   where
-    mightNotExist e | isDoesNotExistError e = writeFileAtomic path newContent
+    mightNotExist e | isDoesNotExistError e = writeFileAtomic path
+                                              (BS.Char8.pack newContent)
                     | otherwise             = ioError e
 
 -- | The path name that represents the current directory.
@@ -1112,7 +1111,7 @@ withUTF8FileContents name action =
 -- Uses 'writeFileAtomic', so provides the same guarantees.
 --
 writeUTF8File :: FilePath -> String -> IO ()
-writeUTF8File path = writeFileAtomic path . toUTF8
+writeUTF8File path = writeFileAtomic path . BS.Char8.pack . toUTF8
 
 -- | Fix different systems silly line ending conventions
 normaliseLineEndings :: String -> String

cabal-install/Distribution/Client/HttpUtils.hs

@@ -190,7 +190,7 @@ downloadURI verbosity uri path = do
     Left err   -> die $ "Failed to download " ++ show uri ++ " : " ++ show err
     Right body -> do
       info verbosity ("Downloaded to " ++ path)
-      writeFileAtomic path (ByteString.unpack body)
+      writeFileAtomic path body
       --FIXME: check the content-length header matches the body length.
       --TODO: stream the download into the file rather than buffering the whole
       --      thing in memory.

cabal-install/Distribution/Client/Update.hs

@@ -21,8 +21,6 @@ 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 )
 
@@ -31,7 +29,7 @@ import Distribution.Package
 import Distribution.Version
          ( anyVersion, withinRange )
 import Distribution.Simple.Utils
-         ( warn, notice )
+         ( writeFileAtomic, warn, notice )
 import Distribution.Verbosity
          ( Verbosity )
 
@@ -80,4 +78,3 @@ checkForSelfUpgrade verbosity repos = do
     notice verbosity $
          "Note: there is a new version of cabal-install available.\n"
       ++ "To upgrade, run: cabal install cabal-install"
-

cabal-install/Distribution/Client/Utils.hs

@@ -2,8 +2,7 @@
 
 module Distribution.Client.Utils ( MergeResult(..)
                                  , mergeBy, duplicates, duplicatesBy
-                                 , moreRecentFile, inDir, numberOfProcessors
-                                 , writeFileAtomic )
+                                 , moreRecentFile, inDir, numberOfProcessors )
        where
 
 import Data.List
@@ -11,14 +10,10 @@ import Data.List
 import Foreign.C.Types ( CInt(..) )
 import System.Directory
          ( doesFileExist, getModificationTime
-         , getCurrentDirectory, setCurrentDirectory
-         , renameFile, removeFile )
-import System.FilePath ( splitFileName, (<.>) )
-import System.IO ( openBinaryTempFile, hClose )
+         , getCurrentDirectory, setCurrentDirectory )
 import System.IO.Unsafe ( unsafePerformIO )
 import qualified Control.Exception as Exception
-         ( bracketOnError, finally )
-import qualified Data.ByteString.Lazy as BS
+         ( finally )
 
 -- | Generic merging utility. For sorted input lists this is a full outer join.
 --
@@ -77,22 +72,3 @@ 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)

cabal-install/Distribution/Client/World.hs

@@ -102,7 +102,7 @@ modifyWorld f verbosity world pkgs =
             all (`elem` pkgsNewWorld) pkgsOldWorld)
       then do
         info verbosity "Updating world file..."
-        writeFileAtomic world $ unlines
+        writeFileAtomic world . B.pack $ unlines
             [ (display pkg) | pkg <- pkgsNewWorld]
       else
         info verbosity "World file is already up to date."