src/Language/Haskell/LSP/Test/Server.hs

   1 module Language.Haskell.LSP.Test.Server (withServer) where
   2
   3 import Control.Concurrent
   4 import Control.Monad
   5 import Control.Monad.IO.Class
   6 import Language.Haskell.LSP.Test.Compat
   7 import System.IO
   8 import System.Process
   9
  10 withServer :: MonadIO m => String -> Bool -> (Handle -> Handle -> Int -> m a) -> m a
  11 withServer serverExe logStdErr f = do
  12   -- TODO Probably should just change runServer to accept
  13   -- separate command and arguments
  14   let cmd:args = words serverExe
  15       createProc = (proc cmd args) { std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe }
  16   (Just serverIn, Just serverOut, Just serverErr, serverProc) <- liftIO $ createProcess createProc
  17
  18   -- Need to continuously consume to stderr else it gets blocked
  19   -- Can't pass NoStream either to std_err
  20   liftIO $ hSetBuffering serverErr NoBuffering
  21   errSinkThread <- liftIO $ forkIO $ forever $ hGetLine serverErr >>= when logStdErr . putStrLn
  22
  23   pid <- liftIO $ getProcessID serverProc
  24
  25   result <- f serverIn serverOut pid
  26
  27   liftIO $ killThread errSinkThread
  28   liftIO $ terminateProcess serverProc
  29   return result