github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-22 14:21:31 +03:00
Code Issues Projects Releases Wiki Activity

🔥 Action.

Browse Source
This commit is contained in:
Rob Rix 2018-05-10 11:46:15 -04:00
parent 5a9ea5aba0
commit db3fc91d5d
2 changed files with 3 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
src/Semantic/Distribute.hs
View File

@ -5,7 +5,6 @@ module Semantic.Distribute
, distributeFoldMap
, Distribute
, runDistribute
, Action(..)
) where
import qualified Control.Concurrent.Async as Async
@ -40,12 +39,6 @@ data Distribute task output where
-- | Evaluate a 'Distribute' effect concurrently.
runDistribute :: Members '[Exc SomeException, IO] effs => Action task -> Eff (Distribute task ': effs) a -> Eff effs a
runDistribute :: Members '[Exc SomeException, IO] effs => (forall output . task output -> IO (Either SomeException output)) -> Eff (Distribute task ': effs) a -> Eff effs a
runDistribute action = interpret (\ (Distribute tasks) ->
liftIO (Async.mapConcurrently (runAction action) tasks) >>= either throwError pure . sequenceA . withStrategy (parTraversable (parTraversable rseq)))
-- | An action evaluating @task@s to some output in 'IO', or failing with an exception.
--
-- This is necessary because GHC won’t allow us to use a rank-n quantified type in the third parameter to our instance of 'Run', below.
newtype Action task = Action { runAction :: forall output . task output -> IO (Either SomeException output) }
liftIO (Async.mapConcurrently action tasks) >>= either throwError pure . sequenceA . withStrategy (parTraversable (parTraversable rseq)))

2
src/Semantic/Task.hs
View File

@ -125,7 +125,7 @@ runTaskWithOptions options task = do
(result, stat) <- withTiming "run" [] $ do
let run :: TaskEff a -> IO (Either SomeException a)
run = runM . runError . flip runReader (Queues logger statter) . runTelemetry . runTraceInTelemetry . flip runReader options . IO.runFiles . runTaskF . runDistribute (Action (run . unwrapTask))
run = runM . runError . flip runReader (Queues logger statter) . runTelemetry . runTraceInTelemetry . flip runReader options . IO.runFiles . runTaskF . runDistribute (run . unwrapTask)
run task
queue statter stat