Hide some internals

[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 b224be6cbf0132a6e50b6bc0380edd453ac94e2d..6c049d0b56272fd9ff7ff7992ef02370cccdbaa7 100644 (file)
--- 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
@@ -82,12 +84,12 @@ sendMessages (nextMsg:remainingMsgs) reqSema rspSema =
   notification msg@(NotificationMessage _ Exit _) = do
     liftIO $ putStrLn "Will send exit notification soon"
     liftIO $ threadDelay 10000000
-    sendNotification' msg
+    sendMessage msg
 
     liftIO $ error "Done"
 
   notification msg@(NotificationMessage _ m _) = do
-    sendNotification' msg
+    sendMessage msg
 
     liftIO $ putStrLn $ "Sent a notification " ++ show m
 
@@ -114,6 +116,15 @@ sendMessages (nextMsg:remainingMsgs) reqSema rspSema =
 
     sendMessages remainingMsgs reqSema rspSema
 
+sendRequestMessage :: (ToJSON a, ToJSON b) => RequestMessage ClientMethod a b -> Session ()
+sendRequestMessage req = do
+  -- Update the request map
+  reqMap <- requestMap <$> ask
+  liftIO $ modifyMVar_ reqMap $
+    \r -> return $ updateRequestMap r (req ^. LSP.id) (req ^. method)
+
+  sendMessage req
+
 
 isNotification :: FromServerMessage -> Bool
 isNotification (NotPublishDiagnostics      _) = True
@@ -145,7 +156,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