diff options
| -rw-r--r-- | Annex/Content.hs | 25 | ||||
| -rw-r--r-- | Command/AddUrl.hs | 4 | ||||
| -rw-r--r-- | Command/ReKey.hs | 2 |
3 files changed, 15 insertions, 16 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs index a5683c6df..32c164417 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -14,8 +14,8 @@ module Annex.Content ( inAnnexCheck, lockContent, getViaTmp, - getViaTmpUnchecked, - prepGetViaTmpChecked, + getViaTmp', + checkDiskSpaceToGet, prepTmp, withTmp, checkDiskSpace, @@ -211,18 +211,17 @@ lockContent key a = do maybe noop cleanuplockfile mlockfile #endif -{- Runs an action, passing it a temporary filename to get, - - and if the action succeeds, verifies the file matches the key and - - moves the file into the annex as a key's content. -} +{- Runs an action, passing it the temp file to get, + - and if the action succeeds, verifies the file matches + - the key and moves the file into the annex as a key's content. -} getViaTmp :: Key -> (FilePath -> Annex Bool) -> Annex Bool -getViaTmp key action = prepGetViaTmpChecked key False $ - getViaTmpUnchecked key action +getViaTmp key action = checkDiskSpaceToGet key False $ getViaTmp' key action {- Like getViaTmp, but does not check that there is enough disk space - for the incoming key. For use when the key content is already on disk - and not being copied into place. -} -getViaTmpUnchecked :: Key -> (FilePath -> Annex Bool) -> Annex Bool -getViaTmpUnchecked key action = do +getViaTmp' :: Key -> (FilePath -> Annex Bool) -> Annex Bool +getViaTmp' key action = do tmpfile <- prepTmp key ifM (action tmpfile) ( do @@ -234,16 +233,16 @@ getViaTmpUnchecked key action = do , return False ) -{- Prepares to download a key via a tmp file, and checks that there is - - enough free disk space. +{- Checks if there is enough free disk space to download a key + - to its temp file. - - When the temp file already exists, count the space it is using as - free, since the download will overwrite it or resume. - - Wen there's enough free space, runs the download action. -} -prepGetViaTmpChecked :: Key -> a -> Annex a -> Annex a -prepGetViaTmpChecked key unabletoget getkey = do +checkDiskSpaceToGet :: Key -> a -> Annex a -> Annex a +checkDiskSpaceToGet key unabletoget getkey = do tmp <- fromRepo $ gitAnnexTmpObjectLocation key e <- liftIO $ doesFileExist tmp diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index de3bff407..32e89d20f 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -247,7 +247,7 @@ addUrlFileQuvi relaxed quviurl videourl file = do - it later. -} urlinfo <- Url.withUrlOptions (Url.getUrlInfo videourl) let sizedkey = addSizeUrlKey urlinfo key - prepGetViaTmpChecked sizedkey Nothing $ do + checkDiskSpaceToGet sizedkey Nothing $ do tmp <- fromRepo $ gitAnnexTmpObjectLocation key showOutput ok <- Transfer.notifyTransfer Transfer.Download (Just file) $ @@ -305,7 +305,7 @@ downloadWeb url urlinfo file = do - stable. -} downloadWith :: (FilePath -> MeterUpdate -> Annex Bool) -> Key -> UUID -> URLString -> FilePath -> Annex (Maybe Key) downloadWith downloader dummykey u url file = - prepGetViaTmpChecked dummykey Nothing $ do + checkDiskSpaceToGet dummykey Nothing $ do tmp <- fromRepo $ gitAnnexTmpObjectLocation dummykey ifM (runtransfer tmp) ( do diff --git a/Command/ReKey.hs b/Command/ReKey.hs index 597be57a5..e38ce3c50 100644 --- a/Command/ReKey.hs +++ b/Command/ReKey.hs @@ -52,7 +52,7 @@ perform file oldkey newkey = do {- Make a hard link to the old key content (when supported), - to avoid wasting disk space. -} linkKey :: Key -> Key -> Annex Bool -linkKey oldkey newkey = getViaTmpUnchecked newkey $ \tmp -> do +linkKey oldkey newkey = getViaTmp' newkey $ \tmp -> do src <- calcRepo $ gitAnnexLocation oldkey liftIO $ ifM (doesFileExist tmp) ( return True |