Haskell实现异常终止后自动重启的定时配置更新线程

你的代码无法捕获子线程异常的核心原因是：forkIO本身几乎不会抛出异常，它只会返回线程ID，外层的try只能捕获forkIO调用时的异常，完全无法感知子线程运行过程中抛出的异常——子线程崩溃时只会自行终止，父线程不会收到任何通知。

下面给出几种可行的实现方案，以及针对配置更新需求的额外优化建议：

方案一：让任务自身具备异常重启能力 #

把任务逻辑放在带异常捕获的循环中，子线程内部处理崩溃后的重启逻辑：

import Control.Exception (SomeException, try)
import Control.Concurrent (threadDelay, forkIO)

-- 封装带自动重启的任务逻辑
runWithAutoRestart :: IO () -> IO ()
runWithAutoRestart action = loop
  where
    loop = do
      result <- try action
      case result of
        Left e -> do
          putStrLn $ "任务异常终止: " ++ show (e :: SomeException)
          threadDelay 1000000  -- 延迟1秒避免频繁重启
          loop
        Right () -> do
          putStrLn "任务正常结束，将自动重启"
          threadDelay 1000000
          loop

-- 启动可重启线程
startRestartableThread :: IO () -> IO ()
startRestartableThread action = do
  _ <- forkIO (runWithAutoRestart action)
  return ()

方案二：用forkFinally监控线程终止 #

利用forkFinally监听子线程的终止事件（无论正常结束还是异常崩溃），在回调中触发重启：

import Control.Exception (finally)
import Control.Concurrent (threadDelay, forkIO, ThreadId)

startRestartableThread :: IO () -> IO ThreadId
startRestartableThread action = forkIO $ do
  let restart = do
        threadDelay 1000000
        startRestartableThread action
        return ()
  -- 无论任务正常结束还是异常崩溃，都会执行restart逻辑
  action `finally` restart

方案三：使用async库简化异步任务管理 #

async库提供了更强大的异步任务监控能力，适合复杂场景：

import Control.Concurrent.Async (async, waitCatch)
import Control.Exception (SomeException)
import Control.Concurrent (threadDelay)

startRestartableAsync :: IO () -> IO ()
startRestartableAsync action = loop
  where
    loop = do
      asyncTask <- async action
      result <- waitCatch asyncTask
      case result of
        Left e -> do
          putStrLn $ "异步任务异常: " ++ show (e :: SomeException)
          threadDelay 1000000
          loop
        Right () -> do
          putStrLn "异步任务正常结束，重启中"
          threadDelay 1000000
          loop

针对配置更新需求的额外优化 #

1. 线程安全的配置存储：用MVar或IORef存储配置，避免Web服务器读取时出现数据竞争：

import Control.Concurrent.MVar (MVar, newMVar, readMVar, swapMVar)

-- 假设你的配置结构
data Config = Config { sessionToken :: String } deriving (Show)

-- 初始化配置（先获取一次初始值）
initConfigStore :: IO (MVar Config)
initConfigStore = do
  initialCfg <- fetchConfigFromAPI
  newMVar initialCfg

-- 从API/DB获取配置的逻辑
fetchConfigFromAPI :: IO Config
fetchConfigFromAPI = do
  -- 替换为实际的API调用/数据库查询
  putStrLn "正在获取最新配置..."
  return $ Config "fresh-token-456"

-- 带定时刷新的配置任务
refreshConfigTask :: MVar Config -> IO ()
refreshConfigTask cfgVar = do
  threadDelay (10 * 60 * 1000000)  -- 10分钟间隔
  newCfg <- fetchConfigFromAPI
  _ <- swapMVar cfgVar newCfg
  refreshConfigTask cfgVar  -- 循环执行

Web服务器只需通过readMVar cfgVar即可安全读取最新配置。

2. 优雅关闭：如果需要在应用 shutdown 时终止刷新线程，可以用Async的cancel方法实现优雅停止。

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