X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=test%2FTest.hs;h=73a7b45431a41f0974977e759c3b477f86e68060;hb=fa0bdbf2ca975ea2493d0fcfaa6cb63c076567c1;hp=08c21be300e45fc9b87e766750399fc8b62d5329;hpb=e0926c045ccd5444f3112cb231cc3590c600d48d;p=lsp-test.git diff --git a/test/Test.hs b/test/Test.hs index 08c21be..73a7b45 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -18,8 +18,10 @@ import GHC.Generics import Language.Haskell.LSP.Messages import Language.Haskell.LSP.Test import Language.Haskell.LSP.Test.Replay -import Language.Haskell.LSP.Types.Capabilities -import Language.Haskell.LSP.Types as LSP hiding (capabilities, message) +import Language.Haskell.LSP.Types +import Language.Haskell.LSP.Types.Lens as LSP hiding + (capabilities, message, rename, applyEdit) +import Language.Haskell.LSP.Types.Capabilities as LSP import System.Timeout {-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} @@ -113,15 +115,16 @@ main = hspec $ do selector _ = False sesh = do doc <- openDoc "Desktop/simple.hs" "haskell" - sendRequest' TextDocumentDocumentSymbol (DocumentSymbolParams doc) + sendRequest TextDocumentDocumentSymbol (DocumentSymbolParams doc) skipMany anyNotification message :: Session RenameResponse -- the wrong type in runSession "hie --lsp" fullCaps "test/data/renamePass" sesh `shouldThrow` selector - describe "replaySession" $ do - it "passes a test" $ - replaySession "hie --lsp" "test/data/renamePass" + describe "replaySession" $ + -- This is too fickle at the moment + -- it "passes a test" $ + -- replaySession "hie --lsp" "test/data/renamePass" it "fails a test" $ let selector (ReplayOutOfOrder _ _) = True selector _ = False @@ -134,7 +137,7 @@ main = hspec $ do noDiagnostics - (fooSymbol:_) <- getDocumentSymbols doc + Right (fooSymbol:_) <- getDocumentSymbols doc liftIO $ do fooSymbol ^. name `shouldBe` "foo" @@ -149,7 +152,7 @@ main = hspec $ do (Position 1 14) "Redundant bracket" reqParams = ExecuteCommandParams "applyrefact:applyOne" (Just (List [args])) - sendRequest_ WorkspaceExecuteCommand reqParams + request_ WorkspaceExecuteCommand reqParams editReq <- message :: Session ApplyWorkspaceEditRequest liftIO $ do @@ -172,18 +175,25 @@ main = hspec $ do (Position 1 14) "Redundant bracket" reqParams = ExecuteCommandParams "applyrefact:applyOne" (Just (List [args])) - sendRequest_ WorkspaceExecuteCommand reqParams + request_ WorkspaceExecuteCommand reqParams contents <- getDocumentEdit doc liftIO $ contents `shouldBe` "main :: IO Int\nmain = return 42\n" noDiagnostics + describe "getCodeActions" $ + it "works" $ runSession "hie" fullCaps "test/data/refactor" $ do + doc <- openDoc "Main.hs" "haskell" + waitForDiagnostics + [CACodeAction action] <- getCodeActions doc (Range (Position 1 14) (Position 1 18)) + liftIO $ action ^. title `shouldBe` "Apply hint:Redundant bracket" + describe "getAllCodeActions" $ it "works" $ runSession "hie --lsp" fullCaps "test/data/refactor" $ do doc <- openDoc "Main.hs" "haskell" _ <- waitForDiagnostics actions <- getAllCodeActions doc liftIO $ do - let [CommandOrCodeActionCodeAction action] = actions + let [CACodeAction action] = actions action ^. title `shouldBe` "Apply hint:Redundant bracket" action ^. command . _Just . command `shouldSatisfy` T.isSuffixOf ":applyrefact:applyOne" @@ -195,13 +205,12 @@ main = hspec $ do noDiagnostics - (mainSymbol:_) <- getDocumentSymbols doc + Left (mainSymbol:_) <- getDocumentSymbols doc liftIO $ do mainSymbol ^. name `shouldBe` "main" mainSymbol ^. kind `shouldBe` SkFunction - mainSymbol ^. location . range `shouldBe` Range (Position 3 0) (Position 3 4) - mainSymbol ^. containerName `shouldBe` Nothing + mainSymbol ^. range `shouldBe` Range (Position 3 0) (Position 5 30) describe "applyEdit" $ do it "increments the version" $ runSession "hie --lsp" docChangesCaps "test/data/renamePass" $ do