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

wip, wtf

This commit is contained in:
voidlizard 2025-01-12 13:37:05 +03:00
parent 0d4fbcc368
commit ad13361266
1 changed files with 8 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
hbs2-git3/lib/HBS2/Git3/State/Index.hs
View File

@ -107,17 +107,17 @@ mergeSortedFilesN getKey inputFiles outFile = do
liftIO $ UIO.withBinaryFileAtomic outFile WriteMode $ \hOut -> do liftIO $ UIO.withBinaryFileAtomic outFile WriteMode $ \hOut -> do
let seed = HPSQ.fromList $ mapMaybe mkState mmaped let seed = Heap.fromList $ mapMaybe mkState mmaped
flip fix seed $ \next heap -> do flip fix seed $ \next heap -> do
let h0 = HPSQ.minView heap let h0 = Heap.uncons heap
maybe1 h0 none $ \case maybe1 h0 none $ \case
(_,_,[],rest) -> next rest (Entry _ [], rest) -> next rest
(k,_,e:xs,rest) -> do (Entry k (e:xs), rest) -> do
liftIO $ writeSection (LBS.fromStrict e) (LBS.hPutStr hOut) liftIO $ writeSection (LBS.fromStrict e) (LBS.hPutStr hOut)
let zu = maybe rest (\(a,b,c) -> HPSQ.insert a b c rest) (mkState xs) let zu = maybe rest (`Heap.insert` rest) (mkState xs)
let what = HPSQ.toList zu & mapMaybe (mkState . dropDupes k . view _3) let what = Heap.toUnsortedList zu & mapMaybe (mkState . dropDupes k . payload)
& HPSQ.fromList & Heap.fromList
let new = what let new = what
next new next new
@ -126,7 +126,7 @@ mergeSortedFilesN getKey inputFiles outFile = do
where where
dropDupes k = L.dropWhile ( (== k) . getKey ) dropDupes k = L.dropWhile ( (== k) . getKey )
mkState [] = Nothing mkState [] = Nothing
mkState (x:xs) = Just (getKey x, getKey x, x:xs) mkState (x:xs) = Just (Entry (getKey x) (x:xs))
compactIndex :: forall m . (Git3Perks m, MonadReader Git3Env m) => Natural -> m () compactIndex :: forall m . (Git3Perks m, MonadReader Git3Env m) => Natural -> m ()
compactIndex maxSize = do compactIndex maxSize = do