From 0f6292920ac360f78c3c4a3b9d883b758900c063 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 27 Jul 2012 11:47:34 -0400 Subject: webapp now displays the real running and queued transfers yowza!!! --- Logs/Transfer.hs | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) (limited to 'Logs') 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 -- cgit v1.2.3