import Control.Concurrent
import Control.Monad
+import Control.Monad.IO.Class
import Language.Haskell.LSP.Test.Compat
import System.IO
import System.Process
-withServer :: String -> Bool -> (Handle -> Handle -> Int -> IO a) -> IO a
+withServer :: MonadIO m => String -> Bool -> (Handle -> Handle -> Int -> m a) -> m a
withServer serverExe logStdErr f = do
-- TODO Probably should just change runServer to accept
-- separate command and arguments
let cmd:args = words serverExe
createProc = (proc cmd args) { std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe }
- (Just serverIn, Just serverOut, Just serverErr, serverProc) <- createProcess createProc
+ (Just serverIn, Just serverOut, Just serverErr, serverProc) <- liftIO $ createProcess createProc
-- Need to continuously consume to stderr else it gets blocked
-- Can't pass NoStream either to std_err
- hSetBuffering serverErr NoBuffering
- errSinkThread <- forkIO $ forever $ hGetLine serverErr >>= when logStdErr . putStrLn
+ liftIO $ hSetBuffering serverErr NoBuffering
+ errSinkThread <- liftIO $ forkIO $ forever $ hGetLine serverErr >>= when logStdErr . putStrLn
- pid <- getProcessID serverProc
+ pid <- liftIO $ getProcessID serverProc
result <- f serverIn serverOut pid
- killThread errSinkThread
- terminateProcess serverProc
+ liftIO $ killThread errSinkThread
+ liftIO $ terminateProcess serverProc
return result