1 module Language.Haskell.LSP.Test.Server (withServer) where
3 import Control.Concurrent
5 import Control.Monad.IO.Class
6 import Language.Haskell.LSP.Test.Compat
10 withServer :: MonadIO m => String -> Bool -> (Handle -> Handle -> Int -> m a) -> m a
11 withServer serverExe logStdErr f = do
12 -- TODO Probably should just change runServer to accept
13 -- separate command and arguments
14 let cmd:args = words serverExe
15 createProc = (proc cmd args) { std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe }
16 (Just serverIn, Just serverOut, Just serverErr, serverProc) <- liftIO $ createProcess createProc
18 -- Need to continuously consume to stderr else it gets blocked
19 -- Can't pass NoStream either to std_err
20 liftIO $ hSetBuffering serverErr NoBuffering
21 errSinkThread <- liftIO $ forkIO $ forever $ hGetLine serverErr >>= when logStdErr . putStrLn
23 pid <- liftIO $ getProcessID serverProc
25 result <- f serverIn serverOut pid
27 liftIO $ killThread errSinkThread
28 liftIO $ terminateProcess serverProc