-anyResponse = named "Any response" $ satisfy isServerResponse
-
--- | Matches a response for a specific id.
-responseForId :: forall a. FromJSON a => LspId -> Session (ResponseMessage a)
-responseForId lid = named (T.pack $ "Response for id: " ++ show lid) $ do
- let parser = decode . encodeMsg :: FromServerMessage -> Maybe (ResponseMessage a)
- x <- satisfy (maybe False (\z -> z ^. LSP.id == responseId lid) . parser)
- return $ castMsg x
+anyResponse = named "Any response" $ satisfy $ \case
+ FromServerMess _ _ -> False
+ FromServerRsp _ _ -> True
+
+-- | Matches a response coming from the server.
+response :: SMethod (m :: Method FromClient Request) -> Session (ResponseMessage m)
+response m1 = named (T.pack $ show m1) $ satisfyMaybe $ \case
+ FromServerRsp m2 msg -> do
+ HRefl <- mEqClient m1 m2
+ pure msg
+ _ -> Nothing
+
+-- | Like 'response', but matches a response for a specific id.
+responseForId :: SMethod (m :: Method FromClient Request) -> LspId m -> Session (ResponseMessage m)
+responseForId m lid = named (T.pack $ "Response for id: " ++ show lid) $ do
+ satisfyMaybe $ \msg -> do
+ case msg of
+ FromServerMess _ _ -> Nothing
+ FromServerRsp m' rspMsg@(ResponseMessage _ lid' _) ->
+ case mEqClient m m' of
+ Just HRefl -> do
+ guard (lid' == Just lid)
+ pure rspMsg
+ Nothing
+ | SCustomMethod tm <- m
+ , SCustomMethod tm' <- m'
+ , tm == tm'
+ , lid' == Just lid -> pure rspMsg
+ _ -> empty