Add a rename test that tests for compilation errors

Author: sgillespie

plugins/hls-rename-plugin/hls-rename-plugin.cabal

@@ -70,3 +70,7 @@ test-suite tests
     , hls-plugin-api
     , hls-rename-plugin
     , hls-test-utils             == 2.4.0.0
+    , lens
+    , lsp-types
+    , row-types
+    , text

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

@@ -1,12 +1,18 @@
+{-# LANGUAGE OverloadedLabels  #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Main (main) where
 
+import           Control.Lens               ((^.))
 import           Data.Aeson
-import qualified Data.Map          as M
+import qualified Data.Map                   as M
+import           Data.Maybe                 (fromJust)
+import           Data.Row                   ((.+), (.==))
+import qualified Data.Text                  as T
 import           Ide.Plugin.Config
-import qualified Ide.Plugin.Rename as Rename
-import           Ide.Types         (IdePlugins (IdePlugins))
+import qualified Ide.Plugin.Rename          as Rename
+import           Ide.Types                  (IdePlugins (IdePlugins))
+import qualified Language.LSP.Protocol.Lens as L
 import           System.FilePath
 import           Test.Hls
 
@@ -65,6 +71,53 @@ tests = testGroup "Rename"
         rename doc (Position 2 17) "BinaryTree"
     , goldenWithRename "Type variable" "TypeVariable" $ \doc ->
         rename doc (Position 0 13) "b"
+
+    , testCase "fails when module does not compile" $ runRenameSession "" $ do
+        doc <- openDoc "CompileError.hs" "haskell"
+        diags@(tcDiag : _) <- waitForDiagnosticsFrom doc
+
+        -- Make sure there's a typecheck error
+        liftIO $ do
+          length diags @?= 1
+          tcDiag ^. L.range @?= Range (Position 2 7) (Position 2 8)
+          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 7) (Position 2 8)
+                                                         .+ #rangeLength .== Nothing
+                                                         .+ #text .== "Int"
+        changeDoc doc [change]
+        expectNoMoreDiagnostics 3 doc "typecheck"
+
+        -- Make sure renaming succeeds
+        rename doc (Position 3 0) "foo'"
+
+        -- Update it again so it doesn't compile
+        let change' = TextDocumentContentChangeEvent $ InL $ #range .== Range (Position 2 7) (Position 2 11)
+                                                          .+ #rangeLength .== Nothing
+                                                          .+ #text .== "A"
+        changeDoc doc [change']
+
+        -- Make sure there's a compiler error again
+        diags'@(tcDiag' : _) <- waitForDiagnosticsFrom doc
+        liftIO $ do
+          length diags' @?= 1
+          tcDiag' ^. L.range @?= Range (Position 2 7) (Position 2 8)
+          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"
     ]
 
 goldenWithRename :: TestName-> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree
@@ -73,3 +126,21 @@ goldenWithRename title path act =
 
 testDataDir :: FilePath
 testDataDir = "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 (T.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)

plugins/hls-rename-plugin/test/testdata/CompileError.hs

@@ -0,0 +1,4 @@
+module CompilerError () where
+
+foo :: T
+foo = 0