X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest%2FReplay.hs;h=b2d54a39de2b0c561cfad93ccffed9e29d814d73;hb=fa0bdbf2ca975ea2493d0fcfaa6cb63c076567c1;hp=23e6137637d2b7ac7434a2ea1b7ee932b3c2ae58;hpb=e0926c045ccd5444f3112cb231cc3590c600d48d;p=opengl.git

diff --git a/src/Language/Haskell/LSP/Test/Replay.hs b/src/Language/Haskell/LSP/Test/Replay.hs
index 23e6137..b2d54a3 100644
--- a/src/Language/Haskell/LSP/Test/Replay.hs
+++ b/src/Language/Haskell/LSP/Test/Replay.hs
@@ -12,7 +12,8 @@ import qualified Data.ByteString.Lazy.Char8    as B
 import qualified Data.Text                     as T
 import           Language.Haskell.LSP.Capture
 import           Language.Haskell.LSP.Messages
-import           Language.Haskell.LSP.Types as LSP hiding (error)
+import           Language.Haskell.LSP.Types 
+import           Language.Haskell.LSP.Types.Lens as LSP hiding (error)
 import           Data.Aeson
 import           Data.Default
 import           Data.List
@@ -20,12 +21,13 @@ import           Data.Maybe
 import           Control.Lens hiding (List)
 import           Control.Monad
 import           System.FilePath
+import           System.IO
 import           Language.Haskell.LSP.Test
 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 
 -- makes sure it matches up with an expected response.
@@ -83,12 +85,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
 
@@ -115,6 +117,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
@@ -123,15 +134,15 @@ isNotification (NotShowMessage             _) = True
 isNotification (NotCancelRequestFromServer _) = True
 isNotification _                              = False
 
--- listenServer :: [FromServerMessage]
---              -> RequestMap
---              -> MVar LspId
---              -> MVar LspIdRsp
---              -> MVar ()
---              -> ThreadId
---              -> Handle
---              -> SessionContext
---              -> IO ()
+listenServer :: [FromServerMessage]
+             -> RequestMap
+             -> MVar LspId
+             -> MVar LspIdRsp
+             -> MVar ()
+             -> ThreadId
+             -> Handle
+             -> SessionContext
+             -> IO ()
 listenServer [] _ _ _ passSema _ _ _ = putMVar passSema ()
 listenServer expectedMsgs reqMap reqSema rspSema passSema mainThreadId serverOut ctx = do