X-Git-Url: http://git.lukelau.me/?p=opengl.git;a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest%2FParsing.hs;h=db5e4433b582dde899d7b0ae908eb1fa52b4a850;hp=fdc2e958bafc45eae1e02deceba80ba4e03657b4;hb=563d0885c5cf4456ea04c041771d68dca5c274d4;hpb=3581d880c87b59cc4c856aee83f77fea9a38890b diff --git a/src/Language/Haskell/LSP/Test/Parsing.hs b/src/Language/Haskell/LSP/Test/Parsing.hs index fdc2e95..db5e443 100644 --- a/src/Language/Haskell/LSP/Test/Parsing.hs +++ b/src/Language/Haskell/LSP/Test/Parsing.hs @@ -17,8 +17,9 @@ import Language.Haskell.LSP.Types hiding (error) import Language.Haskell.LSP.Test.Exceptions import Language.Haskell.LSP.Test.Messages import Language.Haskell.LSP.Test.Session +import System.Console.ANSI -satisfy :: (MonadIO m, MonadSessionConfig m) => (a -> Bool) -> ConduitParser a m a +satisfy :: (MonadIO m, MonadSessionConfig m) => (FromServerMessage -> Bool) -> ConduitParser FromServerMessage m FromServerMessage satisfy pred = do timeout <- timeout <$> lift sessionConfig tId <- liftIO myThreadId @@ -27,6 +28,12 @@ satisfy pred = do throwTo tId TimeoutException x <- await liftIO $ killThread timeoutThread + + liftIO $ do + setSGR [SetColor Foreground Vivid Magenta] + putStrLn $ "<-- " ++ B.unpack (encodeMsg x) + setSGR [Reset] + if pred x then return x else empty