X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest%2FServer.hs;h=c59a755979314316d4759765088f883df873c73a;hb=502c8dc3ff63383487536922176330a3f459a462;hp=65011fd3f106b0947243590c8b86af6b014dffd6;hpb=5170a20560a68b8fcaed83ecaf6146d84a147992;p=opengl.git diff --git a/src/Language/Haskell/LSP/Test/Server.hs b/src/Language/Haskell/LSP/Test/Server.hs index 65011fd..c59a755 100644 --- a/src/Language/Haskell/LSP/Test/Server.hs +++ b/src/Language/Haskell/LSP/Test/Server.hs @@ -1,14 +1,17 @@ -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 } + -- 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 @@ -16,7 +19,7 @@ withServer serverExe f = do hSetBuffering serverErr NoBuffering errSinkThread <- forkIO $ forever $ hGetLine serverErr - pid <- fromIntegral . fromJust <$> getPid serverProc + pid <- getProcessID serverProc result <- f serverIn serverOut pid