X-Git-Url: http://git.lukelau.me/?p=opengl.git;a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest%2FParsing.hs;h=614495b27e68c051249fa10beb0bef0e5a11b788;hp=b28047ce0f93ac75fee9f54fad0581ab39d9ebf7;hb=d8e460543b7cbc32550bed20d20ef4b13d6705a5;hpb=0da56e90a0fd4ada9acb01ca9ce769c5924653ec diff --git a/src/Language/Haskell/LSP/Test/Parsing.hs b/src/Language/Haskell/LSP/Test/Parsing.hs index b28047c..614495b 100644 --- a/src/Language/Haskell/LSP/Test/Parsing.hs +++ b/src/Language/Haskell/LSP/Test/Parsing.hs @@ -6,6 +6,7 @@ module Language.Haskell.LSP.Test.Parsing where import Control.Applicative import Control.Concurrent +import Control.Lens import Control.Monad.IO.Class import Control.Monad.Trans.Class import Data.Aeson @@ -13,7 +14,7 @@ import qualified Data.ByteString.Lazy.Char8 as B import Data.Conduit.Parser import Data.Maybe import Language.Haskell.LSP.Messages -import Language.Haskell.LSP.Types hiding (error) +import Language.Haskell.LSP.Types as LSP hiding (error) import Language.Haskell.LSP.Test.Exceptions import Language.Haskell.LSP.Test.Messages import Language.Haskell.LSP.Test.Session @@ -68,6 +69,15 @@ response = named "Response" $ do x <- satisfy (isJust . parser) return $ castMsg x +responseForId :: forall m a. (MonadIO m, MonadSessionConfig m, FromJSON a) => LspId -> ConduitParser FromServerMessage m (ResponseMessage a) +responseForId lid = named "Response for id" $ do + let parser = decode . encodeMsg :: FromServerMessage -> Maybe (ResponseMessage a) + x <- satisfy (maybe False (\z -> z ^. LSP.id == responseId lid) . parser) + return $ castMsg x + +anyMessage :: (MonadIO m, MonadSessionConfig m) => ConduitParser FromServerMessage m FromServerMessage +anyMessage = satisfy (const True) + -- | A stupid method for getting out the inner message. castMsg :: FromJSON a => FromServerMessage -> a castMsg = fromMaybe (error "Failed casting a message") . decode . encodeMsg