From ef5f4581f31ec35a4b2afefbafac56f175566879 Mon Sep 17 00:00:00 2001 From: Fabian Kirchner Date: Sat, 14 Oct 2023 12:11:38 +0200 Subject: add basic caching of Issue's --- app/History.hs | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) (limited to 'app/History.hs') diff --git a/app/History.hs b/app/History.hs index fad911a..0621fd8 100644 --- a/app/History.hs +++ b/app/History.hs @@ -5,6 +5,7 @@ module History (getIssues, InvalidTreeGrepperResult (..), UnknownFileExtension ( import Control.Exception (Exception, catch, handle, throw) import Data.Aeson (eitherDecode) +import Data.Binary (Binary, decodeFile, encodeFile) import Data.ByteString.Lazy.Char8 qualified as L8 import Data.List (intercalate) import Data.Maybe (catMaybes, mapMaybe) @@ -14,7 +15,7 @@ import Data.Text.Encoding (decodeUtf8) import Issue (Issue (..), fromMatch, id) import Issue.Filter (Filter, applyFilter) import Process (quote, sh, sh_) -import System.Directory (getCurrentDirectory, setCurrentDirectory) +import System.Directory (createDirectoryIfMissing, doesFileExist, getCurrentDirectory, setCurrentDirectory) import System.Exit (ExitCode (ExitFailure), exitWith) import System.FilePath (takeExtension, ()) import System.IO.Temp (withSystemTempDirectory) @@ -41,7 +42,7 @@ instance Exception InvalidTreeGrepperResult listIssues :: [Filter] -> [FilePath] -> IO [Issue] listIssues filters files = do commits <- fmap (lines . decodeUtf8 . L8.toStrict) $ sh ("git log --format=%H") - issueses <- mapM (\commit -> listIssuesOf commit filters files) commits + issueses <- mapM (\commit -> cached commit (\_ -> listIssuesOf commit filters files)) commits (currentIssues, historicalIssues) <- case issueses of currentIssues : historicalIssueses -> @@ -65,6 +66,19 @@ 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 + listIssuesOf :: Text -> [Filter] -> [FilePath] -> IO [Issue] listIssuesOf commit filters files = do cwd <- getCurrentDirectory -- cgit v1.2.3