[waspls] fix debouncer tests (#1284)

waspc/waspls/test/Wasp/LSP/DebouncerTest.hs

@@ -3,52 +3,72 @@ module Wasp.LSP.DebouncerTest
   )
 where
 
-import Control.Concurrent (newEmptyMVar, threadDelay, tryPutMVar, tryReadMVar)
-import Control.Monad (replicateM_, void)
-import GHC.Conc (atomically, newTVarIO, readTVar, readTVarIO, writeTVar)
+import Control.Concurrent (newEmptyMVar, readMVar, tryPutMVar)
+import Control.Monad (void)
+import Data.Maybe (isJust)
+import System.Timeout (timeout)
 import Test.Tasty.Hspec
 import Wasp.LSP.Debouncer (debounce, newDebouncerIO)
 
+-- | Debounce time for all tests in microseconds.
+debounceTime :: Int
+debounceTime = 1000
+
+-- | How long to wait until we decide a test is never going to finish.
+timeoutTime :: Int
+timeoutTime = 1 * 1000 * 1000
+
 spec_Debouncer :: Spec
 spec_Debouncer = describe "Wasp.LSP.Debouncer" $ do
-  it "runs the action" $ do
+  -- To test this multithreaded code, which can have nondeterminism problems due
+  -- to randomness in what order the threads get woken up, these tests follow
+  -- this general pattern:
+  --
+  -- 1. Create an empty MVar to track when actions get run.
+  -- 2. Debounce actions to fill those MVars.
+  -- 3. Wait on those MVars to be filled (with a timeout) and check their
+  --    properties.
+  -- 4. If we want to make sure the action was run, check to make sure the
+  --    timeout wasn't reached, which is done by checking if the return value is
+  --    'Just'.
+  --
+  -- TODO: find a robust  way to test that actions get debounced when run close
+  -- enough to each other in time.
+
+  it "eventually runs the action" $ do
     debouncer <- newDebouncerIO
     mvar <- newEmptyMVar
 
-    debounce debouncer 1000 () (void $ tryPutMVar mvar ())
-    threadDelay 20000
-
-    tryReadMVar mvar >>= (`shouldBe` Just ())
+    -- Debounce filling the mvar and wait for it to be filled.
+    debounce debouncer debounceTime () (void $ tryPutMVar mvar ())
+    timedOut <- timeout timeoutTime $ readMVar mvar >>= (`shouldBe` ())
+    timedOut `shouldSatisfy` isJust
 
   it "doesn't debounce actions for different events" $ do
     debouncer <- newDebouncerIO
     mvar1 <- newEmptyMVar
     mvar2 <- newEmptyMVar
 
-    debounce debouncer 1000 'a' (void $ tryPutMVar mvar1 ())
-    debounce debouncer 1000 'b' (void $ tryPutMVar mvar2 ())
-    threadDelay 20000
+    -- Run two actions with different events.
+    debounce debouncer debounceTime 'a' (void $ tryPutMVar mvar1 ())
+    debounce debouncer debounceTime 'b' (void $ tryPutMVar mvar2 ())
 
-    tryReadMVar mvar1 >>= (`shouldBe` Just ())
-    tryReadMVar mvar2 >>= (`shouldBe` Just ())
+    -- Check that both actions executed.
+    timedOut <- timeout timeoutTime $ do
+      readMVar mvar1 >>= (`shouldBe` ())
+      readMVar mvar2 >>= (`shouldBe` ())
+    timedOut `shouldSatisfy` isJust
 
-  it "debounces actions with the same event" $ do
+  it "can run multiple actions with the same event" $ do
     debouncer <- newDebouncerIO
-    countTVar <- newTVarIO (0 :: Int)
+    mvar <- newEmptyMVar
 
-    replicateM_ 2 $
-      debounce debouncer 1000 () (atomically $ readTVar countTVar >>= (writeTVar countTVar . (+ 1)))
-    threadDelay 20000
+    -- Run an action, wait for it to run, and check that it ran.
+    debounce debouncer debounceTime () (void $ tryPutMVar mvar ())
+    firstTimedOut <- timeout timeoutTime $ readMVar mvar
+    firstTimedOut `shouldSatisfy` isJust
 
-    readTVarIO countTVar >>= (`shouldBe` 1)
-
-  it "executes multiple actions from the same event given enough time" $ do
-    debouncer <- newDebouncerIO
-    countTVar <- newTVarIO (0 :: Int)
-
-    debounce debouncer 1000 () (atomically $ readTVar countTVar >>= (writeTVar countTVar . (+ 1)))
-    threadDelay 20000
-    debounce debouncer 1000 () (atomically $ readTVar countTVar >>= (writeTVar countTVar . (+ 1)))
-    threadDelay 20000
-
-    readTVarIO countTVar >>= (`shouldBe` 2)
+    -- Run the second action, wait for it to run, and check that it ran.
+    debounce debouncer debounceTime () (void $ tryPutMVar mvar ())
+    secondTimedOut <- timeout timeoutTime $ readMVar mvar
+    secondTimedOut `shouldSatisfy` isJust