only consider changed files when looking through commits

1 files changed, 36 insertions, 6 deletions

diff --git a/app/History.hs b/app/History.hs
index b1ccd10..8ec47fa 100644
--- a/app/History.hs
+++ b/app/History.hs
@@ -45,7 +45,17 @@ instance Exception InvalidTreeGrepperResult
 listIssues :: [Filter] -> [FilePath] -> IO [Issue]
 listIssues filters files = do
   commits <- fmap (lines . decodeUtf8 . L8.toStrict) $ sh ("git log --format=%H")
-  issueses <- parMapM (\commit -> cached commit (\_ -> listIssuesOf commit filters files)) commits
+  issueses <-
+    parMapM
+      ( \maybeCommit ->
+          case maybeCommit of
+            Nothing ->
+              listIssuesOf Nothing filters files
+            Just commit ->
+              cached commit (\_ -> listIssuesOf (Just commit) filters files)
+      )
+      $ (:) Nothing
+      $ map Just commits
   (currentIssues, historicalIssues) <-
     case issueses of
       currentIssues : historicalIssueses ->
@@ -82,15 +92,27 @@ cached commit func = do
       encodeFile file blob
       pure blob
 
-listIssuesOf :: Text -> [Filter] -> [FilePath] -> IO [Issue]
-listIssuesOf commit filters files = do
+listIssuesOf :: Maybe Text -> [Filter] -> [FilePath] -> IO [Issue]
+listIssuesOf maybeCommit filters files = do
   issue <- withSystemTempDirectory "history" $ \tmp -> do
-    let worktree = tmp </> unpack commit
-    sh_ (fromString (printf "git worktree add --detach %s %s" (quote worktree) (quote (unpack commit))))
+    worktree <-
+      case maybeCommit of
+        Nothing ->
+          getCurrentDirectory
+        Just commit -> do
+          let worktree = tmp </> unpack commit
+          sh_ (fromString (printf "git worktree add --detach %s %s" (quote worktree) (quote (unpack commit))))
+          pure worktree
+
     filter (applyFilter filters) . concat
       <$> catch
         ( parMapM (handle forgetGetIssuesExceptions . getIssues worktree)
-            =<< getFiles worktree files
+            =<< ( case maybeCommit of
+                    Nothing ->
+                      getFiles worktree files
+                    Just _ ->
+                      getFilesChanged worktree
+                )
         )
         (\(InvalidTreeGrepperResult e) -> die e)
   pure issue
@@ -112,6 +134,14 @@ getFiles cwd files =
           & setWorkingDir cwd
       )
 
+getFilesChanged :: FilePath -> IO [FilePath]
+getFilesChanged cwd =
+  Prelude.lines . L8.unpack
+    <$> sh
+      ( "git show -p --name-only --format=''"
+          & setWorkingDir cwd
+      )
+
 getIssues :: FilePath -> FilePath -> IO [Issue]
 getIssues cwd filename = do
   let extension = takeExtension filename