aboutsummaryrefslogtreecommitdiffstats
path: root/app/History.hs
diff options
context:
space:
mode:
Diffstat (limited to 'app/History.hs')
-rw-r--r--app/History.hs57
1 files changed, 53 insertions, 4 deletions
diff --git a/app/History.hs b/app/History.hs
index fc3b156..20e51ab 100644
--- a/app/History.hs
+++ b/app/History.hs
@@ -1,14 +1,22 @@
{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
-module History (getIssues, InvalidTreeGrepperResult (..), UnknownFileExtension (..)) where
+module History (getIssues, InvalidTreeGrepperResult (..), UnknownFileExtension (..), listIssues) where
-import Control.Exception (Exception, throw)
+import Control.Exception (Exception, catch, handle, throw)
import Data.Aeson (eitherDecode)
+import Data.ByteString.Lazy.Char8 qualified as L8
+import Data.List (intercalate)
import Data.Maybe (catMaybes)
import Data.String (fromString)
+import Data.Text (Text, unpack)
import Issue (Issue (..), fromMatch)
-import Process (quote, sh)
-import System.FilePath (takeExtension)
+import Issue.Filter (Filter, applyFilter)
+import Process (quote, sh, sh_)
+import System.Directory (getCurrentDirectory, setCurrentDirectory)
+import System.Exit (ExitCode (ExitFailure), exitWith)
+import System.FilePath (takeExtension, (</>))
+import System.IO.Temp (withSystemTempDirectory)
import Text.Printf (printf)
import TreeGrepper.Match qualified as G
import TreeGrepper.Result qualified as G
@@ -27,6 +35,42 @@ data InvalidTreeGrepperResult = InvalidTreeGrepperResult
instance Exception InvalidTreeGrepperResult
+listIssues :: [Filter] -> [FilePath] -> IO [Issue]
+listIssues filters files =
+ listIssuesOf "HEAD" filters files
+
+listIssuesOf :: Text -> [Filter] -> [FilePath] -> IO [Issue]
+listIssuesOf commit filters files = do
+ cwd <- getCurrentDirectory
+ issue <- withSystemTempDirectory "history" $ \tmp -> do
+ let worktree = tmp </> unpack commit
+ sh_ (fromString (printf "git worktree add --detach %s %s" (quote worktree) (quote (unpack commit))))
+ setCurrentDirectory worktree
+ filter (applyFilter filters) . concat
+ <$> catch
+ ( mapM (handle forgetGetIssuesExceptions . getIssues)
+ =<< getFiles files
+ )
+ (\(InvalidTreeGrepperResult e) -> die e)
+ setCurrentDirectory cwd
+ pure issue
+ where
+ forgetGetIssuesExceptions :: UnknownFileExtension -> IO [a]
+ forgetGetIssuesExceptions _ = pure []
+
+getFiles :: [String] -> IO [FilePath]
+getFiles files =
+ lines . L8.unpack
+ <$> sh
+ ( fromString
+ ( (printf "git ls-files --cached --exclude-standard --other%s")
+ ( case files of
+ [] -> ""
+ _ -> " -- " ++ intercalate " " (map quote files)
+ )
+ )
+ )
+
getIssues :: FilePath -> IO [Issue]
getIssues filename = do
let extension = takeExtension filename
@@ -72,3 +116,8 @@ getIssues filename = do
fixTreeGrepper :: G.Result -> G.Result
fixTreeGrepper treeGrepperResult =
treeGrepperResult {G.matches = G.merge treeGrepperResult.matches}
+
+die :: String -> IO a
+die s = do
+ printf "error: %s\n" s
+ exitWith (ExitFailure 1)