X-Git-Url: https://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FLSP%2FTest%2FParsing.hs;h=b5221168dff1ba2bf6d2f55fecb96fa99c3b3935;hb=7ce2b4cb189b6276eed979661852029d68191c8f;hp=95937c51c11fca122f8d0bafd7735a38f64169c0;hpb=aa0ac8a0a985651741e11efc3af3973db88cf80f;p=lsp-test.git

diff --git a/src/Language/LSP/Test/Parsing.hs b/src/Language/LSP/Test/Parsing.hs
index 95937c5..b522116 100644
--- a/src/Language/LSP/Test/Parsing.hs
+++ b/src/Language/LSP/Test/Parsing.hs
@@ -4,7 +4,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeInType #-}
 {-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeInType #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RankNTypes #-}
@@ -110,10 +110,12 @@ named s (Session x) = Session (Data.Conduit.Parser.named s x)
 
 -- | Matches a request or a notification coming from the server.
 message :: SServerMethod m -> Session (ServerMessage m)
-message m1 = named (T.pack $ show m1) $ satisfyMaybe $ \case
+message m1 = named (T.pack $ "Request for: " <> show m1) $ satisfyMaybe $ \case
   FromServerMess m2 msg -> do
-    HRefl <- mEqServer m1 m2
-    pure msg
+    res <- mEqServer m1 m2
+    case res of
+      Right HRefl -> pure msg
+      Left f -> Nothing
   _ -> Nothing
 
 customRequest :: T.Text -> Session (ServerMessage (CustomMethod :: Method FromServer Request))
@@ -161,9 +163,9 @@ anyResponse = named "Any response" $ satisfy $ \case
 
 -- | 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
+response m1 = named (T.pack $ "Response for: " <> show m1) $ satisfyMaybe $ \case
   FromServerRsp m2 msg -> do
-    HRefl <- mEqClient m1 m2
+    HRefl <- runEq mEqClient m1 m2
     pure msg
   _ -> Nothing
 
@@ -173,17 +175,10 @@ 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)
+      FromServerRsp m' rspMsg@(ResponseMessage _ lid' _) -> do
+        HRefl <- runEq mEqClient m m'
+        guard (Just lid == lid')
         pure rspMsg
-          Nothing
-            | SCustomMethod tm <- m
-            , SCustomMethod tm' <- m'
-            , tm == tm'
-            , lid' == Just lid -> pure rspMsg
-          _ -> empty
 
 -- | Matches any type of message.
 anyMessage :: Session FromServerMessage
@@ -198,9 +193,9 @@ loggingNotification = named "Logging notification" $ satisfy shouldSkip
     shouldSkip (FromServerMess SWindowShowMessageRequest _) = True
     shouldSkip _ = False
 
--- | Matches a 'Language.LSP.Test.PublishDiagnosticsNotification'
+-- | Matches a 'Language.LSP.Types.TextDocumentPublishDiagnostics'
 -- (textDocument/publishDiagnostics) notification.
-publishDiagnosticsNotification :: Session PublishDiagnosticsNotification
+publishDiagnosticsNotification :: Session (Message TextDocumentPublishDiagnostics)
 publishDiagnosticsNotification = named "Publish diagnostics notification" $
   satisfyMaybe $ \msg -> case msg of
     FromServerMess STextDocumentPublishDiagnostics diags -> Just diags