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

wip

This commit is contained in:
voidlizard 2024-11-20 05:54:24 +03:00
parent 0456c32d52
commit 2e6fbaccc0
1 changed files with 12 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -15,10 +15,12 @@ import HBS2.Misc.PrettyStuff as Exported
import Data.Config.Suckless.Script import Data.Config.Suckless.Script
import Codec.Compression.Zstd qualified as Z -- import Codec.Compression.GZip as GZ1
-- import Codec.Compression.Zlib.Internal qualified as GZ
import Codec.Compression.GZip as GZ1 import Codec.Compression.BZip as BZ1
import Codec.Compression.Zlib.Internal qualified as GZ import Codec.Compression.BZip.Internal qualified as BZ
-- import Codec.Compression.Zlib.Internal qualified as GZ
import Data.Maybe import Data.Maybe
import Data.List qualified as L import Data.List qualified as L
@ -162,7 +164,7 @@ theDict = do
entry $ bindMatch "test:git:tree:pack:dump" $ nil_ $ \case entry $ bindMatch "test:git:tree:pack:dump" $ nil_ $ \case
[ StringLike fn ] -> do [ StringLike fn ] -> do
content <- liftIO $ fmap GZ1.decompress (LBS8.readFile fn) content <- BZ.decompress defaultDecompressParams <$> liftIO (LBS8.readFile fn)
flip fix (UHead content) $ \next -> \case flip fix (UHead content) $ \next -> \case
UHead "" -> none UHead "" -> none
@ -218,8 +220,8 @@ theDict = do
writeTQueue inq (gitEntryType, gitEntryHash) writeTQueue inq (gitEntryType, gitEntryHash)
let let
go :: Handle -> GZ.CompressStream IO -> IO () go :: Handle -> BZ.CompressStream IO -> IO ()
go outh (GZ.CompressInputRequired next) = do go outh (BZ.CompressInputRequired next) = do
inO <- atomically $ tryReadTQueue inq inO <- atomically $ tryReadTQueue inq
@ -243,13 +245,13 @@ theDict = do
e -> error (show e) e -> error (show e)
go outh (GZ.CompressOutputAvailable outchunk next) = do go outh (BZ.CompressOutputAvailable outchunk next) = do
BS.hPut outh outchunk BS.hPut outh outchunk
go outh =<< next go outh =<< next
go _ GZ.CompressStreamEnd = return () go _ BZ.CompressStreamEnd = return ()
let params = defaultCompressParams { compressLevel = compressionLevel 7 } let params = defaultCompressParams
let compressStream = GZ.compressIO GZ.gzipFormat params let compressStream = BZ.compressIO params
liftIO $ go stdout compressStream liftIO $ go stdout compressStream