+ it "runSessionWithConfig" $
+ runSessionWithConfig (def { capabilities = didChangeCaps })
+ "hie --lsp" "test/data/renamePass" $ return ()
+
+ describe "withTimeout" $ do
+ it "times out" $
+ let sesh = runSession "hie --lsp" "test/data/renamePass" $ do
+ openDoc "Desktop/simple.hs" "haskell"
+ -- won't receive a request - will timeout
+ -- incoming logging requests shouldn't increase the
+ -- timeout
+ withTimeout 5 $ skipManyTill anyMessage message :: Session ApplyWorkspaceEditRequest
+ -- wait just a bit longer than 5 seconds so we have time
+ -- to open the document
+ in timeout 6000000 sesh `shouldThrow` anySessionException
+
+ it "doesn't time out" $
+ let sesh = runSession "hie --lsp" "test/data/renamePass" $ do
+ openDoc "Desktop/simple.hs" "haskell"
+ withTimeout 5 $ skipManyTill anyMessage publishDiagnosticsNotification
+ in void $ timeout 6000000 sesh
+
+ it "further timeout messages are ignored" $ runSession "hie --lsp" "test/data/renamePass" $ do
+ doc <- openDoc "Desktop/simple.hs" "haskell"
+ withTimeout 3 $ getDocumentSymbols doc
+ liftIO $ threadDelay 5000000
+ -- shouldn't throw an exception
+ getDocumentSymbols doc
+ return ()
+
+ it "overrides global message timeout" $
+ let sesh =
+ runSessionWithConfig (def { messageTimeout = 5 }) "hie --lsp" "test/data/renamePass" $ do
+ doc <- openDoc "Desktop/simple.hs" "haskell"
+ -- shouldn't time out in here since we are overriding it
+ withTimeout 10 $ liftIO $ threadDelay 7000000
+ getDocumentSymbols doc
+ return True
+ in sesh `shouldReturn` True
+
+ it "unoverrides global message timeout" $
+ let sesh =
+ runSessionWithConfig (def { messageTimeout = 5 }) "hie --lsp" "test/data/renamePass" $ do
+ doc <- openDoc "Desktop/simple.hs" "haskell"
+ -- shouldn't time out in here since we are overriding it
+ withTimeout 10 $ liftIO $ threadDelay 7000000
+ getDocumentSymbols doc
+ -- should now timeout
+ skipManyTill anyMessage message :: Session ApplyWorkspaceEditRequest
+ in sesh `shouldThrow` (== Timeout)
+
+
+ describe "SessionException" $ do
+ it "throw on time out" $
+ let sesh = runSessionWithConfig (def {messageTimeout = 10}) "hie --lsp" "test/data/renamePass" $ do
+ skipMany loggingNotification
+ _ <- message :: Session ApplyWorkspaceEditRequest
+ return ()
+ in sesh `shouldThrow` anySessionException
+
+ it "don't throw when no time out" $ runSessionWithConfig (def {messageTimeout = 5}) "hie --lsp" "test/data/renamePass" $ do
+ loggingNotification
+ liftIO $ threadDelay 10
+ _ <- openDoc "Desktop/simple.hs" "haskell"
+ return ()
+
+ describe "UnexpectedMessageException" $ do
+ it "throws when there's an unexpected message" $
+ let selector (UnexpectedMessage "Publish diagnostics notification" (NotLogMessage _)) = True
+ selector _ = False
+ in runSession "hie --lsp" "test/data/renamePass" publishDiagnosticsNotification `shouldThrow` selector
+ it "provides the correct types that were expected and received" $
+ let selector (UnexpectedMessage "ResponseMessage WorkspaceEdit" (RspDocumentSymbols _)) = True
+ selector _ = False
+ sesh = do
+ doc <- openDoc "Desktop/simple.hs" "haskell"
+ sendRequest' TextDocumentDocumentSymbol (DocumentSymbolParams doc)
+ skipMany anyNotification
+ message :: Session RenameResponse -- the wrong type
+ in runSession "hie --lsp" "test/data/renamePass" sesh
+ `shouldThrow` selector
+
+ describe "replaySession" $ do