Skip to content

Commit

Permalink
Extremly ugly logging
Browse files Browse the repository at this point in the history
  • Loading branch information
michaelpj committed Sep 28, 2022
1 parent eb12c59 commit d6543fe
Show file tree
Hide file tree
Showing 3 changed files with 11 additions and 1 deletion.
5 changes: 5 additions & 0 deletions lsp/src/Language/LSP/Server/Control.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
3 changes: 3 additions & 0 deletions lsp/src/Language/LSP/Server/IO.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
4 changes: 3 additions & 1 deletion lsp/src/Language/LSP/Server/Processing.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down

0 comments on commit d6543fe

Please sign in to comment.