Haskell Pipes——让管道消耗它产生的东西（本身）答案

【问题标题】：Haskell Pipes -- Having a pipe consume what it yields (itself)Haskell Pipes——让管道消耗它产生的东西（本身）
【发布时间】：2016-07-21 22:13:43
【问题描述】：

我正在尝试使用 Pipes 编写一个 webscraper，我已经开始关注抓取的链接。我有一个process 函数，它可以下载网址、查找链接并生成它们。

process :: Pipe Item Item (StateT CState IO) ()
 ....
    for (each links) yield
 ....

现在我想了解如何递归地跟踪这些链接，将 StateT 线程化。我意识到可能会做一些更惯用的事情，然后将单个管道用于大部分刮板（尤其是当我开始添加更多功能时），我愿意接受建议。无论如何，当我考虑使用共享状态的多线程时，我可能不得不重新考虑设计。

【问题讨论】：

偏好问题，但我可能有process :: (MonadState CState m, MonadIO m) => Pipe Item Item m ()。没有太多的代码更改（可能），更具可读性，并抽象出你的 monad 堆栈的实现细节。

标签： haskell pipe haskell-pipes

【解决方案1】：

您可以通过m 参数将Pipe a b m r 连接到副作用，该参数交换出管道正在运行的Monad。您可以通过将管道的下游端连接到将链接粘贴在队列中的另一个管道并将管道的上游端连接到从队列中读取链接的管道来使用它来重新排队链接。

我们的目标是写作

import Pipes

loopLeft :: Monad m => Pipe (Either l a) (Either l b) m r -> Pipe a b m r

我们将采用一个管道，其下游输出 Either l b 是 Left l 发送回上游或 Right b 发送下游，并将 ls 发送回上游输入 @987654331 @，要么是排队的 Left l，要么是来自上游的 Right a。我们将把Left ls 连接在一起，形成一个管道，该管道只能看到来自上游的as，并且只产生指向下游的bs。

在下游端，我们会将ls 从Left l 推入堆栈。我们yield 来自Right r 下游的rs。

import Control.Monad
import Control.Monad.Trans.State

pushLeft :: Monad m => Pipe (Either l a) a (StateT [l] m) r
pushLeft = forever $ do
    o <- await
    case o of
        Right a -> yield a
        Left l -> do
            stack <- lift get
            lift $ put (l : stack)

在上游端，我们将在堆栈顶部查找yield 的内容。如果没有，我们将 await 获取来自上游的值，然后 yield 它。

popLeft :: Monad m => Pipe a (Either l a) (StateT [l] m) r
popLeft = forever $ do
    stack <- lift get
    case stack of
        [] -> await >>= yield . Right
        (x : xs) -> do
            lift $ put xs
            yield (Left x)

现在我们可以写loopLeft。我们将上游和下游管道与管道组合popLeft >-> hoist lift p >-> pushLeft 一起组成。 hoist lift 将 Pipe a b m r 转换为 Pipe a b (t m) r。 distribute 将 Pipe a b (t m) r 转换为 t (Pipe a b m) r。为了回到Pipe a b m r，我们从一个空堆栈[] 开始运行整个StateT 计算。在Pipes.Lift 中有一个很好的名字evalStateP 是evalStateT 和distribute 的组合。

import Pipes.Lift

loopLeft :: Monad m => Pipe (Either l a) (Either l b) m r -> Pipe a b m r
loopLeft p = flip evalStateT [] . distribute $ popLeft >-> hoist lift p >-> pushLeft

【讨论】：

【解决方案2】：

我会这样做：

import Pipes

type Url = String

getLinks :: Url -> IO [Url]
getLinks = undefined

crawl :: MonadIO m => Pipe Url Url m a
crawl = loop []
  where
    loop [] = do url <- await; loop [url]
    loop (url:urls) = do
      yield url
      urls' <- liftIO $ getLinks url
      loop (urls ++ urls')

您可以根据url' 与urls 的组合方式来实现DFS 或BFS。

【讨论】：