Add test for #374

Author: pepeiborra

lsp-test/src/Language/LSP/Test/Session.hs

@@ -425,7 +425,7 @@ updateState (FromServerMess SWorkspaceApplyEdit r) = do
           vers <- textDocumentVersions uri
           pure $ map (\(v, e) -> TextDocumentEdit v (List [InL e])) $ zip vers edits
 
-        getChangeParams uri (List edits) = do 
+        getChangeParams uri (List edits) = do
           map <$> pure getParamsFromTextDocumentEdit <*> textDocumentEdits uri (reverse edits)
 
         mergeParams :: [DidChangeTextDocumentParams] -> DidChangeTextDocumentParams

lsp-test/test/DummyServer.hs

@@ -139,15 +139,33 @@ handlers =
                 do
                   Just token <- runInIO $ asks absRegToken >>= tryReadMVar
                   runInIO $ unregisterCapability token
+      , notificationHandler STextDocumentDidChange $ \noti -> do
+          let NotificationMessage _ _ params = noti
+          void $ sendNotification (SCustomMethod "custom/textDocument/didChange") (toJSON params)
+
      , requestHandler SWorkspaceExecuteCommand $ \req resp -> do
-        let RequestMessage _ _ _ (ExecuteCommandParams Nothing "doAnEdit" (Just (List [val]))) = req
+       case req of
+        RequestMessage _ _ _ (ExecuteCommandParams Nothing "doAnEdit" (Just (List [val]))) -> do
+          let
             Success docUri = fromJSON val
             edit = List [TextEdit (mkRange 0 0 0 5) "howdy"]
             params =
               ApplyWorkspaceEditParams (Just "Howdy edit") $
                 WorkspaceEdit (Just (HM.singleton docUri edit)) Nothing Nothing
-        resp $ Right Null
-        void $ sendRequest SWorkspaceApplyEdit params (const (pure ()))
+          resp $ Right Null
+          void $ sendRequest SWorkspaceApplyEdit params (const (pure ()))
+        RequestMessage _ _ _ (ExecuteCommandParams Nothing "doAVersionedEdit" (Just (List [val]))) -> do
+          let
+            Success versionedDocUri = fromJSON val
+            edit = List [InL (TextEdit (mkRange 0 0 0 5) "howdy")]
+            documentEdit = TextDocumentEdit versionedDocUri edit
+            params =
+              ApplyWorkspaceEditParams (Just "Howdy edit") $
+                WorkspaceEdit Nothing (Just (List [InL documentEdit])) Nothing
+          resp $ Right Null
+          void $ sendRequest SWorkspaceApplyEdit params (const (pure ()))
+        RequestMessage _ _ _ (ExecuteCommandParams _ name _) ->
+          error $ "unsupported command: " <> show name
      , requestHandler STextDocumentCodeAction $ \req resp -> do
         let RequestMessage _ _ _ params = req
             CodeActionParams _ _ _ _ cactx = params

lsp-test/test/Test.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveAnyClass #-}
 
@@ -132,7 +133,37 @@ main = hspec $ around withDummyServer $ do
             in runSessionWithHandles hin hout def fullCaps "." sesh
               `shouldThrow` selector
 
-  describe "text document VFS" $
+  describe "text document VFS" $ do
+    it "sends back didChange notifications (documentChanges)" $ \(hin, hout) ->
+      runSessionWithHandles hin hout def fullCaps "." $ do
+        doc <- openDoc "test/data/refactor/Main.hs" "haskell"
+        VersionedTextDocumentIdentifier _ beforeVersion <- getVersionedDoc doc
+
+        let args = toJSON (VersionedTextDocumentIdentifier (doc ^. uri) beforeVersion)
+            reqParams = ExecuteCommandParams Nothing "doAVersionedEdit" (Just (List [args]))
+
+        request_ SWorkspaceExecuteCommand reqParams
+
+        editReq <- message SWorkspaceApplyEdit
+        liftIO $ do
+          let Just (List [InL(TextDocumentEdit vdoc (List [InL edit_]))]) =
+                editReq ^. params . edit . documentChanges
+          vdoc `shouldBe` VersionedTextDocumentIdentifier  (doc ^. uri) beforeVersion
+          edit_ `shouldBe` TextEdit (Range (Position 0 0) (Position 0 5)) "howdy"
+
+        change <- customNotification "custom/textDocument/didChange"
+        let NotMess (NotificationMessage _ _ (c::Value)) = change
+            Success (DidChangeTextDocumentParams reportedVDoc _edit) = fromJSON c
+            VersionedTextDocumentIdentifier _ reportedVersion = reportedVDoc
+
+        contents <- documentContents doc
+
+        liftIO $ contents `shouldBe` "howdy:: IO Int\nmain = return (42)\n"
+        VersionedTextDocumentIdentifier _ afterVersion <- getVersionedDoc doc
+        liftIO $ afterVersion `shouldNotBe` beforeVersion
+
+        liftIO $ reportedVersion `shouldNotBe` beforeVersion
+
     it "sends back didChange notifications" $ \(hin, hout) ->
       runSessionWithHandles hin hout def fullCaps "." $ do
         doc <- openDoc "test/data/refactor/Main.hs" "haskell"