Extremly ugly logging

Author: michaelpj

lsp/src/Language/LSP/Server/Control.hs

@@ -33,6 +33,8 @@ import           Language.LSP.VFS
 import qualified Language.LSP.Server.IO as IO
 import Language.LSP.Logging (defaultClientLogger)
 import           System.IO
+import Debug.Trace (traceM)
+import Control.Exception
 
 data LspServerLog =
   LspProcessingLog Processing.LspProcessingLog
@@ -140,4 +142,7 @@ runServerWith ioLogger logger clientIn clientOut serverDefinition = do
         Async.withAsync processingLoop $ \a3 ->
           Async.waitAny [a1, a2, a3]
 
+  traceM "Threads killed, exiting"
   ioLogger <& Stopping `WithSeverity` Info
+  `catch`
+  \(e :: SomeException) -> traceM ("Dying due to escaping exception " ++ show e) >> throw e

lsp/src/Language/LSP/Server/IO.hs

@@ -14,6 +14,7 @@ import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import           Data.Text.Prettyprint.Doc
 import           Data.List
+import Debug.Trace (traceM)
 
 data LspIoLog =
   HeaderParseFail [String] String
@@ -57,6 +58,8 @@ serverIn logger msgOut clientIn = do
       if BS.null bs
       then do
         logger <& EOF `WithSeverity` Error
+
+        traceM "Exiting due to EOF"
         pure ()
       else loop (c bs)
     loop (Done remainder parsed) = do

lsp/src/Language/LSP/Server/Processing.hs

@@ -51,6 +51,7 @@ import Data.Default (def)
 import Control.Monad.State
 import Control.Monad.Writer.Strict 
 import Data.Foldable (traverse_)
+import Debug.Trace (traceM)
 
 data LspProcessingLog =
   VfsLog VfsLog
@@ -108,7 +109,8 @@ processingLoop ioLogger logger vfs serverDefinition sendMsg recvMsg = do
           msg <- liftIO recvMsg
           processMessage logger msg
   `E.catch`
-  (\(_ :: RequestedShutdown) -> pure ())
+  (\(_ :: RequestedShutdown) -> traceM "Exiting due to shutdown request" >> pure ())
+
 
 processMessage :: (m ~ LspM config) => LogAction m (WithSeverity LspProcessingLog) -> Value -> m ()
 processMessage logger val = do