voidlizard
/
hbs2
mirror of https://github.com/voidlizard/hbs2
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

better

This commit is contained in:
Dmitry Zuikov 2023-01-26 10:03:35 +03:00
parent 817dd9349a
commit 38a000b2b6
1 changed files with 8 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
hbs2-core/lib/HBS2/Actors/ChunkWriter.hs
View File

@ -72,7 +72,7 @@ data ChunkWriter h m = forall a . ( MonadIO m
, pipeline :: Pipeline m () , pipeline :: Pipeline m ()
, dir :: FilePath , dir :: FilePath
, storage :: a , storage :: a
, perBlock :: TVar (HashMap FilePath [IO ()]) , perBlock :: TVar (HashMap FilePath [Handle -> IO ()])
, perBlockSem :: TVar (HashMap FilePath TSem) , perBlockSem :: TVar (HashMap FilePath TSem)
} }
@ -208,10 +208,10 @@ writeChunk2 w salt h o bs = do
let cache = perBlock w let cache = perBlock w
let action = do let action fh = do
withBinaryFile fn ReadWriteMode $ \fh -> do -- withBinaryFile fn ReadWriteMode $ \fh -> do
hSeek fh AbsoluteSeek (fromIntegral o) hSeek fh AbsoluteSeek (fromIntegral o)
B.hPutStr fh bs B.hPutStr fh bs
liftIO $ do liftIO $ do
atomically $ modifyTVar cache (HashMap.insertWith (<>) fn [action]) atomically $ modifyTVar cache (HashMap.insertWith (<>) fn [action])
@ -233,7 +233,9 @@ flush w fn = do
atomically $ Sem.waitTSem sem atomically $ Sem.waitTSem sem
actions <- atomically $ stateTVar cache (\v -> (HashMap.lookup fn v, HashMap.delete fn v)) actions <- atomically $ stateTVar cache (\v -> (HashMap.lookup fn v, HashMap.delete fn v))
sequence_ (fromMaybe mempty actions)
withBinaryFile fn ReadWriteMode $ \h -> do
mapM_ (\f -> f h) (fromMaybe mempty actions)
atomically $ Sem.signalTSem sem atomically $ Sem.signalTSem sem