diff options
author | Alexander Foremny <aforemny@posteo.de> | 2023-12-07 03:55:45 +0100 |
---|---|---|
committer | Alexander Foremny <aforemny@posteo.de> | 2023-12-07 03:55:47 +0100 |
commit | 3c6e62b75293b6625509ade3c278fc2d4d147c30 (patch) | |
tree | b33f76c2634a771879f9178cff8e5335e43d2f43 /app/History/CommitInfo.hs | |
parent | a5dde0c6e1c1f54a1660f6c2345277927beef30f (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.hs | 137 |
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 |