X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest.hs;h=04fcc21a7f9510a10f4acc0c0eb012a24321db21;hb=9dbcb47a59e389b2dcc4e86cde6b626a2f17e38a;hp=17cdd85028d21c95e41d468a6dc2c1f3997d8c33;hpb=cdb1ba7038c32bac71a3bc783effc1e07049a985;p=opengl.git diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs index 17cdd85..04fcc21 100644 --- a/src/Language/Haskell/LSP/Test.hs +++ b/src/Language/Haskell/LSP/Test.hs @@ -10,9 +10,9 @@ Maintainer : luke_lau@icloud.com Stability : experimental Portability : POSIX -A framework for testing - -functionally. +Provides the framework to start functionally testing +. +You should import "Language.Haskell.LSP.Types" alongside this. -} module Language.Haskell.LSP.Test ( @@ -23,30 +23,21 @@ module Language.Haskell.LSP.Test , runSessionWithConfig , SessionConfig(..) , defaultConfig - , module Language.Haskell.LSP.Test.Capabilities + , module Language.Haskell.LSP.Types.Capabilities -- ** Exceptions - , SessionException(..) - , anySessionException + , module Language.Haskell.LSP.Test.Exceptions , withTimeout -- * Sending , request , request_ , sendRequest , sendNotification - , sendRequestMessage - , 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 @@ -100,10 +91,9 @@ 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.Capabilities 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 @@ -116,17 +106,24 @@ import System.FilePath import qualified Yi.Rope 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. + -> 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. + -> 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 @@ -250,22 +247,13 @@ instance ToJSON a => ToJSON (RequestMessage' a) where object ["jsonrpc" .= rpc, "id" .= id, "method" .= method, "params" .= params] -sendRequestMessage :: (ToJSON a, ToJSON b) => RequestMessage ClientMethod a b -> Session () -sendRequestMessage req = do - -- Update the request map - reqMap <- requestMap <$> ask - liftIO $ modifyMVar_ reqMap $ - \r -> return $ updateRequestMap r (req ^. LSP.id) (req ^. method) - - sendMessage req - -- | Sends a notification to the server. sendNotification :: ToJSON a => ClientMethod -- ^ The notification method. -> 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 @@ -273,9 +261,9 @@ sendNotification TextDocumentDidOpen params = do oldVFS <- vfs <$> get newVFS <- liftIO $ openVFS oldVFS n modify (\s -> s { vfs = newVFS }) - sendNotification' n + 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 @@ -283,13 +271,11 @@ sendNotification TextDocumentDidClose params = do oldVFS <- vfs <$> get newVFS <- liftIO $ closeVFS oldVFS n modify (\s -> s { vfs = newVFS }) - sendNotification' n - -sendNotification method params = sendNotification' (NotificationMessage "2.0" method params) + sendMessage n -sendNotification' :: (ToJSON a, ToJSON b) => NotificationMessage a b -> Session () -sendNotification' = sendMessage +sendNotification method params = sendMessage (NotificationMessage "2.0" method params) +-- | Sends a response to the server. sendResponse :: ToJSON a => ResponseMessage a -> Session () sendResponse = sendMessage @@ -341,6 +327,8 @@ waitForDiagnostics = do 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 @@ -361,17 +349,19 @@ 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 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 @@ -379,7 +369,7 @@ getAllCodeActions doc = do foldM (go ctx) [] curDiags 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) @@ -430,9 +420,9 @@ applyEdit doc edit = do caps <- asks sessionCapabilities let supportsDocChanges = fromMaybe False $ do - let LSP.ClientCapabilities mWorkspace _ _ = caps - LSP.WorkspaceClientCapabilities _ mEdit _ _ _ _ <- mWorkspace - LSP.WorkspaceEditClientCapabilities mDocChanges <- mEdit + let ClientCapabilities mWorkspace _ _ = caps + WorkspaceClientCapabilities _ mEdit _ _ _ _ _ _ <- mWorkspace + WorkspaceEditClientCapabilities mDocChanges <- mEdit mDocChanges let wEdit = if supportsDocChanges @@ -476,7 +466,7 @@ getDefinitions doc pos = let params = TextDocumentPositionParams doc pos in getResponseResult <$> request TextDocumentDefinition params --- ^ Renames the term at the specified position. +-- | 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)