extract listIssues to History and make commit configurable

2 files changed, 56 insertions, 34 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)
diff --git a/app/Main.hs b/app/Main.hs
index 5e48568..d75ef9c 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -74,13 +74,11 @@
 
 module Main where
 
-import Control.Exception (catch, handle)
-import Data.ByteString.Lazy.Char8 qualified as L8
-import Data.List (find, intercalate)
+import Data.List (find)
 import Data.Maybe (catMaybes, fromMaybe)
 import Data.String qualified as String
 import Data.Text qualified as T
-import History (InvalidTreeGrepperResult (..), UnknownFileExtension (..), getIssues)
+import History (listIssues)
 import Issue (Issue (..))
 import Issue qualified as I
 import Issue.Filter (Filter)
@@ -90,7 +88,7 @@ import Options.Applicative ((<**>))
 import Options.Applicative qualified as O
 import Prettyprinter qualified as P
 import Prettyprinter.Render.Terminal qualified as P
-import Process (quote, sh, sh_)
+import Process (sh_)
 import System.Exit (ExitCode (ExitFailure), exitWith)
 import System.Process.Typed qualified as P
 import Text.Printf
@@ -246,28 +244,3 @@ putDoc doc = do
   P.putDoc . (if isTty then (\x -> x) else P.unAnnotate) $ doc
 
 foreign import ccall "unistd.h isatty" c_isatty :: Int -> IO Int
-
-listIssues :: [Filter] -> [FilePath] -> IO [Issue]
-listIssues filters files =
-  filter (I.applyFilter filters) . concat
-    <$> catch
-      ( mapM (handle forgetGetIssuesExceptions . getIssues)
-          =<< getFiles files
-      )
-      (\(InvalidTreeGrepperResult e) -> die e)
-  where
-    forgetGetIssuesExceptions :: UnknownFileExtension -> IO [a]
-    forgetGetIssuesExceptions _ = pure []
-
-getFiles :: [String] -> IO [FilePath]
-getFiles files =
-  lines . L8.unpack
-    <$> sh
-      ( String.fromString
-          ( (printf "git ls-files --cached --exclude-standard --other%s")
-              ( case files of
-                  [] -> ""
-                  _ -> " -- " ++ intercalate " " (map quote files)
-              )
-          )
-      )