Add config option to log stderr

[lsp-test.git] / src / Language / Haskell / LSP / Test / Server.hs

diff --git a/src/Language/Haskell/LSP/Test/Server.hs b/src/Language/Haskell/LSP/Test/Server.hs
index 65011fd3f106b0947243590c8b86af6b014dffd6..7d00f2382900e454b5b67b32de1a33ffc71a4caa 100644 (file)
--- a/src/Language/Haskell/LSP/Test/Server.hs
+++ b/src/Language/Haskell/LSP/Test/Server.hs
@@ -1,22 +1,25 @@
-module Language.Haskell.LSP.Test.Server where
+module Language.Haskell.LSP.Test.Server (withServer) where
 
 import Control.Concurrent
 import Control.Monad
-import Data.Maybe
+import Language.Haskell.LSP.Test.Compat
 import System.IO
 import System.Process
 
-withServer :: String -> (Handle -> Handle -> Int -> IO a) -> IO a
-withServer serverExe f = do
-  let createProc = (shell serverExe) { std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe }
+withServer :: String -> Bool -> (Handle -> Handle -> Int -> IO a) -> IO 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
 
   -- 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
+  errSinkThread <- forkIO $ forever $ hGetLine serverErr >>= when logStdErr . putStrLn
 
-  pid <- fromIntegral . fromJust <$> getPid serverProc
+  pid <- getProcessID serverProc
 
   result <- f serverIn serverOut pid