refactor `Git.withWorkingTree`

2 files changed, 27 insertions, 15 deletions

diff --git a/app/Git.hs b/app/Git.hs
new file mode 100644
index 0000000..57fffdc
--- /dev/null
+++ b/app/Git.hs
@@ -0,0 +1,15 @@
+module Git (withWorkingTree) where
+
+import Control.Exception (finally)
+import Data.Text (Text)
+import Process (proc, sh_)
+import System.Directory (createDirectoryIfMissing)
+import System.FilePath (dropTrailingPathSeparator, takeDirectory)
+
+-- | Runs an IO-action within a working tree.
+withWorkingTree :: FilePath -> Text -> IO a -> IO a
+withWorkingTree path hash action = do
+  createDirectoryIfMissing True (takeDirectory (dropTrailingPathSeparator path))
+  sh_ $ proc "git worktree add --quiet --detach % %" path hash
+  action `finally` do
+    sh_ $ proc "git worktree remove --force %" path
diff --git a/app/History.hs b/app/History.hs
index ff7f889..4f62610 100644
--- a/app/History.hs
+++ b/app/History.hs
@@ -10,12 +10,13 @@ import Data.Maybe (catMaybes, mapMaybe)
 import Data.Text (Text, append, isPrefixOf, lines, pack, unpack)
 import Data.Text.Encoding (decodeUtf8)
 import GHC.Generics (Generic)
+import Git qualified
 import Issue (Issue (..), fromMatch, id)
 import Issue.Filter (Filter, applyFilter)
-import Issue.Tag qualified as I
 import Issue.Sort (Sort, applySort)
+import Issue.Tag qualified as I
 import Parallel (parMapM)
-import Process (proc, sh, sh_)
+import Process (proc, sh)
 import System.Directory (createDirectoryIfMissing, doesFileExist, getCurrentDirectory)
 import System.Exit (ExitCode (ExitFailure), exitWith)
 import System.FilePath (takeExtension, (</>))
@@ -220,25 +221,21 @@ getIssuesAndFilesWorkingTreeChanged paths = do
 getIssuesCommitAll :: Text -> IO [Issue]
 getIssuesCommitAll hash = do
   withSystemTempDirectory "history" $ \tmp -> do
-    cwd <- do
-      let cwd = tmp </> unpack hash
-      sh_ $ proc "git worktree add --detach % %" cwd (unpack hash)
-      pure cwd
-    files <- gitLsFilesAll cwd
-    concat <$> catch (getIssuesPar cwd files) (dieOfInvalidTreeGrepperResult)
+    let cwd = tmp </> unpack hash
+    Git.withWorkingTree cwd hash do
+      files <- gitLsFilesAll cwd
+      concat <$> catch (getIssuesPar cwd files) (dieOfInvalidTreeGrepperResult)
 
 -- | Given the hash of a commit, get all issues in the files which have
 -- been changed by this commit, as well as all changed files.
 getIssuesAndFilesCommitChanged :: Text -> IO ([Issue], [FilePath])
 getIssuesAndFilesCommitChanged hash = do
   withSystemTempDirectory "history" $ \tmp -> do
-    cwd <- do
-      let cwd = tmp </> unpack hash
-      sh_ $ proc "git worktree add --detach % %" cwd (unpack hash)
-      pure cwd
-    files <- gitShowChanged cwd
-    issues <- concat <$> catch (getIssuesPar cwd files) (dieOfInvalidTreeGrepperResult)
-    pure (issues, files)
+    let cwd = tmp </> unpack hash
+    Git.withWorkingTree cwd hash do
+      files <- gitShowChanged cwd
+      issues <- concat <$> catch (getIssuesPar cwd files) (dieOfInvalidTreeGrepperResult)
+      pure (issues, files)
 
 gitLsFilesAll :: FilePath -> IO [FilePath]
 gitLsFilesAll cwd =