module Main (main) where
import Version ( version, targetOS, targetARCH )
-import Distribution.InstalledPackageInfo.Binary
+import Distribution.InstalledPackageInfo.Binary()
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.ModuleName hiding (main)
import Distribution.InstalledPackageInfo
" by tools that parse the results, rather than humans. The output is\n" ++
" always encoded in UTF-8, regardless of the current locale.\n" ++
"\n" ++
+ " $p recache\n" ++
+ " Regenerate the package database cache. This command should only be\n" ++
+ " necessary if you added a package to the database by dropping a file\n" ++
+ " into the database directory manually. By default, the global DB\n" ++
+ " is recached; to recache a different DB use --user or --package-conf\n" ++
+ " as appropriate.\n" ++
+ "\n" ++
" Substring matching is supported for {module} in find-module and\n" ++
" for {pkg} in list, describe, and field, where a '*' indicates\n" ++
" open substring ends (prefix*, *suffix, *infix*).\n" ++
let filename = location db </> cachefilename
when (verbosity > Normal) $
putStrLn ("writing cache " ++ filename)
- writeBinPackageDB filename (map convertPackageInfoOut (packages db))
+ writeBinaryFileAtomic filename (map convertPackageInfoOut (packages db))
`catch` \e ->
if isPermissionError e
then die (filename ++ ": you don't have permission to modify this file")
where handler' (Exception.ErrorCall err) = handler err
+writeBinaryFileAtomic :: Bin.Binary a => FilePath -> a -> IO ()
+writeBinaryFileAtomic targetFile obj =
+ withFileAtomic targetFile $ \h -> B.hPutStr h (Bin.encode obj)
+
+writeFileAtomic :: FilePath -> String -> IO ()
+writeFileAtomic targetFile content =
+ withFileAtomic targetFile $ \h -> hPutStr h content
+
-- copied from Cabal's Distribution.Simple.Utils, except that we want
-- to use text files here, rather than binary files.
-writeFileAtomic :: FilePath -> String -> IO ()
-writeFileAtomic targetFile content = do
+withFileAtomic :: FilePath -> (Handle -> IO ()) -> IO ()
+withFileAtomic targetFile write_content = do
(newFile, newHandle) <- openNewFile targetDir template
- do hPutStr newHandle content
+ do write_content newHandle
hClose newHandle
#if mingw32_HOST_OS || mingw32_TARGET_OS
renameFile newFile targetFile