Add a rename test that tests for compilation errors

Author: sgillespie

haskell-language-server.cabal

@@ -614,6 +614,7 @@ test-suite hls-rename-plugin-tests
     , hls-test-utils             == 2.7.0.0
     , lens
     , lsp-types
+    , row-types
     , text
 
 -----------------------------

plugins/hls-rename-plugin/test/Main.hs

@@ -1,13 +1,15 @@
+{-# LANGUAGE OverloadedLabels  #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Main (main) where
 
 import           Control.Lens               ((^.))
 import           Data.Aeson
 import qualified Data.Map                   as M
-import           Data.Text                  (Text)
+import           Data.Text                  (Text, pack)
 import           Ide.Plugin.Config
 import qualified Ide.Plugin.Rename          as Rename
+import           Data.Row                   ((.+), (.==))
 import qualified Language.LSP.Protocol.Lens as L
 import           System.FilePath
 import           Test.Hls
@@ -73,6 +75,40 @@ tests = testGroup "Rename"
                 "rename: Invalid Params: No symbol to rename at given position"
                 Nothing
         renameExpectError expectedError doc (Position 0 10) "ImpossibleRename"
+
+    , testCase "fails when module does not compile" $ runRenameSession "" $ do
+        doc <- openDoc "FunctionArgument.hs" "haskell"
+        expectNoMoreDiagnostics 3 doc "typecheck"
+
+        -- Update the document so it doesn't compile
+        let change = TextDocumentContentChangeEvent $ InL $ #range .== Range (Position 2 13) (Position 2 17)
+                                                         .+ #rangeLength .== Nothing
+                                                         .+ #text .== "A"
+        changeDoc doc [change]
+        diags@(tcDiag : _) <- waitForDiagnosticsFrom doc
+
+        -- Make sure there's a typecheck error
+        liftIO $ do
+          length diags @?= 1
+          tcDiag ^. L.range @?= Range (Position 2 13) (Position 2 14)
+          tcDiag ^. L.severity @?= Just DiagnosticSeverity_Error
+          tcDiag ^. L.source @?= Just "typecheck"
+
+        -- Make sure renaming fails
+        renameErr <- expectRenameError doc (Position 3 0) "foo'"
+        liftIO $ do
+          renameErr ^. L.code @?= InL LSPErrorCodes_RequestFailed
+          renameErr ^. L.message @?= "rename: Rule Failed: GetHieAst"
+
+        -- Update the document so it compiles
+        let change' = TextDocumentContentChangeEvent $ InL $ #range .== Range (Position 2 13) (Position 2 14)
+                                                          .+ #rangeLength .== Nothing
+                                                          .+ #text .== "Int"
+        changeDoc doc [change']
+        expectNoMoreDiagnostics 3 doc "typecheck"
+
+        -- Make sure renaming succeeds
+        rename doc (Position 3 0) "foo'"
     ]
 
 goldenWithRename :: TestName-> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree
@@ -90,3 +126,21 @@ renameExpectError expectedError doc pos newName = do
 
 testDataDir :: FilePath
 testDataDir = "plugins" </> "hls-rename-plugin" </> "test" </> "testdata"
+
+-- | Attempts to renames the term at the specified position, expecting a failure
+expectRenameError ::
+  TextDocumentIdentifier ->
+  Position ->
+  String ->
+  Session ResponseError
+expectRenameError doc pos newName = do
+  let params = RenameParams Nothing doc pos (pack newName)
+  rsp <- request SMethod_TextDocumentRename params
+  case rsp ^. L.result of
+    Left err -> pure err
+    Right x -> liftIO $ assertFailure $
+      "Got unexpected successful rename response for " <> show (doc ^. L.uri)
+
+runRenameSession :: FilePath -> Session a -> IO a
+runRenameSession subdir = failIfSessionTimeout
+  . runSessionWithServerAndCaps def renamePlugin codeActionNoResolveCaps (testDataDir </> subdir)