hsinstall-3.0: src/app/HSInstall/System/Process.hs

module HSInstall.System.Process
  ( CmdArgs
  , readProcessWithLogging
  )
  where

import Formatting ((%), (%+), formatToString, string)
import System.Exit (ExitCode (ExitFailure, ExitSuccess))
import System.Log.Logger
import System.Process (readProcessWithExitCode)

import HSInstall.Log (n)


type CmdArgs = (String, [String])


readProcessWithLogging :: String -> CmdArgs -> IO ()
readProcessWithLogging logMsg args = do
  noticeM n $ formatToString (string % ", command:" %+ string) logMsg (formatArgs args)
  (ec, out', err) <- uncurry readProcessWithExitCode args ""
  log' ec "stdout" out'
  log' ec "stderr" err
  where
    log' :: ExitCode -> String -> String -> IO ()
    log' _  _  ""     = pure ()
    log' ec handleName output = logM n (ecToPriority ec)
      $ formatToString (string % ", " % string % ":\n" % string) logMsg handleName output

    ecToPriority :: ExitCode -> Priority
    ecToPriority ExitSuccess = INFO
    ecToPriority (ExitFailure _) = ERROR


formatArgs :: (String, [String]) -> String
formatArgs (binary, args) = unwords $ binary : args