X-Git-Url: https://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FLSP%2FTest.hs;h=ae2453065be6051420e6c73e218208cd0c120a4a;hb=cc180dcaf2f72684a42b73d1cb76c31037c8c81a;hp=90000fd38936eb470e8a13448032466551d180e8;hpb=ad1d8fc387457dbcebcad90e0e6e6dbff62b6bba;p=lsp-test.git

diff --git a/src/Language/LSP/Test.hs b/src/Language/LSP/Test.hs
index 90000fd..ae24530 100644
--- a/src/Language/LSP/Test.hs
+++ b/src/Language/LSP/Test.hs
@@ -7,6 +7,7 @@
 {-# LANGUAGE TypeInType #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 
 {-|
 Module      : Language.LSP.Test
@@ -371,7 +372,7 @@ sendResponse = sendMessage
 -- The initialize requests and responses are not included the session,
 -- so if you need to test it use this.
 initializeResponse :: Session (ResponseMessage Initialize)
-initializeResponse = initRsp <$> ask >>= (liftIO . readMVar)
+initializeResponse = ask >>= (liftIO . readMVar) . initRsp
 
 -- | /Creates/ a new text document. This is different from 'openDoc'
 -- as it sends a workspace/didChangeWatchedFiles notification letting the server
@@ -383,7 +384,7 @@ initializeResponse = initRsp <$> ask >>= (liftIO . readMVar)
 --
 -- @since 11.0.0.0
 createDoc :: FilePath -- ^ The path to the document to open, __relative to the root directory__.
-          -> String -- ^ The text document's language identifier, e.g. @"haskell"@.
+          -> T.Text -- ^ The text document's language identifier, e.g. @"haskell"@.
           -> T.Text -- ^ The content of the text document to create.
           -> Session TextDocumentIdentifier -- ^ The identifier of the document just created.
 createDoc file languageId contents = do
@@ -398,7 +399,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
@@ -423,7 +424,7 @@ createDoc file languageId contents = do
 
 -- | Opens a text document that /exists on disk/, and sends a
 -- textDocument/didOpen notification to the server.
-openDoc :: FilePath -> String -> Session TextDocumentIdentifier
+openDoc :: FilePath -> T.Text -> Session TextDocumentIdentifier
 openDoc file languageId = do
   context <- ask
   let fp = rootDir context </> file
@@ -432,12 +433,12 @@ openDoc file languageId = do
 
 -- | This is a variant of `openDoc` that takes the file content as an argument.
 -- Use this is the file exists /outside/ of the current workspace.
-openDoc' :: FilePath -> String -> T.Text -> Session TextDocumentIdentifier
+openDoc' :: FilePath -> T.Text -> T.Text -> Session TextDocumentIdentifier
 openDoc' file languageId contents = do
   context <- ask
   let fp = rootDir context </> file
       uri = filePathToUri fp
-      item = TextDocumentItem uri (T.pack languageId) 0 contents
+      item = TextDocumentItem uri languageId 0 contents
   sendNotification STextDocumentDidOpen (DidOpenTextDocumentParams item)
   pure $ TextDocumentIdentifier uri
 
@@ -501,7 +502,7 @@ getDocumentSymbols doc = do
 -- | Returns the code actions in the specified range.
 getCodeActions :: TextDocumentIdentifier -> Range -> Session [Command |? CodeAction]
 getCodeActions doc range = do
-  ctx <- getCodeActionContext doc
+  ctx <- getCodeActionContextInRange doc range
   rsp <- request STextDocumentCodeAction (CodeActionParams Nothing Nothing doc range ctx)
 
   case rsp ^. result of
@@ -526,6 +527,26 @@ getAllCodeActions doc = do
         Left e -> throw (UnexpectedResponseError (SomeLspId $ fromJust rspLid) e)
         Right (List cmdOrCAs) -> pure (acc ++ cmdOrCAs)
 
+getCodeActionContextInRange :: TextDocumentIdentifier -> Range -> Session CodeActionContext
+getCodeActionContextInRange doc caRange = do
+  curDiags <- getCurrentDiagnostics doc
+  let diags = [ d | d@Diagnostic{_range=range} <- curDiags
+                  , overlappingRange caRange range
+              ]
+  return $ CodeActionContext (List diags) Nothing
+  where
+    overlappingRange :: Range -> Range -> Bool
+    overlappingRange (Range s e) range =
+         positionInRange s range
+      || positionInRange e range
+
+    positionInRange :: Position -> Range -> Bool
+    positionInRange (Position pl po) (Range (Position sl so) (Position el eo)) =
+         pl >  sl && pl <  el
+      || pl == sl && pl == el && po >= so && po <= eo
+      || pl == sl && po >= so
+      || pl == el && po <= eo
+
 getCodeActionContext :: TextDocumentIdentifier -> Session CodeActionContext
 getCodeActionContext doc = do
   curDiags <- getCurrentDiagnostics doc
@@ -724,4 +745,4 @@ getCodeLenses tId = do
 --
 -- @since 0.11.0.0
 getRegisteredCapabilities :: Session [SomeRegistration]
-getRegisteredCapabilities = (Map.elems . curDynCaps) <$> get
+getRegisteredCapabilities = Map.elems . curDynCaps <$> get