remove calls to `setWorkingDirectory`

1 files changed, 12 insertions, 11 deletions

diff --git a/app/History.hs b/app/History.hs
index 0621fd8..1604760 100644
--- a/app/History.hs
+++ b/app/History.hs
@@ -7,6 +7,7 @@ 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.Function ((&))
 import Data.List (intercalate)
 import Data.Maybe (catMaybes, mapMaybe)
 import Data.String (fromString)
@@ -15,10 +16,11 @@ import Data.Text.Encoding (decodeUtf8)
 import Issue (Issue (..), fromMatch, id)
 import Issue.Filter (Filter, applyFilter)
 import Process (quote, sh, sh_)
-import System.Directory (createDirectoryIfMissing, doesFileExist, getCurrentDirectory, setCurrentDirectory)
+import System.Directory (createDirectoryIfMissing, doesFileExist, getCurrentDirectory)
 import System.Exit (ExitCode (ExitFailure), exitWith)
 import System.FilePath (takeExtension, (</>))
 import System.IO.Temp (withSystemTempDirectory)
+import System.Process.Typed (setWorkingDir)
 import Text.Printf (printf)
 import TreeGrepper.Match qualified as G
 import TreeGrepper.Result qualified as G
@@ -81,25 +83,22 @@ cached commit func = do
 
 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
+        ( parMapM (handle forgetGetIssuesExceptions . getIssues worktree)
+            =<< getFiles worktree files
         )
         (\(InvalidTreeGrepperResult e) -> die e)
-  setCurrentDirectory cwd
   pure issue
   where
     forgetGetIssuesExceptions :: UnknownFileExtension -> IO [a]
     forgetGetIssuesExceptions _ = pure []
 
-getFiles :: [String] -> IO [FilePath]
-getFiles files =
+getFiles :: FilePath -> [String] -> IO [FilePath]
+getFiles cwd files =
   Prelude.lines . L8.unpack
     <$> sh
       ( fromString
@@ -109,10 +108,11 @@ getFiles files =
                   _ -> " -- " ++ intercalate " " (map quote files)
               )
           )
+          & setWorkingDir cwd
       )
 
-getIssues :: FilePath -> IO [Issue]
-getIssues filename = do
+getIssues :: FilePath -> FilePath -> IO [Issue]
+getIssues cwd filename = do
   let extension = takeExtension filename
       treeGrepperLanguage =
         -- TODO Add support for all tree-grepper supported files
@@ -149,9 +149,10 @@ getIssues filename = do
                 (quote treeGrepperQuery)
                 (quote filename)
             )
+            & setWorkingDir cwd
         )
 
-  catMaybes <$> mapM (uncurry fromMatch) matches
+  catMaybes <$> mapM (uncurry (fromMatch cwd)) matches
 
 fixTreeGrepper :: G.Result -> G.Result
 fixTreeGrepper treeGrepperResult =