Change server filepath to a command to run

[lsp-test.git] / src / Language / Haskell / LSP / Test / Replay.hs

diff --git a/src/Language/Haskell/LSP/Test/Replay.hs b/src/Language/Haskell/LSP/Test/Replay.hs
index 8c9e1d07593b5c833780afbcf1b3a65af796a86b..9d7f136a20056a7f81359e23f9856c0248c915de 100644 (file)
--- a/src/Language/Haskell/LSP/Test/Replay.hs
+++ b/src/Language/Haskell/LSP/Test/Replay.hs
@@ -29,9 +29,10 @@ import           Language.Haskell.LSP.Test.Messages
 -- makes sure it matches up with an expected response.
 -- The session directory should have a captured session file in it
 -- named "session.log".
-replaySession :: FilePath -- ^ The recorded session directory.
+replaySession :: String -- ^ The command to run the server.
+              -> FilePath -- ^ The recorded session directory.
               -> IO Bool
-replaySession sessionDir = do
+replaySession serverExe sessionDir = do
 
   entries <- B.lines <$> B.readFile (sessionDir </> "session.log")
 
@@ -46,15 +47,19 @@ replaySession sessionDir = do
       serverMsgs = filter (not . shouldSkip) $ map (\(FromServer _ msg) -> msg) serverEvents
       requestMap = getRequestMap clientMsgs
 
-
   reqSema <- newEmptyMVar
   rspSema <- newEmptyMVar
   passVar <- newEmptyMVar :: IO (MVar Bool)
 
-  forkIO $ runSessionWithHandler (listenServer serverMsgs requestMap reqSema rspSema passVar) sessionDir $
-    sendMessages clientMsgs reqSema rspSema
+  threadId <- forkIO $
+    runSessionWithHandler (listenServer serverMsgs requestMap reqSema rspSema passVar)
+                          serverExe
+                          sessionDir
+                          (sendMessages clientMsgs reqSema rspSema)
 
-  takeMVar passVar
+  result <- takeMVar passVar
+  killThread threadId
+  return result
 
   where
     isClientMsg (FromClient _ _) = True
@@ -99,7 +104,7 @@ sendMessages (nextMsg:remainingMsgs) reqSema rspSema =
     if responseId reqId /= id
       then error $ "Expected id " ++ show reqId ++ ", got " ++ show reqId
       else do
-        sendResponse' msg
+        sendResponse msg
         liftIO $ putStrLn $ "Sent response to request id " ++ show id
 
     sendMessages remainingMsgs reqSema rspSema
@@ -130,7 +135,7 @@ listenServer expectedMsgs reqMap reqSema rspSema passVar serverOut  = do
         print msg
         putStrLn "Expected one of:"
         mapM_ print $ takeWhile (not . isNotification) expectedMsgs
-        print $ head $ dropWhile (not . isNotification) expectedMsgs
+        print $ head $ dropWhile isNotification expectedMsgs
         putMVar passVar False
 
   where