diff options
| -rw-r--r-- | app/History.hs | 61 |
1 files changed, 34 insertions, 27 deletions
diff --git a/app/History.hs b/app/History.hs index 252380d..f1d3e97 100644 --- a/app/History.hs +++ b/app/History.hs @@ -30,15 +30,15 @@ import Prelude qualified as Prelude listIssues :: [Filter] -> [FilePath] -> IO [Issue] listIssues filters paths = do - commits <- getCommits - currentIssues <- listIssuesCurrent paths - historicalIssues <- fmap concat $ parMapM (\commit -> cached commit (\_ -> listIssuesOf commit)) commits - let currentIssuesFiltered = filter (applyFilter filters) currentIssues + 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 -getCommits :: IO [Text] -getCommits = - fmap (lines . decodeUtf8 . L8.toStrict) $ sh ("git log --format=%H") +getCommitHashes :: IO [Text] +getCommitHashes = + fmap (lines . decodeUtf8 . L8.toStrict) $ sh "git log --format=%H" fixProvenance :: [Issue] -> Issue -> Issue fixProvenance historicalIssues = @@ -59,21 +59,13 @@ merge (issue, issues) = provenance : _ -> issue {provenance = Just provenance} -listIssuesCurrent :: [FilePath] -> IO [Issue] -listIssuesCurrent paths = do - worktree <- getCurrentDirectory - files <- getFiles worktree paths - concat <$> (catch (getIssuesPar worktree files) dieOfInvalidTreeGrepperResult) - -listIssuesOf :: Text -> IO [Issue] -listIssuesOf commit = do - withSystemTempDirectory "history" $ \tmp -> do - worktree <- do - let worktree = tmp </> unpack commit - sh_ (fromString (printf "git worktree add --detach %s %s" (quote worktree) (quote (unpack commit)))) - pure worktree - files <- getFilesChanged worktree - concat <$> catch (getIssuesPar worktree files) (dieOfInvalidTreeGrepperResult) +-- | Gets issues in all files in your current [working +-- - tree](https://git-scm.com/docs/gitglossary#Documentation/gitglossary.txt-aiddefworkingtreeaworkingtree) +getIssuesWorkingTreeAll :: [FilePath] -> IO [Issue] +getIssuesWorkingTreeAll paths = do + cwd <- getCurrentDirectory + files <- getFiles cwd paths + concat <$> catch (getIssuesPar cwd files) dieOfInvalidTreeGrepperResult getFiles :: FilePath -> [String] -> IO [FilePath] getFiles cwd paths = @@ -89,6 +81,18 @@ getFiles cwd paths = & setWorkingDir cwd ) +-- | 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 + 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 <- getFilesChanged cwd + concat <$> catch (getIssuesPar cwd files) (dieOfInvalidTreeGrepperResult) + getFilesChanged :: FilePath -> IO [FilePath] getFilesChanged cwd = Prelude.lines . L8.unpack @@ -97,9 +101,11 @@ getFilesChanged cwd = & setWorkingDir cwd ) +-- | Get all issues in the given directory and files. Runs +-- parallelized. getIssuesPar :: FilePath -> [FilePath] -> IO [[Issue]] -getIssuesPar worktree = - parMapM (handle forgetGetIssuesExceptions . getIssues worktree) +getIssuesPar cwd files = + parMapM (handle forgetGetIssuesExceptions . getIssues cwd) files data UnknownFileExtension = UnknownFileExtension { extension :: String @@ -122,6 +128,7 @@ dieOfInvalidTreeGrepperResult :: InvalidTreeGrepperResult -> IO a dieOfInvalidTreeGrepperResult (InvalidTreeGrepperResult e) = die e +-- | Get all issues in the given directory and file. getIssues :: FilePath -> FilePath -> IO [Issue] getIssues cwd filename = do let extension = takeExtension filename @@ -170,15 +177,15 @@ fixTreeGrepper treeGrepperResult = treeGrepperResult {G.matches = G.merge treeGrepperResult.matches} cached :: Binary a => Text -> (Text -> IO a) -> IO a -cached commit func = do +cached hash func = do cwd <- getCurrentDirectory createDirectoryIfMissing True (cwd ++ "/.anissue") - let file = (cwd ++ "/.anissue/" ++ unpack commit) + let file = (cwd ++ "/.anissue/" ++ unpack hash) fileExists <- doesFileExist file if fileExists then decodeFile file else do - blob <- func commit + blob <- func hash encodeFile file blob pure blob |