Improve command rendering

Values to `git config` should be quoted to work properly, otherwise they
(specifically aliases) would be set as multi-value configs.

However, if we just blindly change this to be quoted values, we would
split them into separate arguments for a proc, which would lead to the
same issue.
To improve this, we just need to use `[]` instead of `Text` for command
args.

Note: I've switched to "raw strings" (`[s|raw string|]`) in
`AcquireRepositorySpec.hs` to remove escaping of double quotes.

#299

Author: teggotic

src/Elegit/Git/Action.hs

@@ -38,19 +38,27 @@ import           Universum                 hiding (print)
 
 -- TODO: maybe, cover with tests
 class RenderGitCommand c where
-  renderGC :: c -> Text
+  commandArgs :: c -> [Text]
+  toolName :: c -> Text
+  toolName _ = "git"
+
+renderGC :: RenderGitCommand c => c -> Text
+renderGC c = toolName c|+" "+|renderedArgs|+""
+  where
+    renderedArgs = T.intercalate " " (commandArgs c)
 
 data GCurrentBranchData
   = GCurrentBranchData
 
 instance RenderGitCommand GCurrentBranchData where
-  renderGC _ = "rev-parse --abbrev-ref @"
+  commandArgs _ = ["rev-parse", "--abbrev-ref", "@"]
 
 newtype GBranchUpstreamData
   = GBranchUpstreamData { branch :: Text }
 
 instance RenderGitCommand GBranchUpstreamData where
-  renderGC (GBranchUpstreamData branchName) = "rev-parse --abbrev-ref "+|branchName|+"@{upstream}"
+  commandArgs (GBranchUpstreamData branchName) =
+    ["rev-parse", "--abbrev-ref", branchName, "@{upstream}"]
 
 data GLogData
   = GLogData
@@ -59,7 +67,8 @@ data GLogData
       , target  :: Text
       }
 instance RenderGitCommand GLogData where
-  renderGC (GLogData lType baseName targetName) = "log "+|logArg|+" "+|baseName|+".."+|targetName|+""
+  commandArgs (GLogData lType baseName targetName) =
+    ["log ", logArg, ""+|baseName|+".."+|targetName|+""]
     where
       logArg :: Text
       logArg = case lType of
@@ -69,7 +78,7 @@ newtype GStatusData
   = GStatusData { statusType :: StatusType }
 
 instance RenderGitCommand GStatusData where
-  renderGC (GStatusData sType) = "status "+|statusFormat|+""
+  commandArgs (GStatusData sType) = ["status", statusFormat]
     where
       statusFormat :: Text
       statusFormat = case sType of
@@ -78,7 +87,7 @@ instance RenderGitCommand GStatusData where
 data GStashListData
   = GStashListData
 instance RenderGitCommand GStashListData where
-  renderGC _ = "stash list"
+  commandArgs _ = ["stash", "list"]
 
 data GReadConfigData
   = GReadConfigData
@@ -87,7 +96,7 @@ data GReadConfigData
       }
 
 instance RenderGitCommand GReadConfigData where
-  renderGC (GReadConfigData cScope cName) = "config "+|scopeText|+" --get "+|cName|+""
+  commandArgs (GReadConfigData cScope cName) = ["config", scopeText, "--get", cName]
     where
       scopeText :: Text
       scopeText = case cScope of
@@ -103,7 +112,7 @@ data GSetConfigData
       }
 
 instance RenderGitCommand GSetConfigData where
-  renderGC (GSetConfigData cScope cName cValue) = "config "+|scopeText|+" "+|cName|+" "+|cValue|+""
+  commandArgs (GSetConfigData cScope cName cValue) = ["config", scopeText, cName, "\""+|cValue|+"\""]
     where
       scopeText :: Text
       scopeText = case cScope of
@@ -118,7 +127,7 @@ data GUnsetConfigData
       }
 
 instance RenderGitCommand GUnsetConfigData where
-  renderGC (GUnsetConfigData cScope cName) = "config "+|scopeText|+" --unset "+|cName|+""
+  commandArgs (GUnsetConfigData cScope cName) = ["config", scopeText, "--unset", cName]
     where
       scopeText :: Text
       scopeText = case cScope of
@@ -130,7 +139,8 @@ newtype GAliasesToRemoveData
   = GAliasesToRemoveData { scope :: ConfigScope }
 
 instance RenderGitCommand GAliasesToRemoveData where
-  renderGC (GAliasesToRemoveData cScope) = "config "+|scopeText|+" --name-only --get-regexp \"^alias.\" \"^elegant ([-a-z]+)$\""
+  commandArgs (GAliasesToRemoveData cScope) =
+    ["config", scopeText, "--name-only", "--get-regexp", "\"^alias.\"", "\"^elegant ([-a-z]+)$\""]
     where
       scopeText :: Text
       scopeText = case cScope of
@@ -246,7 +256,7 @@ print content = liftF $ PrintText content ()
 -- Derived actions
 
 formatGitCommand :: (RenderGitCommand gc, MonadFree GitF m) => gc -> m Text
-formatGitCommand gc = formatCommand ("git "+|renderGC gc|+"")
+formatGitCommand gc = formatCommand (renderGC gc)
 
 setConfigVerbose :: MonadFree GitF m => ConfigScope -> Text -> Text -> m ()
 setConfigVerbose cScope cName cValue = do

src/Elegit/Git/Exec.hs

@@ -27,16 +27,16 @@ data GitCommand
 
 
 -- TODO: cover with tests
-renderGitCommand :: GitCommand -> Text
-renderGitCommand (GCCB gc)  = renderGC gc
-renderGitCommand (GCBU gc)  = renderGC gc
-renderGitCommand (GCL gc)   = "-c color.ui=always "+|renderGC gc|+""
-renderGitCommand (GCS gc)   = "-c color.status=always "+|renderGC gc|+""
-renderGitCommand (GCSL gc)  = renderGC gc
-renderGitCommand (GCRC gc)  = renderGC gc
-renderGitCommand (GCSC gc)  = renderGC gc
-renderGitCommand (GCUC gc)  = renderGC gc
-renderGitCommand (GCATR gc) = renderGC gc
+gitCommandArgs :: GitCommand -> [Text]
+gitCommandArgs (GCCB gc)  = commandArgs gc
+gitCommandArgs (GCBU gc)  = commandArgs gc
+gitCommandArgs (GCL gc)   = "-c":"color.ui=always":commandArgs gc
+gitCommandArgs (GCS gc)   = "-c":"color.status=always":commandArgs gc
+gitCommandArgs (GCSL gc)  = commandArgs gc
+gitCommandArgs (GCRC gc)  = commandArgs gc
+gitCommandArgs (GCSC gc)  = commandArgs gc
+gitCommandArgs (GCUC gc)  = commandArgs gc
+gitCommandArgs (GCATR gc) = commandArgs gc
 
 
 class Monad m => MonadGitExec m where
@@ -47,7 +47,7 @@ class Monad m => MonadGitExec m where
 
 instance MonadIO m => MonadGitExec (GitExecT m) where
   execGit gc = do
-    (eCode, outputBS, _errBS) <- readProcess $ proc "git" (toString <$> words (renderGitCommand gc))
+    (eCode, outputBS, _errBS) <- readProcess $ proc "git" (toString <$> gitCommandArgs gc)
     case eCode of
       -- TODO: Handle error codes per `gc`
       ExitFailure _ -> do