X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest%2FParsing.hs;h=fdd01c2a047b7d620ee606334ae96c9805a01ee3;hb=88c70a40654c7152fb50b2a4e171fbdc00324f51;hp=53485f19c832ed0cdaab269fbc758aec16cbb1c8;hpb=d8ce5332e9ac2dc24bf1490f03bd30abb17196e8;p=opengl.git diff --git a/src/Language/Haskell/LSP/Test/Parsing.hs b/src/Language/Haskell/LSP/Test/Parsing.hs index 53485f1..fdd01c2 100644 --- a/src/Language/Haskell/LSP/Test/Parsing.hs +++ b/src/Language/Haskell/LSP/Test/Parsing.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} module Language.Haskell.LSP.Test.Parsing where @@ -9,7 +8,7 @@ import Control.Monad.IO.Class import Control.Monad.Trans.Reader import Control.Monad.Trans.State import Language.Haskell.LSP.Messages -import Language.Haskell.LSP.Types +import Language.Haskell.LSP.Types hiding (error) import Language.Haskell.LSP.Test.Messages import Language.Haskell.LSP.Test.Decoding import System.IO @@ -18,8 +17,6 @@ import Control.Concurrent.MVar import Data.Conduit hiding (await) import Data.Conduit.Parser -data MessageParserState = MessageParserState - data SessionContext = SessionContext { serverIn :: Handle, @@ -34,6 +31,7 @@ newtype SessionState = SessionState } 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', @@ -48,19 +46,19 @@ type ParserStateReader a s r m = ConduitParser a (StateT s (ReaderT r m)) type Session = ParserStateReader FromServerMessage SessionState SessionContext IO -- | Matches if the message is a notification. -notification :: Session FromServerMessage +notification :: Monad m => ConduitParser FromServerMessage m FromServerMessage notification = satisfy isServerNotification -- | Matches if the message is a request. -request :: Session FromServerMessage +request :: Monad m => ConduitParser FromServerMessage m FromServerMessage request = satisfy isServerRequest -- | Matches if the message is a response. -response :: Session FromServerMessage +response :: Monad m => ConduitParser FromServerMessage m FromServerMessage response = satisfy isServerResponse -- | Matches if the message is a log message notification or a show message notification/request. -loggingNotification :: Session FromServerMessage +loggingNotification :: Monad m => ConduitParser FromServerMessage m FromServerMessage loggingNotification = satisfy shouldSkip where shouldSkip (NotLogMessage _) = True @@ -68,6 +66,13 @@ loggingNotification = satisfy shouldSkip shouldSkip (ReqShowMessage _) = True shouldSkip _ = False +publishDiagnosticsNotification :: Monad m => ConduitParser FromServerMessage m PublishDiagnosticsNotification +publishDiagnosticsNotification = do + NotPublishDiagnostics diags <- satisfy test + return diags + where test (NotPublishDiagnostics _) = True + test _ = False + satisfy :: Monad m => (a -> Bool) -> ConduitParser a m a satisfy pred = do x <- await