Haskell STM实现Telnet控制台无预期输出问题求助

核心问题1：状态未被正确共享，查询始终读取初始值 #

你在someFunc中传递给talk的是newTVar Aus——这是一个STM动作，而非实际的TVar实例。这意味着每次在STM上下文里执行state'（比如state' >>= readTVar）时，都会创建一个全新的TVar，初始值固定为Aus。因此：

• 执行an/aus时修改的是临时创建的TVar，下次查询会读取新的初始值
• 不同客户端的状态完全独立，没有实现共享状态的预期

核心问题2：sendAll动作未被实际执行 #

在anzeigen分支中，你错误地使用<$>（fmap）组合sendAll s和atomically的结果：

sendAll s <$> (atomically $ C.pack <$> show <$> (state' >>= readTVar))

sendAll s是ByteString -> IO ()类型，atomically ...返回IO ByteString，用<$>组合后得到IO (IO ())——这是一个返回IO动作的操作，但内层的sendAll并没有被执行，只是被包裹起来，导致客户端收不到任何有效数据。

修复方案 #

步骤1：正确创建并共享TVar #

在IO上下文里创建TVar，将实际的TVar实例传递给talk，确保所有客户端共享同一个状态：

someFunc :: IO ()
someFunc = do
  state <- atomically $ newTVar Aus  -- 在IO中创建全局共享的TVar
  runTCPServer Nothing "3000" (talk state)

步骤2：修复talk和write的逻辑 #

修改函数类型，直接接收TVar，并修复sendAll的执行方式：

talk :: TVar Störm -> Socket -> IO ()
talk state s = recv s 1024 >>= \msg -> unless (S.null msg) $
  case C.unpack msg of
    "exit\r\n" -> sendAll s (C.pack "Auf Widerhoren")
    "an\r\n" -> sendAll s (C.pack "Am An\n") >> putStrLn "Am An" >> write state An >> talk state s
    "aus\r\n" -> sendAll s (C.pack "Am Aus\n") >> putStrLn "Am Aus" >> write state Aus >> talk state s
    "anzeigen\r\n" -> do
      currentState <- atomically $ readTVar state
      sendAll s $ C.pack $ show currentState
      putStrLn "Am Anzeigen State"
      talk state s
    otherwise -> sendAll s (C.pack "Unbekannte Befehl\n") >> putStrLn (show msg) >> talk state s

write :: TVar Störm -> Störm -> IO ()
write state new = atomically $ writeTVar state new

额外优化建议 #

1. 自定义Störm的Show实例，让返回更简洁友好：

data Störm = An | Aus deriving (Eq)
instance Show Störm where
  show An = "An"
  show Aus = "Aus"

2. 兼容不同客户端的换行符格式，用C.strip处理输入：

case C.unpack $ C.strip msg of
  "exit" -> sendAll s (C.pack "Auf Widerhoren")
  "an" -> sendAll s (C.pack "Am An\n") >> putStrLn "Am An" >> write state An >> talk state s
  -- 其他分支同理

内容的提问来源于stack exchange，提问作者Erdel von Mises