Add back some more tests

diff --git a/test/Test.hs b/test/Test.hs
index 4cffda347f150c4de7a9ba6e9797dfa4c1fa196f..6c153a935c99266ddb8c79f0aa3034a168483a95 100644 (file)
--- 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 f67b043a2f213fb873650b0d2e814e614c82d818..a7e6439078ead5af4db0275c3863bc610294d5e1 100644 (file)
--- 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