X-Git-Url: https://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FLSP%2FTest.hs;h=62b3267366a2caf8edd1f2386c6d91648ad206d8;hb=dcad2a3010b8f40e1e32ee0a3c980c32980e20e3;hp=a068b0eda6bb9254e32aa49c4daadcb95716eb86;hpb=56c39e493dfc0bf610e3807f69ccc7af8549d3e3;p=lsp-test.git

diff --git a/src/Language/LSP/Test.hs b/src/Language/LSP/Test.hs
index a068b0e..62b3267 100644
--- a/src/Language/LSP/Test.hs
+++ b/src/Language/LSP/Test.hs
@@ -62,6 +62,7 @@ module Language.LSP.Test
   , waitForDiagnosticsSource
   , noDiagnostics
   , getCurrentDiagnostics
+  , getIncompleteProgressSessions
   -- ** Commands
   , executeCommand
   -- ** Code Actions
@@ -101,6 +102,7 @@ import Control.Monad.IO.Class
 import Control.Exception
 import Control.Lens hiding ((.=), List, Empty)
 import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
 import Data.Aeson
@@ -283,13 +285,6 @@ getDocumentEdit doc = do
 
   documentContents doc
   where
-    -- extract Uri out from DocumentChange
-    documentChangeUri :: DocumentChange -> Uri
-    documentChangeUri (InL x) = x ^. textDocument . uri
-    documentChangeUri (InR (InL x)) = x ^. uri
-    documentChangeUri (InR (InR (InL x))) = x ^. oldUri
-    documentChangeUri (InR (InR (InR x))) = x ^. uri
-
     checkDocumentChanges req =
       let changes = req ^. params . edit . documentChanges
           maybeDocs = fmap (fmap documentChangeUri) changes
@@ -403,7 +398,7 @@ createDoc file languageId contents = do
       watchHits :: FileSystemWatcher -> Bool
       watchHits (FileSystemWatcher pattern kind) =
         -- If WatchKind is exlcuded, defaults to all true as per spec
-        fileMatches pattern && createHits (fromMaybe (WatchKind True True True) kind)
+        fileMatches (T.unpack pattern) && createHits (fromMaybe (WatchKind True True True) kind)
 
       fileMatches pattern = Glob.match (Glob.compile pattern) relOrAbs
         -- If the pattern is absolute then match against the absolute fp
@@ -541,6 +536,10 @@ getCodeActionContext doc = do
 getCurrentDiagnostics :: TextDocumentIdentifier -> Session [Diagnostic]
 getCurrentDiagnostics doc = fromMaybe [] . Map.lookup (toNormalizedUri $ doc ^. uri) . curDiagnostics <$> get
 
+-- | Returns the tokens of all progress sessions that have started but not yet ended.
+getIncompleteProgressSessions :: Session (Set.Set ProgressToken)
+getIncompleteProgressSessions = curProgressSessions <$> get
+
 -- | Executes a command.
 executeCommand :: Command -> Session ()
 executeCommand cmd = do