Соберите все результаты Чана с помощью getChanContents

Я играю с каналами в Хаскеле. Я хочу сделать немного IO параллельные действия, пока один из них не завершится неудачей, затем соберите все результаты в список.

Этот код ошибки с Exception <<loop>>, Как мне заставить его работать с getChanContents? Все примеры, которые я видел, предполагают, что они знают, сколько сообщений на канале.

Есть ли более чистый способ собрать кучу результатов от работников?

module UrlPatterns where

import Control.Concurrent
import Types
import Text.HTML.Scalpel
import Data.Monoid ((<>))
import Control.Concurrent.Chan
import Control.Applicative
import Data.Maybe (isJust, catMaybes)
import Data.List (takeWhile)


-- find all valid links under a domain that follow the pattern:
-- http://example.com/pages/(1..N)
-- as soon as one is missing, return a list of all the ones you found
findIncrementing :: URL -> IO [Link]
findIncrementing base = do

    let num = 1

    -- find channel
    cfind <- newChan
    writeChan cfind (base, num)

    -- results channel
    cdone <- newChan

    forkIO $ worker cfind cdone

    -- collect the results
    results <- getChanContents cdone
    let results = takeWhile isJust results :: [Maybe Link]
    print results

    return []


worker :: Chan (URL, Int) -> Chan (Maybe Link) -> IO ()
worker next done = loop
  where 
    loop = do
      (base, num) <- readChan next
      let url = pageUrl base num
      putStrLn $ "FETCHING: " <> url

      mt <- findPageTitle url

      case mt of
        Nothing -> do
          writeChan done Nothing
          putStrLn ("Missed " <> show num)
        Just t  -> do
          writeChan done $ Just $ Link url t
          writeChan next (base, num+1)

      loop

scrapeTitle :: Scraper String String
scrapeTitle = text "title"

findPageTitle :: URL -> IO (Maybe String)
findPageTitle url = scrapeURL url scrapeTitle

pageUrl :: URL -> Int -> URL
pageUrl base num = base <> show num

1 ответ

Решение

Спасибо @bartavelle. У меня была ошибка, не связанная с кодом канала. Вот соответствующее исправление:

-- collect the results
results <- getChanContents cdone
let links = catMaybes $ takeWhile isJust results

return links
Другие вопросы по тегам