@@ -24,9 +24,11 @@ module Experiments
24
24
, exampleToOptions
25
25
) where
26
26
import Control.Applicative.Combinators (skipManyTill )
27
+ import Control.Concurrent.Async (withAsync )
27
28
import Control.Exception.Safe (IOException , handleAny , try )
28
- import Control.Monad.Extra (allM , forM , forM_ , unless ,
29
- void , whenJust , (&&^) )
29
+ import Control.Monad.Extra (allM , forM , forM_ , forever ,
30
+ unless , void , when , whenJust ,
31
+ (&&^) )
30
32
import Control.Monad.Fail (MonadFail )
31
33
import Control.Monad.IO.Class
32
34
import Data.Aeson (Value (Null ),
@@ -55,10 +57,12 @@ import Options.Applicative
55
57
import System.Directory
56
58
import System.Environment.Blank (getEnv )
57
59
import System.FilePath ((<.>) , (</>) )
60
+ import System.IO
58
61
import System.Process
59
62
import System.Time.Extra
60
63
import Text.ParserCombinators.ReadP (readP_to_S )
61
64
import Text.Printf
65
+
62
66
charEdit :: Position -> TextDocumentContentChangeEvent
63
67
charEdit p =
64
68
TextDocumentContentChangeEvent
@@ -341,8 +345,15 @@ runBenchmarksFun dir allBenchmarks = do
341
345
}
342
346
results <- forM benchmarks $ \ b@ Bench {name} -> do
343
347
let p = (proc (ghcide ? config) (allArgs name dir))
344
- { std_in = CreatePipe , std_out = CreatePipe }
345
- run sess = withCreateProcess p $ \ (Just inH) (Just outH) _errH _pH ->
348
+ { std_in = CreatePipe , std_out = CreatePipe , std_err = CreatePipe }
349
+ run sess = withCreateProcess p $ \ (Just inH) (Just outH) (Just errH) _pH -> do
350
+ -- Need to continuously consume to stderr else it gets blocked
351
+ -- Can't pass NoStream either to std_err
352
+ hSetBuffering errH NoBuffering
353
+ hSetBinaryMode errH True
354
+ let errSinkThread =
355
+ forever $ hGetLine errH >>= when (verbose ? config). putStrLn
356
+ withAsync errSinkThread $ \ _ -> do
346
357
runSessionWithHandles inH outH conf lspTestCaps dir sess
347
358
(b,) <$> runBench run b
348
359
0 commit comments