mirror of https://github.com/voidlizard/hbs2
wip, .ref trimming
This commit is contained in:
parent
712063c5f9
commit
62eba43739
|
@ -982,26 +982,6 @@ theDict = do
|
||||||
exportEntries "reflog:"
|
exportEntries "reflog:"
|
||||||
|
|
||||||
|
|
||||||
limitedResourceWorkerRequestQ :: MonadUnliftIO m
|
|
||||||
=> Int
|
|
||||||
-> m r -- ^ create resource
|
|
||||||
-> ( r -> m () ) -- ^ destroy resource
|
|
||||||
-> m ( Async (), (r -> m b) -> m b )
|
|
||||||
|
|
||||||
limitedResourceWorkerRequestQ n create destroy = do
|
|
||||||
inQ <- newTQueueIO
|
|
||||||
ass <- async $ flip runContT pure do
|
|
||||||
replicateM_ n do
|
|
||||||
(link <=< ContT . withAsync) $ flip runContT pure do
|
|
||||||
r <- ContT $ bracket create destroy
|
|
||||||
(fix . (>>)) $ atomically (readTQueue inQ) >>= \(a,reply) -> do
|
|
||||||
lift (tryAny (a r)) >>= reply
|
|
||||||
|
|
||||||
pure $ (ass, \fn -> do
|
|
||||||
tmv <- newEmptyTMVarIO
|
|
||||||
atomically $ writeTQueue inQ (fn, atomically . STM.putTMVar tmv)
|
|
||||||
atomically (readTMVar tmv) >>= either throwIO pure)
|
|
||||||
|
|
||||||
linearSearchLBS hash lbs = do
|
linearSearchLBS hash lbs = do
|
||||||
|
|
||||||
found <- S.toList_ $ runConsumeLBS lbs $ flip fix 0 \go n -> do
|
found <- S.toList_ $ runConsumeLBS lbs $ flip fix 0 \go n -> do
|
||||||
|
|
|
@ -30,19 +30,13 @@ import Data.HashSet qualified as HS
|
||||||
import Data.Word
|
import Data.Word
|
||||||
|
|
||||||
import Data.Config.Suckless
|
import Data.Config.Suckless
|
||||||
|
import Data.Config.Suckless.Script.File
|
||||||
|
|
||||||
import Codec.Compression.Zstd.Streaming as ZStdS
|
|
||||||
import Codec.Serialise
|
|
||||||
import Streaming.Prelude qualified as S
|
import Streaming.Prelude qualified as S
|
||||||
import Streaming hiding (run,chunksOf)
|
|
||||||
import System.TimeIt
|
import System.TimeIt
|
||||||
import Lens.Micro.Platform
|
|
||||||
|
|
||||||
import UnliftIO
|
|
||||||
import UnliftIO.IO.File qualified as UIO
|
import UnliftIO.IO.File qualified as UIO
|
||||||
|
|
||||||
import Data.HashPSQ qualified as HPSQ
|
|
||||||
|
|
||||||
|
|
||||||
readLogFileLBS :: forall opts m . ( MonadIO m, ReadLogOpts opts, BytesReader m )
|
readLogFileLBS :: forall opts m . ( MonadIO m, ReadLogOpts opts, BytesReader m )
|
||||||
=> opts
|
=> opts
|
||||||
|
@ -370,3 +364,17 @@ updateReflogIndex = do
|
||||||
<+> pretty gh
|
<+> pretty gh
|
||||||
<+> pretty nm
|
<+> pretty nm
|
||||||
|
|
||||||
|
|
||||||
|
entries <- liftIO $ S.toList_ $ glob ["**/*.ref"] [] idxPath $ \fn -> do
|
||||||
|
ls <- liftIO (LBS8.readFile fn) <&> LBS8.lines
|
||||||
|
S.each ls
|
||||||
|
rm fn
|
||||||
|
pure True
|
||||||
|
|
||||||
|
let es = HS.fromList entries
|
||||||
|
|
||||||
|
liftIO do
|
||||||
|
name <- emptyTempFile idxPath ".ref"
|
||||||
|
UIO.withBinaryFileAtomic name WriteMode $ \wh -> do
|
||||||
|
for_ es $ \s -> LBS8.hPutStrLn wh s
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue