1+ {-# LANGUAGE OverloadedLabels #-}
12{-# LANGUAGE OverloadedStrings #-}
23
34module Main (main ) where
45
6+ import Control.Lens ((^.) )
57import Data.Aeson
6- import qualified Data.Map as M
8+ import qualified Data.Map as M
9+ import Data.Maybe (fromJust )
10+ import Data.Row ((.+) , (.==) )
11+ import qualified Data.Text as T
712import Ide.Plugin.Config
8- import qualified Ide.Plugin.Rename as Rename
9- import Ide.Types (IdePlugins (IdePlugins ))
13+ import qualified Ide.Plugin.Rename as Rename
14+ import Ide.Types (IdePlugins (IdePlugins ))
15+ import qualified Language.LSP.Protocol.Lens as L
1016import System.FilePath
1117import Test.Hls
1218
@@ -65,6 +71,40 @@ tests = testGroup "Rename"
6571 rename doc (Position 2 17 ) " BinaryTree"
6672 , goldenWithRename " Type variable" " TypeVariable" $ \ doc ->
6773 rename doc (Position 0 13 ) " b"
74+
75+ , testCase " fails when module does not compile" $ runRenameSession " " $ do
76+ doc <- openDoc " FunctionArgument.hs" " haskell"
77+ expectNoMoreDiagnostics 3 doc " typecheck"
78+
79+ -- Update the document so it doesn't compile
80+ let change = TextDocumentContentChangeEvent $ InL $ # range .== Range (Position 2 13 ) (Position 2 17 )
81+ .+ # rangeLength .== Nothing
82+ .+ # text .== " A"
83+ changeDoc doc [change]
84+ diags@ (tcDiag : _) <- waitForDiagnosticsFrom doc
85+
86+ -- Make sure there's a typecheck error
87+ liftIO $ do
88+ length diags @?= 1
89+ tcDiag ^. L. range @?= Range (Position 2 13 ) (Position 2 14 )
90+ tcDiag ^. L. severity @?= Just DiagnosticSeverity_Error
91+ tcDiag ^. L. source @?= Just " typecheck"
92+
93+ -- Make sure renaming fails
94+ renameErr <- expectRenameError doc (Position 3 0 ) " foo'"
95+ liftIO $ do
96+ renameErr ^. L. code @?= InL LSPErrorCodes_RequestFailed
97+ renameErr ^. L. message @?= " rename: Rule Failed: GetHieAst"
98+
99+ -- Update the document so it compiles
100+ let change' = TextDocumentContentChangeEvent $ InL $ # range .== Range (Position 2 13 ) (Position 2 14 )
101+ .+ # rangeLength .== Nothing
102+ .+ # text .== " Int"
103+ changeDoc doc [change']
104+ expectNoMoreDiagnostics 3 doc " typecheck"
105+
106+ -- Make sure renaming succeeds
107+ rename doc (Position 3 0 ) " foo'"
68108 ]
69109
70110goldenWithRename :: TestName -> FilePath -> (TextDocumentIdentifier -> Session () ) -> TestTree
@@ -73,3 +113,21 @@ goldenWithRename title path act =
73113
74114testDataDir :: FilePath
75115testDataDir = " test" </> " testdata"
116+
117+ -- | Attempts to renames the term at the specified position, expecting a failure
118+ expectRenameError ::
119+ TextDocumentIdentifier ->
120+ Position ->
121+ String ->
122+ Session ResponseError
123+ expectRenameError doc pos newName = do
124+ let params = RenameParams Nothing doc pos (T. pack newName)
125+ rsp <- request SMethod_TextDocumentRename params
126+ case rsp ^. L. result of
127+ Left err -> pure err
128+ Right x -> liftIO $ assertFailure $
129+ " Got unexpected successful rename response for " <> show (doc ^. L. uri)
130+
131+ runRenameSession :: FilePath -> Session a -> IO a
132+ runRenameSession subdir = failIfSessionTimeout
133+ . runSessionWithServerAndCaps def renamePlugin codeActionNoResolveCaps (testDataDir </> subdir)
0 commit comments