add Process.proc

Adds type-trickery akin to `Text.printf` to provide

- (1) an abstraction over `fromString (printf ".." ..)` for
  `ProcessConfig`s,
- (2) have arguments be quoted automatically.

As string is the only argument type that Shell knows, the formatting
character is simply "%".

1 files changed, 13 insertions, 22 deletions

diff --git a/app/History.hs b/app/History.hs
index 0e7465c..f436672 100644
--- a/app/History.hs
+++ b/app/History.hs
@@ -5,16 +5,15 @@ import Data.Aeson (eitherDecode)
 import Data.Binary (Binary, decodeFileOrFail, encodeFile)
 import Data.ByteString.Lazy.Char8 qualified as L8
 import Data.Function ((&))
-import Data.List (foldl', intercalate)
+import Data.List (foldl')
 import Data.Maybe (catMaybes, mapMaybe)
-import Data.String (fromString)
 import Data.Text (Text, append, isPrefixOf, lines, pack, unpack)
 import Data.Text.Encoding (decodeUtf8)
 import GHC.Generics (Generic)
 import Issue (Issue (..), fromMatch, id)
 import Issue.Filter (Filter, applyFilter)
 import Parallel (parMapM)
-import Process (quote, sh, sh_)
+import Process (proc, sh, sh_)
 import System.Directory (createDirectoryIfMissing, doesFileExist, getCurrentDirectory)
 import System.Exit (ExitCode (ExitFailure), exitWith)
 import System.FilePath (takeExtension, (</>))
@@ -39,9 +38,9 @@ listIssues filters paths = do
       -- contain the full issue title and description.  For a fast
       -- lookup it may already be enough to only store the issue's
       --
-      -- * filename
-      -- * start position
-      -- * end position
+      -- \* filename
+      -- \* start position
+      -- \* end position
       --
       -- With this information we can use git to quickly look up the
       -- complete issue text and parse it.
@@ -216,7 +215,7 @@ getIssuesCommitAll hash = do
   withSystemTempDirectory "history" $ \tmp -> do
     cwd <- do
       let cwd = tmp </> unpack hash
-      sh_ $ fromString $ printf "git worktree add --detach %s %s" (quote cwd) (quote $ unpack hash)
+      sh_ $ proc "git worktree add --detach % %" cwd (unpack hash)
       pure cwd
     files <- gitLsFilesAll cwd
     concat <$> catch (getIssuesPar cwd files) (dieOfInvalidTreeGrepperResult)
@@ -228,7 +227,7 @@ getIssuesAndFilesCommitChanged hash = do
   withSystemTempDirectory "history" $ \tmp -> do
     cwd <- do
       let cwd = tmp </> unpack hash
-      sh_ $ fromString $ printf "git worktree add --detach %s %s" (quote cwd) (quote $ unpack hash)
+      sh_ $ proc "git worktree add --detach % %" cwd (unpack hash)
       pure cwd
     files <- gitShowChanged cwd
     issues <- concat <$> catch (getIssuesPar cwd files) (dieOfInvalidTreeGrepperResult)
@@ -248,13 +247,7 @@ gitLsFilesModifiedIn :: FilePath -> [FilePath] -> IO [FilePath]
 gitLsFilesModifiedIn cwd paths =
   Prelude.lines . L8.unpack
     <$> sh
-      ( fromString
-          ( (printf "git ls-files --modified%s")
-              ( case paths of
-                  [] -> ""
-                  _ -> " -- " ++ intercalate " " (map quote paths)
-              )
-          )
+      ( proc "git ls-files --modified %" ("--" : paths)
           & setWorkingDir cwd
       )
 
@@ -317,13 +310,11 @@ getIssues cwd filename = do
       . map fixTreeGrepper
       . decode
       <$> sh
-        ( fromString
-            ( printf
-                "tree-grepper --query %s %s --format json %s"
-                (quote treeGrepperLanguage)
-                (quote treeGrepperQuery)
-                (quote filename)
-            )
+        ( proc
+            "tree-grepper --query % % --format json %"
+            (treeGrepperLanguage :: String)
+            (treeGrepperQuery :: String)
+            filename
             & setWorkingDir cwd
         )