From: Luke Lau <luke_lau@icloud.com>
Date: Sat, 27 Feb 2021 17:17:51 +0000 (+0000)
Subject: Merge pull request #89 from wz1000/lsp-equality
X-Git-Url: https://git.lukelau.me/?p=lsp-test.git;a=commitdiff_plain;h=0132314e3f91ad3ba9e0405e53f5dca6f5d46ab1;hp=-c

Merge pull request #89 from wz1000/lsp-equality

update equality function
---

0132314e3f91ad3ba9e0405e53f5dca6f5d46ab1
diff --combined src/Language/LSP/Test/Parsing.hs
index 58785d9,b522116..247f969
--- a/src/Language/LSP/Test/Parsing.hs
+++ b/src/Language/LSP/Test/Parsing.hs
@@@ -83,21 -83,16 +83,21 @@@ satisfyMaybeM pred = d
    
    skipTimeout <- overridingTimeout <$> get
    timeoutId <- getCurTimeoutId
 -  unless skipTimeout $ do
 +  mtid <-
 +    if skipTimeout
 +    then pure Nothing
 +    else Just <$> do
        chan <- asks messageChan
        timeout <- asks (messageTimeout . config)
 -    void $ liftIO $ forkIO $ do
 +      liftIO $ forkIO $ do
          threadDelay (timeout * 1000000)
          writeChan chan (TimeoutMessage timeoutId)
  
    x <- Session await
  
 -  unless skipTimeout (bumpTimeoutId timeoutId)
 +  forM_ mtid $ \tid -> do
 +    bumpTimeoutId timeoutId
 +    liftIO $ killThread tid
  
    modify $ \s -> s { lastReceivedMessage = Just x }
  
@@@ -117,8 -112,10 +117,10 @@@ named s (Session x) = Session (Data.Con
  message :: SServerMethod m -> Session (ServerMessage m)
  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))
@@@ -168,7 -165,7 +170,7 @@@ anyResponse = named "Any response" $ sa
  response :: SMethod (m :: Method FromClient Request) -> Session (ResponseMessage m)
  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
  
@@@ -178,17 -175,10 +180,10 @@@ responseForId m lid = named (T.pack $ "
    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