git.iko.soy/ghcide
on master help sign in
Report progress in VSCode (#2112)
edaeac7Moritz Kiefer
src/Development/IDE/Core/Shake.hs+38−1
compare with master
unifiedsplit
@@ -55,6 +55,7 @@ import Data.Map.Strict (Map)
55import Data.Either.Extra
55import Data.Either.Extra
56import Data.List.Extra
56import Data.List.Extra
57import qualified Data.Text as T
57import qualified Data.Text as T
58+import Data.Unique
58import Development.IDE.Core.Debouncer
59import Development.IDE.Core.Debouncer
59import Development.IDE.Types.Logger hiding (Priority)
60import Development.IDE.Types.Logger hiding (Priority)
60import Language.Haskell.LSP.Diagnostics
61import Language.Haskell.LSP.Diagnostics
@@ -231,11 +232,47 @@ shakeOpen eventer logger opts rules = do
231 publishedDiagnostics <- newVar mempty
232 publishedDiagnostics <- newVar mempty
232 debouncer <- newDebouncer
233 debouncer <- newDebouncer
233 pure ShakeExtras{..}
234 pure ShakeExtras{..}
235+ (shakeDb, shakeClose) <-
236+ shakeOpenDatabase
237+ opts
234− (shakeDb, shakeClose) <- shakeOpenDatabase opts{shakeExtra = addShakeExtra shakeExtras $ shakeExtra opts} rules
238+ { shakeExtra = addShakeExtra shakeExtras $ shakeExtra opts
239+ , shakeProgress = lspShakeProgress eventer
240+ }
241+ rules
235 shakeAbort <- newVar $ return ()
242 shakeAbort <- newVar $ return ()
236 shakeDb <- shakeDb
243 shakeDb <- shakeDb
237 return IdeState{..}
244 return IdeState{..}
238
245
246+lspShakeProgress :: (LSP.FromServerMessage -> IO ()) -> IO Progress -> IO ()
247+lspShakeProgress sendMsg prog = do
248+ u <- T.pack . show . hashUnique <$> newUnique
249+ bracket_ (start u) (stop u) (loop u)
250+ where
251+ start id = sendMsg $ LSP.NotProgressStart $ LSP.fmServerProgressStartNotification
252+ ProgressStartParams
253+ { _id = id
254+ , _title = "Processing"
255+ , _cancellable = Nothing
256+ , _message = Nothing
257+ , _percentage = Nothing
258+ }
259+ stop id = sendMsg $ LSP.NotProgressDone $ LSP.fmServerProgressDoneNotification
260+ ProgressDoneParams
261+ { _id = id
262+ }
263+ sample = 0.1
264+ loop id = forever $ do
265+ sleep sample
266+ p <- prog
267+ let done = countSkipped p + countBuilt p
268+ let todo = done + countUnknown p + countTodo p
269+ sendMsg $ LSP.NotProgressReport $ LSP.fmServerProgressReportNotification
270+ ProgressReportParams
271+ { _id = id
272+ , _message = Just $ T.pack $ show done <> "/" <> show todo
273+ , _percentage = Nothing
274+ }
275+
239shakeProfile :: IdeState -> FilePath -> IO ()
276shakeProfile :: IdeState -> FilePath -> IO ()
240shakeProfile IdeState{..} = shakeProfileDatabase shakeDb
277shakeProfile IdeState{..} = shakeProfileDatabase shakeDb
241
278