{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PolyKinds #-}
satisfy
, satisfyMaybe
, message
+ , responseForId
+ , customRequest
+ , customNotification
, anyRequest
, anyResponse
, anyNotification
, anyMessage
, loggingNotification
, publishDiagnosticsNotification
- , responseForId
) where
import Control.Applicative
pure HRefl
_ -> Nothing
+-- | Matches non-custom messages
message :: SServerMethod m -> Session (ServerMessage m)
message m1 = named (T.pack $ show m1) $ satisfyMaybe $ \case
FromServerMess m2 msg -> do
pure msg
_ -> Nothing
+customRequest :: T.Text -> Session (ServerMessage (CustomMethod :: Method FromServer Request))
+customRequest m = named m $ satisfyMaybe $ \case
+ FromServerMess m1 msg -> case splitServerMethod m1 of
+ IsServerEither -> case msg of
+ ReqMess _ | m1 == SCustomMethod m -> Just msg
+ _ -> Nothing
+ _ -> Nothing
+ _ -> Nothing
+
+customNotification :: T.Text -> Session (ServerMessage (CustomMethod :: Method FromServer Notification))
+customNotification m = named m $ satisfyMaybe $ \case
+ FromServerMess m1 msg -> case splitServerMethod m1 of
+ IsServerEither -> case msg of
+ NotMess _ | m1 == SCustomMethod m -> Just msg
+ _ -> Nothing
+ _ -> Nothing
+ _ -> Nothing
+
-- | Matches if the message is a notification.
anyNotification :: Session FromServerMessage
anyNotification = named "Any notification" $ satisfy $ \case
- FromServerMess m _ -> case splitServerMethod m of
+ FromServerMess m msg -> case splitServerMethod m of
IsServerNot -> True
+ IsServerEither -> case msg of
+ NotMess _ -> True
+ _ -> False
_ -> False
FromServerRsp _ _ -> False
Just HRefl -> do
guard (lid' == Just lid)
pure rspMsg
- Nothing -> empty
+ Nothing
+ | SCustomMethod tm <- m
+ , SCustomMethod tm' <- m'
+ , tm == tm'
+ , lid' == Just lid -> pure rspMsg
+ _ -> empty
-- | Matches any type of message.
anyMessage :: Session FromServerMessage