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

Close over the statter, logger, and options.

Browse Source
This commit is contained in:
Rob Rix 2018-04-04 11:07:16 -04:00
parent a21e09a2fd
commit 5fe10f4221
1 changed files with 4 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
src/Semantic/Task.hs
View File

@ -172,24 +172,16 @@ runTaskWithOptions options task = do
statter <- defaultStatsClient >>= newQueue sendStat
logger <- newQueue logMessage options
(result, stat) <- withTiming "run" [] $
run options logger statter task
(result, stat) <- withTiming "run" [] $ do
let run :: Task a -> IO (Either SomeException a)
run = runM . runError . flip runReader statter . flip runReader logger . runTelemetry . flip runReader options . runTaskF . runDistribute (run . unwrapTask)
run task
queue statter stat
closeQueue statter
closeStatClient (asyncQueueExtra statter)
closeQueue logger
either (die . displayException) pure result
where
run :: Options
-> LogQueue
-> StatQueue
-> Task a
-> IO (Either SomeException a)
run options logger statter = run'
where
run' :: Task a -> IO (Either SomeException a)
run' = runM . runError . flip runReader statter . flip runReader logger . runTelemetry . flip runReader options . runTaskF . runDistribute (run' . unwrapTask)
logError :: Member Telemetry effs => Options -> Level -> Blob -> Error.Error String -> [(String, String)] -> Eff effs ()
logError Options{..} level blob err = writeLog level (Error.formatError optionsPrintSource (optionsIsTerminal && optionsEnableColour) blob err)