Multithreading 有没有一种方法可以让管道从多个源获取数据而不阻塞其中任何一个？

我正在编写一个服务器，其中一个要求是它需要能够将数据推送到客户端，而不需要客户端直接请求数据。我正在使用导管，但感觉这超出了导管的能力。我遇到的问题是，似乎没有办法判断套接字是否有可用数据，而wait将阻止执行，直到有可用数据为止。假设我有以下功能

getPacket :: Conduit ByteString IO ClientPacket --take a bytestring and yield a ClientPacket i.e. the ByteString deserialized into a sensible form
processPacket :: Conduit ClientPacket IO ServerPacket --take a ClientPacket and yield a ServerPacket i.e. a response to the client's request
putPacket :: Conduit ServerPacket IO ByteString --serialize the ServerPacket

然后我将导管与导管网络库中的源和汇连接在一起

appSource appData $$ getPacket =$= processPacket =$= putPacket $= appSink appData

现在，我从管道外部引入一个数据源，我想将该数据合并到管道中。例如，如果这是一个聊天服务器，外部数据将是其他客户端发送的消息。问题是，无论我在哪里尝试引入这些外部数据，它都会被等待的呼叫阻塞。从本质上讲，我将以如下代码结束

yield processOutsideData --deal with the outside data
data <- await            --await data from upstream

yield processOutsideData——处理外部数据
数据michaelsnoyman's。telnet客户端示例运行一个线程发送输入，另一个线程显示接收到的内容。我已经调整它来发送和接收整条线路

{-# LANGUAGE OverloadedStrings #-}
import Conduit
import Control.Concurrent.Async (concurrently)
import Control.Monad            (liftM, void)
import Data.ByteString          (ByteString)
import Data.ByteString.Char8    (unpack)
import Data.Conduit.Network
import Data.String              (IsString, fromString)
import Network                  (withSocketsDo)

getLines :: (IsString a, MonadIO m) => Producer m a
getLines = repeatMC . liftM fromString $ liftIO getLine

putLines :: (MonadIO m) => Consumer ByteString m ()
putLines = mapM_C $ liftIO . putStrLn . unpack

main :: IO ()
main = withSocketsDo $
    runTCPClient (clientSettings 4000 "localhost") $ \server ->
        void $ concurrently
            (getLines $$ appSink server)
            (appSource server $$ putLines)

我们可以在服务器上做同样的事情。创建一个STM通道，将接收到的数据写入通道，并将数据从通道发送到客户端。这在STM通道周围使用包的简单包装，
sourceTBMChan
和
sinktmbmchan

{-# LANGUAGE OverloadedStrings #-}
import Conduit
import Control.Concurrent.Async       (concurrently)
import Control.Concurrent.STM.TBMChan (newTBMChan)
import Control.Monad                  (void)
import Control.Monad.STM              (atomically)
import Data.Conduit.Network
import Data.Conduit.TMChan            (sourceTBMChan, sinkTBMChan)
import Network                        (withSocketsDo)

main :: IO ()
main = withSocketsDo $ do
    channel <- atomically $ newTBMChan 10
    runTCPServer (serverSettings 4000 "*") $ \server ->
        void $ concurrently
            (appSource server $$ sinkTBMChan channel False)
            (sourceTBMChan channel $$ appSink server)

如果我们在连接了多个客户机的情况下运行服务器，则消息将分布在客户机之间，每个消息由一个客户机获取

----------             ----------
| 1      | (sent)      | 1      | (received)
| 2      | (sent)      | 3      | (received)
| 2      | (received)  |        |
| 3      | (sent)      |        |
|        |             |        |
|        |             |        |
----------             ----------

此示例不处理客户端关闭连接时要执行的操作。
请查看或查看管道。
----------             ----------
| 1      | (sent)      | 1      | (received)
| 2      | (sent)      | 3      | (received)
| 2      | (received)  |        |
| 3      | (sent)      |        |
|        |             |        |
|        |             |        |
----------             ----------