This commit is contained in:
Joey Hess 2013-02-18 02:39:40 -04:00
parent 9aa979edbd
commit 422dd28f0b
3 changed files with 15 additions and 16 deletions

View file

@ -81,7 +81,7 @@ inAnnex' isgood bad check key = withObjectLoc key checkindirect checkdirect
{- A safer check; the key's content must not only be present, but
- is not in the process of being removed. -}
inAnnexSafe :: Key -> Annex (Maybe Bool)
inAnnexSafe = inAnnex' (maybe False id) (Just False) go
inAnnexSafe = inAnnex' (fromMaybe False) (Just False) go
where
go f = liftIO $ openforlock f >>= check
openforlock f = catchMaybeIO $
@ -240,15 +240,14 @@ checkDiskSpace destination key alreadythere = do
moveAnnex :: Key -> FilePath -> Annex ()
moveAnnex key src = withObjectLoc key storeobject storedirect
where
storeobject dest = do
ifM (liftIO $ doesFileExist dest)
( liftIO $ removeFile src
, do
createContentDir dest
liftIO $ moveFile src dest
freezeContent dest
freezeContentDir dest
)
storeobject dest = ifM (liftIO $ doesFileExist dest)
( liftIO $ removeFile src
, do
createContentDir dest
liftIO $ moveFile src dest
freezeContent dest
freezeContentDir dest
)
storedirect fs = storedirect' =<< filterM validsymlink fs
validsymlink f = (==) (Just key) <$> isAnnexLink f
@ -278,7 +277,7 @@ replaceFile file a = do
- If this happens, runs the rollback action and returns False. The
- rollback action should remove the data that was transferred.
-}
sendAnnex :: Key -> (Annex ()) -> (FilePath -> Annex Bool) -> Annex Bool
sendAnnex :: Key -> Annex () -> (FilePath -> Annex Bool) -> Annex Bool
sendAnnex key rollback sendobject = go =<< prepSendAnnex key
where
go Nothing = return False

View file

@ -75,7 +75,7 @@ removeAssociatedFile key file = do
addAssociatedFile :: Key -> FilePath -> Annex [FilePath]
addAssociatedFile key file = do
file' <- normaliseAssociatedFile file
changeAssociatedFiles key $ \files -> do
changeAssociatedFiles key $ \files ->
if file' `elem` files
then files
else file':files

View file

@ -135,7 +135,7 @@ mergeDirectCleanup d oldsha newsha = do
| otherwise = araw f
f = DiffTree.file item
moveout k f = removeDirect k f
moveout = removeDirect
{- Files deleted by the merge are removed from the work tree.
- Empty work tree directories are removed, per git behavior. -}
@ -164,7 +164,7 @@ mergeDirectCleanup d oldsha newsha = do
{- If possible, converts a symlink in the working tree into a direct
- mode file. -}
toDirect :: Key -> FilePath -> Annex ()
toDirect k f = maybe noop id =<< toDirectGen k f
toDirect k f = fromMaybe noop =<< toDirectGen k f
toDirectGen :: Key -> FilePath -> Annex (Maybe (Annex ()))
toDirectGen k f = do
@ -181,7 +181,7 @@ toDirectGen k f = do
liftIO . moveFile loc
, return Nothing
)
(loc':_) -> ifM (not . isJust <$> getAnnexLinkTarget loc')
(loc':_) -> ifM (isNothing <$> getAnnexLinkTarget loc')
{- Another direct file has the content; copy it. -}
( return $ Just $
replaceFile f $
@ -194,7 +194,7 @@ removeDirect :: Key -> FilePath -> Annex ()
removeDirect k f = do
locs <- removeAssociatedFile k f
when (null locs) $
whenM (not . isJust <$> getAnnexLinkTarget f) $
whenM (isNothing <$> getAnnexLinkTarget f) $
moveAnnex k f
liftIO $ do
nukeFile f