4aaba4d · ghcide · git.iko.soy

exe/Main.hs+4−2

compare with master

unifiedsplit

@@ -16,6 +16,7 @@ import Control.Monad.Extra

16import Control.Monad.IO.Class

17import Data.Default

18import System.Time.Extra

19+import Development.IDE.Core.Debouncer

19import Development.IDE.Core.FileStore

20import Development.IDE.Core.FileStore

20import Development.IDE.Core.OfInterest

21import Development.IDE.Core.OfInterest

21import Development.IDE.Core.Service

22import Development.IDE.Core.Service

@@ -101,7 +102,8 @@ main = do

101 { optReportProgress = clientSupportsProgress caps

102 { optReportProgress = clientSupportsProgress caps

102 , optShakeProfiling = argsShakeProfiling

103 , optShakeProfiling = argsShakeProfiling

103 }

104 }

105+ debouncer <- newAsyncDebouncer

104− initialise caps (mainRule >> pluginRules plugins >> action kick) getLspId event (logger minBound) options vfs

106+ initialise caps (mainRule >> pluginRules plugins >> action kick) getLspId event (logger minBound) debouncer options vfs

105 else do

107 else do

106 putStrLn $ "Ghcide setup tester in " ++ dir ++ "."

108 putStrLn $ "Ghcide setup tester in " ++ dir ++ "."

107 putStrLn "Report bugs at https://github.com/digital-asset/ghcide/issues"

109 putStrLn "Report bugs at https://github.com/digital-asset/ghcide/issues"

@@ -136,7 +138,7 @@ main = do

136 let options =

138 let options =

137 (defaultIdeOptions $ return $ return . grab)

139 (defaultIdeOptions $ return $ return . grab)

138 { optShakeProfiling = argsShakeProfiling }

140 { optShakeProfiling = argsShakeProfiling }

139− ide <- initialise def mainRule (pure $ IdInt 0) (showEvent lock) (logger Info) options vfs

141+ ide <- initialise def mainRule (pure $ IdInt 0) (showEvent lock) (logger Info) noopDebouncer options vfs

140

142

141 putStrLn "\nStep 6/6: Type checking the files"

143 putStrLn "\nStep 6/6: Type checking the files"

142 setFilesOfInterest ide $ Set.fromList $ map toNormalizedFilePath files

144 setFilesOfInterest ide $ Set.fromList $ map toNormalizedFilePath files

ghcide.cabal+1−1

@@ -99,6 +99,7 @@ library

99 include-dirs:

100 include

101 exposed-modules:

102+ Development.IDE.Core.Debouncer

102 Development.IDE.Core.FileStore

103 Development.IDE.Core.FileStore

103 Development.IDE.Core.OfInterest

104 Development.IDE.Core.OfInterest

104 Development.IDE.Core.PositionMapping

105 Development.IDE.Core.PositionMapping

@@ -121,7 +122,6 @@ library

121 Development.IDE.Plugin.Completions

122 Development.IDE.Plugin.Completions

122 Development.IDE.Plugin.CodeAction

123 Development.IDE.Plugin.CodeAction

123 other-modules:

124 other-modules:

124− Development.IDE.Core.Debouncer

125 Development.IDE.Core.Compile

126 Development.IDE.Core.Preprocessor

127 Development.IDE.Core.FileExists

src/Development/IDE/Core/Debouncer.hs+15−9

@@ -3,8 +3,9 @@

3

4module Development.IDE.Core.Debouncer

5 ( Debouncer

6− , newDebouncer

7 , registerEvent

6 , registerEvent

7+ , newAsyncDebouncer

8+ , noopDebouncer

8 ) where

9 ) where

9

10

10import Control.Concurrent.Extra

11import Control.Concurrent.Extra

@@ -22,13 +23,14 @@ import System.Time.Extra

22-- by delaying each event for a given time. If another event

23-- by delaying each event for a given time. If another event

23-- is registered for the same key within that timeframe,

24-- is registered for the same key within that timeframe,

24-- only the new event will fire.

25-- only the new event will fire.

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.

25−newtype Debouncer k = Debouncer (Var (HashMap k (Async ())))

29+newtype Debouncer k = Debouncer { registerEvent :: Seconds -> k -> IO () -> IO () }

26

30

27−-- | Create a new empty debouncer.

31+-- | Debouncer used in the IDE that delays events as expected.

28−newDebouncer :: IO (Debouncer k)

32+newAsyncDebouncer :: (Eq k, Hashable k) => IO (Debouncer k)

29−newDebouncer = do

33+newAsyncDebouncer = Debouncer . asyncRegisterEvent <$> newVar Map.empty

30− m <- newVar Map.empty

31− pure $ Debouncer m

32

34

33-- | Register an event that will fire after the given delay if no other event

35-- | Register an event that will fire after the given delay if no other event

