X-Git-Url: http://git.lukelau.me/?p=lsp-test.git;a=blobdiff_plain;f=lib%2FLanguage%2FHaskell%2FLSP%2FTest.hs;fp=lib%2FLanguage%2FHaskell%2FLSP%2FTest.hs;h=c5090f939c8c669f44e65a5d04d698d2bb7a6350;hp=eda3cd2f2925bd34fdef4014482d4c8eef2a6133;hb=b1b104cd31ca2e90b6c1842be93b61a14d942101;hpb=fbb260c6078a39ff071fefd6586af18715b3e6a3

diff --git a/lib/Language/Haskell/LSP/Test.hs b/lib/Language/Haskell/LSP/Test.hs
index eda3cd2..c5090f9 100644
--- a/lib/Language/Haskell/LSP/Test.hs
+++ b/lib/Language/Haskell/LSP/Test.hs
@@ -39,25 +39,6 @@ module Language.Haskell.LSP.Test
   , loggingNotification
   , publishDiagnosticsNotification
   -- * Combinators
-  , choice
-  , option
-  , optional
-  , between
-  , some
-  , many
-  , sepBy
-  , sepBy1
-  , sepEndBy1
-  , sepEndBy
-  , endBy1
-  , endBy
-  , count
-  , manyTill
-  , skipMany
-  , skipSome
-  , skipManyTill
-  , skipSomeTill
-  , (<|>)
   , satisfy
   -- * Utilities
   , initializeResponse
@@ -66,19 +47,28 @@ module Language.Haskell.LSP.Test
   , documentContents
   , getDocumentEdit
   , getDocUri
+  , getVersionedDoc
   -- ** Symbols
   , getDocumentSymbols
   -- ** Diagnostics
   , waitForDiagnostics
+  , waitForDiagnosticsSource
   , noDiagnostics
   -- ** Commands
   , executeCommand
   -- ** Code Actions
   , getAllCodeActions
   , executeCodeAction
+  -- ** Completions
+  , getCompletions
+  -- ** References
+  , getReferences
+  -- ** Renaming
+  , rename
+  -- ** Edits
+  , applyEdit
   ) where
 
-import Control.Applicative
 import Control.Applicative.Combinators
 import Control.Concurrent
 import Control.Monad
@@ -94,6 +84,7 @@ import qualified Data.Map as Map
 import Data.Maybe
 import Language.Haskell.LSP.Types hiding (id, capabilities, message)
 import qualified Language.Haskell.LSP.Types as LSP
+import qualified Language.Haskell.LSP.Types.Capabilities as LSP
 import Language.Haskell.LSP.Messages
 import Language.Haskell.LSP.VFS
 import Language.Haskell.LSP.Test.Compat
@@ -177,7 +168,7 @@ getDocumentEdit doc = do
   req <- message :: Session ApplyWorkspaceEditRequest
 
   unless (checkDocumentChanges req || checkChanges req) $
-    liftIO $ throw (IncorrectApplyEditRequestException (show req))
+    liftIO $ throw (IncorrectApplyEditRequest (show req))
 
   documentContents doc
   where
@@ -313,19 +304,31 @@ getDocUri file = do
   let fp = rootDir context </> file
   return $ filePathToUri fp
 
+-- | Waits for diagnostics to be published and returns them.
 waitForDiagnostics :: Session [Diagnostic]
 waitForDiagnostics = do
   diagsNot <- skipManyTill anyMessage message :: Session PublishDiagnosticsNotification
   let (List diags) = diagsNot ^. params . LSP.diagnostics
   return diags
 
+waitForDiagnosticsSource :: String -> Session [Diagnostic]
+waitForDiagnosticsSource src = do
+  diags <- waitForDiagnostics
+  let res = filter matches diags
+  if null res
+    then waitForDiagnosticsSource src
+    else return res
+  where
+    matches :: Diagnostic -> Bool
+    matches d = d ^. source == Just (T.pack src)
+
 -- | Expects a 'PublishDiagnosticsNotification' and throws an
 -- 'UnexpectedDiagnosticsException' if there are any diagnostics
 -- returned.
 noDiagnostics :: Session ()
 noDiagnostics = do
   diagsNot <- message :: Session PublishDiagnosticsNotification
-  when (diagsNot ^. params . LSP.diagnostics /= List []) $ liftIO $ throw UnexpectedDiagnosticsException
+  when (diagsNot ^. params . LSP.diagnostics /= List []) $ liftIO $ throw UnexpectedDiagnostics
 
 -- | Returns the symbols in a document.
 getDocumentSymbols :: TextDocumentIdentifier -> Session [SymbolInformation]
@@ -335,6 +338,9 @@ getDocumentSymbols doc = do
   let (Just (List symbols)) = mRes
   return symbols
 
