module Language.LSP.Test.Server (withServer) where

import Control.Concurrent.Async
import Control.Monad
import Language.LSP.Test.Compat
import System.IO
import System.Process hiding (withCreateProcess)

withServer :: String -> Bool -> (Handle -> Handle -> ProcessHandle -> IO a) -> IO a
withServer :: String
-> Bool -> (Handle -> Handle -> ProcessHandle -> IO a) -> IO a
withServer String
serverExe Bool
logStdErr Handle -> Handle -> ProcessHandle -> IO a
f = do
  -- TODO Probably should just change runServer to accept
  -- separate command and arguments
  let String
cmd:[String]
args = String -> [String]
words String
serverExe
      createProc :: CreateProcess
createProc = (String -> [String] -> CreateProcess
proc String
cmd [String]
args) { std_in :: StdStream
std_in = StdStream
CreatePipe, std_out :: StdStream
std_out = StdStream
CreatePipe, std_err :: StdStream
std_err = StdStream
CreatePipe }
  CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
forall a.
CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
withCreateProcess CreateProcess
createProc ((Maybe Handle
  -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
 -> IO a)
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
forall a b. (a -> b) -> a -> b
$ \(Just Handle
serverIn) (Just Handle
serverOut) (Just Handle
serverErr) ProcessHandle
serverProc -> do
    -- Need to continuously consume to stderr else it gets blocked
    -- Can't pass NoStream either to std_err
    Handle -> BufferMode -> IO ()
hSetBuffering Handle
serverErr BufferMode
NoBuffering
    Handle -> Bool -> IO ()
hSetBinaryMode Handle
serverErr Bool
True
    let errSinkThread :: IO b
errSinkThread = IO () -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO b) -> IO () -> IO b
forall a b. (a -> b) -> a -> b
$ Handle -> IO String
hGetLine Handle
serverErr IO String -> (String -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
logStdErr (IO () -> IO ()) -> (String -> IO ()) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn
    IO Any -> (Async Any -> IO a) -> IO a
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync IO Any
forall b. IO b
errSinkThread ((Async Any -> IO a) -> IO a) -> (Async Any -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Async Any
_ -> do
      Handle -> Handle -> ProcessHandle -> IO a
f Handle
serverIn Handle
serverOut ProcessHandle
serverProc