-import System.IO
-
-data SessionContext = SessionContext
- {
- serverIn :: Handle,
- rootDir :: FilePath,
- messageChan :: Chan FromServerMessage,
- requestMap :: MVar RequestMap
- }
-
-newtype SessionState = SessionState
- {
- curReqId :: LspId
- }
-
-type ParserStateReader a s r m = ConduitParser a (StateT s (ReaderT r m))
-
--- | A session representing one instance of launching and connecting to a server.
---
--- You can send and receive messages to the server within 'Session' via 'getMessage',
--- 'sendRequest' and 'sendNotification'.
---
--- @
--- runSession \"path\/to\/root\/dir\" $ do
--- docItem <- getDocItem "Desktop/simple.hs" "haskell"
--- sendNotification TextDocumentDidOpen (DidOpenTextDocumentParams docItem)
--- diagnostics <- getMessage :: Session PublishDiagnosticsNotification
--- @
-type Session = ParserStateReader FromServerMessage SessionState SessionContext IO
+import Language.Haskell.LSP.Test.Session
+import System.Console.ANSI
+
+satisfy :: (MonadIO m, MonadSessionConfig m) => (FromServerMessage -> Bool) -> ConduitParser FromServerMessage m FromServerMessage
+satisfy pred = do
+ timeout <- timeout <$> lift sessionConfig
+ tId <- liftIO myThreadId
+ timeoutThread <- liftIO $ forkIO $ do
+ threadDelay (timeout * 1000000)
+ throwTo tId TimeoutException
+ x <- await
+ liftIO $ killThread timeoutThread
+
+ if pred x
+ then do
+ liftIO $ do
+ setSGR [SetColor Foreground Vivid Magenta]
+ putStrLn $ "<-- " ++ B.unpack (encodeMsg x)
+ setSGR [Reset]
+ return x
+ else empty