Haskell中带副作用的动作序列处理惯用方法及故障处理问询

我之前刚好做过类似的需求，要实现这种分阶段执行Shell命令、失败即终止且触发对应补救操作的逻辑，用Haskell的process库配合基本的Monad错误处理就能搞定。下面是我整理的完整方案：

核心思路 #

1. 用System.Process库执行Shell命令，捕获每个命令的退出状态
2. 将三个阶段（预操作组、单个主命令、后操作组）分别封装为可中断的执行单元
3. 为每个阶段定义专属的故障补救逻辑（比如预操作失败时推送日志）
4. 用Either类型传递错误信息，结合foldM实现命令组的依次执行（失败即停）

完整代码实现 #

首先需要导入必要的依赖库（确保你的项目已添加process和base包）：

import System.Process (readCreateProcess, shell, proc, waitForProcess, CreateProcess(..))
import System.Exit (ExitCode(..))
import Control.Monad (foldM)
import Control.Exception (catch, IOException)
import System.IO (hFlush, stdout)

1. 基础命令执行函数 #

先实现一个通用的单命令执行函数，捕获退出码和IO异常（比如命令不存在）：

-- 执行单个Shell命令，返回Either类型：成功返回Right ()，失败返回Left 错误信息
runSingleCommand :: String -> IO (Either String ())
runSingleCommand cmd = do
  putStrLn $ "正在执行命令: " ++ cmd
  hFlush stdout  -- 确保日志实时输出
  let process = shell cmd
  handle <- catch (createProcess process >>= \(_, _, _, h) -> return h)
                  (\e -> return $ Left $ "命令执行异常: " ++ show (e :: IOException))
  case handle of
    Left err -> return $ Left err
    Right h -> do
      exitCode <- waitForProcess h
      case exitCode of
        ExitSuccess -> return $ Right ()
        ExitFailure code -> return $ Left $ "命令执行失败，退出码: " ++ show code

2. 命令组执行函数 #

用foldM实现命令组的依次执行，只要有一个命令失败就终止整个组：

-- 执行一组Shell命令，依次执行，失败即停
runCommandGroup :: [String] -> IO (Either String ())
runCommandGroup cmds = foldM (\acc cmd -> case acc of
                                           Right () -> runSingleCommand cmd
                                           Left err -> return $ Left err)
                             (Right ())
                             cmds

3. 补救操作函数 #

定义各个阶段失败时的补救逻辑，比如预操作失败时推送日志：

-- 预操作失败时的补救：推送日志到指定位置
handlePreOpsFailure :: FilePath -> IO ()
handlePreOpsFailure logPath = do
  putStrLn "预操作执行失败，开始推送日志文件..."
  let pushCmd = "scp " ++ logPath ++ " user@remote-server:/path/to/logs/"
  -- 这里可以忽略推送命令的失败，或者根据需求添加处理
  _ <- runSingleCommand pushCmd
  putStrLn "日志推送完成"

-- 主命令失败时的补救逻辑（示例：记录错误日志）
handleMainCmdFailure :: IO ()
handleMainCmdFailure = do
  putStrLn "主命令执行失败，记录错误日志到本地..."
  _ <- runSingleCommand "echo '主命令执行失败' >> /var/workflow/error.log"
  return ()

-- 后操作失败时的补救逻辑（示例：发送告警邮件）
handlePostOpsFailure :: IO ()
handlePostOpsFailure = do
  putStrLn "后操作执行失败，发送告警邮件..."
  _ <- runSingleCommand "echo '后操作失败' | mail -s 'Workflow告警' admin@example.com"
  return ()

4. 主工作流函数 #

把所有阶段串起来，实现完整的逻辑：

-- 完整工作流：预操作组 -> 主命令 -> 后操作组
runWorkflow :: [String]       -- 预操作命令组
            -> String         -- 主命令
            -> [String]       -- 后操作命令组
            -> FilePath       -- 日志文件路径（用于预操作失败时推送）
            -> IO ()
runWorkflow preOps mainCmd postOps logPath = do
  -- 执行预操作组
  preResult <- runCommandGroup preOps
  case preResult of
    Left err -> do
      putStrLn $ "预操作失败: " ++ err
      handlePreOpsFailure logPath
    Right () -> do
      -- 预操作成功，执行主命令
      mainResult <- runSingleCommand mainCmd
      case mainResult of
        Left err -> do
          putStrLn $ "主命令失败: " ++ err
          handleMainCmdFailure
        Right () -> do
          -- 主命令成功，执行后操作组
          postResult <- runCommandGroup postOps
          case postResult of
            Left err -> do
              putStrLn $ "后操作失败: " ++ err
              handlePostOpsFailure
            Right () -> putStrLn "所有阶段执行成功！"

关键细节说明 #

• 实时日志输出：用hFlush stdout确保命令执行日志能实时打印，避免因为缓冲区导致日志延迟
• 异常捕获：不仅捕获命令的退出码，还捕获IO异常（比如命令不存在、权限不足），让错误处理更全面
• 灵活扩展：每个阶段的补救逻辑都可以单独修改，比如你可以把推送日志的命令换成rsync或者其他工具，只要修改handlePreOpsFailure即可
• 终止逻辑：每个阶段失败后都会直接跳转到对应的补救操作，不会执行后续阶段，符合需求中的“任意命令失败则终止后续执行”

使用示例 #

比如你要执行的预操作是创建临时目录、拉取配置，主命令是编译代码，后操作是清理临时文件，日志路径是/var/workflow/run.log，可以这样调用：

main :: IO ()
main = runWorkflow
         ["mkdir -p /tmp/workflow", "wget https://example.com/config.ini -O /tmp/workflow/config.ini"]
         "cd /tmp/workflow && make build"
         ["rm -rf /tmp/workflow"]
         "/var/workflow/run.log"

内容的提问来源于stack exchange，提问作者user4601931