1
1
mirror of https://github.com/github/semantic.git synced 2024-12-22 06:11:49 +03:00

📝 Distribute.

This commit is contained in:
Rob Rix 2018-04-05 10:10:47 -04:00
parent 43b0d43168
commit 54a94e8df9

View File

@ -28,10 +28,12 @@ distributeFoldMap :: (Member (Distribute task) effs, Monoid output, Traversable
distributeFoldMap toTask inputs = fmap fold (distribute (fmap toTask inputs)) distributeFoldMap toTask inputs = fmap fold (distribute (fmap toTask inputs))
-- | Distribute effects run tasks concurrently.
data Distribute task output where data Distribute task output where
Distribute :: Traversable t => t (task output) -> Distribute task (t output) Distribute :: Traversable t => t (task output) -> Distribute task (t output)
-- | Evaluate a 'Distribute' effect concurrently.
runDistribute :: Members '[Exc SomeException, IO] effs => Eff (Distribute task ': effs) a -> Action task -> Eff effs a runDistribute :: Members '[Exc SomeException, IO] effs => Eff (Distribute task ': effs) a -> Action task -> Eff effs a
runDistribute m action = interpret (\ (Distribute tasks) -> runDistribute m action = interpret (\ (Distribute tasks) ->
liftIO (Async.mapConcurrently (runAction action) tasks) >>= either throwError pure . sequenceA . withStrategy (parTraversable (parTraversable rseq))) m liftIO (Async.mapConcurrently (runAction action) tasks) >>= either throwError pure . sequenceA . withStrategy (parTraversable (parTraversable rseq))) m