X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest.hs;h=aeae56bee28fa6ec0684116a4080bd7cd7a302c6;hb=e0926c045ccd5444f3112cb231cc3590c600d48d;hp=d4c63110890707bcbb40a2457ffb2ac68b844590;hpb=9b78d100e96d3ea4c059edbc45d3d084dddcab0a;p=lsp-test.git

diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs
index d4c6311..aeae56b 100644
--- a/src/Language/Haskell/LSP/Test.hs
+++ b/src/Language/Haskell/LSP/Test.hs
@@ -24,6 +24,8 @@ module Language.Haskell.LSP.Test
   , SessionException(..)
   , anySessionException
   , withTimeout
+  -- * Capabilities
+  , fullCaps
   -- * Sending
   , sendRequest
   , sendRequest_
@@ -46,6 +48,7 @@ module Language.Haskell.LSP.Test
   , initializeResponse
   -- ** Documents
   , openDoc
+  , closeDoc
   , documentContents
   , getDocumentEdit
   , getDocUri
@@ -69,6 +72,13 @@ module Language.Haskell.LSP.Test
   , getDefinitions
   -- ** Renaming
   , rename
+  -- ** Hover
+  , getHover
+  -- ** Highlights
+  , getHighlights
+  -- ** Formatting
+  , formatDoc
+  , formatRange
   -- ** Edits
   , applyEdit
   ) where
@@ -91,6 +101,7 @@ 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.Capabilities
 import Language.Haskell.LSP.Test.Compat
 import Language.Haskell.LSP.Test.Decoding
 import Language.Haskell.LSP.Test.Exceptions
@@ -104,18 +115,20 @@ import qualified Yi.Rope as Rope
 
 -- | Starts a new session.
 runSession :: String -- ^ The command to run the server.
+           -> LSP.ClientCapabilities -- ^ The capabilities that the client should declare.
            -> FilePath -- ^ The filepath to the root directory for the session.
            -> Session a -- ^ The session to run.
            -> IO a
 runSession = runSessionWithConfig def
 
 -- | Starts a new sesion with a client with the specified capabilities.
-runSessionWithConfig :: SessionConfig -- ^ The capabilities the client should have.
+runSessionWithConfig :: SessionConfig -- ^ Configuration options for the session.
                      -> String -- ^ The command to run the server.
+                     -> LSP.ClientCapabilities -- ^ The capabilities that the client should declare.
                      -> FilePath -- ^ The filepath to the root directory for the session.
                      -> Session a -- ^ The session to run.
                      -> IO a
-runSessionWithConfig config serverExe rootDir session = do
+runSessionWithConfig config serverExe caps rootDir session = do
   pid <- getCurrentProcessID
   absRootDir <- canonicalizePath rootDir
 
@@ -123,10 +136,10 @@ runSessionWithConfig config serverExe rootDir session = do
                                           (Just $ T.pack absRootDir)
                                           (Just $ filePathToUri absRootDir)
                                           Nothing
-                                          (capabilities config)
+                                          caps
                                           (Just TraceOff)
   withServer serverExe (logStdErr config) $ \serverIn serverOut _ ->
-    runSessionWithHandles serverIn serverOut listenServer config rootDir $ do
+    runSessionWithHandles serverIn serverOut listenServer config caps rootDir $ do
 
       -- Wrap the session around initialize and shutdown calls
       initRspMsg <- sendRequest Initialize initializeParams :: Session InitializeResponse
@@ -301,6 +314,17 @@ openDoc file languageId = do
     contents <- liftIO $ T.readFile fp
     return $ TextDocumentItem (filePathToUri fp) (T.pack languageId) 0 contents
 
+-- | Closes a text document and sends a notification to the client.
+closeDoc :: TextDocumentIdentifier -> Session ()
+closeDoc docId = do
+  let params = DidCloseTextDocumentParams (TextDocumentIdentifier (docId ^. uri))
+  sendNotification TextDocumentDidClose params
+
+  oldVfs <- vfs <$> get
+  let notif = NotificationMessage "" TextDocumentDidClose params
+  newVfs <- liftIO $ closeVFS oldVfs notif
+  modify $ \s -> s { vfs = newVfs }
+
 -- | Gets the Uri for the file corrected to the session directory.
 getDocUri :: FilePath -> Session Uri
 getDocUri file = do
@@ -401,7 +425,7 @@ applyEdit doc edit = do
 
   verDoc <- getVersionedDoc doc
 
-  caps <- asks (capabilities . config)
+  caps <- asks sessionCapabilities
 
   let supportsDocChanges = fromMaybe False $ do
         let LSP.ClientCapabilities mWorkspace _ _ = caps
@@ -459,6 +483,18 @@ rename doc pos newName = do
       req = RequestMessage "" (IdInt 0) WorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit)
   updateState (ReqApplyWorkspaceEdit req)
 
+-- | Returns the hover information at the specified position.
+getHover :: TextDocumentIdentifier -> Position -> Session (Maybe Hover)
+getHover doc pos =
+  let params = TextDocumentPositionParams doc pos
+  in getResponseResult <$> sendRequest TextDocumentHover params
+
+-- | Returns the highlighted occurences of the term at the specified position
+getHighlights :: TextDocumentIdentifier -> Position -> Session [DocumentHighlight]
+getHighlights doc pos =
+  let params = TextDocumentPositionParams doc pos
+  in getResponseResult <$> sendRequest TextDocumentDocumentHighlight params
+
 -- | Checks the response for errors and throws an exception if needed.
 -- Returns the result if successful.
 getResponseResult :: ResponseMessage a -> a 
@@ -466,3 +502,23 @@ getResponseResult rsp = fromMaybe exc (rsp ^. result)
   where exc = throw $ UnexpectedResponseError (rsp ^. LSP.id)
                                               (fromJust $ rsp ^. LSP.error)
 
+-- | Applies formatting to the specified document.
+formatDoc :: TextDocumentIdentifier -> FormattingOptions -> Session ()
+formatDoc doc opts = do
+  let params = DocumentFormattingParams doc opts
+  edits <- getResponseResult <$> sendRequest TextDocumentFormatting params
+  applyTextEdits doc edits
+
+-- | Applies formatting to the specified range in a document.
+formatRange :: TextDocumentIdentifier -> FormattingOptions -> Range -> Session ()
+formatRange doc opts range = do
+  let params = DocumentRangeFormattingParams doc range opts
+  edits <- getResponseResult <$> sendRequest TextDocumentRangeFormatting params
+  applyTextEdits doc edits
+
+applyTextEdits :: TextDocumentIdentifier -> List TextEdit -> Session ()
+applyTextEdits doc edits =
+  let wEdit = WorkspaceEdit (Just (HashMap.singleton (doc ^. uri) edits)) Nothing
+      req = RequestMessage "" (IdInt 0) WorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit)
+  in updateState (ReqApplyWorkspaceEdit req)
+