diff options
author | Alexander Foremny <aforemny@posteo.de> | 2023-11-07 22:12:00 +0100 |
---|---|---|
committer | Alexander Foremny <aforemny@posteo.de> | 2023-11-07 22:12:02 +0100 |
commit | 83e40ef27b2291ff7308243cbecf9431f3489554 (patch) | |
tree | 0efddedf9767be23cb3ad4500372d7b0539e916d | |
parent | 60fb967e2de7ab290f46d4a84fd920dfe8d264b0 (diff) |
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.
-rw-r--r-- | app/History/PartialCommitInfo.hs | 9 | ||||
-rw-r--r-- | app/Issue.hs | 12 |
2 files changed, 7 insertions, 14 deletions
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 [] |