Question

在我使用stm，network-conduit和conduit的GHC Haskell应用程序中，每个套接字都有一个链，它使用runTCPServer自动分叉。 Strands可以通过使用广播TChan与其他线路进行通信。

这展示了我如何设置管道“链”：

enter image description here

所以，我们这里有两个源（每个都绑定到辅助管道），它们产生一个Packet对象encoder将接受并变成ByteString，然后发出插座。对于两个输入的有效（性能是一个问题），我遇到了很大的困难。

如果有人能指出我正确的方向，我将不胜感激。

由于我在没有尝试的情况下发布这个问题是不礼貌的，我会把我以前在这里试过的东西放在一边;

我已经编写/编写了一个函数（阻塞）从TMChan（可关闭的通道）生成一个源;

-- | Takes a generic type of STM chan and, given read and close functionality,
--   returns a conduit 'Source' which consumes the elements of the channel.
chanSource 
    :: (MonadIO m, MonadSTM m)
    => a                    -- ^ The channel
    -> (a -> STM (Maybe b)) -- ^ The read function
    -> (a -> STM ())        -- ^ The close/finalizer function
    -> Source m b
chanSource ch readCh closeCh = ConduitM pull
    where close     = liftSTM $ closeCh ch
          pull      = PipeM $ liftSTM $ readCh ch >>= translate
          translate = return . maybe (Done ()) (HaveOutput pull close)

同样，将Chan转换为接收器的功能;

-- | Takes a stream and, given write and close functionality, returns a sink
--   which wil consume elements and broadcast them into the channel 
chanSink
    :: (MonadIO m, MonadSTM m)
    => a                 -- ^ The channel
    -> (a -> b -> STM()) -- ^ The write function
    -> (a -> STM())      -- ^ The close/finalizer function
    -> Sink b m ()
chanSink ch writeCh closeCh = ConduitM sink
    where close  = const . liftSTM $ closeCh ch
          sink   = NeedInput push close
          write  = liftSTM . writeCh ch
          push x = PipeM $ write x >> return sink

然后mergeSources很简单; fork 2个线程（我真的不想这么做，但是到底是什么）可以将他们的新项目放入一个列表中，然后我生成一个源代码;

-- | Merges a list of 'Source' objects, sinking them into a 'TMChan' and returns
--   a source which consumes the elements of the channel.
mergeSources
    :: (MonadIO m, MonadBaseControl IO m, MonadSTM m)
    => [Source (ResourceT m) a]             -- ^ The list of sources
    -> ResourceT m (Source (ResourceT m) a)
mergeSources sx = liftSTM newTMChan >>= liftA2 (>>) (fsrc sx) retn
    where push c s = s $$ chanSink c writeTMChan closeTMChan
          fsrc x c = mapM_ (\s -> resourceForkIO $ push c s) x
          retn c   = return $ chanSource c readTMChan closeTMChan

虽然我成功地使用了这些函数来进行类型检查，但是我没有成功地将这些函数用于类型检查;

-- | Helper which represents a conduit chain for each client connection
serverApp :: Application SessionIO
serverApp appdata = do
    use ssBroadcast >>= liftIO . atomically . dupTMChan >>= assign ssBroadcast
    -- appSource appdata $$ decoder $= protocol =$= encoder =$ appSink appdata
    mergsrc $$ protocol $= encoder =$ appSink appdata
    where chansrc = chanSource (use ssBroadcast) readTMChan closeTMChan
          mergsrc = mergeSources [appSource appdata $= decoder, chansrc]

-- | Structure which holds mutable information for clients
data SessionState = SessionState
    { _ssBroadcast     :: TMChan Packet -- ^ Outbound packet broadcast channel
    }

makeLenses ''SessionState

-- | A transformer encompassing both SessionReader and SessionState
type Session m = ReaderT SessionReader (StateT SessionState m)

-- | Macro providing Session applied to an IO monad
type SessionIO = Session IO

我认为这种方法无论如何都有缺陷 - 有许多中间列表和转换。这对性能不利。寻求指导。

PS。据我所知，这不是重复的; Fusing conduits with multiple inputs，因为在我的情况下，两个源都生成相同的类型，我不关心Packet对象的生成源，只要我不等待一个，而另一个已经准备好对象被消费。

PPS。我为示例代码中Lens的用法（以及知识要求）道歉。

Answer 1

我不知道这是否有任何帮助，但我试图实施Iain的建议并制作了mergeSources'的变体，只要其中任何一个频道停止，就会停止：

mergeSources' :: (MonadIO m, MonadBaseControl IO m)
              => [Source (ResourceT m) a] -- ^ The sources to merge.
              -> Int -- ^ The bound of the intermediate channel.
              -> ResourceT m (Source (ResourceT m) a)
mergeSources' sx bound = do
    c <- liftSTM $ newTBMChan bound
    mapM_ (\s -> resourceForkIO $
                    s $$ chanSink c writeTBMChan closeTBMChan) sx
    return $ sourceTBMChan c

（这个简单的添加可用here）。

对你的mergeSources版本发表了一些评论（带上一些盐，可能是我对此并不了解）：

使用...TMChan代替...TBMChan似乎很危险。如果编写者比读者快，那么你的堆就会崩溃。如果你的TCP对等体没有足够快地读取数据，那么看看你的图表似乎很容易发生这种情况。所以我肯定会使用...TBMChan可能很大但有限的界限。
您不需要MonadSTM m约束。所有STM内容都包含在IO中
```
liftSTM = liftIO . atomically
```
在mergeSources'中使用serverApp时，这可能会对您有所帮助。
只是化妆品问题，我找到了
```
liftSTM newTMChan >>= liftA2 (>>) (fsrc sx) retn
```
由于在liftA2 monad上使用了(->) r，因此很难阅读。我会说
```
do
    c <- liftSTM newTMChan
    fsrc sx c
    retn c
```
会更长，但更容易阅读。

您是否可以创建一个可以与serverApp一起玩的自包含项目？

一个处理管道，2个相同类型的IO源

1 个答案: