[commit: ghc] master: ghc-pkg: use read/writeUTF8File from Cabal (9aa0e4b)
git at git.haskell.org
git at git.haskell.org
Thu Jul 2 08:27:20 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/9aa0e4b23d074af44363236fb0f120f07c6e0067/ghc
>---------------------------------------------------------------
commit 9aa0e4b23d074af44363236fb0f120f07c6e0067
Author: Thomas Miedema <thomasmiedema at gmail.com>
Date: Sat Jun 13 16:44:18 2015 +0200
ghc-pkg: use read/writeUTF8File from Cabal
Use writeUTF8File and readUTF8File from Distribution.Simple.Utils,
instead of our own buggy copies. Refactoring only.
>---------------------------------------------------------------
9aa0e4b23d074af44363236fb0f120f07c6e0067
utils/ghc-pkg/Main.hs | 58 +++------------------------------------------------
1 file changed, 3 insertions(+), 55 deletions(-)
diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs
index a83720b..6133017 100644
--- a/utils/ghc-pkg/Main.hs
+++ b/utils/ghc-pkg/Main.hs
@@ -22,7 +22,7 @@ import Distribution.ParseUtils
import Distribution.Package hiding (installedPackageId)
import Distribution.Text
import Distribution.Version
-import Distribution.Simple.Utils (fromUTF8, toUTF8)
+import Distribution.Simple.Utils (fromUTF8, toUTF8, writeUTF8File, readUTF8File)
import System.FilePath as FilePath
import qualified System.FilePath.Posix as FilePath.Posix
import System.Directory ( getAppUserDataDirectory, createDirectoryIfMissing,
@@ -42,7 +42,7 @@ import Control.Applicative (Applicative(..))
#endif
import Control.Monad
import System.Directory ( doesDirectoryExist, getDirectoryContents,
- doesFileExist, renameFile, removeFile,
+ doesFileExist, removeFile,
getCurrentDirectory )
import System.Exit ( exitWith, ExitCode(..) )
import System.Environment ( getArgs, getProgName, getEnv )
@@ -1056,7 +1056,7 @@ changeDBDir verbosity cmds db = do
do_cmd (AddPackage p) = do
let file = location db </> display (installedPackageId p) <.> "conf"
when (verbosity > Normal) $ infoLn ("writing " ++ file)
- writeFileUtf8Atomic file (showInstalledPackageInfo p)
+ writeUTF8File file (showInstalledPackageInfo p)
do_cmd (ModifyPackage p) =
do_cmd (AddPackage p)
@@ -1988,58 +1988,6 @@ catchIO = Exception.catch
tryIO :: IO a -> IO (Either Exception.IOException a)
tryIO = Exception.try
-writeFileUtf8Atomic :: FilePath -> String -> IO ()
-writeFileUtf8Atomic targetFile content =
- withFileAtomic targetFile $ \h -> do
- hSetEncoding h utf8
- hPutStr h content
-
--- copied from Cabal's Distribution.Simple.Utils, except that we want
--- to use text files here, rather than binary files.
-withFileAtomic :: FilePath -> (Handle -> IO ()) -> IO ()
-withFileAtomic targetFile write_content = do
- (newFile, newHandle) <- openNewFile targetDir template
- do write_content newHandle
- hClose newHandle
-#if mingw32_HOST_OS || mingw32_TARGET_OS
- renameFile newFile targetFile
- -- If the targetFile exists then renameFile will fail
- `catchIO` \err -> do
- exists <- doesFileExist targetFile
- if exists
- then do removeFileSafe targetFile
- -- Big fat hairy race condition
- renameFile newFile targetFile
- -- If the removeFile succeeds and the renameFile fails
- -- then we've lost the atomic property.
- else throwIOIO err
-#else
- renameFile newFile targetFile
-#endif
- `Exception.onException` do hClose newHandle
- removeFileSafe newFile
- where
- template = targetName <.> "tmp"
- targetDir | null targetDir_ = "."
- | otherwise = targetDir_
- --TODO: remove this when takeDirectory/splitFileName is fixed
- -- to always return a valid dir
- (targetDir_,targetName) = splitFileName targetFile
-
-openNewFile :: FilePath -> String -> IO (FilePath, Handle)
-openNewFile dir template = do
- -- this was added to System.IO in 6.12.1
- -- we must use this version because the version below opens the file
- -- in binary mode.
- openTempFileWithDefaultPermissions dir template
-
-readUTF8File :: FilePath -> IO String
-readUTF8File file = do
- h <- openFile file ReadMode
- -- fix the encoding to UTF-8
- hSetEncoding h utf8
- hGetContents h
-
-- removeFileSave doesn't throw an exceptions, if the file is already deleted
removeFileSafe :: FilePath -> IO ()
removeFileSafe fn =
More information about the ghc-commits
mailing list