Squashed commit of the following:

[opengl.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 c59a755979314316d4759765088f883df873c73a..bd5bdb959f670652a5e910d5d0942b43fcb0c494 100644 (file)
--- a/src/Language/Haskell/LSP/Test/Server.hs
+++ b/src/Language/Haskell/LSP/Test/Server.hs
@@ -1,13 +1,14 @@
 module Language.Haskell.LSP.Test.Server (withServer) where
 
 import Control.Concurrent
+import Control.Exception
 import Control.Monad
 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
+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
@@ -17,12 +18,10 @@ withServer serverExe f = do
   -- 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 <- getProcessID serverProc
 
-  result <- f serverIn serverOut pid
-
+  finally (f serverIn serverOut pid) $ do
     killThread errSinkThread
     terminateProcess serverProc
-  return result