From 1f39d55cc3fb2e840a115c12d7da3935b9529361 Mon Sep 17 00:00:00 2001
From: Luke Lau <luke_lau@icloud.com>
Date: Fri, 15 Jun 2018 01:08:49 -0400
Subject: [PATCH] Add test for document change tracking

---
 haskell-lsp-test.cabal                  |  2 ++
 src/Language/Haskell/LSP/Test.hs        |  1 -
 src/Language/Haskell/LSP/Test/Server.hs |  5 ++--
 test/Test.hs                            | 33 +++++++++++++++++++++++++
 test/data/refactor/Main.hs              |  2 ++
 5 files changed, 40 insertions(+), 3 deletions(-)
 create mode 100644 test/data/refactor/Main.hs

diff --git a/haskell-lsp-test.cabal b/haskell-lsp-test.cabal
index 0c12d5e..9fb63a3 100644
--- a/haskell-lsp-test.cabal
+++ b/haskell-lsp-test.cabal
@@ -61,6 +61,8 @@ test-suite tests
                      , haskell-lsp
                      , conduit
                      , conduit-parse
+                     , aeson
+                     , unordered-containers
   other-modules:       ParsingTests
   default-language:    Haskell2010
 
diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs
index 4f82498..047e35b 100644
--- a/src/Language/Haskell/LSP/Test.hs
+++ b/src/Language/Haskell/LSP/Test.hs
@@ -157,7 +157,6 @@ processTextChanges (ReqApplyWorkspaceEdit r) = do
               params = DidChangeTextDocumentParams docId (List changeEvents)
           newVFS <- liftIO $ changeVFS oldVFS (fmClientDidChangeTextDocumentNotification params)
           modify (\s -> s { vfs = newVFS })
-          liftIO $ print newVFS
           return params
 
         applyTextEdit uri edits = applyTextDocumentEdit (TextDocumentEdit (VersionedTextDocumentIdentifier uri 0) edits)
diff --git a/src/Language/Haskell/LSP/Test/Server.hs b/src/Language/Haskell/LSP/Test/Server.hs
index 65011fd..8159bef 100644
--- a/src/Language/Haskell/LSP/Test/Server.hs
+++ b/src/Language/Haskell/LSP/Test/Server.hs
@@ -1,4 +1,4 @@
-module Language.Haskell.LSP.Test.Server where
+module Language.Haskell.LSP.Test.Server (withServer) where
 
 import Control.Concurrent
 import Control.Monad
@@ -8,7 +8,8 @@ import System.Process
 
 withServer :: String -> (Handle -> Handle -> Int -> IO a) -> IO a
 withServer serverExe f = do
-  let createProc = (shell serverExe) { std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe }
+  let cmd:args = words serverExe
+      createProc = (proc cmd args) { std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe }
   (Just serverIn, Just serverOut, Just serverErr, serverProc) <- createProcess createProc
 
   -- Need to continuously consume to stderr else it gets blocked
diff --git a/test/Test.hs b/test/Test.hs
index ce8a357..8f71533 100644
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -1,9 +1,14 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveAnyClass #-}
 import           Test.Hspec
+import           Data.Aeson
+import qualified Data.HashMap.Strict as HM
 import           Data.Maybe
 import           Control.Monad.IO.Class
 import           Control.Lens hiding (List)
+import           GHC.Generics
 import           Language.Haskell.LSP.Test
 import           Language.Haskell.LSP.Test.Replay
 import           Language.Haskell.LSP.Types
@@ -61,8 +66,36 @@ main = hspec $ do
           fooSymbol ^. name `shouldBe` "foo"
           fooSymbol ^. kind `shouldBe` SkFunction
 
+  describe "text document state" $
+    it "sends back didChange notifications" $
+      runSession "hie --lsp" "test/data/refactor" $ do
+        doc <- openDoc "Main.hs" "haskell"
+
+        let args = toJSON $ AOP (doc ^. uri)
+                                (Position 1 14)
+                                "Redundant bracket"
+            reqParams = ExecuteCommandParams "applyrefact:applyOne" (Just (List [args]))
+        sendRequest WorkspaceExecuteCommand reqParams
+        skipMany anyNotification
+        _ <- response :: Session ExecuteCommandResponse
+
+        editReq <- request :: Session ApplyWorkspaceEditRequest
+        liftIO $ do
+          let (Just cs) = editReq ^. params . edit . changes
+              [(u, List es)] = HM.toList cs
+          u `shouldBe` doc ^. uri
+          es `shouldBe` [TextEdit (Range (Position 1 0) (Position 1 18)) "main = return 42"]
+
+        checkNoDiagnostics
+
   parsingSpec
 
+data ApplyOneParams = AOP
+  { file      :: Uri
+  , start_pos :: Position
+  , hintTitle :: String
+  } deriving (Generic, ToJSON)
+
 checkNoDiagnostics :: Session ()
 checkNoDiagnostics = do
   diagsNot <- notification :: Session PublishDiagnosticsNotification
diff --git a/test/data/refactor/Main.hs b/test/data/refactor/Main.hs
new file mode 100644
index 0000000..625e3b8
--- /dev/null
+++ b/test/data/refactor/Main.hs
@@ -0,0 +1,2 @@
+main :: IO Int
+main = return (42)
\ No newline at end of file
-- 
2.30.2