From 7ee14165e9d2ebcc171716d41e3e207444c418b3 Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Thu, 26 Jul 2018 22:13:42 +0100 Subject: [PATCH] Pretty print message trace Make colours a bit less eye-bleeding Also implement logMessages config --- haskell-lsp-test.cabal | 1 + src/Language/Haskell/LSP/Test/Parsing.hs | 11 ++++++++--- src/Language/Haskell/LSP/Test/Session.hs | 9 ++++++--- 3 files changed, 15 insertions(+), 6 deletions(-) diff --git a/haskell-lsp-test.cabal b/haskell-lsp-test.cabal index d3e9b20..d3ef940 100644 --- a/haskell-lsp-test.cabal +++ b/haskell-lsp-test.cabal @@ -26,6 +26,7 @@ library build-depends: base >= 4.7 && < 5 , haskell-lsp >= 0.4 , aeson + , aeson-pretty , ansi-terminal , bytestring , conduit diff --git a/src/Language/Haskell/LSP/Test/Parsing.hs b/src/Language/Haskell/LSP/Test/Parsing.hs index 36349da..2936b31 100644 --- a/src/Language/Haskell/LSP/Test/Parsing.hs +++ b/src/Language/Haskell/LSP/Test/Parsing.hs @@ -10,6 +10,7 @@ import Control.Lens import Control.Monad.IO.Class import Control.Monad import Data.Aeson +import Data.Aeson.Encode.Pretty import qualified Data.ByteString.Lazy.Char8 as B import Data.Conduit.Parser import Data.Maybe @@ -42,9 +43,10 @@ satisfy pred = do if pred x then do - liftIO $ do - setSGR [SetColor Foreground Vivid Magenta] - putStrLn $ "<-- " ++ B.unpack (encodeMsg x) + shouldLog <- asks $ logMessages . config + liftIO $ when shouldLog $ do + setSGR [SetColor Foreground Dull Magenta] + putStrLn $ "<-- " ++ B.unpack (encodeMsgPretty x) setSGR [Reset] return x else empty @@ -86,6 +88,9 @@ castMsg = fromMaybe (error "Failed casting a message") . decode . encodeMsg encodeMsg :: FromServerMessage -> B.ByteString encodeMsg = encode . genericToJSON (defaultOptions { sumEncoding = UntaggedValue }) +encodeMsgPretty :: FromServerMessage -> B.ByteString +encodeMsgPretty = encodePretty . genericToJSON (defaultOptions { sumEncoding = UntaggedValue }) + -- | Matches if the message is a log message notification or a show message notification/request. loggingNotification :: Session FromServerMessage loggingNotification = named "Logging notification" $ satisfy shouldSkip diff --git a/src/Language/Haskell/LSP/Test/Session.hs b/src/Language/Haskell/LSP/Test/Session.hs index c923478..a58496d 100644 --- a/src/Language/Haskell/LSP/Test/Session.hs +++ b/src/Language/Haskell/LSP/Test/Session.hs @@ -35,6 +35,7 @@ import Control.Monad.Trans.State (StateT, runStateT) import qualified Control.Monad.Trans.State as State (get, put) import qualified Data.ByteString.Lazy.Char8 as B import Data.Aeson +import Data.Aeson.Encode.Pretty import Data.Conduit as Conduit import Data.Conduit.Parser as Parser import Data.Default @@ -276,10 +277,12 @@ updateState _ = return () sendMessage :: (MonadIO m, HasReader SessionContext m, ToJSON a) => a -> m () sendMessage msg = do h <- serverIn <$> ask - let encoded = encode msg - liftIO $ do + let encoded = encodePretty msg - setSGR [SetColor Foreground Vivid Cyan] + shouldLog <- asks $ logMessages . config + liftIO $ when shouldLog $ do + + setSGR [SetColor Foreground Dull Cyan] putStrLn $ "--> " ++ B.unpack encoded setSGR [Reset] -- 2.30.2