34-- for the same key gets registered until then.

36-- for the same key gets registered until then.

@@ -36,11 +38,15 @@ newDebouncer = do

36-- If there is a pending event for the same key, the pending event will be killed.

38-- If there is a pending event for the same key, the pending event will be killed.

37-- Events are run unmasked so it is up to the user of `registerEvent`

39-- Events are run unmasked so it is up to the user of `registerEvent`

38-- to mask if required.

40-- to mask if required.

39−registerEvent :: (Eq k, Hashable k) => Debouncer k -> Seconds -> k -> IO () -> IO ()

41+asyncRegisterEvent :: (Eq k, Hashable k) => Var (HashMap k (Async ())) -> Seconds -> k -> IO () -> IO ()

40−registerEvent (Debouncer d) delay k fire = modifyVar_ d $ \m -> mask_ $ do

42+asyncRegisterEvent d delay k fire = modifyVar_ d $ \m -> mask_ $ do

41 whenJust (Map.lookup k m) cancel

43 whenJust (Map.lookup k m) cancel

42 a <- asyncWithUnmask $ \unmask -> unmask $ do

44 a <- asyncWithUnmask $ \unmask -> unmask $ do

43 sleep delay

45 sleep delay

44 fire

46 fire

45 modifyVar_ d (pure . Map.delete k)

47 modifyVar_ d (pure . Map.delete k)

46 pure $ Map.insert k a m

48 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

src/Development/IDE/Core/Service.hs+4−1

@@ -23,6 +23,7 @@ import Control.Concurrent.Async

23import Data.Maybe

24import Development.IDE.Types.Options (IdeOptions(..))

25import Control.Monad

26+import Development.IDE.Core.Debouncer

26import Development.IDE.Core.FileStore (VFSHandle, fileStoreRules)

27import Development.IDE.Core.FileStore (VFSHandle, fileStoreRules)

27import Development.IDE.Core.FileExists (fileExistsRules)

28import Development.IDE.Core.FileExists (fileExistsRules)

28import Development.IDE.Core.OfInterest

29import Development.IDE.Core.OfInterest

@@ -49,14 +50,16 @@ initialise :: LSP.ClientCapabilities

49 -> IO LSP.LspId

50 -> IO LSP.LspId

50 -> (LSP.FromServerMessage -> IO ())

51 -> (LSP.FromServerMessage -> IO ())

51 -> Logger

52 -> Logger

53+ -> Debouncer LSP.NormalizedUri

52 -> IdeOptions

54 -> IdeOptions

53 -> VFSHandle

55 -> VFSHandle

54 -> IO IdeState

56 -> IO IdeState

55−initialise caps mainRule getLspId toDiags logger options vfs =

57+initialise caps mainRule getLspId toDiags logger debouncer options vfs =

56 shakeOpen

58 shakeOpen

57 getLspId

59 getLspId

58 toDiags

60 toDiags

59 logger

61 logger

62+ debouncer

60 (optShakeProfiling options)

63 (optShakeProfiling options)

61 (optReportProgress options)

64 (optReportProgress options)

62 shakeOptions

65 shakeOptions

src/Development/IDE/Core/Shake.hs+2−2

@@ -294,12 +294,13 @@ seqValue v b = case v of

294shakeOpen :: IO LSP.LspId

295 -> (LSP.FromServerMessage -> IO ()) -- ^ diagnostic handler

296 -> Logger

297+ -> Debouncer NormalizedUri

297 -> Maybe FilePath

298 -> Maybe FilePath

298 -> IdeReportProgress

299 -> IdeReportProgress

299 -> ShakeOptions

300 -> ShakeOptions

300 -> Rules ()

301 -> Rules ()

301 -> IO IdeState

302 -> IO IdeState

302−shakeOpen getLspId eventer logger shakeProfileDir (IdeReportProgress reportProgress) opts rules = do

303+shakeOpen getLspId eventer logger debouncer shakeProfileDir (IdeReportProgress reportProgress) opts rules = do

303 inProgress <- newVar Map.empty

304 inProgress <- newVar Map.empty

304 shakeExtras <- do

305 shakeExtras <- do

305 globals <- newVar HMap.empty

306 globals <- newVar HMap.empty

@@ -307,7 +308,6 @@ shakeOpen getLspId eventer logger shakeProfileDir (IdeReportProgress reportProgr

307 diagnostics <- newVar mempty

308 diagnostics <- newVar mempty

308 hiddenDiagnostics <- newVar mempty

309 hiddenDiagnostics <- newVar mempty

309 publishedDiagnostics <- newVar mempty

310 publishedDiagnostics <- newVar mempty

310− debouncer <- newDebouncer

311 positionMapping <- newVar Map.empty

312 pure ShakeExtras{..}

313 (shakeDb, shakeClose) <-