diff options
Diffstat (limited to 'Remote/Helper/Chunked.hs')
| -rw-r--r-- | Remote/Helper/Chunked.hs | 33 |
1 files changed, 25 insertions, 8 deletions
diff --git a/Remote/Helper/Chunked.hs b/Remote/Helper/Chunked.hs index 46678de70..ad3b04d49 100644 --- a/Remote/Helper/Chunked.hs +++ b/Remote/Helper/Chunked.hs @@ -43,6 +43,10 @@ type ChunkExt = String chunkCount :: ChunkExt chunkCount = ".chunkcount" +{- An infinite stream of extensions to use for chunks. -} +chunkStream :: [ChunkExt] +chunkStream = map (\n -> ".chunk" ++ show n) [1 :: Integer ..] + {- Parses the String from the chunkCount file, and returns the files that - are used to store the chunks. -} listChunks :: FilePath -> String -> [FilePath] @@ -50,15 +54,28 @@ listChunks basedest chunkcount = take count $ map (basedest ++) chunkStream where count = fromMaybe 0 $ readish chunkcount -{- An infinite stream of extensions to use for chunks. -} -chunkStream :: [ChunkExt] -chunkStream = map (\n -> ".chunk" ++ show n) [1 :: Integer ..] +{- For use when there is no chunkCount file; uses the action to find + - chunks, and returns them, or Nothing if none found. Relies on + - storeChunks's finalizer atomically moving the chunks into place once all + - are written. + - + - This is only needed to work around a bug that caused the chunkCount file + - not to be written. + -} +probeChunks :: FilePath -> (FilePath -> IO Bool) -> IO [FilePath] +probeChunks basedest check = go [] $ map (basedest ++) chunkStream + where + go l [] = return (reverse l) + go l (c:cs) = ifM (check c) + ( go (c:l) cs + , go l [] + ) {- Given the base destination to use to store a value, - generates a stream of temporary destinations (just one when not chunking) - and passes it to an action, which should chunk and store the data, - and return the destinations it stored to, or [] on error. Then - - calls the storer to write the chunk count (if chunking). Finally, the + - calls the recorder to write the chunk count (if chunking). Finally, the - finalizer is called to rename the tmp into the dest - (and do any other cleanup). -} @@ -68,7 +85,7 @@ storeChunks key tmp dest chunksize storer recorder finalizer = either onerr retu where go = do stored <- storer tmpdests - when (chunksize /= Nothing) $ do + when (isJust chunksize) $ do let chunkcount = basef ++ chunkCount recorder chunkcount (show $ length stored) finalizer tmp dest @@ -79,7 +96,7 @@ storeChunks key tmp dest chunksize storer recorder finalizer = either onerr retu basef = tmp ++ keyFile key tmpdests - | chunksize == Nothing = [basef] + | isNothing chunksize = [basef] | otherwise = map (basef ++ ) chunkStream {- Given a list of destinations to use, chunks the data according to the @@ -123,5 +140,5 @@ storeChunked chunksize dests storer content = either onerr return meteredWriteFileChunks :: MeterUpdate -> FilePath -> [v] -> (v -> IO L.ByteString) -> IO () meteredWriteFileChunks meterupdate dest chunks feeder = withBinaryFile dest WriteMode $ \h -> - forM_ chunks $ \c -> - meteredWrite meterupdate h =<< feeder c + forM_ chunks $ + meteredWrite meterupdate h <=< feeder |