direct: Avoid leaving file content in misctemp if interrupted.

This commit is contained in:
Joey Hess 2014-08-15 13:38:05 -04:00
parent aa31a7182e
commit bb6cec3461
4 changed files with 14 additions and 9 deletions

View file

@ -353,11 +353,8 @@ toDirectGen k f = do
void $ addAssociatedFile k f
modifyContent loc $ do
thawContent loc
replaceFileOr f
(liftIO . moveFile loc)
$ \tmp -> do -- rollback
liftIO (moveFile tmp loc)
freezeContent loc
liftIO (replaceFileFrom loc f)
`catchIO` (\_ -> freezeContent loc)
fromdirect loc = do
replaceFile f $
liftIO . void . copyFileExternal loc

View file

@ -39,7 +39,12 @@ replaceFileOr file action rollback = do
return tmpfile
go tmpfile = do
action tmpfile
liftIO $ catchIO (rename tmpfile file) (fallback tmpfile)
fallback tmpfile _ = do
createDirectoryIfMissing True $ parentDir file
moveFile tmpfile file
liftIO $ replaceFileFrom tmpfile file
replaceFileFrom :: FilePath -> FilePath -> IO ()
replaceFileFrom src dest = go `catchIO` fallback
where
go = moveFile src dest
fallback _ = do
createDirectoryIfMissing True $ parentDir dest
go