1 module Language.Haskell.LSP.Test.Server (withServer) where
3 import Control.Concurrent.Async
5 import Language.Haskell.LSP.Test.Compat
7 import System.Process hiding (withCreateProcess)
9 withServer :: String -> Bool -> (Handle -> Handle -> ProcessHandle -> IO a) -> IO a
10 withServer serverExe logStdErr f = do
11 -- TODO Probably should just change runServer to accept
12 -- separate command and arguments
13 let cmd:args = words serverExe
14 createProc = (proc cmd args) { std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe }
15 withCreateProcess createProc $ \(Just serverIn) (Just serverOut) (Just serverErr) serverProc -> do
16 -- Need to continuously consume to stderr else it gets blocked
17 -- Can't pass NoStream either to std_err
18 hSetBuffering serverErr NoBuffering
19 hSetBinaryMode serverErr True
20 let errSinkThread = forever $ hGetLine serverErr >>= when logStdErr . putStrLn
21 withAsync errSinkThread $ \_ -> do
22 f serverIn serverOut serverProc