@@ -3,8 +3,9 @@
33
44module Development.IDE.Core.Debouncer
55 ( Debouncer
6− , newDebouncer
76 , registerEvent
7+ , newAsyncDebouncer
8+ , noopDebouncer
89 ) where
910
1011import Control.Concurrent.Extra
@@ -22,13 +23,14 @@ import System.Time.Extra
2223-- by delaying each event for a given time. If another event
2324-- is registered for the same key within that timeframe,
2425-- only the new event will fire.
25−newtype Debouncer k = Debouncer (Var (HashMap k (Async ())))
26+--
27+-- We abstract over the debouncer used so we an use a proper debouncer in the IDE but disable
28+-- debouncing in the DAML CLI compiler.
29+newtype Debouncer k = Debouncer { registerEvent :: Seconds -> k -> IO () -> IO () }
2630
27−-- | Create a new empty debouncer.
28−newDebouncer :: IO (Debouncer k)
29−newDebouncer = do
30− m <- newVar Map.empty
31− pure $ Debouncer m
31+-- | Debouncer used in the IDE that delays events as expected.
32+newAsyncDebouncer :: (Eq k, Hashable k) => IO (Debouncer k)
33+newAsyncDebouncer = Debouncer . asyncRegisterEvent <$> newVar Map.empty
3234
3335-- | Register an event that will fire after the given delay if no other event
3436-- for the same key gets registered until then.
@@ -36,11 +38,15 @@ newDebouncer = do
3638-- If there is a pending event for the same key, the pending event will be killed.
3739-- Events are run unmasked so it is up to the user of `registerEvent`
3840-- to mask if required.
39−registerEvent :: (Eq k, Hashable k) => Debouncer k -> Seconds -> k -> IO () -> IO ()
40−registerEvent (Debouncer d) delay k fire = modifyVar_ d $ \m -> mask_ $ do
41+asyncRegisterEvent :: (Eq k, Hashable k) => Var (HashMap k (Async ())) -> Seconds -> k -> IO () -> IO ()
42+asyncRegisterEvent d delay k fire = modifyVar_ d $ \m -> mask_ $ do
4143 whenJust (Map.lookup k m) cancel
4244 a <- asyncWithUnmask $ \unmask -> unmask $ do
4345 sleep delay
4446 fire
4547 modifyVar_ d (pure . Map.delete k)
4648 pure $ Map.insert k a m
49+
50+-- | Debouncer used in the DAML CLI compiler that emits events immediately.
51+noopDebouncer :: Debouncer k
52+noopDebouncer = Debouncer $ \_ _ a -> a