From ea87bf94ca92b6de74505ba8df208ad3e2110de5 Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Wed, 6 May 2020 16:16:43 +0100 Subject: [PATCH] Add back some more tests --- test/Test.hs | 57 +++++++++++++++++++-------------------- test/dummy-server/Main.hs | 10 ++++--- 2 files changed, 33 insertions(+), 34 deletions(-) diff --git a/test/Test.hs b/test/Test.hs index 4cffda3..6c153a9 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -15,7 +15,6 @@ import Control.Concurrent import Control.Monad.IO.Class 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.Replay @@ -178,12 +177,12 @@ main = findServer >>= \serverExe -> hspec $ do contents <- getDocumentEdit doc liftIO $ contents `shouldBe` "howdy:: IO Int\nmain = return (42)\n" - -- describe "getCodeActions" $ - -- it "works" $ runSession serverExe fullCaps "test/data/refactor" $ do - -- doc <- openDoc "Main.hs" "haskell" - -- waitForDiagnostics - -- [CACodeAction action] <- getCodeActions doc (Range (Position 1 14) (Position 1 18)) - -- liftIO $ action ^. title `shouldBe` "Apply hint:Redundant bracket" + describe "getCodeActions" $ + it "works" $ runSession serverExe fullCaps "test/data/refactor" $ do + doc <- openDoc "Main.hs" "haskell" + waitForDiagnostics + [CACodeAction action] <- getCodeActions doc (Range (Position 1 14) (Position 1 18)) + liftIO $ action ^. title `shouldBe` "Delete this" describe "getAllCodeActions" $ it "works" $ runSession serverExe fullCaps "test/data/refactor" $ do @@ -195,20 +194,18 @@ main = findServer >>= \serverExe -> hspec $ do action ^. title `shouldBe` "Delete this" action ^. command . _Just . command `shouldBe` "deleteThis" - -- describe "getDocumentSymbols" $ - -- it "works" $ runSession serverExe fullCaps "test/data/renamePass" $ do - -- doc <- openDoc "Desktop/simple.hs" "haskell" - - -- skipMany loggingNotification + describe "getDocumentSymbols" $ + it "works" $ runSession serverExe fullCaps "test/data/renamePass" $ do + doc <- openDoc "Desktop/simple.hs" "haskell" - -- noDiagnostics + skipMany loggingNotification - -- Left (mainSymbol:_) <- getDocumentSymbols doc + Left (mainSymbol:_) <- getDocumentSymbols doc - -- liftIO $ do - -- mainSymbol ^. name `shouldBe` "main" - -- mainSymbol ^. kind `shouldBe` SkFunction - -- mainSymbol ^. range `shouldBe` Range (Position 3 0) (Position 5 30) + liftIO $ do + mainSymbol ^. name `shouldBe` "foo" + mainSymbol ^. kind `shouldBe` SkObject + mainSymbol ^. range `shouldBe` mkRange 0 0 3 6 describe "applyEdit" $ do it "increments the version" $ runSession serverExe docChangesCaps "test/data/renamePass" $ do @@ -266,13 +263,13 @@ main = findServer >>= \serverExe -> hspec $ do -- defs <- getTypeDefinitions doc pos -- liftIO $ defs `shouldBe` [Location (doc ^. uri) (mkRange 10 0 14 19)] -- Type definition - -- describe "waitForDiagnosticsSource" $ - -- it "works" $ runSession serverExe fullCaps "test/data" $ do - -- openDoc "Error.hs" "haskell" - -- [diag] <- waitForDiagnosticsSource "bios" - -- liftIO $ do - -- diag ^. severity `shouldBe` Just DsError - -- diag ^. source `shouldBe` Just "bios" + describe "waitForDiagnosticsSource" $ + it "works" $ runSession serverExe fullCaps "test/data" $ do + openDoc "Error.hs" "haskell" + [diag] <- waitForDiagnosticsSource "dummy-server" + liftIO $ do + diag ^. severity `shouldBe` Just DsWarning + diag ^. source `shouldBe` Just "dummy-server" -- describe "rename" $ do -- it "works" $ pendingWith "HaRe not in hie-bios yet" @@ -282,11 +279,11 @@ main = findServer >>= \serverExe -> hspec $ do -- rename doc (Position 2 11) "bar" -- documentContents doc >>= liftIO . (`shouldContain` "function bar()") . T.unpack - -- describe "getHover" $ - -- it "works" $ runSession serverExe fullCaps "test/data/renamePass" $ do - -- doc <- openDoc "Desktop/simple.hs" "haskell" - -- hover <- getHover doc (Position 45 9) - -- liftIO $ hover `shouldSatisfy` isJust + describe "getHover" $ + it "works" $ runSession serverExe fullCaps "test/data/renamePass" $ do + doc <- openDoc "Desktop/simple.hs" "haskell" + hover <- getHover doc (Position 45 9) + liftIO $ hover `shouldSatisfy` isJust -- describe "getHighlights" $ -- it "works" $ runSession serverExe fullCaps "test/data/renamePass" $ do diff --git a/test/dummy-server/Main.hs b/test/dummy-server/Main.hs index f67b043..a7e6439 100644 --- a/test/dummy-server/Main.hs +++ b/test/dummy-server/Main.hs @@ -35,8 +35,8 @@ handlers lfvar = def Nothing SkObject Nothing - (Range (Position 0 0) (Position 0 1)) - (Range (Position 0 0) (Position 0 1)) + (mkRange 0 0 3 6) + (mkRange 0 0 3 6) Nothing ] , didOpenTextDocumentNotificationHandler = pure $ \noti -> @@ -44,7 +44,7 @@ handlers lfvar = def threadDelay (2 * 10^6) let NotificationMessage _ _ (DidOpenTextDocumentParams doc) = noti TextDocumentItem uri _ _ _ = doc - diag = Diagnostic (Range (Position 0 0) (Position 0 1)) + diag = Diagnostic (mkRange 0 0 0 1) (Just DsWarning) (Just (NumberValue 42)) (Just "dummy-server") @@ -58,7 +58,7 @@ handlers lfvar = def reqId <- readMVar lfvar >>= getNextReqId let RequestMessage _ _ _ (ExecuteCommandParams "doAnEdit" (Just (List [val])) _) = req Success docUri = fromJSON val - edit = List [TextEdit (Range (Position 0 0) (Position 0 5)) "howdy"] + edit = List [TextEdit (mkRange 0 0 0 5) "howdy"] send $ ReqApplyWorkspaceEdit $ fmServerApplyWorkspaceEditRequest reqId $ ApplyWorkspaceEditParams $ WorkspaceEdit (Just (HM.singleton docUri edit)) Nothing @@ -76,3 +76,5 @@ handlers lfvar = def send $ RspCodeAction $ makeResponseMessage req caresults } where send msg = readMVar lfvar >>= \lf -> (sendFunc lf) msg + +mkRange sl sc el ec = Range (Position sl sc) (Position el ec) \ No newline at end of file -- 2.30.2