Haskell 将管道与返回不同值的使用者和生产者连接

我正在使用pipes生态系统编写一个流函数，特别是pipes并发性，它基于操作库，允许我快速制作小程序片段，通过网络或shell命令向服务器或stdin/out生成命令，然后读回响应。在这种情况下，它是星号，但可以概括为任何类似的东西

我最初写这篇文章时考虑到了管道，但它不起作用。以下代码不起作用的原因是astPipe返回一个

管道IO a

，而来自管道并发的i和o都返回

消费者/生产者IO（）

。我曾考虑过让

astPipe

产生

可能是通过testring

，然后让输出

消费者
消费
可能是通过testring
，但这仍然不能解决
制作人
返回
（）
的问题

我觉得我真的很接近一个解决方案，但我不能完全找到它。您应该能够在这个文件上运行stack进行复制

#!/usr/bin/env stack
-- stack --resolver lts-6.20 runghc --package pipes  --package pipes-concurrency  --package operational --package process-streaming

{-# LANGUAGE OverloadedStrings, LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE GADTs #-}
module West.Asterisk where

import System.Process.Streaming as PS
import Control.Monad.Operational as Op

import Pipes as P
import Pipes.Concurrent as PC;

import qualified Data.ByteString.Char8 as B

import Control.Concurrent.Async

import GHC.IO.Exception (ExitCode)

data Version = Version String
data Channels = Channels

data AsteriskInstruction a where
    Login :: AsteriskInstruction (Maybe Version)
    CoreShowChannels :: AsteriskInstruction (Maybe Channels)

type Asterisk a = Program AsteriskInstruction a

runAsterisk :: forall a. Asterisk a -> IO a
runAsterisk m = 
  let

    runAsterisk' :: Producer B.ByteString {- TODO Response -} IO () -> Consumer B.ByteString IO () -> Asterisk a -> IO a
    runAsterisk' i o m' = runEffect $ i >-> astPipe m' >-> o
      where
        astPipe :: Asterisk a -> Pipe B.ByteString B.ByteString IO a
        astPipe k = 
          case Op.view m' of

            Return a -> return a

            Login :>>= k -> do
              yield logincmd
              resp <- await -- :: Response
              let v = undefined resp :: Maybe Version
              astPipe (k v)

            CoreShowChannels :>>= k -> do
              yield coreshowchannelscmd
              resp <- await
              let c = undefined resp :: Maybe Channels
              astPipe (k c)

  in do
    withSpawn unbounded $ \(out1, in1) -> do
        async $ asteriskManager (fromInput in1) (toOutput out1)
        runAsterisk' (fromInput in1) (toOutput out1) m 

asteriskManager :: Producer B.ByteString IO () -> Consumer B.ByteString IO () -> IO ExitCode
asteriskManager prod cons = do
  let ssh = shell "nc someserver 5038"
  execute (piped ssh) (foldOut (withConsumer cons) *> feedProducer prod *> exitCode)


logincmd, coreshowchannelscmd :: B.ByteString
logincmd = "action: login\nusername: username\nsecret: pass\nevents: off\n\n"
coreshowchannelscmd = "action: coreshowchannels\n\n"

返回
（）
的
生产者和
消费者可以自行停止<代码>生产者
s和
消费者
s在其返回类型上是多态的，它们自己永远不会停止

要统一案例中的返回类型，请使用
fmap
将每个返回类型放在
的不同分支中

runAsterisk' :: Producer B.ByteString IO () 
             -> Consumer B.ByteString IO () 
             -> Asterisk a 
             -> IO (Either () a)
runAsterisk' i o m' = runEffect $ fmap Left i >-> fmap Right (astPipe m') >-> fmap Left o

在
或
上进行模式匹配将显示哪个组件停止了管道

此外，您还可以使用将
消费者a IO（）
转换为从不自行停止的消费者：

neverStop :: Consumer a IO () -> Consumer a IO r
neverStop consumer = consumer *> drain

原始使用者停止后收到的所有输入都将被丢弃。
看起来您可以修复您的类型签名，这样会更好。在类型签名中有一个
消费者B.ByteString IO（）
，而不是
消费者B.ByteString IO a
。
runEffect
返回您的总体
Effect
返回的任何内容，并且您已经告诉它必须是
消费者B.ByteString IO（）
，但是
runEffect
需要返回
IO a
。这不起作用，因为明确地返回
Producer'a m（）
toOutput
类似。我曾想尝试以某种方式改变他们，但我不确定这是否有意义。这正是我所希望的。好处：我可以判断我的程序是否正确退出，或者服务器是否意外中断。
neverStop :: Consumer a IO () -> Consumer a IO r
neverStop consumer = consumer *> drain