haskell - 单步导管

Question

我想按照 ArrowChoice 的方式做一些事情，但是使用 conduits .我想等待一个 Either 值，然后将 Left 值传递给一个管道，将 Right 值传递给另一个，然后将结果合并回 Either 流。

大概这可以通过使内部管道像自动机一样来完成:将管道变成一个函数，该函数接受一个参数并返回一个产生的输出的单子(monad)列表:

newtype AutomataM i m o = Automata (i -> m (o, Automata i o))

conduitStep :: Conduit i m o -> AutomataM i m [o]

输出列表的原因是导管可能为每个输入产生 0 个或多个输出。

我查看了 ResumableConduit 及其亲属，大概答案就在某处。但我不太明白它是如何完成的。

Answer 1

它与您提供的类型签名不完全相同，但是:

import Data.Conduit
import Data.Conduit.Internal (Pipe (..), ConduitM (..))

newtype Automata i o m r = Automata (m ([o], Either r (i -> Automata i o m r)))

conduitStep :: Monad m => ConduitM i o m r -> Automata i o m r
conduitStep (ConduitM con0) =
    Automata $ go [] id con0
  where
    go _ front (Done r) = return (front [], Left r)
    go ls front (HaveOutput p _ o) = go ls (front . (o:)) p
    go ls front (NeedInput p _) =
        case ls of
            [] -> return (front [], Right $ conduitStep . ConduitM . p)
            l:ls' -> go ls' front (p l)
    go ls front (PipeM mp) = mp >>= go ls front
    go ls front (Leftover p l) = go (l:ls) front p

但请注意这种方法:

通过将输出保留为列表，它不是恒定的内存。

我们正在丢弃终结器。

可能有一种方法可以提供 ZipConduit抽象，类似于 ZipSource和 ZipSink ，那样会更优雅地处理这种问题，但我没有考虑太多。

编辑 我最终实现了 ZipConduit在导管额外 0.1.5 中。这是一个使用它的演示，听起来有点像你的情况:

import           Control.Applicative
import           Data.Conduit
import           Data.Conduit.Extra
import qualified Data.Conduit.List   as CL

conduit1 :: Monad m => Conduit Int m String
conduit1 = CL.map $ \i -> "conduit1: " ++ show i

conduit2 :: Monad m => Conduit Double m String
conduit2 = CL.map $ \d -> "conduit2: " ++ show d

conduit :: Monad m => Conduit (Either Int Double) m String
conduit = getZipConduit $
    ZipConduit (lefts =$= conduit1) *>
    ZipConduit (rights =$= conduit2)
  where
    lefts = CL.mapMaybe (either Just (const Nothing))
    rights = CL.mapMaybe (either (const Nothing) Just)

main :: IO ()
main = do
    let src = do
            yield $ Left 1
            yield $ Right 2
            yield $ Left 3
            yield $ Right 4
        sink = CL.mapM_ putStrLn
    src $$ conduit =$ sink