diff options
Diffstat (limited to 'app')
-rw-r--r-- | app/History.hs | 48 |
1 files changed, 28 insertions, 20 deletions
diff --git a/app/History.hs b/app/History.hs index bd8af43..09d66e1 100644 --- a/app/History.hs +++ b/app/History.hs @@ -43,12 +43,20 @@ data InvalidTreeGrepperResult = InvalidTreeGrepperResult instance Exception InvalidTreeGrepperResult listIssues :: [Filter] -> [FilePath] -> IO [Issue] -listIssues filters files = do - commits <- fmap (lines . decodeUtf8 . L8.toStrict) $ sh ("git log --format=%H") - currentIssues <- listIssuesCurrent files +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 - pure $ map (merge . pick historicalIssues) currentIssuesFiltered + pure $ map (fixProvenance historicalIssues) currentIssuesFiltered + +getCommits :: IO [Text] +getCommits = + fmap (lines . decodeUtf8 . L8.toStrict) $ sh ("git log --format=%H") + +fixProvenance :: [Issue] -> Issue -> Issue +fixProvenance historicalIssues = + merge . pick historicalIssues pick :: [Issue] -> Issue -> (Issue, [Issue]) pick issues issue = @@ -65,19 +73,6 @@ merge (issue, issues) = provenance : _ -> issue {provenance = Just provenance} -cached :: Binary a => Text -> (Text -> IO a) -> IO a -cached commit func = do - cwd <- getCurrentDirectory - createDirectoryIfMissing True (cwd ++ "/.anissue") - let file = (cwd ++ "/.anissue/" ++ unpack commit) - fileExists <- doesFileExist file - if fileExists - then decodeFile file - else do - blob <- func commit - encodeFile file blob - pure blob - listIssuesCurrent :: [FilePath] -> IO [Issue] listIssuesCurrent paths = do worktree <- getCurrentDirectory @@ -98,14 +93,14 @@ forgetGetIssuesExceptions :: UnknownFileExtension -> IO [a] forgetGetIssuesExceptions _ = pure [] getFiles :: FilePath -> [String] -> IO [FilePath] -getFiles cwd files = +getFiles cwd paths = Prelude.lines . L8.unpack <$> sh ( fromString ( (printf "git ls-files --cached --exclude-standard --other%s") - ( case files of + ( case paths of [] -> "" - _ -> " -- " ++ intercalate " " (map quote files) + _ -> " -- " ++ intercalate " " (map quote paths) ) ) & setWorkingDir cwd @@ -170,6 +165,19 @@ fixTreeGrepper :: G.Result -> G.Result fixTreeGrepper treeGrepperResult = treeGrepperResult {G.matches = G.merge treeGrepperResult.matches} +cached :: Binary a => Text -> (Text -> IO a) -> IO a +cached commit func = do + cwd <- getCurrentDirectory + createDirectoryIfMissing True (cwd ++ "/.anissue") + let file = (cwd ++ "/.anissue/" ++ unpack commit) + fileExists <- doesFileExist file + if fileExists + then decodeFile file + else do + blob <- func commit + encodeFile file blob + pure blob + die :: String -> IO a die s = do printf "error: %s\n" s |