git.iko.soy/ghcide
on master help sign in
Implement debouncing of diagnostics (#1991)

Previously, we emitted diagnostics notifications as soon as we got them. This resulted in a lot of flickering due to diagnostics getting cleared briefly when typing only to immediately reappear. Now, we buffer them for 0.1s so that a new event restoring the same diagnostics for a slightly modified file will overwrite the initial clear of diagnostics for the new document version.

commitd61807c240d4d5d393096aff9fe4fdcc89ca5368 authorMoritz Kiefer <moritz.kiefer@purelyfunctional.org> dateWed 3 Jul 2019, 19:30 (7 years ago) parentddb7bd3
2 files changed+56−6
compare with master
unifiedsplit
src/Development/IDE/Core/Debouncer.hs+45 src/Development/IDE/Core/Shake.hs+11−6
src/Development/IDE/Core/Debouncer.hsnew file+45
@@ -0,0 +1,45 @@
1+-- Copyright (c) 2019 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
2+-- SPDX-License-Identifier: Apache-2.0
3+
4+module Development.IDE.Core.Debouncer
5+ ( Debouncer
6+ , newDebouncer
7+ , registerEvent
8+ ) where
9+
10+import Control.Concurrent.Extra
11+import Control.Concurrent.Async
12+import Control.Exception
13+import Control.Monad.Extra
14+import Data.Map.Strict (Map)
15+import qualified Data.Map.Strict as Map
16+import System.Time.Extra
17+
18+-- | A debouncer can be used to avoid triggering many events
19+-- (e.g. diagnostics) for the same key (e.g. the same file)
20+-- within a short timeframe. This is accomplished
21+-- by delaying each event for a given time. If another event
22+-- is registered for the same key within that timeframe,
23+-- only the new event will fire.
24+newtype Debouncer k = Debouncer (Var (Map k (Async ())))
25+
26+-- | Create a new empty debouncer.
27+newDebouncer :: IO (Debouncer k)
28+newDebouncer = do
29+ m <- newVar Map.empty
30+ pure $ Debouncer m
31+
32+-- | Register an event that will fire after the given delay if no other event
33+-- for the same key gets registered until then.
34+--
35+-- If there is a pending event for the same key, the pending event will be killed.
36+-- Events are run unmasked so it is up to the user of `registerEvent`
37+-- to mask if required.
38+registerEvent :: Ord k => Debouncer k -> Seconds -> k -> IO () -> IO ()
39+registerEvent (Debouncer d) delay k fire = modifyVar_ d $ \m -> mask_ $ do
40+ whenJust (Map.lookup k m) cancel
41+ a <- asyncWithUnmask $ \unmask -> unmask $ do
42+ sleep delay
43+ fire
44+ modifyVar_ d (pure . Map.delete k)
45+ pure $ Map.insert k a m
src/Development/IDE/Core/Shake.hs+11−6
@@ -54,6 +54,7 @@ import Data.Maybe
5454import Data.Either.Extra
5555import Data.List.Extra
5656import qualified Data.Text as T
57+import Development.IDE.Core.Debouncer
5758import Development.IDE.Types.Logger hiding (Priority)
5859import Language.Haskell.LSP.Diagnostics
5960import qualified Data.SortedList as SL
@@ -79,6 +80,7 @@ import Language.Haskell.LSP.Types
7980-- information we stash inside the shakeExtra field
8081data ShakeExtras = ShakeExtras
8182 {eventer :: LSP.FromServerMessage -> IO ()
83+ ,debouncer :: Debouncer Uri
8284 ,logger :: Logger
8385 ,globals :: Var (HMap.HashMap TypeRep Dynamic)
8486 ,state :: Var Values
@@ -222,6 +224,7 @@ shakeOpen eventer logger opts rules = do
222224 globals <- newVar HMap.empty
223225 state <- newVar HMap.empty
224226 diagnostics <- newVar mempty
227+ debouncer <- newDebouncer
225228 pure ShakeExtras{..}
226229 (shakeDb, shakeClose) <- shakeOpenDatabase opts{shakeExtra = addShakeExtra shakeExtras $ shakeExtra opts} rules
227230 shakeAbort <- newVar $ return ()
@@ -379,7 +382,7 @@ updateFileDiagnostics ::
379382 -> ShakeExtras
380383 -> [Diagnostic] -- ^ current results
381384 -> Action ()
382−updateFileDiagnostics fp k ShakeExtras{diagnostics, state, eventer} current = liftIO $ do
385+updateFileDiagnostics fp k ShakeExtras{diagnostics, state, debouncer, eventer} current = liftIO $ do
383386 modTime <- join <$> getValues state GetModificationTime fp
384387 mask_ $ do
385388 -- Mask async exceptions to ensure that updated diagnostics are always
@@ -391,14 +394,16 @@ updateFileDiagnostics fp k ShakeExtras{diagnostics, state, eventer} current = li
391394 let newDiagsStore = setStageDiagnostics fp (vfsVersion =<< modTime) (T.pack $ show k) current old
392395 let newDiags = getFileDiagnostics fp newDiagsStore
393396 pure (newDiagsStore, (newDiags, oldDiags))
394− when (newDiags /= oldDiags) $
395− eventer $ publishDiagnosticsNotification fp newDiags
397+ let uri = fromNormalizedUri $ filePathToUri' fp
398+ when (newDiags /= oldDiags) $ do
399+ let delay = if null newDiags then 0.1 else 0
400+ registerEvent debouncer delay uri $ eventer $ publishDiagnosticsNotification uri newDiags
396401
397−publishDiagnosticsNotification :: NormalizedFilePath -> [Diagnostic] -> LSP.FromServerMessage
398−publishDiagnosticsNotification fp diags =
402+publishDiagnosticsNotification :: Uri -> [Diagnostic] -> LSP.FromServerMessage
403+publishDiagnosticsNotification uri diags =
399404 LSP.NotPublishDiagnostics $
400405 LSP.NotificationMessage "2.0" LSP.TextDocumentPublishDiagnostics $
401− LSP.PublishDiagnosticsParams (fromNormalizedUri $ filePathToUri' fp) (List diags)
406+ LSP.PublishDiagnosticsParams uri (List diags)
402407
403408newtype Priority = Priority Double
404409