events <- swapFiles sessionDir unswappedEvents
- let clientEvents = map (\(FromClient _ msg) -> msg) $ filter isClientMsg events
- serverEvents = map (\(FromServer _ msg) -> msg) $ filter isServerMsg events
- requestMap = getRequestMap clientEvents
+ let clientEvents = filter isClientMsg events
+ serverEvents = filter isServerMsg events
+ clientMsgs = map (\(FromClient _ msg) -> msg) clientEvents
+ serverMsgs = filter (not . shouldSkip) $ map (\(FromServer _ msg) -> msg) serverEvents
+ requestMap = getRequestMap clientMsgs
reqSema <- newEmptyMVar
rspSema <- newEmptyMVar
passVar <- newEmptyMVar :: IO (MVar Bool)
- forkIO $ runSessionWithHandler (listenServer serverEvents requestMap reqSema rspSema passVar) sessionDir $
- sendMessages clientEvents reqSema rspSema
+ forkIO $ runSessionWithHandler (listenServer serverMsgs requestMap reqSema rspSema passVar) sessionDir $
+ sendMessages clientMsgs reqSema rspSema
takeMVar passVar
sendMessages remainingMsgs reqSema rspSema
request msg@(RequestMessage _ id m _) = do
- liftIO $ print $ addHeader $ encode msg
-
sendRequest' msg
liftIO $ putStrLn $ "Sent a request id " ++ show id ++ ": " ++ show m ++ "\nWaiting for a response"
NotTelemetry m -> notification m
NotCancelRequestFromServer m -> notification m
- if inRightOrder msg expectedMsgs
+ if shouldSkip msg
+ then listenServer expectedMsgs reqMap reqSema rspSema passVar serverOut
+ else if inRightOrder msg expectedMsgs
then listenServer (delete msg expectedMsgs) reqMap reqSema rspSema passVar serverOut
else liftIO $ do
putStrLn "Out of order"
response res = do
liftIO $ putStrLn $ "Got response for id " ++ show (res ^. id)
- liftIO $ print res
-
liftIO $ putMVar rspSema (res ^. id) -- unblock the handler waiting to send a request
request :: (Show a, Show b) => RequestMessage ServerMethod a b -> Session ()
++ " "
++ show (req ^. method)
- liftIO $ print req
-
liftIO $ putMVar reqSema (req ^. id) -- unblock the handler waiting for a response
notification :: Show a => NotificationMessage ServerMethod a -> Session ()
- notification n = do
- liftIO $ putStrLn $ "Got notification " ++ show (n ^. method)
- liftIO $ print n
-
- liftIO
- $ putStrLn
- $ show (length (filter isNotification expectedMsgs) - 1)
- ++ " notifications remaining"
+ notification n = liftIO $ putStrLn $ "Got notification " ++ show (n ^. method)
inRightOrder :: FromServerMessage -> [FromServerMessage] -> Bool
inRightOrder _ [] = error "Why is this empty"
--- inRightOrder (LSP.NotificationMessage _ _ _) _ = True
inRightOrder received (expected : msgs)
| received == expected = True
| isNotification expected = inRightOrder received msgs
| otherwise = False
+
+-- | Ignore logging notifications since they vary from session to session
+shouldSkip :: FromServerMessage -> Bool
+shouldSkip (NotLogMessage _) = True
+shouldSkip (NotShowMessage _) = True
+shouldSkip (ReqShowMessage _) = True
+shouldSkip _ = False