git.iko.soy/typeable/wai
on warp-3.2.27-conn-closed-by-pear help sign in
typeable/wai/auto-update/Control/Debounce.hs
94 lines 2.7 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.
7--
8-- Example usage:
9--
10-- @
11-- printString <- 'mkDebounce' 'defaultDebounceSettings'
12-- { 'debounceAction' = putStrLn "Running action"
13-- , 'debounceFreq' = 5000000 -- 5 seconds
14-- }
15-- @
16--
17-- >>> printString
18-- Running action
19-- >>> printString
20-- <Wait five seconds>
21-- Running action
22--
23-- See the fast-logger package ("System.Log.FastLogger") for real-world usage.
24--
25-- @since 0.1.2
26module Control.Debounce
27 ( -- * Type
28 DebounceSettings
29 , defaultDebounceSettings
30 -- * Accessors
31 , debounceFreq
32 , debounceAction
33 -- * Creation
34 , mkDebounce
35 ) where
37import Control.Concurrent (forkIO, threadDelay)
38import Control.Concurrent.MVar (newEmptyMVar, takeMVar, tryPutMVar)
39import Control.Exception (SomeException, handle, mask_)
40import Control.Monad (forever, void)
42-- | Settings to control how debouncing should work.
43--
44-- This should be constructed using 'defaultDebounceSettings' and record
45-- update syntax, e.g.:
46--
47-- @
48-- let settings = 'defaultDebounceSettings' { 'debounceAction' = flushLog }
49-- @
50--
51-- @since 0.1.2
52data DebounceSettings = DebounceSettings
53 { debounceFreq :: Int
54 -- ^ Microseconds lag required between subsequence calls to the debounced
55 -- action.
56 --
57 -- Default: 1 second (1000000)
58 --
59 -- @since 0.1.2
60 , debounceAction :: IO ()
61 -- ^ Action to be performed.
62 --
63 -- Note: all exceptions thrown by this action will be silently discarded.
64 --
65 -- Default: does nothing.
66 --
67 -- @since 0.1.2
68 }
70-- | Default value for creating a 'DebounceSettings'.
71--
72-- @since 0.1.2
73defaultDebounceSettings :: DebounceSettings
74defaultDebounceSettings = DebounceSettings
75 { debounceFreq = 1000000
76 , debounceAction = return ()
77 }
79-- | Generate an action which will trigger the debounced action to be
80-- performed. The action will either be performed immediately, or after the
81-- current cooldown period has expired.
82--
83-- @since 0.1.2
84mkDebounce :: DebounceSettings -> IO (IO ())
85mkDebounce (DebounceSettings freq action) = do
86 baton <- newEmptyMVar
87 mask_ $ void $ forkIO $ forever $ do
88 takeMVar baton
89 ignoreExc action
90 threadDelay freq
91 return $ void $ tryPutMVar baton ()
93ignoreExc :: IO () -> IO ()
94ignoreExc = handle $ \(_ :: SomeException) -> return ()