X-Git-Url: https://git.lukelau.me/?a=blobdiff_plain;f=test%2FTest.hs;h=e38af42cf1b8de77c3ae025100d8cb32d9fb25f5;hb=ddf9bc17ce8a548a927c201c6b0edb8cf1c9fcad;hp=75e16283b49895b6dae4eee1737c7dc92a5acf50;hpb=b00bc722f2bba5276e895cf2c769cf139e4f2ed3;p=lsp-test.git diff --git a/test/Test.hs b/test/Test.hs index 75e1628..e38af42 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -7,6 +7,7 @@ import Test.Hspec import Data.Aeson import Data.Default import qualified Data.HashMap.Strict as HM +import Data.Either import Data.Maybe import qualified Data.Text as T import Control.Applicative.Combinators @@ -37,7 +38,7 @@ main = hspec $ do in session `shouldThrow` anySessionException it "initializeResponse" $ runSession "hie" fullCaps "test/data/renamePass" $ do rsp <- initializeResponse - liftIO $ rsp ^. result `shouldNotBe` Nothing + liftIO $ rsp ^. result `shouldSatisfy` isLeft it "runSessionWithConfig" $ runSession "hie" didChangeCaps "test/data/renamePass" $ return () @@ -91,7 +92,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 @@ -118,7 +121,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 +157,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 +180,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 +241,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 +277,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 +341,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