2020-07-14 22:28:02 +04:00
|
|
|
|
|
|
|
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
|
|
|
|
|
2020-08-11 13:33:26 +03:00
|
|
|
_test :: IO ([Int] -> IO Int)
|
|
|
|
_test = debounced \s -> do
|
2020-07-14 22:28:02 +04:00
|
|
|
threadDelay 2000000
|
|
|
|
unless (odd (length s)) do
|
|
|
|
error "even"
|
2020-07-20 01:04:01 +04:00
|
|
|
return (length s)
|