В моем приложении GHC Haskell
, использующем stm, network-conduit и conduit, у меня есть прядь для каждого сокета, который автоматически разветвляется с помощью runTCPServer
. Стренды могут обмениваться информацией с другими каналами с помощью трансляционного TChan.
Это демонстрирует, как я хотел бы настроить цепочку каналов:
Итак, у нас есть два источника (каждая связана с вспомогательными каналами, которые), которые создают объект 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)
Аналогично, функция преобразования Чан в раковину;
-- | 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 threads (которые я действительно не хочу делать, но что это за черт), которые могут помещать свои новые предметы в один список, который я затем создаю источником;
-- | 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
В то время как я был успешным в выполнении этих функций typecheck, мне не удалось получить какое-либо использование этих функций для typecheck;
-- | 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. Из того, что я могу понять, это не дубликат; Соединительные кабели с несколькими входами, так как в моей ситуации оба источника генерируют один и тот же тип, и мне не важно, из какого источника создается объект Packet
, пока Я не жду на одном, а у другого есть объекты, готовые к употреблению.
ПФС. Я прошу прощения за использование (и, следовательно, требование знания) объектива в примере кода.