X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest.hs;h=568ead8ff592846fbc77e0e41adbaa9e08a2064b;hb=f0d93bbe47d55ab650909e0487c65c1048f1bb9a;hp=403c0e112600acda919a77656434e8a792f089d8;hpb=0d03bbc4a85a2d625fa663a47bcd079883bf7900;p=opengl.git

diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs
index 403c0e1..568ead8 100644
--- a/src/Language/Haskell/LSP/Test.hs
+++ b/src/Language/Haskell/LSP/Test.hs
@@ -21,9 +21,12 @@ module Language.Haskell.LSP.Test
   , runSessionWithConfig
   , Session
   , SessionConfig(..)
+  , defaultConfig
   , SessionException(..)
   , anySessionException
   , withTimeout
+  -- * Capabilities
+  , fullCaps
   -- * Sending
   , sendRequest
   , sendRequest_
@@ -46,6 +49,7 @@ module Language.Haskell.LSP.Test
   , initializeResponse
   -- ** Documents
   , openDoc
+  , closeDoc
   , documentContents
   , getDocumentEdit
   , getDocUri
@@ -71,6 +75,11 @@ module Language.Haskell.LSP.Test
   , rename
   -- ** Hover
   , getHover
+  -- ** Highlights
+  , getHighlights
+  -- ** Formatting
+  , formatDoc
+  , formatRange
   -- ** Edits
   , applyEdit
   ) where
@@ -93,6 +102,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
@@ -106,18 +116,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
 
@@ -125,10 +137,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
@@ -303,6 +315,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
@@ -403,7 +426,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
@@ -461,11 +484,17 @@ rename doc pos newName = do
       req = RequestMessage "" (IdInt 0) WorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit)
   updateState (ReqApplyWorkspaceEdit req)
 
--- ^ Returns the hover information at the specified position.
+-- | Returns the hover information at the specified position.
 getHover :: TextDocumentIdentifier -> Position -> Session (Maybe Hover)
-getHover doc pos = do
+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
-  getResponseResult <$> sendRequest TextDocumentHover params
+  in getResponseResult <$> sendRequest TextDocumentDocumentHighlight params
 
 -- | Checks the response for errors and throws an exception if needed.
 -- Returns the result if successful.
@@ -474,3 +503,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)
+