This commit is contained in:
Joey Hess 2012-11-18 18:27:53 -04:00
parent 81379bb29c
commit c8751be151
3 changed files with 22 additions and 31 deletions

View file

@ -180,13 +180,8 @@ retrieve :: FilePath -> ChunkSize -> Key -> AssociatedFile -> FilePath -> Annex
retrieve d chunksize k _ f = metered Nothing 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
meteredWriteFileChunks meterupdate f files feeder meteredWriteFileChunks meterupdate f files $ L.readFile
return True return True
where
feeder [] = return ([], [])
feeder (x:xs) = do
chunks <- L.toChunks <$> L.readFile x
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 Nothing k $ \meterupdate -> retrieveEncrypted d chunksize (cipher, enck) k f = metered Nothing k $ \meterupdate ->

View file

@ -125,21 +125,21 @@ storeChunked chunksize dests storer content =
- after each chunk of the L.ByteString, typically every 64 kb or so. -} - after each chunk of the L.ByteString, typically every 64 kb or so. -}
meteredWriteFile :: MeterUpdate -> FilePath -> L.ByteString -> IO () meteredWriteFile :: MeterUpdate -> FilePath -> L.ByteString -> IO ()
meteredWriteFile meterupdate dest b = meteredWriteFile meterupdate dest b =
meteredWriteFileChunks meterupdate dest (L.toChunks b) feeder meteredWriteFileChunks meterupdate dest [b] return
where
feeder chunks = return ([], chunks)
{- Writes a series of S.ByteString chunks to a file, updating a progress {- Writes a series of major chunks to a file. The feeder is called to get
- meter after each chunk. The feeder is called to get more chunks. -} - each major chunk. Then each chunk of the L.ByteString is written,
meteredWriteFileChunks :: MeterUpdate -> FilePath -> s -> (s -> IO (s, [S.ByteString])) -> IO () - with the meter updated after each chunk. -}
meteredWriteFileChunks meterupdate dest startstate feeder = meteredWriteFileChunks :: MeterUpdate -> FilePath -> [v] -> (v -> IO L.ByteString) -> IO ()
E.bracket (openFile dest WriteMode) hClose (feed startstate []) meteredWriteFileChunks meterupdate dest chunks feeder =
E.bracket (openFile dest WriteMode) hClose (feed chunks [])
where where
feed state [] h = do feed [] [] _ = noop
(state', cs) <- feeder state feed (c:cs) [] h = do
unless (null cs) $ bs <- L.toChunks <$> feeder c
feed state' cs h unless (null bs) $
feed state (c:cs) h = do feed cs bs h
S.hPut h c feed cs (b:bs) h = do
meterupdate $ toInteger $ S.length c S.hPut h b
feed state cs h meterupdate $ toInteger $ S.length b
feed cs bs h

View file

@ -116,19 +116,15 @@ retrieve :: Remote -> Key -> AssociatedFile -> FilePath -> Annex Bool
retrieve r k _f d = metered Nothing k $ \meterupdate -> retrieve r k _f d = metered Nothing k $ \meterupdate ->
davAction r False $ \(baseurl, user, pass) -> liftIO $ catchBoolIO $ davAction r False $ \(baseurl, user, pass) -> liftIO $ catchBoolIO $
withStoredFiles r k baseurl user pass onerr $ \urls -> do withStoredFiles r k baseurl user pass onerr $ \urls -> do
meteredWriteFileChunks meterupdate d urls $ meteredWriteFileChunks meterupdate d urls $ \url -> do
feeder user pass mb <- davGetUrlContent url user pass
case mb of
Nothing -> throwIO "download failed"
Just b -> return b
return True return True
where where
onerr _ = return False onerr _ = return False
feeder _ _ [] = return ([], [])
feeder user pass (url:urls) = do
mb <- davGetUrlContent url user pass
case mb of
Nothing -> throwIO "download failed"
Just b -> return (urls, L.toChunks b)
retrieveEncrypted :: Remote -> (Cipher, Key) -> Key -> FilePath -> Annex Bool retrieveEncrypted :: Remote -> (Cipher, Key) -> Key -> FilePath -> Annex Bool
retrieveEncrypted r (cipher, enck) k d = metered Nothing k $ \meterupdate -> retrieveEncrypted r (cipher, enck) k d = metered Nothing k $ \meterupdate ->
davAction r False $ \(baseurl, user, pass) -> liftIO $ catchBoolIO $ davAction r False $ \(baseurl, user, pass) -> liftIO $ catchBoolIO $