@@ -20,7 +20,7 @@ module Obelisk.CliApp.Process
2020
2121import Control.Applicative (liftA2)
2222import Control.Monad (void, (<=<))
23−import Control.Monad.Catch (Exception, MonadMask, throwM)
23+import Control.Monad.Catch (Exception(..), MonadMask, throwM)
2424import Control.Monad.IO.Class (MonadIO, liftIO)
2525import qualified Data.ByteString.Char8 as BSC
2626import Data.Function (fix)
@@ -44,7 +44,9 @@ import Obelisk.CliApp.Types (Cli)
4444data ProcessFailed = ProcessFailed Process.CmdSpec Int -- exit code
4545 deriving Show
4646
47−instance Exception ProcessFailed
47+instance Exception ProcessFailed where
48+ displayException (ProcessFailed spec exitCode) =
49+ unwords ["ProcessFailed", reconstructCommand spec, show exitCode]
4850
4951readProcessAndLogStderr
5052 :: (MonadIO m, MonadMask m, Cli m)
@@ -77,7 +79,7 @@ createProcess
7779 :: (MonadIO m, Cli m)
7880 => CreateProcess -> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
7981createProcess p = do
80− putLog Debug $ "Creating process: " <> T.pack (show $ cmdspec p)
82+ putLog Debug $ "Creating process: " <> T.pack (reconstructCommand (cmdspec p))
8183 liftIO $ Process.createProcess p
8284
8385-- | Like `System.Process.createProcess_` but also logs (debug) the process being run
@@ -85,7 +87,7 @@ createProcess_
8587 :: (MonadIO m, Cli m)
8688 => String -> CreateProcess -> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
8789createProcess_ name p = do
88− putLog Debug $ "Creating process " <> T.pack name <> ": " <> T.pack (show $ cmdspec p)
90+ putLog Debug $ "Creating process " <> T.pack name <> ": " <> T.pack (reconstructCommand (cmdspec p))
8991 liftIO $ Process.createProcess p
9092
9193-- | Like `System.Process.callProcess` but also logs (debug) the process being run
@@ -130,3 +132,10 @@ streamToLog stream = fix $ \loop -> do
130132 liftIO (Streams.read stream) >>= \case
131133 Nothing -> return ()
132134 Just (sev, line) -> putLogRaw sev (decodeUtf8 line) >> loop
135+
136+reconstructCommand :: Process.CmdSpec -> String
137+reconstructCommand (Process.ShellCommand str) = str
138+reconstructCommand (Process.RawCommand c as) = processToShellString c as
139+ where
140+ processToShellString cmd args = unwords $ map quoteAndEscape (cmd : args)
141+ quoteAndEscape x = T.unpack $ "'" <> T.replace "'" "'\''" (T.pack x) <> "'"