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

wip35

This commit is contained in:
voidlizard 2024-12-07 14:45:58 +03:00
parent 4724a85a52
commit c7c323ca9e
1 changed files with 11 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
hbs2-git3/app/Main.hs
View File

@ -1259,10 +1259,11 @@ theDict = do
debug $ "WHATEVER" <+> pretty e <+> pretty cb <+> pretty co
pure $ not e
traverseToCBlock sto cb whatever $ \i h hs -> do
debug $ green "process cblock data" <+> pretty i <+> pretty h
traverseToCBlock sto cb whatever $ \i theCblk hs -> do
debug $ green "process cblock data" <+> pretty i <+> pretty theCblk
_orphans <- newTVarIO ( mempty :: HashSet GitHash )
_cblocks <- newTQueueIO
for_ hs $ \hx -> do
@ -1289,6 +1290,9 @@ theDict = do
let contents = Zlib.compressWith params (signature <> body)
LBS.hPutStr fh contents
when (t == Commit) do
atomically $ writeTQueue _cblocks (theCblk, h)
pure True
IOp _ _ (ISetRef ref w h ) -> do
@ -1316,6 +1320,11 @@ theDict = do
UIO.writeBinaryFileAtomic shallowFile current
withState $ transactional do
cbs <- atomically $ STM.flushTQueue _cblocks
for_ cbs $ \(cbh, commit) -> do
insertCBlock commit cbh
entry $ bindMatch "test:git:cblock:size:deep" $ nil_ $ \case
[ HashLike cblock ] -> lift do