wip

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

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