module History.IssueEvents ( IssueEvents (..), ) where import Backend qualified import Data.Binary (Binary) import Data.Function (on) import Data.List import Data.List.NonEmpty qualified as NE import Data.Map qualified as M import Data.Maybe (fromMaybe) import Data.Ord (comparing) import Data.Proxy (Proxy) import GHC.Generics (Generic) import History.Plan (Id, Planable, Proto, assume, postprocess, propagate, protoOf) import History.Scramble (Scramble (..), getScrambleOf) import Issue (Issue (..)) import IssueEvent (IssueEvent (..)) import IssueEvent qualified as E data IssueEvents = IssueEvents { commitHash :: Backend.CommitHash, issueEvents :: [E.IssueEvent], filesSeen :: M.Map FilePath Backend.CommitHash } deriving (Show, Generic, Binary) instance Planable IssueEvents where type Id IssueEvents = Backend.CommitHash type Proto IssueEvents = Scramble protoOf :: Proxy IssueEvents -> Backend.CommitHash -> IO Scramble protoOf _ = getScrambleOf assume :: Scramble -> IssueEvents assume Scramble {..} = IssueEvents { issueEvents = [ IssueCreated commitHash issue | issue <- M.elems issues ], filesSeen = M.unions [ M.singleton issue.file commitHash | issue <- M.elems issues ], .. } propagate :: [Backend.CommitHash] -> IssueEvents -> Scramble -> IssueEvents propagate = propagateIssueEvents postprocess :: [Backend.CommitHash] -> IssueEvents -> IssueEvents postprocess log issueEvents = issueEvents { issueEvents = sortOn logOrder . concatMap dropLastDeleted . groupPerIssue $ issueEvents.issueEvents } where dropLastDeleted xs = case NE.last xs of IssueDeleted _ _ -> NE.init xs _ -> NE.toList xs groupPerIssue = map (NE.sortBy (comparing logOrder)) . NE.groupBy (sym `on` issue) . sortOn ((.id) . issue) logOrder = fromMaybe (-1) . (`elemIndex` log) . commitHash sym :: Issue -> Issue -> Bool sym = (==) `on` (.id) commitHash (IssueChanged commitHash _ _) = commitHash commitHash (IssueCreated commitHash _) = commitHash commitHash (IssueDeleted commitHash _) = commitHash issue (IssueChanged _ _ issue) = issue issue (IssueCreated _ issue) = issue issue (IssueDeleted _ issue) = issue -- | Propagates issue events from a top commit to a consecutive bottom commit. -- -- Because we are building the history of issue events backwards, we use *top* and *bottom* to refer to the later and earlier commit within the Git history, respectively. We use *earlier* and *later* to refer to the top and bottom commits within the application of this function. In particular, top commits are processed earlier, and bottom commits are processed later. -- -- For the top/earlier commit, issue events are known. For the bottom/later commit, only the scramble is known. -- -- The scramble is said to *witness* an issue, if its changed files contain the issue's file. Thus, in addition to the issues a scramble contains, it witnesses the issues that have been deleted in the scramble's commit. -- -- Because we are building the history from top/earlier to bottom/later commits, we have to assume that at any top/earlier commit, the issues present have been created in that commit. This function advances the issue's original commit as we learn about bottom/later commits from scrambles. -- -- Suppose an issue `1` is present since a top commit `b`, and we encounter a scramble that witnesses the issue at commit `a`. Has issue `1` originally been created in commit `b`, or has it been closed in commit `a` and re-opened in commit `b`? Answering that question depends on later information, ie. whether issue `1` is created in a later commit. In the first case, it would be correct to simply not advance the original commit of issue `a`. In the second case, it would be correct to create an event that the issue has been deleted. Not advancing the original commit of issue `a` leaves us no information to answer the question later. Thus, we create an event that the issue has been deleted. -- -- This is incorrect for issues that have not been re-opened. Finally, those issues will have a chain of issue events that end in a deletion event, and we post-process issue events to remove precisely those. propagateIssueEvents :: [Backend.CommitHash] -> IssueEvents -> Scramble -> IssueEvents propagateIssueEvents log topIssueEvents bottomScramble = IssueEvents { commitHash = bottomScramble.commitHash, issueEvents = sortOn logOrder $ let issueEventsPerIssue = groupPerIssue topIssueEvents.issueEvents in concat [ -- CASE 1. The issue is present in the top/earlier history and bottom/later scramble. We advance the issue's original commit, and track any change if there was any. concat [ NE.init issueEvents ++ case NE.last issueEvents of IssueCreated commitHash _ -> concat [ if topIssue `neq` bottomIssue then [ IssueChanged commitHash bottomIssue topIssue ] else [], [ IssueCreated bottomCommitHash bottomIssue ] ] issueEvent@(IssueDeleted _ _) -> [ issueEvent, IssueCreated bottomCommitHash bottomIssue ] issueEvent -> [issueEvent] | issueEvents <- issueEventsPerIssue, let topIssue = issue (NE.last issueEvents), bottomIssue <- bottomIssues, bottomIssue `sym` topIssue ], concat [ -- CASE 2. The issue is present in the top/earlier history, not contained in the bottom/later scramble, but witnessed by the bottom/later scramble. We track a deletion, because we don't know whether or not the issue has been re-opened (see above). NE.init issueEvents ++ case NE.last issueEvents of issueEvent@(IssueCreated _ issue) -> [ issueEvent, IssueDeleted bottomCommitHash issue {closed = True} ] issueEvent -> [issueEvent] | issueEvents <- issueEventsPerIssue, let topIssue = issue (NE.last issueEvents), all (`nsym` topIssue) bottomIssues, topIssue.file `elem` bottomScramble.filesChanged ], concat [ -- CASE 3. The issue is present in the top/earlier history, but not witnessed by the bottom/later scramble. We keep the issue event unchanged. NE.init issueEvents ++ case NE.last issueEvents of issueEvent -> [issueEvent] | issueEvents <- issueEventsPerIssue, let topIssue = issue (NE.last issueEvents), all (`nsym` topIssue) bottomIssues, not (topIssue.file `elem` bottomScramble.filesChanged) ], concat [ -- CASE 4. The issue it not present in the top/earlier history, but contained in the bottom scramble. If we have seen the issue's file earlier, this means the issue had to be deleted at the earlier commit. If the file has not been seen earlier, we plainly track the issue's creation. concat [ case M.lookup bottomIssue.file topIssueEvents.filesSeen of Nothing -> [] Just seenCommitHash -> [IssueDeleted seenCommitHash bottomIssue {closed = True}], [IssueCreated bottomCommitHash bottomIssue] ] | bottomIssue <- bottomIssues, all ((`nsym` bottomIssue) . issue . NE.last) issueEventsPerIssue ] ], filesSeen = M.union ( M.unions [ M.singleton file bottomScramble.commitHash | file <- bottomScramble.filesChanged ] ) topIssueEvents.filesSeen } where groupPerIssue = map (NE.sortBy (comparing logOrder)) . NE.groupBy (sym `on` issue) . sortOn ((.id) . issue) logOrder = fromMaybe (-1) . (`elemIndex` log) . commitHash bottomCommitHash = bottomScramble.commitHash bottomIssues = M.elems bottomScramble.issues neq, sym, nsym :: Issue -> Issue -> Bool sym = (==) `on` (.id) nsym = (/=) `on` (.id) neq = (/=) `on` (.rawTextHash) commitHash (IssueChanged commitHash _ _) = commitHash commitHash (IssueCreated commitHash _) = commitHash commitHash (IssueDeleted commitHash _) = commitHash issue (IssueChanged _ _ issue) = issue issue (IssueCreated _ issue) = issue issue (IssueDeleted _ issue) = issue