refactor history

1 files changed, 122 insertions, 0 deletions

diff --git a/app/History/CommitInfo.hs b/app/History/CommitInfo.hs
new file mode 100644
index 0000000..8461b8e
--- /dev/null
+++ b/app/History/CommitInfo.hs
@@ -0,0 +1,122 @@
+module History.CommitInfo
+  ( CommitInfo (..),
+    fromPartialCommitInfos,
+    issueEvents,
+    diffCommitInfos,
+  )
+where
+
+import Data.Binary (Binary)
+import Data.Function (on)
+import Data.List (deleteFirstsBy, find)
+import Data.Maybe (catMaybes, isJust)
+import GHC.Generics (Generic)
+import History.CommitHash (CommitHash)
+import History.IssueEvent (IssueEvent (..))
+import History.PartialCommitInfo (PartialCommitInfo (..))
+import Issue (Issue (..), id)
+import Issue.Tag qualified as I
+import TreeGrepper.Match (Position (..))
+import Prelude hiding (id)
+
+data CommitInfo = CommitInfo
+  { hash :: CommitHash,
+    filesChanged :: [FilePath],
+    issues :: [Issue]
+  }
+  deriving (Show, Binary, Generic)
+
+fromPartialCommitInfos :: [PartialCommitInfo] -> [CommitInfo]
+fromPartialCommitInfos [] = []
+fromPartialCommitInfos (partialCommitInfo : partialCommitInfos) =
+  scanl propagate (assume partialCommitInfo) partialCommitInfos
+  where
+    assume :: PartialCommitInfo -> CommitInfo
+    assume (PartialCommitInfo {..}) = CommitInfo {..}
+
+    propagate :: CommitInfo -> PartialCommitInfo -> CommitInfo
+    propagate oldInfo newInfo@(PartialCommitInfo {..}) =
+      CommitInfo
+        { issues =
+            catMaybes $
+              mergeListsBy
+                eq
+                ( \old new ->
+                    Just
+                      new
+                        { provenance = old.provenance,
+                          internalTags = I.internalTags new.title old.provenance
+                        }
+                )
+                ( \old ->
+                    if elemBy eq old newInfo.issues
+                      || not (old.file `elem` newInfo.filesChanged)
+                      then Just old
+                      else Nothing
+                )
+                (\new -> Just new)
+                oldInfo.issues
+                newInfo.issues,
+          ..
+        }
+
+    eq = (==) `on` id
+
+issueEvents :: [CommitInfo] -> [(CommitHash, [IssueEvent])]
+issueEvents xs = zip (map (.hash) xs') (zipWith diffCommitInfos xs xs')
+  where
+    xs' = tail xs
+
+diffCommitInfos :: CommitInfo -> CommitInfo -> [IssueEvent]
+diffCommitInfos oldInfo newInfo =
+  concat
+    [ [IssueCreated newHash issue | issue <- deleteFirstsBy eq newIssues oldIssues],
+      [ IssueChanged newHash (last issues)
+        | issues <- intersectBy' eq newIssues oldIssues,
+          not (null [(x, y) | x <- issues, y <- issues, clear x /= clear y])
+      ],
+      [IssueDeleted newHash issue | issue <- deleteFirstsBy eq oldIssues newIssues]
+    ]
+  where
+    newHash = newInfo.hash
+    newIssues = newInfo.issues
+    oldIssues = oldInfo.issues
+
+    -- TODO Fix issue comparison
+    --
+    -- Because issues carry `provenance` and `internalTags`, issues compare
+    -- unequally when we want them to be equal.
+    clear i =
+      i
+        { provenance = Nothing,
+          internalTags = [],
+          start = Position 0 0,
+          end = Position 0 0,
+          file = ""
+        }
+
+    eq = (==) `on` id
+
+mergeListsBy :: (a -> a -> Bool) -> (a -> a -> b) -> (a -> b) -> (a -> b) -> [a] -> [a] -> [b]
+mergeListsBy eq onBoth onLeft onRight lefts rights =
+  concat
+    [ [ maybe (onLeft left) (onBoth left) right
+        | left <- lefts,
+          right <-
+            let rights' = filter (eq left) rights
+             in if null rights' then [Nothing] else (map Just rights')
+      ],
+      [ onRight right
+        | right <- rights,
+          not (elemBy eq right lefts)
+      ]
+    ]
+
+-- | A variant of `Data.List.intersectBy` that retuns the witnesses of the
+-- intersection.
+intersectBy' :: (a -> a -> Bool) -> [a] -> [a] -> [[a]]
+intersectBy' eq xs ys = filter (not . null) (map (\x -> x : filter (eq x) ys) xs)
+
+-- | A variant of `elem` that uses a custom comparison function.
+elemBy :: (a -> a -> Bool) -> a -> [a] -> Bool
+elemBy eq x xs = isJust $ find (eq x) xs