X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest%2FServer.hs;fp=src%2FLanguage%2FHaskell%2FLSP%2FTest%2FServer.hs;h=65011fd3f106b0947243590c8b86af6b014dffd6;hb=5170a20560a68b8fcaed83ecaf6146d84a147992;hp=0000000000000000000000000000000000000000;hpb=bf93e74482200ee189ca0be09970b9a34bb1511c;p=opengl.git

diff --git a/src/Language/Haskell/LSP/Test/Server.hs b/src/Language/Haskell/LSP/Test/Server.hs
new file mode 100644
index 0000000..65011fd
--- /dev/null
+++ b/src/Language/Haskell/LSP/Test/Server.hs
@@ -0,0 +1,25 @@
+module Language.Haskell.LSP.Test.Server where
+
+import Control.Concurrent
+import Control.Monad
+import Data.Maybe
+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 }
+  (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
+  
+  pid <- fromIntegral . fromJust <$> getPid serverProc
+
+  result <- f serverIn serverOut pid
+
+  killThread errSinkThread
+  terminateProcess serverProc
+  return result
\ No newline at end of file