diff options
| -rw-r--r-- | .gitignore | 1 | ||||
| -rw-r--r-- | anissue.cabal | 1 | ||||
| -rw-r--r-- | app/History.hs | 18 | ||||
| -rw-r--r-- | app/Issue.hs | 12 | ||||
| -rw-r--r-- | app/Issue/Tag.hs | 5 | ||||
| -rw-r--r-- | app/TreeGrepper/Match.hs | 4 |
6 files changed, 35 insertions, 6 deletions
@@ -1,3 +1,4 @@ /.direnv /.history /dist-newstyle +/.anissue diff --git a/anissue.cabal b/anissue.cabal index efada75..046abb6 100644 --- a/anissue.cabal +++ b/anissue.cabal @@ -82,6 +82,7 @@ executable anissue -- Other library packages from which modules are imported. build-depends: base ^>=4.16.4.0, aeson, + binary, bytestring, directory, filepath, 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 diff --git a/app/Issue.hs b/app/Issue.hs index ba8baa8..f7227f1 100644 --- a/app/Issue.hs +++ b/app/Issue.hs @@ -1,10 +1,12 @@ {-# LANGUAGE BlockArguments #-} +{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} module Issue (Issue (..), Provenance (..), fromMatch, id) where +import Data.Binary (Binary, get, put) import Data.ByteString.Lazy (toStrict) import Data.ByteString.Lazy.Char8 (unpack) import Data.List (find, foldl') @@ -13,6 +15,7 @@ import Data.Text (Text) import Data.Text qualified as T import Data.Text.Encoding (decodeUtf8) import Data.Time.Clock (UTCTime) +import GHC.Generics (Generic) import Issue.Tag (Tag (..)) import Issue.Tag qualified as I import Issue.Text qualified as I @@ -34,7 +37,7 @@ data Issue = Issue tags :: [Tag], internalTags :: [Tag] } - deriving (Show) + deriving (Show, Binary, Generic) data Provenance = Provenance { firstCommit :: Text, @@ -42,7 +45,12 @@ data Provenance = Provenance authorEmail :: Text, authorName :: Text } - deriving (Show) + deriving (Show, Generic, Binary) + +instance Binary UTCTime where + -- TODO Serialize UTCTime using POSIX time stamps + put = put . show + get = fmap read get id :: Issue -> Maybe String id issue = diff --git a/app/Issue/Tag.hs b/app/Issue/Tag.hs index af12331..7147cb1 100644 --- a/app/Issue/Tag.hs +++ b/app/Issue/Tag.hs @@ -1,14 +1,17 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE DeriveAnyClass #-} module Issue.Tag (Tag (..), extractTags, internalTags) where import Data.Maybe (catMaybes) import Data.Text (Text) import Data.Text qualified as T +import Data.Binary (Binary) +import GHC.Generics (Generic) -data Tag = Tag Text Text deriving (Show) +data Tag = Tag Text Text deriving (Show, Generic, Binary) extractTags :: Text -> [Tag] extractTags = diff --git a/app/TreeGrepper/Match.hs b/app/TreeGrepper/Match.hs index 7b8cde8..1072fbd 100644 --- a/app/TreeGrepper/Match.hs +++ b/app/TreeGrepper/Match.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE DeriveAnyClass #-} module TreeGrepper.Match ( Match (..), @@ -16,6 +17,7 @@ import Data.Ord (comparing) import Data.Text (Text) import Data.Text qualified as T import GHC.Generics (Generic) +import Data.Binary (Binary) data Match = Match { kind :: String, @@ -32,7 +34,7 @@ data Position = Position { row :: Int, column :: Int } - deriving (Eq, Show, Generic) + deriving (Eq, Show, Generic, Binary) instance Ord Position where compare = compare `on` (\p -> (p.row, p.column)) |