Question

我一直在试验新的pipe-http包，我有一个想法。我有一个网页的两个解析器，一个返回行项目，另一个从页面的其他地方返回一个数字。当我抓住页面时，最好将这些解析器串在一起并从同一个字符串生成器同时获取结果，而不是将页面取两次或将所有html读取到内存中并解析它两次。

换句话说，假设你有两个消费者：

c1 :: Consumer a m r1
c2 :: Consumer a m r2

是否可以制作这样的函数：

combineConsumers :: Consumer a m r1 -> Consumer a m r2 -> Consumer a m (r1, r2)
combineConsumers = undefined

我尝试了一些事情，但我无法弄清楚。我知道如果不可能，但这会很方便。

编辑：

很抱歉，事实证明我正在做一个关于pipe-attoparsec的假设，因为我对conduit-attoparsec的经验导致我提出错误的问题。 Pipes-attoparsec将一个attoparsec变成一个管道Parser，当时我只是假设它会返回一个管道消费者。这意味着我实际上无法将两个attoparsec解析器转换为使用文本并返回结果的消费者，然后将它们与普通的旧管道生态系统一起使用。对不起，我只是不理解管道解析。

即使它对我没有帮助，Arthur的回答几乎就是我在提出这个问题时所设想的，而且我可能会在将来使用他的解决方案。与此同时，我将使用导管。

Answer 1

结果为“monoidal”，您可以使用Pipes前奏中的tee函数，并结合WriterT。

