diff options
Diffstat (limited to 'app/History.hs')
-rw-r--r-- | app/History.hs | 77 |
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, - .. - } |