From 83e40ef27b2291ff7308243cbecf9431f3489554 Mon Sep 17 00:00:00 2001
From: Alexander Foremny <aforemny@posteo.de>
Date: Tue, 7 Nov 2023 22:12:00 +0100
Subject: fix performance when generating history

At some point, we noticed a performance drop when generating the
history. It turns out that per-file granularity is not performant
anymore, presumably since we're analizing changed files.

This restores performance by switching to per-commit granularity
instead.
---
 app/History/PartialCommitInfo.hs |  9 +++++----
 app/Issue.hs                     | 12 ++----------
 2 files changed, 7 insertions(+), 14 deletions(-)

(limited to 'app')

diff --git a/app/History/PartialCommitInfo.hs b/app/History/PartialCommitInfo.hs
index 5272057..2337ef7 100644
--- a/app/History/PartialCommitInfo.hs
+++ b/app/History/PartialCommitInfo.hs
@@ -15,7 +15,8 @@ import GHC.Generics (Generic)
 import Git qualified
 import History.Cache (cached)
 import History.CommitHash (CommitHash (..))
-import Issue (Issue, getIssuesPar)
+import Issue (Issue, getIssues)
+import Parallel (parMapM)
 import Process (proc, sh)
 import System.Directory (getCurrentDirectory)
 import System.FilePath ((</>))
@@ -41,7 +42,7 @@ getPartialCommitInfos = do
   --
   -- @difficulty easy
   commitHashes <- reverse <$> Git.getCommitHashes
-  mapM getCommitInfoOf (map Commit commitHashes ++ [WorkingTree])
+  parMapM getCommitInfoOf (map Commit commitHashes ++ [WorkingTree])
 
 getCommitInfoOf :: CommitHash -> IO PartialCommitInfo
 getCommitInfoOf WorkingTree = do
@@ -69,7 +70,7 @@ getIssuesAndFilesCommitChanged hash = do
     let cwd = tmp </> T.unpack hash
     Git.withWorkingTree cwd hash do
       files <- gitShowChanged cwd
-      issues <- concat <$> catch (getIssuesPar cwd files) dieOfInvalidTreeGrepperResult
+      issues <- concat <$> catch (mapM (getIssues cwd) files) dieOfInvalidTreeGrepperResult
       pure (issues, files)
 
 dieOfInvalidTreeGrepperResult :: E.InvalidTreeGrepperResult -> IO a
@@ -83,7 +84,7 @@ getIssuesAndFilesWorkingTreeChanged :: [FilePath] -> IO ([Issue], [FilePath])
 getIssuesAndFilesWorkingTreeChanged paths = do
   cwd <- getCurrentDirectory
   files <- gitLsFilesModifiedIn cwd paths
-  issues <- concat <$> catch (getIssuesPar cwd files) dieOfInvalidTreeGrepperResult
+  issues <- concat <$> catch (mapM (getIssues cwd) files) dieOfInvalidTreeGrepperResult
   pure (issues, files)
 
 gitShowChanged :: FilePath -> IO [FilePath]
diff --git a/app/Issue.hs b/app/Issue.hs
index e6515a9..54ef5e4 100644
--- a/app/Issue.hs
+++ b/app/Issue.hs
@@ -3,7 +3,7 @@ module Issue
     Provenance (..),
     fromMatch,
     id,
-    getIssuesPar,
+    getIssues,
   )
 where
 
@@ -22,7 +22,6 @@ import Issue.Provenance (Provenance (..), commitFromHEAD)
 import Issue.Tag (Tag (..))
 import Issue.Tag qualified as I
 import Issue.Text qualified as I
-import Parallel (parMapM)
 import Process (proc, sh)
 import System.FilePath (takeExtension)
 import System.Process.Typed (setWorkingDir)
@@ -102,13 +101,9 @@ stripIssueMarkers text =
 
 -- | Get all issues in the given directory and files.  Runs
 -- parallelized.
-getIssuesPar :: FilePath -> [FilePath] -> IO [[Issue]]
-getIssuesPar cwd files =
-  parMapM (handle forgetGetIssuesExceptions . getIssues cwd) files
-
 -- | Get all issues in the given directory and file.
 getIssues :: FilePath -> FilePath -> IO [Issue]
-getIssues cwd filename = do
+getIssues cwd filename = handle (\(_ :: E.UnknownFileExtension) -> pure []) $ do
   let extension = takeExtension filename
       treeGrepperLanguage =
         -- TODO Add support for all tree-grepper supported files
@@ -151,6 +146,3 @@ getIssues cwd filename = do
 fixTreeGrepper :: G.Result -> G.Result
 fixTreeGrepper treeGrepperResult =
   treeGrepperResult {G.matches = G.merge treeGrepperResult.matches}
-
-forgetGetIssuesExceptions :: E.UnknownFileExtension -> IO [a]
-forgetGetIssuesExceptions _ = pure []
-- 
cgit v1.2.3