From 3233270dbabbc1a1c5b4cb8a0bda42bab2f0b77a Mon Sep 17 00:00:00 2001
From: Kirill Andreev <hindmost.one@gmail.com>
Date: Tue, 14 Jul 2020 22:28:02 +0400
Subject: [PATCH] Add `debounced` function

---
 tools/lsp/squirrel/src/Debouncer.hs | 39 +++++++++++++++++++++++++++++
 1 file changed, 39 insertions(+)
 create mode 100644 tools/lsp/squirrel/src/Debouncer.hs

diff --git a/tools/lsp/squirrel/src/Debouncer.hs b/tools/lsp/squirrel/src/Debouncer.hs
new file mode 100644
index 000000000..b90f7bacb
--- /dev/null
+++ b/tools/lsp/squirrel/src/Debouncer.hs
@@ -0,0 +1,39 @@
+
+module Debouncer (debounced) where
+
+import Control.Monad.Catch
+import Control.Monad
+import Control.Concurrent
+
+-- | Ensure the function is run in single thread, w/o overlapping.
+--
+--   If called concurently, everyone will get results of the winner.
+--
+--   If called, waits for next result to arrive.
+--
+--   If function throws an error, will rethrow it in caller thread.
+--
+debounced :: forall s r. (s -> IO r) -> IO (s -> IO r)
+debounced act = do
+  i <- newEmptyMVar
+  o <- newEmptyMVar
+
+  mask_ do
+    forkIO do
+      forever do
+        _  <- tryTakeMVar o
+        i' <- takeMVar i
+        o' <- try $ act i'
+        putMVar o (o' :: Either SomeException r)
+
+  return $ \i' -> do
+    _ <- tryTakeMVar i
+    putMVar i i'
+    readMVar o >>= either throwM return
+
+test :: IO ([Int] -> IO Int)
+test = debounced \s -> do
+  threadDelay 2000000
+  unless (odd (length s)) do
+    error "even"
+  return (length s)
\ No newline at end of file