X-Git-Url: https://git.lukelau.me/?a=blobdiff_plain;f=test%2FTest.hs;h=eb0eef0f269493d3fe3e1b95d0fc4d1210f9fffd;hb=2ba261a93d4d1aebb3f749d65e7ad038fe1fb8ce;hp=cdcdf5d37d5c5fedf093b0d638b20e4f25ff5d29;hpb=66d495a95570769fcdd8d65b0e634aaa6a77131b;p=lsp-test.git diff --git a/test/Test.hs b/test/Test.hs index cdcdf5d..eb0eef0 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -91,7 +91,9 @@ main = hspec $ do getDocumentSymbols doc -- should now timeout skipManyTill anyMessage message :: Session ApplyWorkspaceEditRequest - in sesh `shouldThrow` (== Timeout) + isTimeout (Timeout _) = True + isTimeout _ = False + in sesh `shouldThrow` isTimeout describe "SessionException" $ do @@ -104,7 +106,7 @@ main = hspec $ do it "don't throw when no time out" $ runSessionWithConfig (def {messageTimeout = 5}) "hie" fullCaps "test/data/renamePass" $ do loggingNotification - liftIO $ threadDelay 10 + liftIO $ threadDelay $ 10 * 1000000 _ <- openDoc "Desktop/simple.hs" "haskell" return () @@ -118,7 +120,7 @@ main = hspec $ do selector _ = False sesh = do doc <- openDoc "Desktop/simple.hs" "haskell" - sendRequest TextDocumentDocumentSymbol (DocumentSymbolParams doc) + sendRequest TextDocumentDocumentSymbol (DocumentSymbolParams doc Nothing) skipMany anyNotification message :: Session RenameResponse -- the wrong type in runSession "hie" fullCaps "test/data/renamePass" sesh @@ -154,7 +156,7 @@ main = hspec $ do let args = toJSON $ AOP (doc ^. uri) (Position 1 14) "Redundant bracket" - reqParams = ExecuteCommandParams "applyrefact:applyOne" (Just (List [args])) + reqParams = ExecuteCommandParams "applyrefact:applyOne" (Just (List [args])) Nothing request_ WorkspaceExecuteCommand reqParams editReq <- message :: Session ApplyWorkspaceEditRequest @@ -177,7 +179,7 @@ main = hspec $ do let args = toJSON $ AOP (doc ^. uri) (Position 1 14) "Redundant bracket" - reqParams = ExecuteCommandParams "applyrefact:applyOne" (Just (List [args])) + reqParams = ExecuteCommandParams "applyrefact:applyOne" (Just (List [args])) Nothing request_ WorkspaceExecuteCommand reqParams contents <- getDocumentEdit doc liftIO $ contents `shouldBe` "main :: IO Int\nmain = return 42\n" @@ -238,7 +240,8 @@ main = hspec $ do noDiagnostics noDiagnostics - item:_ <- getCompletions doc (Position 5 5) + comps <- getCompletions doc (Position 5 5) + let item = head (filter (\x -> x ^. label == "interactWithUser") comps) liftIO $ do item ^. label `shouldBe` "interactWithUser" item ^. kind `shouldBe` Just CiFunction @@ -273,16 +276,23 @@ main = hspec $ do describe "waitForDiagnosticsSource" $ it "works" $ runSession "hie" fullCaps "test/data" $ do openDoc "Error.hs" "haskell" - [diag] <- waitForDiagnosticsSource "ghcmod" + [diag] <- waitForDiagnosticsSource "bios" liftIO $ do diag ^. severity `shouldBe` Just DsError - diag ^. source `shouldBe` Just "ghcmod" + diag ^. source `shouldBe` Just "bios" - describe "rename" $ - it "works" $ runSession "hie" fullCaps "test/data" $ do - doc <- openDoc "Rename.hs" "haskell" - rename doc (Position 1 0) "bar" - documentContents doc >>= liftIO . shouldBe "main = bar\nbar = return 42\n" + describe "rename" $ do + it "works" $ pendingWith "HaRe not in hie-bios yet" + it "works on javascript" $ + runSession "javascript-typescript-stdio" fullCaps "test/data/javascriptPass" $ do + doc <- openDoc "test.js" "javascript" + rename doc (Position 2 11) "bar" + documentContents doc >>= liftIO . (`shouldContain` "function bar()") . T.unpack + + -- runSession "hie" fullCaps "test/data" $ do + -- doc <- openDoc "Rename.hs" "haskell" + -- rename doc (Position 1 0) "bar" + -- documentContents doc >>= liftIO . shouldBe "main = bar\nbar = return 42\n" describe "getHover" $ it "works" $ runSession "hie" fullCaps "test/data/renamePass" $ do @@ -330,6 +340,12 @@ main = hspec $ do pred _ = False void $ satisfy pred + describe "ignoreLogNotifications" $ + it "works" $ + runSessionWithConfig (defaultConfig { ignoreLogNotifications = True }) "hie" fullCaps "test/data" $ do + openDoc "Format.hs" "haskell" + void publishDiagnosticsNotification + mkRange sl sc el ec = Range (Position sl sc) (Position el ec) didChangeCaps :: ClientCapabilities