chore: compute issues and issue events separately

2 files changed, 52 insertions, 40 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,
-      ..
-    }
diff --git a/app/Main.hs b/app/Main.hs
index 603ab2a..1b06a0d 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -363,7 +363,6 @@ import Data.Text.IO qualified as T
 import Data.Text.Lazy qualified as LT
 import Data.Text.Lazy.IO qualified as LT
 import Git qualified
-import History (History (..), getHistory)
 import History qualified as H
 import Issue (Issue (..))
 import Issue qualified as I
@@ -534,7 +533,7 @@ idArg =
         <> O.completer
           ( O.listIOCompleter $
               map T.unpack . M.keys . (.issues)
-                <$> getHistory
+                <$> H.getIssues
           )
     )
 
@@ -569,7 +568,7 @@ main = do
           . I.applyPath files
           . I.applyClosed closed
           . (M.elems . (.issues))
-          <$> getHistory
+          <$> H.getIssues
       let groupedIssues = I.groupIssuesByTag group ungroupedIssues
       putDoc colorize noPager width (group, groupedIssues)
     Options {colorize, noPager, width, command = List {sort, filters, files, group = Nothing, closed, detailed, edit}} -> do
@@ -579,20 +578,20 @@ main = do
           . I.applyPath files
           . I.applyClosed closed
           . (M.elems . (.issues))
-          <$> getHistory
+          <$> H.getIssues
       if edit
         then editIssues issues
         else
           putDoc colorize noPager width . (P.vsep . intersperse "") $
             map (if detailed then (P.render . P.Detailed) else (P.render . P.Summarized)) issues
     Options {colorize, noPager, width, command = Log {patch}} -> do
-      es <- reverse . (.issueEvents) <$> getHistory
+      es <- reverse . (.issueEvents) <$> H.getIssueEvents
       putDoc colorize noPager width $
         if patch
           then P.vsep . intersperse P.emptyDoc $ map (P.render . P.Detailed) es
           else P.vsep $ map (P.render . P.Summarized) es
     Options {colorize, noPager, width, command = Show {id, edit}} -> do
-      issues <- (.issues) <$> getHistory
+      issues <- (.issues) <$> H.getIssues
       issue <-
         case M.lookup (T.pack id) issues of
           Nothing -> die (printf "no issue with id `%s'\n" id)
@@ -601,7 +600,7 @@ main = do
         then editIssues [issue]
         else putDoc colorize noPager width $ showIssue (M.elems issues) issue
     Options {colorize, noPager, width, internalTags, command = Tags} -> do
-      issues <- (.issues) <$> getHistory
+      issues <- (.issues) <$> H.getIssues
       let tags =
             concatMap
               ( \issue ->
@@ -637,7 +636,7 @@ editIssues issues = withSystemTempDirectory "anissue-edit" (go issues)
           I.replaceText issue =<< T.readFile (fp issue)
         replaceTexts (issue : issues) = do
           I.replaceText issue =<< T.readFile (fp issue)
-          issues' <- H.getIssues Git.WorkingTree issue.file
+          issues' <- H.getIssuesOfFile Git.WorkingTree issue.file
           replaceTexts [fromMaybe issue (find ((==) issue.id . (.id)) issues') | issue <- issues]
 
 putDoc :: P.Render a => Color -> Bool -> Maybe Int -> a -> IO ()