diff options
Diffstat (limited to 'app/History.hs')
| -rw-r--r-- | app/History.hs | 164 |
1 files changed, 138 insertions, 26 deletions
diff --git a/app/History.hs b/app/History.hs index 59b3961..3a81fa3 100644 --- a/app/History.hs +++ b/app/History.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} @@ -8,11 +9,12 @@ import Data.Aeson (eitherDecode) import Data.Binary (Binary, decodeFile, encodeFile) import Data.ByteString.Lazy.Char8 qualified as L8 import Data.Function ((&)) -import Data.List (intercalate) +import Data.List (foldl', intercalate) import Data.Maybe (catMaybes, mapMaybe) import Data.String (fromString) import Data.Text (Text, lines, unpack) import Data.Text.Encoding (decodeUtf8) +import GHC.Generics (Generic) import Issue (Issue (..), fromMatch, id) import Issue.Filter (Filter, applyFilter) import Parallel (parMapM) @@ -30,34 +32,143 @@ import Prelude qualified as Prelude listIssues :: [Filter] -> [FilePath] -> IO [Issue] listIssues filters paths = do - commitHashes <- getCommitHashes - issuesWorkingTreeAll <- getIssuesWorkingTreeAll paths - historicalIssues <- fmap concat $ parMapM (\hash -> cached hash (\_ -> getIssuesCommitChanged hash)) commitHashes - let currentIssuesFiltered = filter (applyFilter filters) issuesWorkingTreeAll - pure $ map (fixProvenance historicalIssues) currentIssuesFiltered + commitHashes <- fmap reverse getCommitHashes + case commitHashes of + [] -> + pure [] + hashFirst : hashesRest -> do + -- TODO Append ".all" to cache id + issuesInitial <- cached hashFirst (\_ -> getIssuesCommitAll hashFirst) + -- TODO Append ".changed" to cache id + commitInfos <- mapM (\hash -> cached hash (\_ -> getCommitInfo hash)) hashesRest + -- TODO We also have to get the issues which changed in the working tree + let eventses = getEvents hashFirst issuesInitial commitInfos + let issues = mapMaybe issueFromIssueEvents eventses + issuesFiltered = filter (applyFilter filters) issues + -- FIXME We have to only consider issues in the specified paths + pure issuesFiltered getCommitHashes :: IO [Text] getCommitHashes = fmap (lines . decodeUtf8 . L8.toStrict) $ sh "git log --format=%H" -fixProvenance :: [Issue] -> Issue -> Issue -fixProvenance historicalIssues = - merge . pick historicalIssues +data IssueEvent + = IssueCreated + { hash :: Text, + issue :: Issue + } + | IssueChanged + { hash :: Text, + issue :: Issue + } + | IssueDeleted + { hash :: Text + } + deriving (Show) -pick :: [Issue] -> Issue -> (Issue, [Issue]) -pick issues issue = - (issue, filter (isSameIssue) issues) - where - isSameIssue otherIssue = - id otherIssue == id issue +issueFromIssueEvent :: IssueEvent -> Maybe Issue +issueFromIssueEvent issueEvent = + case issueEvent of + IssueCreated {issue} -> + Just issue + IssueChanged {issue} -> + Just issue + IssueDeleted _ -> + Nothing -merge :: (Issue, [Issue]) -> Issue -merge (issue, issues) = - case (mapMaybe provenance (reverse issues)) of - [] -> - issue - provenance : _ -> - issue {provenance = Just provenance} +data CommitInfo = CommitInfo + -- TODO Extact CommitInfo so we can change hash' -> hash + { hash' :: Text, + filesChanged :: [FilePath], + issues :: [Issue] + } + deriving (Show, Binary, Generic) + +getCommitInfo :: Text -> IO CommitInfo +getCommitInfo hash = do + (issuesCommitChanged, filesChanged) <- getIssuesAndFilesCommitChanged hash + pure $ + CommitInfo + { hash' = hash, + filesChanged = filesChanged, + issues = issuesCommitChanged + } + +getEvents :: Text -> [Issue] -> [CommitInfo] -> [[IssueEvent]] +getEvents hashInitial issuesInitial commitInfos = + let issueEventsesInitial = + map + ( \issueInitial -> + [ IssueCreated + { hash = hashInitial, + issue = issueInitial + } + ] + ) + issuesInitial + addIssueEventsFromCommitInfo issueEventses commitInfo = + let issuesCreated = + map + ( \issue -> + [ IssueCreated + { hash = commitInfo.hash', + issue = issue + } + ] + ) + $ filter isNewIssue commitInfo.issues + isNewIssue issue = + all + (\issueOther -> id issueOther /= id issue) + (mapMaybe issueFromIssueEvents $ issueEventses) + addIssueChangedOrDeleted issueEventses' = + map + ( \issueEvents -> + case issueFromIssueEvent $ head issueEvents of + Nothing -> + issueEvents + Just issue -> + case filter isSameIssue commitInfo.issues of + [] -> + if any isSameFile commitInfo.filesChanged + then + IssueDeleted + { hash = commitInfo.hash' + } + : issueEvents + else issueEvents + issueCommit : _ -> + IssueChanged + { hash = commitInfo.hash', + issue = issueCommit + } + : issueEvents + where + isSameIssue issueCommit = + id issueCommit == id issue + isSameFile fileChanged = + fileChanged == issue.file + ) + issueEventses' + in issuesCreated ++ addIssueChangedOrDeleted issueEventses + in foldl' + ( addIssueEventsFromCommitInfo + ) + issueEventsesInitial + commitInfos + +issueFromIssueEvents :: [IssueEvent] -> Maybe Issue +issueFromIssueEvents issueEvents = + case issueEvents of + IssueCreated {issue} : [] -> + Just issue + IssueChanged {issue} : _ -> do + issueFirst <- issueFromIssueEvent $ head $ reverse issueEvents + pure $ issue {provenance = issueFirst.provenance} + IssueDeleted _ : _ -> + Nothing + _ -> + Nothing -- | Gets issues in all files in your current [working -- - tree](https://git-scm.com/docs/gitglossary#Documentation/gitglossary.txt-aiddefworkingtreeaworkingtree) @@ -90,16 +201,17 @@ getIssuesCommitAll hash = do concat <$> catch (getIssuesPar cwd files) (dieOfInvalidTreeGrepperResult) -- | Given the hash of a commit, get all issues in the files which have --- been changed by this commit. -getIssuesCommitChanged :: Text -> IO [Issue] -getIssuesCommitChanged hash = do +-- been changed by this commit, as well as all changed files. +getIssuesAndFilesCommitChanged :: Text -> IO ([Issue], [FilePath]) +getIssuesAndFilesCommitChanged hash = do withSystemTempDirectory "history" $ \tmp -> do cwd <- do let cwd = tmp </> unpack hash sh_ $ fromString $ printf "git worktree add --detach %s %s" (quote cwd) (quote $ unpack hash) pure cwd files <- gitShowChanged cwd - concat <$> catch (getIssuesPar cwd files) (dieOfInvalidTreeGrepperResult) + issues <- concat <$> catch (getIssuesPar cwd files) (dieOfInvalidTreeGrepperResult) + pure (issues, files) gitLsFilesAll :: FilePath -> IO [FilePath] gitLsFilesAll cwd = |