wip4

hbs2-git3/app/Main.hs

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