c784ef4586
Removed old extensible-exceptions, only needed for very old ghc. Made webdav use Utility.Exception, to work after some changes in DAV's exception handling. Removed Annex.Exception. Mostly this was trivial, but note that tryAnnex is replaced with tryNonAsync and catchAnnex replaced with catchNonAsync. In theory that could be a behavior change, since the former caught all exceptions, and the latter don't catch async exceptions. However, in practice, nothing in the Annex monad uses async exceptions. Grepping for throwTo and killThread only find stuff in the assistant, which does not seem related. Command.Add.undo is changed to accept a SomeException, and things that use it for rollback now catch non-async exceptions, rather than only IOExceptions.
43 lines
1.4 KiB
Haskell
43 lines
1.4 KiB
Haskell
{- git-annex file replacing
|
|
-
|
|
- Copyright 2013 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Annex.ReplaceFile where
|
|
|
|
import Common.Annex
|
|
import Annex.Perms
|
|
|
|
{- Replaces a possibly already existing file with a new version,
|
|
- atomically, by running an action.
|
|
-
|
|
- The action is passed a temp file, which it can write to, and once
|
|
- done the temp file is moved into place.
|
|
-
|
|
- The action can throw an IO exception, in which case the temp file
|
|
- will be deleted, and the existing file will be preserved.
|
|
-
|
|
- Throws an IO exception when it was unable to replace the file.
|
|
-}
|
|
replaceFile :: FilePath -> (FilePath -> Annex ()) -> Annex ()
|
|
replaceFile file action = replaceFileOr file action (liftIO . nukeFile)
|
|
|
|
{- If unable to replace the file with the temp file, runs the
|
|
- rollback action, which is responsible for cleaning up the temp file. -}
|
|
replaceFileOr :: FilePath -> (FilePath -> Annex ()) -> (FilePath -> Annex ()) -> Annex ()
|
|
replaceFileOr file action rollback = do
|
|
tmpdir <- fromRepo gitAnnexTmpMiscDir
|
|
void $ createAnnexDirectory tmpdir
|
|
bracket (liftIO $ setup tmpdir) rollback $ \tmpfile -> do
|
|
action tmpfile
|
|
liftIO $ catchIO (rename tmpfile file) (fallback tmpfile)
|
|
where
|
|
setup tmpdir = do
|
|
(tmpfile, h) <- openTempFileWithDefaultPermissions tmpdir "tmp"
|
|
hClose h
|
|
return tmpfile
|
|
fallback tmpfile _ = do
|
|
createDirectoryIfMissing True $ parentDir file
|
|
moveFile tmpfile file
|