+-- | Returns all the code actions in a document by 
+-- querying the code actions at each of the current 
+-- diagnostics' positions.
 getAllCodeActions :: TextDocumentIdentifier -> Session [CommandOrCodeAction]
 getAllCodeActions doc = do
   curDiags <- fromMaybe [] . Map.lookup (doc ^. uri) . curDiagnostics <$> get
@@ -353,12 +359,17 @@ getAllCodeActions doc = do
           let Just (List cmdOrCAs) = mRes
             in return (acc ++ cmdOrCAs)
 
+-- | Executes a command.
 executeCommand :: Command -> Session ()
 executeCommand cmd = do
   let args = decode $ encode $ fromJust $ cmd ^. arguments
       execParams = ExecuteCommandParams (cmd ^. command) args
   sendRequest_ WorkspaceExecuteCommand execParams
 
+-- | Executes a code action. 
+-- Matching with the specification, if a code action
+-- contains both an edit and a command, the edit will
+-- be applied first.
 executeCodeAction :: CodeAction -> Session ()
 executeCodeAction action = do
   maybe (return ()) handleEdit $ action ^. edit
@@ -366,5 +377,80 @@ executeCodeAction action = do
 
   where handleEdit :: WorkspaceEdit -> Session ()
         handleEdit e =
+          -- Its ok to pass in dummy parameters here as they aren't used
           let req = RequestMessage "" (IdInt 0) WorkspaceApplyEdit (ApplyWorkspaceEditParams e)
             in updateState (ReqApplyWorkspaceEdit req)
+
+-- | Adds the current version to the document, as tracked by the session.
+getVersionedDoc :: TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier
+getVersionedDoc (TextDocumentIdentifier uri) = do
+  fs <- vfs <$> get
+  let ver =
+        case fs Map.!? uri of
+          Just (VirtualFile v _) -> Just v
+          _ -> Nothing
+  return (VersionedTextDocumentIdentifier uri ver)
+
+-- | Applys an edit to the document and returns the updated document version.
+applyEdit :: TextDocumentIdentifier -> TextEdit -> Session VersionedTextDocumentIdentifier
+applyEdit doc edit = do
+
+  verDoc <- getVersionedDoc doc
+
+  caps <- asks (capabilities . config)
+
+  let supportsDocChanges = fromMaybe False $ do
+        let LSP.ClientCapabilities mWorkspace _ _ = caps
+        LSP.WorkspaceClientCapabilities _ mEdit _ _ _ _ <- mWorkspace
+        LSP.WorkspaceEditClientCapabilities mDocChanges <- mEdit
+        mDocChanges
+
+  let wEdit = if supportsDocChanges
+      then
+        let docEdit = TextDocumentEdit verDoc (List [edit])
+        in WorkspaceEdit Nothing (Just (List [docEdit]))
+      else
+        let changes = HashMap.singleton (doc ^. uri) (List [edit])
+        in WorkspaceEdit (Just changes) Nothing
+
+  let req = RequestMessage "" (IdInt 0) WorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit)
+  updateState (ReqApplyWorkspaceEdit req)
+
+  -- version may have changed
+  getVersionedDoc doc
+  
+-- | Returns the completions for the position in the document.
+getCompletions :: TextDocumentIdentifier -> Position -> Session [CompletionItem]
+getCompletions doc pos = do
+  rsp <- sendRequest TextDocumentCompletion (TextDocumentPositionParams doc pos)
+
+  case getResponseResult rsp of
+    Completions (List items) -> return items
+    CompletionList (CompletionListType _ (List items)) -> return items
+
+-- | Returns the references for the position in the document.
+getReferences :: TextDocumentIdentifier -- ^ The document to lookup in.
+              -> Position -- ^ The position to lookup. 
+              -> Bool -- ^ Whether to include declarations as references.
+              -> Session [Location] -- ^ The locations of the references.
+getReferences doc pos inclDecl =
+  let ctx = ReferenceContext inclDecl
+      params = ReferenceParams doc pos ctx
+  in fromMaybe [] . (^. result) <$> sendRequest TextDocumentReferences params 
+
+-- ^ Renames the term at the specified position.
+rename :: TextDocumentIdentifier -> Position -> String -> Session ()
+rename doc pos newName = do
+  let params = RenameParams doc pos (T.pack newName)
+  rsp <- sendRequest TextDocumentRename params :: Session RenameResponse
+  let wEdit = getResponseResult rsp
+      req = RequestMessage "" (IdInt 0) WorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit)
+  updateState (ReqApplyWorkspaceEdit req)
+
+-- | Checks the response for errors and throws an exception if needed.
+-- Returns the result if successful.
+getResponseResult :: ResponseMessage a -> a 
+getResponseResult rsp = fromMaybe exc (rsp ^. result)
+  where exc = throw $ UnexpectedResponseError (rsp ^. LSP.id)
+                                              (fromJust $ rsp ^. LSP.error)
+