upload progress tracking for the directory special remote

This commit is contained in:
Joey Hess 2012-09-21 14:54:24 -04:00
parent 226781c047
commit ff32ee5152
3 changed files with 8 additions and 7 deletions

View file

@ -63,8 +63,8 @@ showProgress = handle q $
{- Shows a progress meter while performing a transfer of a key. {- Shows a progress meter while performing a transfer of a key.
- The action is passed a callback to use to update the meter. -} - The action is passed a callback to use to update the meter. -}
metered :: Key -> (MeterUpdate -> Annex a) -> Annex a metered :: (Maybe MeterUpdate) -> Key -> (MeterUpdate -> Annex a) -> Annex a
metered key a = withOutputType $ go (keySize key) metered combinemeterupdate key a = withOutputType $ go (keySize key)
where where
go (Just size) NormalOutput = do go (Just size) NormalOutput = do
progress <- liftIO $ newProgress "" size progress <- liftIO $ newProgress "" size
@ -74,6 +74,7 @@ metered key a = withOutputType $ go (keySize key)
r <- a $ \n -> liftIO $ do r <- a $ \n -> liftIO $ do
incrP progress n incrP progress n
displayMeter stdout meter displayMeter stdout meter
maybe noop (\m -> m n) combinemeterupdate
liftIO $ clearMeter stdout meter liftIO $ clearMeter stdout meter
return r return r
go _ _ = a (const noop) go _ _ = a (const noop)

View file

@ -127,7 +127,7 @@ withStoredFiles = withCheckedFiles doesFileExist
store :: FilePath -> ChunkSize -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool store :: FilePath -> ChunkSize -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
store d chunksize k _f p = do store d chunksize k _f p = do
src <- inRepo $ gitAnnexLocation k src <- inRepo $ gitAnnexLocation k
metered k $ \meterupdate -> metered (Just p) k $ \meterupdate ->
storeHelper d chunksize k $ \dests -> storeHelper d chunksize k $ \dests ->
case chunksize of case chunksize of
Nothing -> do Nothing -> do
@ -142,7 +142,7 @@ store d chunksize k _f p = do
storeEncrypted :: FilePath -> ChunkSize -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool storeEncrypted :: FilePath -> ChunkSize -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
storeEncrypted d chunksize (cipher, enck) k p = do storeEncrypted d chunksize (cipher, enck) k p = do
src <- inRepo $ gitAnnexLocation k src <- inRepo $ gitAnnexLocation k
metered k $ \meterupdate -> metered (Just p) k $ \meterupdate ->
storeHelper d chunksize enck $ \dests -> storeHelper d chunksize enck $ \dests ->
withEncryptedContent cipher (L.readFile src) $ \s -> withEncryptedContent cipher (L.readFile src) $ \s ->
case chunksize of case chunksize of
@ -245,7 +245,7 @@ storeHelper d chunksize key a = prep <&&> check <&&> go
return (not $ null stored) return (not $ null stored)
retrieve :: FilePath -> ChunkSize -> Key -> AssociatedFile -> FilePath -> Annex Bool retrieve :: FilePath -> ChunkSize -> Key -> AssociatedFile -> FilePath -> Annex Bool
retrieve d chunksize k _ f = metered k $ \meterupdate -> retrieve d chunksize k _ f = metered Nothing k $ \meterupdate ->
liftIO $ withStoredFiles chunksize d k $ \files -> liftIO $ withStoredFiles chunksize d k $ \files ->
catchBoolIO $ do catchBoolIO $ do
meteredWriteFile' meterupdate f files feeder meteredWriteFile' meterupdate f files feeder
@ -257,7 +257,7 @@ retrieve d chunksize k _ f = metered k $ \meterupdate ->
return (xs, chunks) return (xs, chunks)
retrieveEncrypted :: FilePath -> ChunkSize -> (Cipher, Key) -> Key -> FilePath -> Annex Bool retrieveEncrypted :: FilePath -> ChunkSize -> (Cipher, Key) -> Key -> FilePath -> Annex Bool
retrieveEncrypted d chunksize (cipher, enck) k f = metered k $ \meterupdate -> retrieveEncrypted d chunksize (cipher, enck) k f = metered Nothing k $ \meterupdate ->
liftIO $ withStoredFiles chunksize d enck $ \files -> liftIO $ withStoredFiles chunksize d enck $ \files ->
catchBoolIO $ do catchBoolIO $ do
withDecryptedContent cipher (L.concat <$> mapM L.readFile files) $ withDecryptedContent cipher (L.concat <$> mapM L.readFile files) $

View file

@ -43,7 +43,7 @@ the ProgressCallback as the upload progresses.
the multiplexing. the multiplexing.
* rsync: **done** * rsync: **done**
* directory * directory: **done**
* web: Not applicable; does not upload * web: Not applicable; does not upload
* S3 * S3
* bup * bup