diff --git a/fixme-new/lib/Fixme/Run.hs b/fixme-new/lib/Fixme/Run.hs index 0ba8a27b..cb0ead0c 100644 --- a/fixme-new/lib/Fixme/Run.hs +++ b/fixme-new/lib/Fixme/Run.hs @@ -375,12 +375,21 @@ runTop forms = do seen <- maybe1 fn (pure False) selectIsAlreadyScanned pure (not seen) - let files = mapMaybe (fixmeGet "file") fxs - & HS.fromList - & HS.toList - & fmap (Text.unpack . coerce) + hashes <- catMaybes <$> flip runContT pure do + p <- ContT $ bracket startGitHash stopProcess + let files = mapMaybe (fixmeGet "file") fxs + & HS.fromList + & HS.toList + & fmap (Text.unpack . coerce) + for files $ \f -> do + mbHash <- lift $ gitHashPathStdin p f + case mbHash of + Just ha -> + pure $ Just (f, ha) + Nothing -> + pure Nothing - blobs <- listBlobs mzero <&> HM.fromList + let blobs = HM.fromList hashes withState $ transactional do for_ fxs $ \fme -> do diff --git a/fixme-new/lib/Fixme/Scan/Git/Local.hs b/fixme-new/lib/Fixme/Scan/Git/Local.hs index c1927e3e..3f07cfe2 100644 --- a/fixme-new/lib/Fixme/Scan/Git/Local.hs +++ b/fixme-new/lib/Fixme/Scan/Git/Local.hs @@ -359,11 +359,28 @@ gitCatBlob h = do (_,s,_) <- readProcess $ shell [qc|git {gd} cat-file blob {pretty h}|] pure s + +startGitHash :: (FixmePerks m, MonadReader FixmeEnv m) => m (Process Handle Handle ()) +startGitHash = do + gd <- fixmeGetGitDirCLIOpt + let cmd = [qc|git {gd} hash-object --stdin-paths|] + debug $ pretty cmd + let config = setStdin createPipe $ setStdout createPipe $ setStderr closed $ shell cmd + startProcess config + +gitHashPathStdin :: FixmePerks m => (Process Handle Handle e) -> FilePath -> FixmeM m (Maybe GitHash) +gitHashPathStdin prc file = do + let ssin = getStdin prc + let sout = getStdout prc + liftIO $ IO.hPutStrLn ssin file >> IO.hFlush ssin + liftIO (IO.hGetLine sout) <&> fromStringMay @GitHash + startGitCatFile :: (FixmePerks m, MonadReader FixmeEnv m) => m (Process Handle Handle ()) startGitCatFile = do gd <- fixmeGetGitDirCLIOpt let cmd = [qc|git {gd} cat-file --batch|] debug $ pretty cmd let config = setStdin createPipe $ setStdout createPipe $ setStderr closed $ shell cmd + -- ssin <- getStdin config startProcess config