From a3130a85efbf9249ab983bcf66586ed3c596e33a Mon Sep 17 00:00:00 2001
From: Luke Lau <luke_lau@icloud.com>
Date: Wed, 6 Jun 2018 11:42:01 -0400
Subject: [PATCH] Ignore logging messages and remove some verbose logging

---
 src/Language/Haskell/LSP/Test/Recorded.hs | 39 +++++++++++------------
 1 file changed, 18 insertions(+), 21 deletions(-)

diff --git a/src/Language/Haskell/LSP/Test/Recorded.hs b/src/Language/Haskell/LSP/Test/Recorded.hs
index c028478..35bd6f3 100644
--- a/src/Language/Haskell/LSP/Test/Recorded.hs
+++ b/src/Language/Haskell/LSP/Test/Recorded.hs
@@ -40,17 +40,19 @@ replaySession sessionDir = do
 
   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
 
@@ -117,8 +119,6 @@ sendMessages (nextMsg:remainingMsgs) reqSema rspSema =
     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"
 
@@ -187,7 +187,9 @@ listenServer expectedMsgs reqMap reqSema rspSema passVar serverOut  = do
     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"
@@ -203,8 +205,6 @@ listenServer expectedMsgs reqMap reqSema rspSema passVar serverOut  = do
   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 ()
@@ -216,19 +216,10 @@ listenServer expectedMsgs reqMap reqSema rspSema passVar serverOut  = do
       ++ " "
       ++ 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)
 
 
 
@@ -245,9 +236,15 @@ listenServer expectedMsgs reqMap reqSema rspSema passVar serverOut  = do
 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
-- 
2.30.2