chore: compute issues and issue events separately

1 files changed, 45 insertions, 32 deletions

diff --git a/app/History.hs b/app/History.hs
index 0e498b7..a76e97b 100644
--- a/app/History.hs
+++ b/app/History.hs
@@ -1,7 +1,9 @@
 module History
-  ( History (..),
-    getHistory,
+  ( Issues (..),
     getIssues,
+    IssueEvents (..),
+    getIssueEvents,
+    getIssuesOfFile,
   )
 where
 
@@ -52,25 +54,52 @@ import Tuple ()
 -- @topic caching
 -- @backlog
 
-data History = History
+data Issues = Issues
+  { commitHash :: CommitHash,
+    issues :: M.Map T.Text I.Issue
+  }
+  deriving (Show, Generic, Binary)
+
+getIssues :: IO Issues
+getIssues = getIssuesOf WorkingTree
+
+getIssuesOf :: CommitHash -> IO Issues
+getIssuesOf commitHash = cachedMaybe (fmap ("issues-" <>) (C.toText commitHash)) do
+  maybeParentCommitHash <- getParentCommitHashOf commitHash
+  case maybeParentCommitHash of
+    Just parentCommitHash -> do
+      oldIssues <- (.issues) <$> getIssuesOf parentCommitHash
+      scramble <- getScrambleOf commitHash
+      let issues = propagateIssues oldIssues scramble
+      pure Issues {..}
+    Nothing -> do
+      scramble <- getScrambleOf commitHash
+      let issues = scramble.issues
+      pure Issues {..}
+
+data IssueEvents = IssueEvents
   { commitHash :: CommitHash,
-    issues :: M.Map T.Text I.Issue,
     issueEvents :: [IssueEvent]
   }
   deriving (Show, Generic, Binary)
 
-getHistory :: IO History
-getHistory = getHistoryOf WorkingTree
+getIssueEvents :: IO IssueEvents
+getIssueEvents = getIssueEventsOf WorkingTree
 
-getHistoryOf :: CommitHash -> IO History
-getHistoryOf commitHash = cachedMaybe (C.toText commitHash) do
+getIssueEventsOf :: CommitHash -> IO IssueEvents
+getIssueEventsOf commitHash = cachedMaybe (fmap ("events-" <>) (C.toText commitHash)) do
   maybeParentCommitHash <- getParentCommitHashOf commitHash
   case maybeParentCommitHash of
-    Just parentCommitHash ->
-      propagate commitHash
-        <$> (getHistoryOf parentCommitHash)
-        <*> (getScrambleOf commitHash)
-    Nothing -> unsafeAssume commitHash <$> getScrambleOf commitHash
+    Just parentCommitHash -> do
+      oldIssues <- (.issues) <$> getIssuesOf parentCommitHash
+      issues <- (.issues) <$> getIssuesOf commitHash
+      oldIssueEvents <- (.issueEvents) <$> getIssueEventsOf parentCommitHash
+      let issueEvents = propagateIssueEvents oldIssueEvents oldIssues commitHash issues
+      pure IssueEvents {..}
+    Nothing -> do
+      scramble <- getScrambleOf commitHash
+      let issueEvents = propagateIssueEvents [] M.empty commitHash scramble.issues
+      pure IssueEvents {..}
 
 getParentCommitHashOf :: CommitHash -> IO (Maybe CommitHash)
 getParentCommitHashOf commitHash =
@@ -103,13 +132,13 @@ getIssuesAndFilesChanged commitHash = do
   issues <-
     concat
       <$> catch
-        (parMapM (getIssues commitHash) files)
+        (parMapM (getIssuesOfFile commitHash) files)
         (\(e :: E.InvalidTreeGrepperResult) -> die (show e))
   pure (issues, files)
 
 -- | Get all issues in the given directory and file.
-getIssues :: CommitHash -> FilePath -> IO [I.Issue]
-getIssues commitHash filename =
+getIssuesOfFile :: CommitHash -> FilePath -> IO [I.Issue]
+getIssuesOfFile commitHash filename =
   handle (\(_ :: E.UnknownFileExtension) -> pure []) $
     fmap catMaybes . parMapM (fromComment commitHash)
       =<< G.getComments commitHash filename
@@ -145,14 +174,6 @@ fromComment commitHash comment = do
   where
     (commentStyle, rawText) = G.uncomment comment.language comment.text
 
-propagate :: CommitHash -> History -> Scramble -> History
-propagate commitHash oldHistory scramble =
-  let issues = propagateIssues oldHistory.issues scramble
-   in History
-        { issueEvents = propagateIssueEvents oldHistory.issueEvents oldHistory.issues commitHash issues,
-          ..
-        }
-
 propagateIssues :: M.Map T.Text I.Issue -> Scramble -> M.Map T.Text I.Issue
 propagateIssues oldIssues scramble =
   M.mergeWithKey
@@ -203,11 +224,3 @@ newIssueEvents oldIssues' commitHash issues' =
   where
     issues = M.filter (not . (.closed)) issues'
     oldIssues = M.filter (not . (.closed)) oldIssues'
-
-unsafeAssume :: CommitHash -> Scramble -> History
-unsafeAssume commitHash scramble =
-  History
-    { issues = scramble.issues,
-      issueEvents = propagateIssueEvents [] M.empty commitHash scramble.issues,
-      ..
-    }