X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest%2FReplay.hs;h=68e6b1ba56424fe4f846fb111b3130717fe6ba4f;hb=269f303e5e44fba835c51eacfca622c488a06b9f;hp=ad26858ee39632d4a5e8260a83576ef0a65a93b6;hpb=bd6901688e6c9d8332fea161260d32666885f9ed;p=lsp-test.git diff --git a/src/Language/Haskell/LSP/Test/Replay.hs b/src/Language/Haskell/LSP/Test/Replay.hs index ad26858..68e6b1b 100644 --- a/src/Language/Haskell/LSP/Test/Replay.hs +++ b/src/Language/Haskell/LSP/Test/Replay.hs @@ -42,7 +42,7 @@ replaySession serverExe sessionDir = do -- decode session let unswappedEvents = map (fromJust . decode) entries - withServer serverExe $ \serverIn serverOut pid -> do + withServer serverExe False $ \serverIn serverOut pid -> do events <- swapCommands pid <$> swapFiles sessionDir unswappedEvents @@ -136,9 +136,9 @@ listenServer expectedMsgs reqMap reqSema rspSema passSema mainThreadId serverOut then listenServer expectedMsgs reqMap reqSema rspSema passSema mainThreadId serverOut else if inRightOrder msg expectedMsgs then listenServer (delete msg expectedMsgs) reqMap reqSema rspSema passSema mainThreadId serverOut - else let expectedMsgs = takeWhile (not . isNotification) expectedMsgs + else let remainingMsgs = takeWhile (not . isNotification) expectedMsgs ++ [head $ dropWhile isNotification expectedMsgs] - exc = ReplayOutOfOrderException msg expectedMsgs + exc = ReplayOutOfOrderException msg remainingMsgs in liftIO $ throwTo mainThreadId exc where