{-# LANGUAGE OverloadedStrings #-}

import Data.Monoid
import Control.Monad
import Control.Monad.Writer
import Control.Monad.Writer.Class
import Pipes
import qualified Pipes.Prelude as P
import qualified Data.Text as T

textSource :: Producer T.Text IO ()
textSource = yield "foo" >> yield "bar" >> yield "foo" >> yield "nah"

counter :: Monoid w => T.Text 
                    -> (T.Text -> w) 
                    -> Consumer T.Text (WriterT w IO) ()
counter word inject = P.filter (==word) >-> P.mapM (tell . inject) >-> P.drain

main :: IO ()
main = do
    result <-runWriterT $ runEffect $ 
        hoist lift textSource >-> 
        P.tee (counter "foo" inject1) >-> (counter "bar" inject2)
    putStrLn . show $ result
    where
    inject1 _ = (,) (Sum 1) mempty
    inject2 _ = (,) mempty (Sum 1)

更新：正如评论中所提到的，我看到的真正问题是pipes解析器不是Consumers。如果他们对剩菜有不同的行为，你怎么能同时运行两个解析器呢？如果其中一个解析器想要“取消”某些文本而另一个解析器没有？会发生什么？

一种可能的解决方案是在不同的线程中以真正并发的方式运行解析器。 pipes-concurrency包中的原语允许您通过将相同的数据写入两个不同的邮箱来“复制”Producer。然后每个解析器都可以使用自己的生产者副本做任何想做的事情。以下是使用pipes-parse，pipes-attoparsec和async包的示例：

{-# LANGUAGE OverloadedStrings #-}

import Data.Monoid
import qualified Data.Text as T
import Data.Attoparsec.Text hiding (takeWhile)
import Data.Attoparsec.Combinator
import Control.Applicative
import Control.Monad
import Control.Monad.State.Strict
import Pipes
import qualified Pipes.Prelude as P
import qualified Pipes.Attoparsec as P
import qualified Pipes.Concurrent as P
import qualified Control.Concurrent.Async as A

parseChars :: Char -> Parser [Char] 
parseChars c = fmap mconcat $ 
    many (notChar c) *> many1 (some (char c) <* many (notChar c))

textSource :: Producer T.Text IO ()
textSource = yield "foo" >> yield "bar" >> yield "foo" >> yield "nah"

parseConc :: Producer T.Text IO () 
          -> Parser a 
          -> Parser b 
          -> IO (Either P.ParsingError a,Either P.ParsingError b)
parseConc producer parser1 parser2 = do
    (outbox1,inbox1,seal1) <- P.spawn' P.Unbounded
    (outbox2,inbox2,seal2) <- P.spawn' P.Unbounded
    feeding <- A.async $ runEffect $ producer >-> P.tee (P.toOutput outbox1) 
                                              >->        P.toOutput outbox2
    sealing <- A.async $ A.wait feeding >> P.atomically seal1 >> P.atomically seal2
    r <- A.runConcurrently $ 
        (,) <$> (A.Concurrently $ parseInbox parser1 inbox1)
            <*> (A.Concurrently $ parseInbox parser2 inbox2)
    A.wait sealing
    return r 
    where
    parseInbox parser inbox = evalStateT (P.parse parser) (P.fromInput inbox)

main :: IO ()
main = do
    (Right a, Right b) <- parseConc textSource (parseChars 'o')  (parseChars 'a')
    putStrLn . show $ (a,b)

结果是：

("oooo","aa")

我不确定这种方法会带来多少开销。

Answer 2

由于达沃拉克在他的评论中提到的原因，我认为你这样做的方式有问题。但是如果你真的需要这样的功能，你可以定义它。

import Pipes.Internal
import Pipes.Core

zipConsumers :: Monad m => Consumer a m r -> Consumer a m s -> Consumer a m (r,s)
zipConsumers p q = go (p,q) where
  go (p,q) = case (p,q) of 
     (Pure r     , Pure s)      -> Pure (r,s)
     (M mpr      , ps)          -> M (do pr <- mpr
                                         return (go (pr, ps)))
     (pr         , M mps)       -> M (do ps <- mps
                                         return (go (pr, ps)))
     (Request _ f, Request _ g) -> Request () (\a -> go (f a, g a))
     (Request _ f, Pure s)      -> Request () (\a -> do r <- f a
                                                        return (r, s))
     (Pure r     , Request _ g) -> Request () (\a -> do s <- g a
                                                        return (r,s))
     (Respond x _, _          ) -> closed x
     (_          , Respond y _) -> closed y

如果您在没有使用返回值的情况下“拉扯”消费者，只能使用他们的“效果”，您只需使用tee consumer1 >-> consumer2

Answer 3

惯用解决方案是从Consumer库中将Fold重写为FoldM或foldl，然后使用Applicative样式合并它们。然后，您可以将此组合折叠转换为适用于管道的折叠。

假设您有两个Fold s：

fold1 :: Fold a r1
fold2 :: Fold a r2

...或两个FoldM s：

foldM1 :: Monad m => FoldM a m r1
foldM2 :: Monad m => FoldM a m r2

然后使用Fold样式将这些组合成一个FoldM / Applicative：

import Control.Applicative

foldBoth :: Fold a (r1, r2)
foldBoth = (,) <$> fold1 <*> fold2

foldBothM :: Monad m => FoldM a m (r1, r2)
foldBothM = (,) <$> foldM1 <*> foldM2

-- or: foldBoth  = liftA2 (,) fold1  fold2
--     foldMBoth = liftA2 (,) foldM1 foldM2

您可以将折叠转换为Pipes.Prelude式折叠或Parser。以下是必要的转换函数：

import Control.Foldl (purely, impurely)
import qualified Pipes.Prelude as Pipes
import qualified Pipes.Parse   as Parse

purely Pipes.fold
    :: Monad m => Fold a b -> Producer a m () -> m b

impurely Pipes.foldM
    :: Monad m => FoldM m a b -> Producer a m () -> m b

purely Parse.foldAll
    :: Monad m => Fold a b -> Parser a m r

impurely Parse.foldMAll
    :: Monad m => FoldM a m b -> Parser a m r

purely和impurely函数的原因是foldl和pipes可以互操作，而不会产生对另一个的依赖。此外，它们允许除pipes以外的库（如conduit）重用foldl而不依赖（Hint提示，@ MichaelSnoyman）。

我很抱歉没有记录这个功能，主要是因为我花了一些时间来弄清楚如何让pipes和foldl以无依赖方式进行互操作，那是在我之后写了pipes教程。我将更新教程以指出这个技巧。

要了解如何使用foldl，请阅读主模块中的the documentation。它是一个非常小且易于学习的图书馆。

Answer 4

对于它的价值，在管道领域，相关功能是zipSinks。可能有某种方法可以使这个功能适用于管道，但自动终止可能会妨碍管道。

Answer 5

消费者形成一个Monad所以

combineConsumers = liftM2 (,)

将输入检查。不幸的是，语义可能与您期望的不同：第一个消费者将运行完成，然后是第二个消费者。

将两个消费者加入到一个返回多个值的消费者中？

5 个答案: