git.iko.soy/typeable/wai
on wai-app-static/3.1.4 help sign in
typeable/wai/auto-update/Control/Debounce.hs
78 lines 2.3 kB history raw
1{-# LANGUAGE ScopedTypeVariables #-}
2-- | Debounce an action, ensuring it doesn't occur more than once for a given
3-- period of time.
4--
5-- This is useful as an optimization, for example to ensure that logs are only
6-- flushed to disk at most once per second. See the fast-logger package for an
7-- example usage.
8--
9-- Since 0.1.2
10module Control.Debounce
11 ( -- * Type
12 DebounceSettings
13 , defaultDebounceSettings
14 -- * Accessors
15 , debounceFreq
16 , debounceAction
17 -- * Creation
18 , mkDebounce
19 ) where
21import Control.Concurrent (forkIO, threadDelay)
22import Control.Concurrent.MVar (newEmptyMVar, takeMVar, tryPutMVar)
23import Control.Exception (SomeException, handle, mask_)
24import Control.Monad (forever, void)
26-- | Settings to control how debouncing should work.
27--
28-- This should be constructed using @defaultDebounceSettings@ and record
29-- update syntax, e.g.:
30--
31-- @
32-- let set = defaultDebounceSettings { debounceAction = flushLog }
33-- @
34--
35-- Since 0.1.2
36data DebounceSettings = DebounceSettings
37 { debounceFreq :: Int
38 -- ^ Microseconds lag required between subsequence calls to the debounced
39 -- action.
40 --
41 -- Default: 1 second (1000000)
42 --
43 -- Since 0.1.2
44 , debounceAction :: IO ()
45 -- ^ Action to be performed.
46 --
47 -- Note: all exceptions thrown by this action will be silently discarded.
48 --
49 -- Default: does nothing.
50 --
51 -- Since 0.1.2
52 }
54-- | Default value for creating a @DebounceSettings@.
55--
56-- Since 0.1.2
57defaultDebounceSettings :: DebounceSettings
58defaultDebounceSettings = DebounceSettings
59 { debounceFreq = 1000000
60 , debounceAction = return ()
61 }
63-- | Generate an action which will trigger the debounced action to be
64-- performed. The action will either be performed immediately, or after the
65-- current cooldown period has expired.
66--
67-- Since 0.1.2
68mkDebounce :: DebounceSettings -> IO (IO ())
69mkDebounce (DebounceSettings freq action) = do
70 baton <- newEmptyMVar
71 mask_ $ void $ forkIO $ forever $ do
72 takeMVar baton
73 ignoreExc action
74 threadDelay freq
75 return $ void $ tryPutMVar baton ()
77ignoreExc :: IO () -> IO ()
78ignoreExc = handle $ \(_ :: SomeException) -> return ()