summaryrefslogtreecommitdiff
path: root/Logs/Transfer.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Logs/Transfer.hs')
-rw-r--r--Logs/Transfer.hs17
1 files changed, 12 insertions, 5 deletions
diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs
index b6962262d..b0e21481c 100644
--- a/Logs/Transfer.hs
+++ b/Logs/Transfer.hs
@@ -12,7 +12,9 @@ import Annex.Perms
import Annex.Exception
import qualified Git
import Types.Remote
+import Types.Key
import qualified Fields
+import Utility.Percentage
import System.Posix.Types
import Data.Time.Clock
@@ -58,24 +60,29 @@ readDirection "upload" = Just Upload
readDirection "download" = Just Download
readDirection _ = Nothing
+percentComplete :: Transfer -> TransferInfo -> Maybe Percentage
+percentComplete (Transfer { transferKey = key }) (TransferInfo { bytesComplete = Just complete }) =
+ (\size -> percentage size complete) <$> keySize key
+percentComplete _ _ = Nothing
+
upload :: UUID -> Key -> AssociatedFile -> Annex a -> Annex a
-upload u key file a = transfer (Transfer Upload u key) file a
+upload u key file a = runTransfer (Transfer Upload u key) file a
download :: UUID -> Key -> AssociatedFile -> Annex a -> Annex a
-download u key file a = transfer (Transfer Download u key) file a
+download u key file a = runTransfer (Transfer Download u key) file a
fieldTransfer :: Direction -> Key -> Annex a -> Annex a
fieldTransfer direction key a = do
afile <- Fields.getField Fields.associatedFile
- maybe a (\u -> transfer (Transfer direction (toUUID u) key) afile a)
+ maybe a (\u -> runTransfer (Transfer direction (toUUID u) key) afile a)
=<< Fields.getField Fields.remoteUUID
{- Runs a transfer action. Creates and locks the lock file while the
- action is running, and stores info in the transfer information
- file. Will throw an error if the transfer is already in progress.
-}
-transfer :: Transfer -> Maybe FilePath -> Annex a -> Annex a
-transfer t file a = do
+runTransfer :: Transfer -> Maybe FilePath -> Annex a -> Annex a
+runTransfer t file a = do
tfile <- fromRepo $ transferFile t
createAnnexDirectory $ takeDirectory tfile
mode <- annexFileMode