Haskell程序终止问题：异步读取stdin后无法正常结束

我想实现对stdin的几秒异步流式读取，当前做法是用forkIO启动线程执行getContents并写入Chan，5秒后杀死线程并读取Chan内容。但程序没有按预期打印内容后终止，而是一直等待输入，必须按^C才能结束。

当前代码如下：

-- OS: Ubuntu 22.04.1 LTS
-- Gnome Terminal
-- ghc 9.2.5

import Control.Concurrent.Chan ( newChan, readChan, writeChan, Chan )
import Control.Concurrent (threadDelay, forkIO, killThread)
import System.IO (getContents, BufferMode (..), stdin, hSetBuffering)

main :: IO ()
main = do
  hSetBuffering stdin NoBuffering
  chan <- newChan

  putStrLn "start"
  threadId <- forkIO $ getContents >>= writeChan chan
  threadDelay 5000000
  putStrLn "\nend"

  killThread threadId
  a <- readChan chan
  print a

相关现象与疑问 #

• 使用getLine仅在按下Enter时生效，但我需要流式读取stdin到Chan；
• hSetBuffering stdin NoBuffering是必要的，否则程序会挂起；
• 使用getContents'会触发‘thread blocked indefinitely in an MVar operation’错误，推测getContents'从未终止；
• 不同编译参数下表现不同：
  • 用ghc -threaded main.hs && ./main +RTS -N2编译运行时，无输出且挂起；
  • 用runghc main.hs运行时，会打印5秒内输入的内容但仍挂起。

问题根源 #

1. getContents的惰性特性：getContents是惰性读取，只有当输入到达EOF时才会把所有内容传递给writeChan，超时杀死线程时，之前输入的内容可能还未被写入Chan；
2. 线程无法被强制中断：killThread无法中断阻塞在系统调用（如读取stdin）的线程，GHC的线程终止机制仅对运行在Haskell代码中的线程有效，阻塞在OS层面的调用不会立即响应；
3. 资源未正确释放：未主动关闭stdin，导致读取线程一直阻塞在输入等待状态。

解决方案 #

通过主动关闭stdin中断读取线程，结合逐字符实时写入Chan的方式，确保程序能正常终止并获取输入内容：

-- OS: Ubuntu 22.04.1 LTS
-- Gnome Terminal
-- ghc 9.2.5

import Control.Concurrent.Chan (newChan, readChan, writeChan, Chan, isEmptyChan)
import Control.Concurrent (threadDelay, forkIO)
import System.IO (stdin, hSetBuffering, BufferMode(NoBuffering), hClose, hGetChar)
import Control.Monad (forever)
import Control.Exception (catch, IOException)

main :: IO ()
main = do
  hSetBuffering stdin NoBuffering
  chan <- newChan

  putStrLn "start"
  -- 启动逐字符读取线程，捕获stdin关闭异常
  _ <- forkIO $ forever $ do
    hGetChar stdin >>= writeChan chan
    `catch` (\(_::IOException) -> return ())
  -- 等待5秒
  threadDelay 5000000
  putStrLn "\nend"

  -- 关闭stdin，中断读取线程的阻塞状态
  hClose stdin
  -- 读取Chan中所有已写入的内容
  result <- readAllChan chan
  print result

-- 遍历读取Chan中所有剩余内容
readAllChan :: Chan Char -> IO String
readAllChan chan = go []
  where
    go acc = do
      empty <- isEmptyChan chan
      if empty
        then return (reverse acc)
        else do
          c <- readChan chan
          go (c : acc)

关键改进点 #

• 用hGetChar逐字符读取并实时写入Chan，避免getContents的惰性导致内容延迟写入；
• 超时后主动关闭stdin，触发读取线程的IOException，捕获异常让线程正常退出，无需强制杀死线程；
• 通过isEmptyChan遍历读取Chan中所有已写入的内容，确保获取到5秒内输入的全部字符；
• 避免了强制杀死线程带来的资源泄漏问题。

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