X-Git-Url: https://git.lukelau.me/?a=blobdiff_plain;f=test%2FTest.hs;h=40c4aab19b0fd8790d3523891af3062d99cd826f;hb=ff565d6a883324c593d394ca43483ed5304ff7bb;hp=380c98b90aedf2c9c498ed3f1539d010edeafc15;hpb=0033204f40889a5ed1736777ffe71d26b7a0d307;p=lsp-test.git diff --git a/test/Test.hs b/test/Test.hs index 380c98b..40c4aab 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, logMessages = True }) + main = hspec $ do describe "Session" $ do it "fails a test" $ @@ -62,8 +64,12 @@ main = hspec $ do it "further timeout messages are ignored" $ runSession "hie" fullCaps "test/data/renamePass" $ do doc <- openDoc "Desktop/simple.hs" "haskell" + -- warm up the cache + getDocumentSymbols doc + -- shouldn't timeout withTimeout 3 $ getDocumentSymbols doc - liftIO $ threadDelay 5000000 + -- longer than the original timeout + liftIO $ threadDelay (5 * 10^6) -- shouldn't throw an exception getDocumentSymbols doc return () @@ -100,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 () @@ -114,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 @@ -150,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 @@ -173,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"