X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest%2FReplay.hs;h=2d5e4e612284ab6c3329a5aa7c36c548f45a1ef2;hb=a65254a5b7a5312bc616d601737f8595b14279ef;hp=72fb0d6e2541706dee6ec2c7d3a214961918c8c9;hpb=d8ce5332e9ac2dc24bf1490f03bd30abb17196e8;p=opengl.git diff --git a/src/Language/Haskell/LSP/Test/Replay.hs b/src/Language/Haskell/LSP/Test/Replay.hs index 72fb0d6..2d5e4e6 100644 --- a/src/Language/Haskell/LSP/Test/Replay.hs +++ b/src/Language/Haskell/LSP/Test/Replay.hs @@ -50,10 +50,14 @@ replaySession sessionDir = do 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) + sessionDir + (sendMessages clientMsgs reqSema rspSema) - takeMVar passVar + result <- takeMVar passVar + killThread threadId + return result where isClientMsg (FromClient _ _) = True @@ -129,7 +133,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