From b98ef2f84195b515b3b00c593249ed418de38814 Mon Sep 17 00:00:00 2001
From: Alexander Foremny <aforemny@posteo.de>
Date: Wed, 13 Dec 2023 04:35:19 +0100
Subject: chore: compute issues and issue events separately
---
app/History.hs | 77 ++++++++++++++++++++++++++++++++++------------------------
app/Main.hs | 15 ++++++------
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 ()
--
cgit v1.2.3