X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest.hs;h=592589c5abb0e39bc44f0fcbd958839b2261c2a8;hb=42757e7fe53223f3bdd81180a682faf72761afe3;hp=4cad784156477f23f4cefdb482de94764ac7d215;hpb=fe5448266f5db772dd3f10be432cd56581bbcb40;p=opengl.git

diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs
index 4cad784..592589c 100644
--- a/src/Language/Haskell/LSP/Test.hs
+++ b/src/Language/Haskell/LSP/Test.hs
@@ -19,9 +19,9 @@ module Language.Haskell.LSP.Test
   , runSessionWithConfig
   , Session
   , SessionConfig(..)
-  , MonadSessionConfig(..)
   , SessionException(..)
   , anySessionException
+  , withTimeout
   -- * Sending
   , sendRequest
   , sendRequest_
@@ -31,35 +31,14 @@ module Language.Haskell.LSP.Test
   , sendNotification'
   , sendResponse
   -- * Receving
+  , message
   , anyRequest
-  , request
   , anyResponse
-  , response
   , anyNotification
-  , notification
   , anyMessage
   , loggingNotification
   , publishDiagnosticsNotification
   -- * Combinators
-  , choice
-  , option
-  , optional
-  , between
-  , some
-  , many
-  , sepBy
-  , sepBy1
-  , sepEndBy1
-  , sepEndBy
-  , endBy1
-  , endBy
-  , count
-  , manyTill
-  , skipMany
-  , skipSome
-  , skipManyTill
-  , skipSomeTill
-  , (<|>)
   , satisfy
   -- * Utilities
   , initializeResponse
@@ -68,6 +47,7 @@ module Language.Haskell.LSP.Test
   , documentContents
   , getDocumentEdit
   , getDocUri
+  , getVersionedDoc
   -- ** Symbols
   , getDocumentSymbols
   -- ** Diagnostics
@@ -78,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,8 +77,9 @@ import Data.Default
 import qualified Data.HashMap.Strict as HashMap
 import qualified Data.Map as Map
 import Data.Maybe
-import Language.Haskell.LSP.Types hiding (id, capabilities)
+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
@@ -161,7 +145,7 @@ runSessionWithConfig config serverExe rootDir session = do
     reqMap <- readMVar $ requestMap context
 
     let msg = decodeFromServerMsg reqMap msgBytes
-    writeChan (messageChan context) msg
+    writeChan (messageChan context) (ServerMessage msg)
 
     listenServer serverOut context
 
@@ -169,6 +153,8 @@ runSessionWithConfig config serverExe rootDir session = do
 documentContents :: TextDocumentIdentifier -> Session T.Text
 documentContents doc = do
   vfs <- vfs <$> get
+  liftIO $ print vfs
+  liftIO $ print doc
   let file = vfs Map.! (doc ^. uri)
   return $ Rope.toText $ Language.Haskell.LSP.VFS._text file
 
@@ -176,10 +162,10 @@ documentContents doc = do
 -- and returns the new content
 getDocumentEdit :: TextDocumentIdentifier -> Session T.Text
 getDocumentEdit doc = do
-  req <- request :: Session ApplyWorkspaceEditRequest
+  req <- message :: Session ApplyWorkspaceEditRequest
 
   unless (checkDocumentChanges req || checkChanges req) $
-    liftIO $ throw (IncorrectApplyEditRequestException (show req))
+    liftIO $ throw (IncorrectApplyEditRequest (show req))
 
   documentContents doc
   where
@@ -315,9 +301,10 @@ 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 notification :: Session PublishDiagnosticsNotification
+  diagsNot <- skipManyTill anyMessage message :: Session PublishDiagnosticsNotification
   let (List diags) = diagsNot ^. params . LSP.diagnostics
   return diags
 
@@ -326,8 +313,8 @@ waitForDiagnostics = do
 -- returned.
 noDiagnostics :: Session ()
 noDiagnostics = do
-  diagsNot <- notification :: Session PublishDiagnosticsNotification
-  when (diagsNot ^. params . LSP.diagnostics /= List []) $ liftIO $ throw UnexpectedDiagnosticsException
+  diagsNot <- message :: Session PublishDiagnosticsNotification
+  when (diagsNot ^. params . LSP.diagnostics /= List []) $ liftIO $ throw UnexpectedDiagnostics
 
 -- | Returns the symbols in a document.
 getDocumentSymbols :: TextDocumentIdentifier -> Session [SymbolInformation]
@@ -337,6 +324,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
@@ -355,12 +345,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
@@ -368,5 +363,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 processMessage (ReqApplyWorkspaceEdit req)
+            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