X-Git-Url: https://git.lukelau.me/?a=blobdiff_plain;f=test%2FTest.hs;h=22f8e21996df80c4b9e9a81b95d07edbab5e72d3;hb=803c622b2a390a310584d9f8170c9ec1c8ea67db;hp=81b5c7b131707c6180fb3ab5c2d39327409ea86b;hpb=5fed47500d838f468dbb26eaf96e67afcfa5f05e;p=lsp-test.git diff --git a/test/Test.hs b/test/Test.hs index 81b5c7b..22f8e21 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -16,7 +16,7 @@ import Control.Monad import Control.Lens hiding (List) import GHC.Generics import Language.Haskell.LSP.Messages -import Language.Haskell.LSP.Test +import Language.Haskell.LSP.Test hiding (runSession) import Language.Haskell.LSP.Test.Replay import Language.Haskell.LSP.Types import Language.Haskell.LSP.Types.Lens as LSP hiding @@ -27,6 +27,8 @@ import System.Timeout {-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} {-# ANN module ("HLint: ignore Unnecessary hiding" :: String) #-} +runSession = runSessionWithConfig (defaultConfig { logStdErr = True }) + main = hspec $ do describe "Session" $ do it "fails a test" $ @@ -44,7 +46,7 @@ main = hspec $ do describe "withTimeout" $ do it "times out" $ - let sesh = runSession "hie" fullCaps "test/data/renamePass" $ do + let sesh = runSession "hie -d --bios-verbose" fullCaps "test/data/renamePass" $ do openDoc "Desktop/simple.hs" "haskell" -- won't receive a request - will timeout -- incoming logging requests shouldn't increase the @@ -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,10 +276,10 @@ 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 @@ -284,18 +287,6 @@ main = hspec $ do rename doc (Position 1 0) "bar" documentContents doc >>= liftIO . shouldBe "main = bar\nbar = return 42\n" - describe "rename suggestion" $ - it "works" $ runSession "hie" fullCaps "test/data" $ do - doc <- openDoc "RenameSuggestion.hs" "haskell" - - _ <- waitForDiagnosticsSource "ghcmod" - - CACodeAction cmd:_ <- getAllCodeActions doc - executeCodeAction cmd - - x:_ <- T.lines <$> documentContents doc - liftIO $ x `shouldBe` "main = putStrLn \"hello\"" - describe "getHover" $ it "works" $ runSession "hie" fullCaps "test/data/renamePass" $ do doc <- openDoc "Desktop/simple.hs" "haskell"