X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=test%2FTest.hs;h=7b911f4e585a92809b4f4488f3252770ea8fdb2b;hb=72257c6a7b5461c529c415b93e1c3507e1c843a7;hp=6c153a935c99266ddb8c79f0aa3034a168483a95;hpb=ea87bf94ca92b6de74505ba8df208ad3e2110de5;p=lsp-test.git

diff --git a/test/Test.hs b/test/Test.hs
index 6c153a9..7b911f4 100644
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -17,10 +17,10 @@ import           Control.Monad
 import           Control.Lens hiding (List)
 import           Language.Haskell.LSP.Messages
 import           Language.Haskell.LSP.Test
-import           Language.Haskell.LSP.Test.Replay
 import           Language.Haskell.LSP.Types
-import           Language.Haskell.LSP.Types.Lens as LSP hiding
+import           Language.Haskell.LSP.Types.Lens hiding
   (capabilities, message, rename, applyEdit)
+import qualified Language.Haskell.LSP.Types.Lens as LSP
 import           Language.Haskell.LSP.Types.Capabilities as LSP
 import           System.Directory
 import           System.FilePath
@@ -126,14 +126,14 @@ main = findServer >>= \serverExe -> hspec $ do
             in runSession serverExe fullCaps "test/data/renamePass" sesh
               `shouldThrow` selector
 
-  describe "replaySession" $
   -- This is too fickle at the moment
+  -- describe "replaySession" $
   --   it "passes a test" $
   --     replaySession serverExe "test/data/renamePass"
-    it "fails a test" $
-      let selector (ReplayOutOfOrder _ _) = True
-          selector _ = False
-        in replaySession serverExe "test/data/renameFail" `shouldThrow` selector
+  --   it "fails a test" $
+  --     let selector (ReplayOutOfOrder _ _) = True
+  --         selector _ = False
+  --       in replaySession serverExe "test/data/renameFail" `shouldThrow` selector
 
   -- describe "manual javascript session" $
   --   it "passes a test" $
@@ -221,21 +221,13 @@ main = findServer >>= \serverExe -> hspec $ do
       contents <- documentContents doc
       liftIO $ contents `shouldSatisfy` T.isPrefixOf "foodule"
 
-  -- describe "getCompletions" $
-  --   it "works" $ runSession serverExe def "test/data/renamePass" $ do
-  --     doc <- openDoc "Desktop/simple.hs" "haskell"
-
-  --     -- wait for module to be loaded
-  --     skipMany loggingNotification
-  --     noDiagnostics
-  --     noDiagnostics
+  describe "getCompletions" $
+    it "works" $ runSession serverExe def "test/data/renamePass" $ do
+      doc <- openDoc "Desktop/simple.hs" "haskell"
 
-  --     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
-  --       item ^. detail `shouldBe` Just "Items -> IO ()\nMain"
+      comps <- getCompletions doc (Position 5 5)
+      let item = head comps
+      liftIO $ item ^. label `shouldBe` "foo"
 
   -- describe "getReferences" $
   --   it "works" $ runSession serverExe fullCaps "test/data/renamePass" $ do
@@ -329,6 +321,56 @@ main = findServer >>= \serverExe -> hspec $ do
         openDoc "Format.hs" "haskell"
         void publishDiagnosticsNotification
 
+  describe "dynamic capabilities" $ do
+    it "keeps track" $ runSession serverExe fullCaps "test/data" $ do
+      loggingNotification -- initialized log message
+
+      createDoc ".register" "haskell" ""
+      message :: Session RegisterCapabilityRequest
+
+      doc <- createDoc "Foo.watch" "haskell" ""
+      NotLogMessage msg <- loggingNotification
+      liftIO $ msg ^. params . LSP.message `shouldBe` "got workspace/didChangeWatchedFiles"
+
+      caps <- getRegisteredCapabilities
+      liftIO $ caps `shouldBe`
+        [ Registration "0" WorkspaceDidChangeWatchedFiles $ Just $ toJSON $
+          DidChangeWatchedFilesRegistrationOptions $ List
+          [ FileSystemWatcher "*.watch" (Just (WatchKind True True True)) ]
+        ]
+
+      -- now unregister it by sending a specific createDoc
+      createDoc ".unregister" "haskell" ""
+      message :: Session UnregisterCapabilityRequest
+
+      createDoc "Bar.watch" "haskell" ""
+      void $ sendRequest TextDocumentHover $ TextDocumentPositionParams doc (Position 0 0) Nothing
+      count 0 $ loggingNotification
+      void $ anyResponse
+
+    it "handles absolute patterns" $ runSession serverExe fullCaps "" $ do
+      curDir <- liftIO $ getCurrentDirectory
+
+      loggingNotification -- initialized log message
+
+      createDoc ".register.abs" "haskell" ""
+      message :: Session RegisterCapabilityRequest
+
+      doc <- createDoc (curDir </> "Foo.watch") "haskell" ""
+      NotLogMessage msg <- loggingNotification
+      liftIO $ msg ^. params . LSP.message `shouldBe` "got workspace/didChangeWatchedFiles"
+
+      -- now unregister it by sending a specific createDoc
+      createDoc ".unregister.abs" "haskell" ""
+      message :: Session UnregisterCapabilityRequest
+
+      createDoc (curDir </> "Bar.watch") "haskell" ""
+      void $ sendRequest TextDocumentHover $ TextDocumentPositionParams doc (Position 0 0) Nothing
+      count 0 $ loggingNotification
+      void $ anyResponse
+
+
+mkRange :: Int -> Int -> Int -> Int -> Range
 mkRange sl sc el ec = Range (Position sl sc) (Position el ec)
 
 didChangeCaps :: ClientCapabilities