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

wip4

This commit is contained in:
voidlizard 2024-12-03 08:38:41 +03:00
parent 778e172b9d
commit 4a380c62c3
1 changed files with 54 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -140,7 +140,7 @@ isGitLsTreeEntry = \case
gitReadTree :: (Pretty what, MonadIO m) => what -> m [GitTreeEntry] gitReadTree :: (Pretty what, MonadIO m) => what -> m [GitTreeEntry]
gitReadTree what = gitReadTree what =
gitRunCommand [qc|git ls-tree -t -l -r {pretty what}|] gitRunCommand [qc|git ls-tree -t -l -r {pretty what}|]
>>= orThrowPassIO >>= orThrow (GitReadError (show $ pretty what))
<&> fmap LBS8.words . LBS8.lines <&> fmap LBS8.words . LBS8.lines
<&> mapMaybe \case <&> mapMaybe \case
GitTreeEntryView v -> do GitTreeEntryView v -> do
@ -522,7 +522,6 @@ export r = connectedDo $ flip runContT pure do
parents <- gitReadCommitParents bs parents <- gitReadCommitParents bs
n <- for (zip [1..] parents) $ \(i,gh) -> do n <- for (zip [1..] parents) $ \(i,gh) -> do
-- exists <- cached missed gh (gitObjectExists gh)
exists <- liftIO $ cached missed gh (isJust <$> gitReadObjectMaybe reader gh) exists <- liftIO $ cached missed gh (isJust <$> gitReadObjectMaybe reader gh)
here <- withState $ selectCBlock gh <&> isJust here <- withState $ selectCBlock gh <&> isJust
@ -560,10 +559,9 @@ export r = connectedDo $ flip runContT pure do
pure mempty pure mempty
else do else do
skip' <- S.toList_ $ for parents $ \p -> do skip' <- S.toList_ $ for parents $ \p -> do
-- exists <- liftIO $ cached missed p (gitObjectExists p) lift (try @_ @GitException (gitReadTree p))
exists <- liftIO $ cached missed p (isJust <$> gitReadObjectMaybe reader p) <&> fromRight mempty
when exists do <&> fmap gitEntryHash >>= S.each
gitReadTree p <&> fmap gitEntryHash >>= S.each
pure $ HS.fromList skip' pure $ HS.fromList skip'