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

wip17, oopsie

This commit is contained in:
voidlizard 2024-12-05 08:14:18 +03:00
parent 857b93a810
commit bbc1c7c342
1 changed files with 11 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -661,6 +661,10 @@ export mref' r = connectedDo $ flip runContT pure do
ExportProcessCommit co bs -> do ExportProcessCommit co bs -> do
debug $ "write pack for" <+> pretty co debug $ "write pack for" <+> pretty co
l <- readTVarIO q<&> HPSQ.keys
let lastBlock = co == r && L.null l
hhead <- gitRevParse co hhead <- gitRevParse co
>>= orThrow (OtherGitError $ show $ "can't parse" <+> pretty co) >>= orThrow (OtherGitError $ show $ "can't parse" <+> pretty co)
@ -690,7 +694,7 @@ export mref' r = connectedDo $ flip runContT pure do
let ref = maybeToList $ EGitRef <$> mref <*> pure now <*> pure (Just co) let ref = maybeToList $ EGitRef <$> mref <*> pure now <*> pure (Just co)
let seed = ref <> [EGitObject Commit co Nothing bs] let seed = (if lastBlock then ref else mempty) <> [EGitObject Commit co Nothing bs]
flip fix (EWAcc 1 r 0 seed) $ \go -> \case flip fix (EWAcc 1 r 0 seed) $ \go -> \case
@ -928,6 +932,12 @@ theDict = do
putStrLn $ show $ "ref" <+> pretty ref <+> pretty w <+> pretty h putStrLn $ show $ "ref" <+> pretty ref <+> pretty w <+> pretty h
pure True pure True
entry $ bindMatch "test:git:cblock:scan" $ nil_ $ \case
[ HashLike cblock ] -> do
none
_ -> throwIO (BadFormException @C nil)
entry $ bindMatch "test:git:tree:export" $ nil_ $ \syn -> lift do entry $ bindMatch "test:git:tree:export" $ nil_ $ \syn -> lift do
(w, r) <- case syn of (w, r) <- case syn of
[] -> (Nothing,) <$> gitRevParseThrow "HEAD" [] -> (Nothing,) <$> gitRevParseThrow "HEAD"