diff options
| -rw-r--r-- | app/History.hs | 77 | ||||
| -rw-r--r-- | 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 () |