Stability : experimental
Portability : POSIX
-A framework for testing
-<https://github.com/Microsoft/language-server-protocol Language Server Protocol servers>
-functionally.
+Provides the framework to start functionally testing
+<https://github.com/Microsoft/language-server-protocol Language Server Protocol servers>.
+You should import "Language.Haskell.LSP.Types" alongside this.
-}
module Language.Haskell.LSP.Test
(
, runSessionWithConfig
, SessionConfig(..)
, defaultConfig
- , module Language.Haskell.LSP.Test.Capabilities
+ , C.fullCaps
-- ** Exceptions
- , SessionException(..)
- , anySessionException
+ , module Language.Haskell.LSP.Test.Exceptions
, withTimeout
-- * Sending
, request
, sendNotification
, sendResponse
-- * Receving
- , message
- , anyRequest
- , anyResponse
- , anyNotification
- , anyMessage
- , loggingNotification
- , publishDiagnosticsNotification
- -- * Combinators
- , satisfy
+ , module Language.Haskell.LSP.Test.Parsing
-- * Utilities
+ -- | Quick helper functions for common tasks.
+ -- ** Initialization
, initializeResponse
-- ** Documents
, openDoc
, waitForDiagnostics
, waitForDiagnosticsSource
, noDiagnostics
+ , getCurrentDiagnostics
-- ** Commands
, executeCommand
-- ** Code Actions
+ , getCodeActions
, getAllCodeActions
, executeCodeAction
-- ** Completions
, getReferences
-- ** Definitions
, getDefinitions
+ , getTypeDefinitions
-- ** Renaming
, rename
-- ** Hover
import qualified Data.HashMap.Strict as HashMap
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.Types
+import Language.Haskell.LSP.Types.Lens hiding
+ (id, capabilities, message, executeCommand, applyEdit, rename)
+import qualified Language.Haskell.LSP.Types.Lens as LSP
+import qualified Language.Haskell.LSP.Types.Capabilities as C
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
import System.IO
import System.Directory
import System.FilePath
-import qualified Yi.Rope as Rope
+import qualified Data.Rope.UTF16 as Rope
-- | Starts a new session.
+--
+-- > runSession "hie" fullCaps "path/to/root/dir" $ do
+-- > doc <- openDoc "Desktop/simple.hs" "haskell"
+-- > diags <- waitForDiagnostics
+-- > let pos = Position 12 5
+-- > params = TextDocumentPositionParams doc
+-- > hover <- request TextDocumentHover params
runSession :: String -- ^ The command to run the server.
- -> LSP.ClientCapabilities -- ^ The capabilities that the client should declare.
+ -> C.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.
+-- | Starts a new sesion with a custom configuration.
runSessionWithConfig :: SessionConfig -- ^ Configuration options for the session.
-> String -- ^ The command to run the server.
- -> LSP.ClientCapabilities -- ^ The capabilities that the client should declare.
+ -> C.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
Nothing
caps
(Just TraceOff)
+ Nothing
withServer serverExe (logStdErr config) $ \serverIn serverOut _ ->
runSessionWithHandles serverIn serverOut listenServer config caps rootDir $ do
sendNotification Initialized InitializedParams
+ case lspConfig config of
+ Just cfg -> sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams cfg)
+ Nothing -> return ()
+
-- Run the actual test
result <- session
-> a -- ^ The notification parameters.
-> Session ()
--- | Open a virtual file if we send a did open text document notification
+-- Open a virtual file if we send a did open text document notification
sendNotification TextDocumentDidOpen params = do
let params' = fromJust $ decode $ encode params
n :: DidOpenTextDocumentNotification
modify (\s -> s { vfs = newVFS })
sendMessage n
--- | Close a virtual file if we send a close text document notification
+-- Close a virtual file if we send a close text document notification
sendNotification TextDocumentDidClose params = do
let params' = fromJust $ decode $ encode params
n :: DidCloseTextDocumentNotification
sendNotification method params = sendMessage (NotificationMessage "2.0" method params)
+-- | Sends a response to the server.
sendResponse :: ToJSON a => ResponseMessage a -> Session ()
sendResponse = sendMessage
let (List diags) = diagsNot ^. params . LSP.diagnostics
return diags
+-- | The same as 'waitForDiagnostics', but will only match a specific
+-- 'Language.Haskell.LSP.Types._source'.
waitForDiagnosticsSource :: String -> Session [Diagnostic]
waitForDiagnosticsSource src = do
diags <- waitForDiagnostics
matches d = d ^. source == Just (T.pack src)
-- | Expects a 'PublishDiagnosticsNotification' and throws an
--- 'UnexpectedDiagnosticsException' if there are any diagnostics
+-- 'UnexpectedDiagnostics' exception if there are any diagnostics
-- returned.
noDiagnostics :: Session ()
noDiagnostics = do
when (diagsNot ^. params . LSP.diagnostics /= List []) $ liftIO $ throw UnexpectedDiagnostics
-- | Returns the symbols in a document.
-getDocumentSymbols :: TextDocumentIdentifier -> Session [SymbolInformation]
+getDocumentSymbols :: TextDocumentIdentifier -> Session (Either [DocumentSymbol] [SymbolInformation])
getDocumentSymbols doc = do
- ResponseMessage _ rspLid mRes mErr <- request TextDocumentDocumentSymbol (DocumentSymbolParams doc)
+ ResponseMessage _ rspLid mRes mErr <- request TextDocumentDocumentSymbol (DocumentSymbolParams doc) :: Session DocumentSymbolsResponse
maybe (return ()) (throw . UnexpectedResponseError rspLid) mErr
- let (Just (List symbols)) = mRes
- return symbols
+ case mRes of
+ Just (DSDocumentSymbols (List xs)) -> return (Left xs)
+ Just (DSSymbolInformation (List xs)) -> return (Right xs)
+ Nothing -> Prelude.error "No result and no error in DocumentSymbolsResponse"
+
+-- | Returns the code actions in the specified range.
+getCodeActions :: TextDocumentIdentifier -> Range -> Session [CAResult]
+getCodeActions doc range = do
+ ctx <- getCodeActionContext doc
+ rsp <- request TextDocumentCodeAction (CodeActionParams doc range ctx)
+
+ case rsp ^. result of
+ Just (List xs) -> return xs
+ _ -> throw (UnexpectedResponseError (rsp ^. LSP.id) (fromJust $ rsp ^. LSP.error))
-- | 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 :: TextDocumentIdentifier -> Session [CAResult]
getAllCodeActions doc = do
- curDiags <- fromMaybe [] . Map.lookup (doc ^. uri) . curDiagnostics <$> get
- let ctx = CodeActionContext (List curDiags) Nothing
+ ctx <- getCodeActionContext doc
- foldM (go ctx) [] curDiags
+ foldM (go ctx) [] =<< getCurrentDiagnostics doc
where
- go :: CodeActionContext -> [CommandOrCodeAction] -> Diagnostic -> Session [CommandOrCodeAction]
+ go :: CodeActionContext -> [CAResult] -> Diagnostic -> Session [CAResult]
go ctx acc diag = do
ResponseMessage _ rspLid mRes mErr <- request TextDocumentCodeAction (CodeActionParams doc (diag ^. range) ctx)
let Just (List cmdOrCAs) = mRes
in return (acc ++ cmdOrCAs)
+getCodeActionContext :: TextDocumentIdentifier -> Session CodeActionContext
+getCodeActionContext doc = do
+ curDiags <- getCurrentDiagnostics doc
+ return $ CodeActionContext (List curDiags) Nothing
+
+-- | Returns the current diagnostics that have been sent to the client.
+-- Note that this does not wait for more to come in.
+getCurrentDiagnostics :: TextDocumentIdentifier -> Session [Diagnostic]
+getCurrentDiagnostics doc = fromMaybe [] . Map.lookup (doc ^. uri) . curDiagnostics <$> get
+
-- | Executes a command.
executeCommand :: Command -> Session ()
executeCommand cmd = do
caps <- asks sessionCapabilities
let supportsDocChanges = fromMaybe False $ do
- let LSP.ClientCapabilities mWorkspace _ _ = caps
- LSP.WorkspaceClientCapabilities _ mEdit _ _ _ _ <- mWorkspace
- LSP.WorkspaceEditClientCapabilities mDocChanges <- mEdit
+ let mWorkspace = C._workspace caps
+ C.WorkspaceClientCapabilities _ mEdit _ _ _ _ _ _ <- mWorkspace
+ C.WorkspaceEditClientCapabilities mDocChanges <- mEdit
mDocChanges
let wEdit = if supportsDocChanges
let params = TextDocumentPositionParams doc pos
in getResponseResult <$> request TextDocumentDefinition params
--- ^ Renames the term at the specified position.
+-- | Returns the type definition(s) for the term at the specified position.
+getTypeDefinitions :: TextDocumentIdentifier -- ^ The document the term is in.
+ -> Position -- ^ The position the term is at.
+ -> Session [Location] -- ^ The location(s) of the definitions
+getTypeDefinitions doc pos =
+ let params = TextDocumentPositionParams doc pos
+ in getResponseResult <$> request TextDocumentTypeDefinition 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)
projects / lsp-test.git / blobdiff