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