aboutsummaryrefslogtreecommitdiffstats
path: root/app/History/CommitInfo.hs
diff options
context:
space:
mode:
authorLibravatar Alexander Foremny <aforemny@posteo.de>2023-12-07 03:55:45 +0100
committerLibravatar Alexander Foremny <aforemny@posteo.de>2023-12-07 03:55:47 +0100
commit3c6e62b75293b6625509ade3c278fc2d4d147c30 (patch)
treeb33f76c2634a771879f9178cff8e5335e43d2f43 /app/History/CommitInfo.hs
parenta5dde0c6e1c1f54a1660f6c2345277927beef30f (diff)
chore: increase performance by caching everything
Initial cache generation is slower, as we are losing out on parallelism.
Diffstat (limited to 'app/History/CommitInfo.hs')
-rw-r--r--app/History/CommitInfo.hs137
1 files changed, 0 insertions, 137 deletions
diff --git a/app/History/CommitInfo.hs b/app/History/CommitInfo.hs
deleted file mode 100644
index 2c861a6..0000000
--- a/app/History/CommitInfo.hs
+++ /dev/null
@@ -1,137 +0,0 @@
-module History.CommitInfo
- ( CommitInfo (..),
- fromPartialCommitInfos,
- issueEvents,
- diffCommitInfos,
- )
-where
-
-import Data.Binary (Binary)
-import Data.Function (on, (&))
-import Data.List (deleteFirstsBy, find)
-import Data.Maybe (isJust)
-import Data.Text.IO qualified as T
-import Data.Text.Lazy qualified as LT
-import Data.Text.Lazy.Encoding qualified as LT
-import GHC.Generics (Generic)
-import History.CommitHash (CommitHash)
-import History.IssueEvent (IssueEvent (..))
-import History.PartialCommitInfo (PartialCommitInfo (..))
-import Issue (Issue (..))
-import Issue.Provenance qualified as I
-import Parallel (parSequence)
-import Patch qualified as A
-import Process (sh)
-import System.FilePath ((</>))
-import System.IO.Temp (withSystemTempDirectory)
-import System.Process.Typed (setWorkingDir)
-
--- TODO Change `CommitInfo` -> `CommitIssuesAll`
-data CommitInfo = CommitInfo
- { hash :: CommitHash,
- 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 =
- mergeListsBy
- eq
- ( \old new ->
- new
- { provenance =
- I.Provenance
- { first = old.provenance.first,
- last =
- if ((/=) `on` (.rawText)) old new
- then new.provenance.last
- else old.provenance.last
- },
- closed = False
- }
- )
- ( \old ->
- if elemBy eq old newInfo.issues
- || not (old.file `elem` newInfo.filesChanged)
- then old
- else old {closed = True}
- )
- id
- oldInfo.issues
- newInfo.issues,
- ..
- }
-
- eq = (==) `on` (.id)
-
--- | We assume that [CommitInfo] is sorted starting with the oldest
--- commits.
-issueEvents :: [CommitInfo] -> IO [(CommitHash, [IssueEvent])]
-issueEvents xs = zip (map (.hash) xs) <$> parSequence (zipWith diffCommitInfos predecessors xs)
- where
- predecessors = Nothing : map Just xs
-
-diffCommitInfos :: Maybe CommitInfo -> CommitInfo -> IO [IssueEvent]
-diffCommitInfos maybeOldInfo newInfo =
- sequence $
- concat
- [ [IssueCreated newHash issue <$> patchCreated issue | issue <- deleteFirstsBy eq newIssues oldIssues],
- [ IssueChanged newHash oldIssue newIssue <$> patchChanged oldIssue newIssue
- | (newIssue : oldIssue : _) <- intersectBy' eq newIssues oldIssues,
- neq newIssue oldIssue
- ],
- [IssueDeleted newHash issue <$> patchDeleted issue | issue <- deleteFirstsBy eq oldIssues newIssues]
- ]
- where
- newHash = newInfo.hash
- newIssues' = newInfo.issues
- oldIssues' = maybe [] (.issues) maybeOldInfo
- newIssues = filter (not . (.closed)) newIssues'
- oldIssues = filter (not . (.closed)) oldIssues'
-
- eq = (==) `on` (.id)
- neq = (/=) `on` (.rawText)
-
- patchCreated new = diff "" new.rawText
- patchChanged old new = diff old.rawText new.rawText
- patchDeleted old = diff old.rawText ""
-
- diff old new = withSystemTempDirectory "diff" $ \tmp -> do
- let cwd = tmp
- T.writeFile (tmp </> "old") old
- T.writeFile (tmp </> "new") new
- A.parse . LT.toStrict . LT.decodeUtf8 <$> sh ("git diff --no-index -- old new || :" & setWorkingDir cwd)
-
-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