X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest%2FReplay.hs;h=73151d75cd8711a0107c65cadff95483014d1d5a;hb=cdb1ba7038c32bac71a3bc783effc1e07049a985;hp=b224be6cbf0132a6e50b6bc0380edd453ac94e2d;hpb=fe5448266f5db772dd3f10be432cd56581bbcb40;p=lsp-test.git diff --git a/src/Language/Haskell/LSP/Test/Replay.hs b/src/Language/Haskell/LSP/Test/Replay.hs index b224be6..73151d7 100644 --- a/src/Language/Haskell/LSP/Test/Replay.hs +++ b/src/Language/Haskell/LSP/Test/Replay.hs @@ -25,6 +25,7 @@ import Language.Haskell.LSP.Test.Files import Language.Haskell.LSP.Test.Decoding import Language.Haskell.LSP.Test.Messages import Language.Haskell.LSP.Test.Server +import Language.Haskell.LSP.Test.Session -- | Replays a captured client output and @@ -61,6 +62,7 @@ replaySession serverExe sessionDir = do serverOut (listenServer serverMsgs requestMap reqSema rspSema passSema mainThread) def + fullCaps sessionDir (sendMessages clientMsgs reqSema rspSema) takeMVar passSema @@ -145,7 +147,7 @@ listenServer expectedMsgs reqMap reqSema rspSema passSema mainThreadId serverOut then listenServer (delete msg expectedMsgs) reqMap reqSema rspSema passSema mainThreadId serverOut ctx else let remainingMsgs = takeWhile (not . isNotification) expectedMsgs ++ [head $ dropWhile isNotification expectedMsgs] - exc = ReplayOutOfOrderException msg remainingMsgs + exc = ReplayOutOfOrder msg remainingMsgs in liftIO $ throwTo mainThreadId exc where