Я пытаюсь запустить несколько загрузок параллельно в Haskell, и я обычно использовал бы функцию Control.Concurrent.Async.mapConcurrently. Однако при этом открывается ~ 3000 соединений, что заставляет веб-сервер отклонять их все. Возможно ли выполнить ту же задачу, что и mapCon текущего, но только ограниченное количество подключений, открытых одновременно (т.е. Только 2 или 4 за раз)?
Может ли Haskell Control.Concurrent.Async.mapConcurrently иметь предел?
Ответ 1
Быстрое решение заключалось бы в использовании semaphore, чтобы ограничить количество одновременных действий. Это не оптимально (все потоки создаются сразу, а затем ждут), но работает:
import Control.Concurrent.MSem
import Control.Concurrent.Async
import Control.Concurrent (threadDelay)
import qualified Data.Traversable as T
mapPool :: T.Traversable t => Int -> (a -> IO b) -> t a -> IO (t b)
mapPool max f xs = do
sem <- new max
mapConcurrently (with sem . f) xs
-- A little test:
main = mapPool 10 (\x -> threadDelay 1000000 >> print x) [1..100]
Ответ 2
Вы также можете попробовать pooled-io, где вы можете написать:
import qualified Control.Concurrent.PooledIO.Final as Pool
import Control.DeepSeq (NFData)
import Data.Traversable (Traversable, traverse)
mapPool ::
(Traversable t, NFData b) =>
Int -> (a -> IO b) -> t a -> IO (t b)
mapPool n f = Pool.runLimited n . traverse (Pool.fork . f)
Ответ 3
Это очень легко сделать с помощью библиотеки Control.Concurrent.Spawn
:
import Control.Concurrent.Spawn
type URL = String
type Response = String
numMaxConcurrentThreads = 4
getURLs :: [URL] -> IO [Response]
getURLs urlList = do
wrap <- pool numMaxConcurrentThreads
parMapIO (wrap . fetchURL) urlList
fetchURL :: URL -> IO Response
Ответ 4
Разделение потоков может быть неэффективным, если некоторые из них остаются значительно длиннее остальных. Вот более плавное, но более сложное решение:
{-# LANGUAGE TupleSections #-}
import Control.Concurrent.Async (async, waitAny)
import Data.List (delete, sortBy)
import Data.Ord (comparing)
concurrentlyLimited :: Int -> [IO a] -> IO [a]
concurrentlyLimited n tasks = concurrentlyLimited' n (zip [0..] tasks) [] []
concurrentlyLimited' _ [] [] results = return . map snd $ sortBy (comparing fst) results
concurrentlyLimited' 0 todo ongoing results = do
(task, newResult) <- waitAny ongoing
concurrentlyLimited' 1 todo (delete task ongoing) (newResult:results)
concurrentlyLimited' n [] ongoing results = concurrentlyLimited' 0 [] ongoing results
concurrentlyLimited' n ((i, task):otherTasks) ongoing results = do
t <- async $ (i,) <$> task
concurrentlyLimited' (n-1) otherTasks (t:ongoing) results
Примечание: приведенный выше код можно сделать более общим с использованием экземпляра MonadBaseControl IO
вместо IO
, благодаря lifted-async
.
Ответ 5
Если у вас есть действия в списке, у этого есть меньше зависимостей
import Control.Concurrent.Async (mapConcurrently)
import Data.List.Split (chunksOf)
mapConcurrentChunks :: Int -> (a -> IO b) -> [a] -> IO [b]
mapConcurrentChunks n ioa xs = concat <$> mapM (mapConcurrently ioa) (chunksOf n xs)
Изменить: немного сокращенно