Fix tests, add changelog

[opengl.git] / src / Language / Haskell / LSP / Test.hs

diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs
index b7057c2d5a4127f00a519c5ed01aa3e2a9ecf6fc..04fcc21a7f9510a10f4acc0c0eb012a24321db21 100644 (file)
--- 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
-<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
   (
@@ -23,10 +23,9 @@ 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
@@ -35,16 +34,10 @@ module Language.Haskell.LSP.Test
   , 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
@@ -98,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
@@ -114,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
@@ -254,7 +253,7 @@ sendNotification :: ToJSON a
                  -> 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
@@ -264,7 +263,7 @@ sendNotification TextDocumentDidOpen params = do
   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
@@ -276,6 +275,7 @@ sendNotification TextDocumentDidClose params = do
 
 sendNotification method params = sendMessage (NotificationMessage "2.0" method params)
 
+-- | Sends a response to the server.
 sendResponse :: ToJSON a => ResponseMessage a -> Session ()
 sendResponse = sendMessage
 
@@ -327,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
@@ -347,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
@@ -365,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)
 
@@ -416,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
@@ -462,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)