Remove leftover loggin

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

diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs
index eda3cd2f2925bd34fdef4014482d4c8eef2a6133..3ba86905c2d48d6c015812421253fa7319f3a3e6 100644 (file)
--- a/src/Language/Haskell/LSP/Test.hs
+++ b/src/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,6 +47,7 @@ module Language.Haskell.LSP.Test
   , documentContents
   , getDocumentEdit
   , getDocUri
+  , getVersionedDoc
   -- ** Symbols
   , getDocumentSymbols
   -- ** Diagnostics
@@ -76,9 +58,12 @@ module Language.Haskell.LSP.Test
   -- ** Code Actions
   , getAllCodeActions
   , executeCodeAction
+  -- ** Completions
+  , getCompletions
+  -- ** Edits
+  , applyEdit
   ) where
 
-import Control.Applicative
 import Control.Applicative.Combinators
 import Control.Concurrent
 import Control.Monad
@@ -94,6 +79,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 +163,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,6 +299,7 @@ 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
@@ -325,7 +312,7 @@ waitForDiagnostics = do
 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 +322,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 +343,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 +361,56 @@ 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)
+
+  let exc = throw $ UnexpectedResponseError (rsp ^. LSP.id)
+                                            (fromJust $ rsp ^. LSP.error)
+      res = fromMaybe exc (rsp ^. result)
+  case res of
+    Completions (List items) -> return items
+    CompletionList (CompletionListType _ (List items)) -> return items