Fix various issues encountered on Windows

[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 bd5bdb959f670652a5e910d5d0942b43fcb0c494..5449dfbbf40317aae94ba65a17ef9d169dc08a6b 100644 (file)
--- a/src/Language/Haskell/LSP/Test/Server.hs
+++ b/src/Language/Haskell/LSP/Test/Server.hs
@@ -1,7 +1,6 @@
 module Language.Haskell.LSP.Test.Server (withServer) where
 
-import Control.Concurrent
-import Control.Exception
+import Control.Concurrent.Async
 import Control.Monad
 import Language.Haskell.LSP.Test.Compat
 import System.IO
@@ -13,15 +12,12 @@ withServer serverExe logStdErr f = do
   -- 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
-
+  withCreateProcess createProc $ \(Just serverIn) (Just serverOut) (Just serverErr) serverProc -> 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 >>= when logStdErr . putStrLn
-
+    hSetBinaryMode serverErr True
+    let errSinkThread = forever $ hGetLine serverErr >>= when logStdErr . putStrLn
+    withAsync errSinkThread $ \_ -> do
       pid <- getProcessID serverProc
-
-  finally (f serverIn serverOut pid) $ do
-    killThread errSinkThread
-    terminateProcess serverProc
+      f serverIn serverOut pid