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 2025-01-20 09:37:45 +03:00
parent 4ba2f040ae
commit 8bb17eaafb
2 changed files with 21 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
hbs2-git3/lib/HBS2/Git3/Repo.hs
View File

@ -129,12 +129,14 @@ initRepo syn = do
, mkForm "seed" [mkInt seed] , mkForm "seed" [mkInt seed]
, mkForm "public" [] , mkForm "public" []
, mkForm "reflog" [mkSym (show $ pretty (AsBase58 rpk))] , mkForm "reflog" [mkSym (show $ pretty (AsBase58 rpk))]
] & vcat . fmap pretty ]
tree <- createTreeWithMetadata sto Nothing mempty (LBS8.pack (show $ manifest)) let mfs = vcat $ fmap pretty manifest
tree <- createTreeWithMetadata sto Nothing mempty (LBS8.pack (show $ mfs))
>>= orThrowPassIO >>= orThrowPassIO
liftIO $ print tree liftIO $ print $ pretty $ mkForm "manifest" manifest
let pt = toPTree (MaxSize defHashListChunk) (MaxNum defTreeChildNum) [tree] let pt = toPTree (MaxSize defHashListChunk) (MaxNum defTreeChildNum) [tree]

21
hbs2-git3/lib/HBS2/Git3/Run.hs
View File

@ -68,11 +68,21 @@ theDict = do
[ StringLike x ] -> helpList False (Just x) >> quit [ StringLike x ] -> helpList False (Just x) >> quit
_ -> helpList False Nothing >> quit _ -> helpList False Nothing >> quit
entry $ bindMatch "compression" $ nil_ $ \case brief "set zstd compression level" do
[ LitIntVal n ] -> lift do examples [qc|
setCompressionLevel (fromIntegral n) compression best ; sets compression level to best (22)
compression 4 ; sets low compression level (faster)
compression ; prints compression level
|] do
entry $ bindMatch "compression" $ nil_ $ \case
[ LitIntVal n ] -> lift do
setCompressionLevel (fromIntegral n)
_ -> throwIO (BadFormException @C nil) [] -> lift do
co <- getCompressionLevel
liftIO $ print $ pretty co
_ -> throwIO (BadFormException @C nil)
entry $ bindMatch "segment" $ nil_ $ \case entry $ bindMatch "segment" $ nil_ $ \case
[ LitIntVal n ] -> lift do [ LitIntVal n ] -> lift do
@ -462,7 +472,8 @@ theDict = do
entry $ bindMatch "reflog:refs" $ nil_ $ \syn -> lift $ connectedDo do entry $ bindMatch "reflog:refs" $ nil_ $ \syn -> lift $ connectedDo do
rrefs <- importedRefs rrefs <- importedRefs
liftIO $ print $ pretty rrefs for_ rrefs $ \(r,h) -> do
liftIO $ print $ fill 20 (pretty h) <+> pretty r
entry $ bindMatch "reflog:imported" $ nil_ $ \syn -> lift $ connectedDo do entry $ bindMatch "reflog:imported" $ nil_ $ \syn -> lift $ connectedDo do
p <- importedCheckpoint p <- importedCheckpoint