Log session messages, don't know why it was ever a good idea to hide them 💩

[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 8e5f21f445e5ae1a4ce8f1f42f2b7909324e57c6..0e8f5bfcaa92259f253defa2d89bbb40610c1e66 100644 (file)
--- a/src/Language/Haskell/LSP/Test.hs
+++ b/src/Language/Haskell/LSP/Test.hs
@@ -62,11 +62,11 @@ module Language.Haskell.LSP.Test
   , initializeResponse
   , openDoc
   , documentContents
-  , documentEdit
+  , getDocumentEdit
   , getDocUri
   , noDiagnostics
-  , documentSymbols
-  ,
+  , getDocumentSymbols
+  , getDiagnostics
   ) where
 
 import Control.Applicative
@@ -93,6 +93,7 @@ import Language.Haskell.LSP.Test.Exceptions
 import Language.Haskell.LSP.Test.Parsing
 import Language.Haskell.LSP.Test.Session
 import Language.Haskell.LSP.Test.Server
+import System.Console.ANSI
 import System.IO
 import System.Directory
 import System.FilePath
@@ -121,8 +122,7 @@ runSessionWithConfig config serverExe rootDir session = do
                                           Nothing
                                           (capabilities config)
                                           (Just TraceOff)
-
-  withServer serverExe $ \serverIn serverOut _ ->
+  withServer serverExe (logStdErr config) $ \serverIn serverOut _ ->
     runSessionWithHandles serverIn serverOut listenServer config rootDir $ do
 
       -- Wrap the session around initialize and shutdown calls
@@ -166,8 +166,8 @@ documentContents doc = do
 
 -- | Parses an ApplyEditRequest, checks that it is for the passed document
 -- and returns the new content
-documentEdit :: TextDocumentIdentifier -> Session T.Text
-documentEdit doc = do
+getDocumentEdit :: TextDocumentIdentifier -> Session T.Text
+getDocumentEdit doc = do
   req <- request :: Session ApplyWorkspaceEditRequest
 
   unless (checkDocumentChanges req || checkChanges req) $
@@ -274,7 +274,16 @@ sendResponse = sendMessage
 sendMessage :: ToJSON a => a -> Session ()
 sendMessage msg = do
   h <- serverIn <$> ask
-  liftIO $ B.hPut h $ addHeader (encode msg)
+  let encoded = encode msg
+  liftIO $ do
+
+    setSGR [SetColor Foreground Vivid Cyan]
+    putStrLn $ "--> " ++ B.unpack encoded
+    setSGR [Reset]
+
+    B.hPut h (addHeader encoded)
+
+
 
 -- | Returns the initialize response that was received from the server.
 -- The initialize requests and responses are not included the session,
@@ -306,16 +315,22 @@ getDocUri file = do
   let fp = rootDir context </> file
   return $ filePathToUri fp
 
+getDiagnostics :: Session [Diagnostic]
+getDiagnostics = do
+  diagsNot <- notification :: Session PublishDiagnosticsNotification
+  let (List diags) = diagsNot ^. params . LSP.diagnostics
+  return diags
+
 -- | Expects a 'PublishDiagnosticsNotification' and throws an
 -- 'UnexpectedDiagnosticsException' if there are any diagnostics
 -- returned.
 noDiagnostics :: Session ()
 noDiagnostics = do
   diagsNot <- notification :: Session PublishDiagnosticsNotification
-  when (diagsNot ^. params . diagnostics /= List []) $ liftIO $ throw UnexpectedDiagnosticsException
+  when (diagsNot ^. params . LSP.diagnostics /= List []) $ liftIO $ throw UnexpectedDiagnosticsException
 
 -- | Returns the symbols in a document.
-documentSymbols :: TextDocumentIdentifier -> Session DocumentSymbolsResponse
-documentSymbols doc = do
+getDocumentSymbols :: TextDocumentIdentifier -> Session DocumentSymbolsResponse
+getDocumentSymbols doc = do
   sendRequest TextDocumentDocumentSymbol (DocumentSymbolParams doc)
   response
\ No newline at end of file