7d00f2382900e454b5b67b32de1a33ffc71a4caa
[opengl.git] / src / Language / Haskell / LSP / Test / Server.hs
1 module Language.Haskell.LSP.Test.Server (withServer) where
2
3 import Control.Concurrent
4 import Control.Monad
5 import Language.Haskell.LSP.Test.Compat
6 import System.IO
7 import System.Process
8
9 withServer :: String -> Bool -> (Handle -> Handle -> Int -> 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   (Just serverIn, Just serverOut, Just serverErr, serverProc) <- createProcess createProc
16
17   -- Need to continuously consume to stderr else it gets blocked
18   -- Can't pass NoStream either to std_err
19   hSetBuffering serverErr NoBuffering
20   errSinkThread <- forkIO $ forever $ hGetLine serverErr >>= when logStdErr . putStrLn
21
22   pid <- getProcessID serverProc
23
24   result <- f serverIn serverOut pid
25
26   killThread errSinkThread
27   terminateProcess serverProc
28   return result