packages feed

synapse-cc-0.2.0: src/SynapseCC/Process.hs

-- | Subprocess execution helpers
module SynapseCC.Process
  ( runProcess
  , runProcessWithInput
  , ProcessResult(..)
  ) where

import Control.Monad (unless, when)
import qualified Data.ByteString as BS
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Encoding.Error as TE
import System.Exit (ExitCode(..))
import System.IO (Handle, hClose, hGetContents, hPutStr)
import System.Process hiding (runProcess)

import SynapseCC.Logging (logDebug)

-- ============================================================================
-- Process Execution
-- ============================================================================

-- | Result of running a process
data ProcessResult = ProcessResult
  { prExitCode :: !ExitCode
  , prStdout   :: !Text
  , prStderr   :: !Text
  } deriving (Show, Eq)

-- | Run a process and capture output
runProcess
  :: FilePath      -- ^ Executable path
  -> [String]      -- ^ Arguments
  -> Maybe FilePath -- ^ Working directory (Nothing = current)
  -> Bool          -- ^ Debug mode
  -> IO ProcessResult
runProcess exe args mbCwd debug = do
  logDebug debug $ "Running: " <> T.pack exe <> " " <> T.pack (unwords args)
  case mbCwd of
    Just cwd -> logDebug debug $ "  Working directory: " <> T.pack cwd
    Nothing  -> pure ()

  (exitCode, stdout, stderr) <- readProcessWithExitCode' exe args mbCwd ""

  logProcessOutput debug stdout stderr
  pure $ ProcessResult exitCode stdout stderr

-- | Run a process with stdin input
runProcessWithInput
  :: FilePath      -- ^ Executable path
  -> [String]      -- ^ Arguments
  -> Maybe FilePath -- ^ Working directory (Nothing = current)
  -> Text          -- ^ Stdin input
  -> Bool          -- ^ Debug mode
  -> IO ProcessResult
runProcessWithInput exe args mbCwd input debug = do
  logDebug debug $ "Running: " <> T.pack exe <> " " <> T.pack (unwords args)
  case mbCwd of
    Just cwd -> logDebug debug $ "  Working directory: " <> T.pack cwd
    Nothing  -> pure ()
  logDebug debug $ "  With input: " <> T.take 100 input <> "..."

  (exitCode, stdout, stderr) <- readProcessWithExitCode' exe args mbCwd (T.unpack input)

  logProcessOutput debug stdout stderr
  pure $ ProcessResult exitCode stdout stderr

-- ============================================================================
-- Helpers
-- ============================================================================

-- | Log process stdout/stderr when in debug mode.
logProcessOutput :: Bool -> Text -> Text -> IO ()
logProcessOutput debug stdout stderr = when debug $ do
  unless (T.null stdout) $ do
    let len = T.length stdout
    if len > 5000
      then logDebug debug $ "  Stdout: <large output, " <> T.pack (show len) <> " chars, truncated>"
      else do
        logDebug debug "  Stdout:"
        logDebug debug $ "    " <> stdout
  unless (T.null stderr) $ do
    logDebug debug "  Stderr:"
    logDebug debug $ "    " <> stderr

-- | Like readProcessWithExitCode but with working directory support
readProcessWithExitCode'
  :: FilePath
  -> [String]
  -> Maybe FilePath
  -> String
  -> IO (ExitCode, Text, Text)
readProcessWithExitCode' exe args mbCwd input = do
  let process = (proc exe args)
        { cwd = mbCwd
        , std_in = CreatePipe
        , std_out = CreatePipe
        , std_err = CreatePipe
        }

  (Just stdin, Just stdout, Just stderr, ph) <- createProcess process

  -- Write input and close stdin
  hPutStr stdin input
  hClose stdin

  -- Read output strictly as ByteString first, then decode with lenient error handling
  stdoutBytes <- BS.hGetContents stdout
  stderrBytes <- BS.hGetContents stderr

  let stdoutText = TE.decodeUtf8With TE.lenientDecode stdoutBytes
      stderrText = TE.decodeUtf8With TE.lenientDecode stderrBytes

  -- Wait for process to complete
  exitCode <- waitForProcess ph

  pure (exitCode, stdoutText, stderrText)