From 7cef3a40e4774016c464d43b2a79c2bd6ef084d3 Mon Sep 17 00:00:00 2001
From: Zubin Duggal <zubin@cmi.ac.in>
Date: Wed, 10 Feb 2021 01:30:07 +0530
Subject: [PATCH] Move responses to updateStateC

---
 src/Language/LSP/Test/Parsing.hs |  4 ++--
 src/Language/LSP/Test/Session.hs | 13 +++++++++----
 2 files changed, 11 insertions(+), 6 deletions(-)

diff --git a/src/Language/LSP/Test/Parsing.hs b/src/Language/LSP/Test/Parsing.hs
index ecf8e45..e55909f 100644
--- a/src/Language/LSP/Test/Parsing.hs
+++ b/src/Language/LSP/Test/Parsing.hs
@@ -110,7 +110,7 @@ named s (Session x) = Session (Data.Conduit.Parser.named s x)
 
 -- | Matches a request or a notification coming from the server.
 message :: SServerMethod m -> Session (ServerMessage m)
-message m1 = named (T.pack $ show m1) $ satisfyMaybe $ \case
+message m1 = named (T.pack $ "Request for: " <> show m1) $ satisfyMaybe $ \case
   FromServerMess m2 msg -> do
     HRefl <- mEqServer m1 m2
     pure msg
@@ -161,7 +161,7 @@ anyResponse = named "Any response" $ satisfy $ \case
 
 -- | Matches a response coming from the server.
 response :: SMethod (m :: Method FromClient Request) -> Session (ResponseMessage m)
-response m1 = named (T.pack $ show m1) $ satisfyMaybe $ \case
+response m1 = named (T.pack $ "Response for: " <> show m1) $ satisfyMaybe $ \case
   FromServerRsp m2 msg -> do
     HRefl <- mEqClient m1 m2
     pure msg
diff --git a/src/Language/LSP/Test/Session.hs b/src/Language/LSP/Test/Session.hs
index 4b3ce84..55055cd 100644
--- a/src/Language/LSP/Test/Session.hs
+++ b/src/Language/LSP/Test/Session.hs
@@ -297,7 +297,16 @@ runSession' serverIn serverOut mServerProc serverHandler config caps rootDir exi
 updateStateC :: ConduitM FromServerMessage FromServerMessage (StateT SessionState (ReaderT SessionContext IO)) ()
 updateStateC = awaitForever $ \msg -> do
   updateState msg
+  respond msg
   yield msg
+  where
+    respond :: (MonadIO m, HasReader SessionContext m) => FromServerMessage -> m ()
+    respond (FromServerMess SWindowWorkDoneProgressCreate req) =
+      sendMessage $ ResponseMessage "2.0" (Just $ req ^. LSP.id) (Right ())
+    respond (FromServerMess SWorkspaceApplyEdit r) = do
+      sendMessage $ ResponseMessage "2.0" (Just $ r ^. LSP.id) (Right $ ApplyWorkspaceEditResponseBody True Nothing)
+    respond _ = pure ()
+
 
 -- extract Uri out from DocumentChange
 -- didn't put this in `lsp-types` because TH was getting in the way
@@ -309,8 +318,6 @@ documentChangeUri (InR (InR (InR x))) = x ^. uri
 
 updateState :: (MonadIO m, HasReader SessionContext m, HasState SessionState m)
             => FromServerMessage -> m ()
-updateState (FromServerMess SWindowWorkDoneProgressCreate req) =
-  sendMessage $ ResponseMessage "2.0" (Just $ req ^. LSP.id) (Right ())
 updateState (FromServerMess SProgress req) = case req ^. params . value of
   Begin _ ->
     modify $ \s -> s { curProgressSessions = Set.insert (req ^. params . token) $ curProgressSessions s }
@@ -362,8 +369,6 @@ updateState (FromServerMess SWorkspaceApplyEdit r) = do
   -- TODO: Don't do this when replaying a session
   forM_ mergedParams (sendMessage . NotificationMessage "2.0" STextDocumentDidChange)
 
-  sendMessage $ ResponseMessage "2.0" (Just $ r ^. LSP.id) (Right $ ApplyWorkspaceEditResponseBody True Nothing)
-
   -- Update VFS to new document versions
   let sortedVersions = map (sortBy (compare `on` (^. textDocument . version))) groupedParams
       latestVersions = map ((^. textDocument) . last) sortedVersions
-- 
2.30.2