Haskell Pipes -- 让管道消耗其产出的内容（自身）

Question

我正在尝试使用 Pipes 写一个网络爬虫，目前遇到跟随抓取链接的部分。我有一个 process 函数，可以下载 URL、查找链接并生成链接迭代器。

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

现在我想以某种方式递归地跟随这些链接，并将StateT线程化。我意识到，可能有比使用单个管道进行大部分爬虫更符合惯用语的做法（特别是当我开始添加更多功能时），我愿意听取建议。无论如何，当考虑具有共享状态的多线程时，我可能不得不重新思考设计。

- user1055947

---

这是个人偏好问题，但我可能会写成 process :: (MonadState CState m, MonadIO m) => Pipe Item Item m ()。这样不会有太多代码变动（可能），更易读，并且抽象了你的单子栈的实现细节。 - Alec

Answer 1

你可以通过将 Pipe a b m r 与副作用连接起来，通过参数 m 来交换管道操作的 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 用于发送下游。我们将把 l 发回到上游输入的 Either l a 中，其中包括一个排队的 Left l 或来自上游的 Right a。我们将连接这些 Left l 形成一个只能从上游看到 a 并且只能向下游产生 b 的管道。

在下游端，我们将 Left l 推入堆栈中，yield 来自 Right r 的 r 向下游产生。

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。如果没有找到，则我们将等待来自上游的值并将其 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

- Cirdec

Answer 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。

- ErikR