Merge branch 'master' into script-fsm

[lsp-test.git] / lib / Language / Haskell / LSP / Test.hs

diff --git a/lib/Language/Haskell/LSP/Test.hs b/lib/Language/Haskell/LSP/Test.hs
index eda3cd2f2925bd34fdef4014482d4c8eef2a6133..c5090f939c8c669f44e65a5d04d698d2bb7a6350 100644 (file)
--- 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
   , loggingNotification
   , publishDiagnosticsNotification
   -- * Combinators

-  , choice
-  , option
-  , optional
-  , between
-  , some
-  , many
-  , sepBy
-  , sepBy1
-  , sepEndBy1
-  , sepEndBy
-  , endBy1
-  , endBy
-  , count
-  , manyTill
-  , skipMany
-  , skipSome
-  , skipManyTill
-  , skipSomeTill
-  , (<|>)

   , satisfy
   -- * Utilities
   , initializeResponse
   , satisfy
   -- * Utilities
   , initializeResponse


@@ -66,19 +47,28 @@ module Language.Haskell.LSP.Test
   , documentContents
   , getDocumentEdit
   , getDocUri
   , documentContents
   , getDocumentEdit
   , getDocUri

+  , getVersionedDoc

   -- ** Symbols
   , getDocumentSymbols
   -- ** Diagnostics
   , waitForDiagnostics
   -- ** Symbols
   , getDocumentSymbols
   -- ** Diagnostics
   , waitForDiagnostics

+  , waitForDiagnosticsSource

   , noDiagnostics
   -- ** Commands
   , executeCommand
   -- ** Code Actions
   , getAllCodeActions
   , executeCodeAction
   , noDiagnostics
   -- ** Commands
   , executeCommand
   -- ** Code Actions
   , getAllCodeActions
   , executeCodeAction

+  -- ** Completions
+  , getCompletions
+  -- ** References
+  , getReferences
+  -- ** Renaming
+  , rename
+  -- ** Edits
+  , applyEdit

   ) where
 
   ) where
 

-import Control.Applicative

 import Control.Applicative.Combinators
 import Control.Concurrent
 import Control.Monad
 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 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
 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) $
   req <- message :: Session ApplyWorkspaceEditRequest
 
   unless (checkDocumentChanges req || checkChanges req) $

-    liftIO $ throw (IncorrectApplyEditRequestException (show req))
+    liftIO $ throw (IncorrectApplyEditRequest (show req))

 
   documentContents doc
   where
 
   documentContents doc
   where


@@ -313,19 +304,31 @@ getDocUri file = do
   let fp = rootDir context </> file
   return $ filePathToUri fp
 
   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
 
 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
 -- | 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]
 
 -- | Returns the symbols in a document.
 getDocumentSymbols :: TextDocumentIdentifier -> Session [SymbolInformation]


@@ -335,6 +338,9 @@ getDocumentSymbols doc = do
   let (Just (List symbols)) = mRes
   return symbols
 
   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
 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)
 
           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
 
 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
 executeCodeAction :: CodeAction -> Session ()
 executeCodeAction action = do
   maybe (return ()) handleEdit $ action ^. edit


@@ -366,5 +377,80 @@ executeCodeAction action = do
 
   where handleEdit :: WorkspaceEdit -> Session ()
         handleEdit e =
 
   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)
           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)
+