Skip to content

Commit afa9c0b

Browse files
pepeiborrapepeiborra
committed
optProgressStyle
1 parent 8f5606b commit afa9c0b

File tree

3 files changed

+56
-18
lines changed

3 files changed

+56
-18
lines changed

‎ghcide/src/Development/IDE/Core/Compile.hs

+23-8
Original file line numberDiff line numberDiff line change
@@ -507,7 +507,9 @@ spliceExpresions Splices{..} =
507507
-- can just increment the 'indexCompleted' TVar and exit.
508508
--
509509
indexHieFile :: ShakeExtras -> ModSummary -> NormalizedFilePath -> Fingerprint -> Compat.HieFile -> IO ()
510-
indexHieFile se mod_summary srcPath hash hf = atomically $ do
510+
indexHieFile se mod_summary srcPath hash hf = do
511+
IdeOptions{optProgressStyle} <- getIdeOptionsIO se
512+
atomically $ do
511513
pending <- readTVar indexPending
512514
case HashMap.lookup srcPath pending of
513515
Just pendingHash | pendingHash == hash -> pure () -- An index is already scheduled
@@ -523,7 +525,7 @@ indexHieFile se mod_summary srcPath hash hf = atomically $ do
523525
-- If the hash in the pending list doesn't match the current hash, then skip
524526
Just pendingHash -> pendingHash /= hash
525527
unless newerScheduled $ do
526-
pre
528+
pre optProgressStyle
527529
addRefsFromLoaded db targetPath (RealFile $ fromNormalizedFilePath srcPath) hash hf
528530
post
529531
where
@@ -532,7 +534,7 @@ indexHieFile se mod_summary srcPath hash hf = atomically $ do
532534
HieDbWriter{..} = hiedbWriter se
533535

534536
-- Get a progress token to report progress and update it for the current file
535-
pre = do
537+
pre style = do
536538
tok <- modifyVar indexProgressToken $ fmap dupe . \case
537539
x@(Just _) -> pure x
538540
-- Create a token if we don't already have one
@@ -559,11 +561,24 @@ indexHieFile se mod_summary srcPath hash hf = atomically $ do
559561

560562
whenJust (lspEnv se) $ \env -> whenJust tok $ \tok -> LSP.runLspT env $
561563
LSP.sendNotification LSP.SProgress $ LSP.ProgressParams tok $
562-
LSP.Report $ LSP.WorkDoneProgressReportParams
563-
{ _cancellable = Nothing
564-
, _message = Nothing
565-
, _percentage = Just (100 * fromIntegral done / fromIntegral (done + remaining) )
566-
}
564+
LSP.Report $
565+
case style of
566+
Percentage -> LSP.WorkDoneProgressReportParams
567+
{ _cancellable = Nothing
568+
, _message = Nothing
569+
, _percentage = Just (100 * fromIntegral done / fromIntegral (done + remaining) )
570+
}
571+
Explicit -> LSP.WorkDoneProgressReportParams
572+
{ _cancellable = Nothing
573+
, _message = Just $
574+
T.pack " (" <> T.pack (show done) <> "/" <> T.pack (show $ done + remaining) <> ")..."
575+
, _percentage = Nothing
576+
}
577+
NoProgress -> LSP.WorkDoneProgressReportParams
578+
{ _cancellable = Nothing
579+
, _message = Nothing
580+
, _percentage = Nothing
581+
}
567582

568583
-- Report the progress once we are done indexing this file
569584
post = do

‎ghcide/src/Development/IDE/Core/Shake.hs

+24-10
Original file line numberDiff line numberDiff line change
@@ -499,7 +499,7 @@ shakeOpen lspEnv defaultConfig logger debouncer
499499
let hiedbWriter = HieDbWriter{..}
500500
progressAsync <- async $
501501
when reportProgress $
502-
progressThread mostRecentProgressEvent inProgress
502+
progressThread optProgressStyle mostRecentProgressEvent inProgress
503503
exportsMap <- newVar mempty
504504

505505
actionQueue <- newQueue
@@ -517,7 +517,10 @@ shakeOpen lspEnv defaultConfig logger debouncer
517517
shakeDatabaseProfile <- shakeDatabaseProfileIO shakeProfileDir
518518
let ideState = IdeState{..}
519519

520-
IdeOptions{ optOTMemoryProfiling = IdeOTMemoryProfiling otProfilingEnabled } <- getIdeOptionsIO shakeExtras
520+
IdeOptions
521+
{ optOTMemoryProfiling = IdeOTMemoryProfiling otProfilingEnabled
522+
, optProgressStyle
523+
} <- getIdeOptionsIO shakeExtras
521524
startTelemetry otProfilingEnabled logger $ state shakeExtras
522525

523526
return ideState
@@ -528,7 +531,7 @@ shakeOpen lspEnv defaultConfig logger debouncer
528531
-- And two transitions, modelled by 'ProgressEvent':
529532
-- 1. KickCompleted - transitions from Reporting into Idle
530533
-- 2. KickStarted - transitions from Idle into Reporting
531-
progressThread mostRecentProgressEvent inProgress = progressLoopIdle
534+
progressThread style mostRecentProgressEvent inProgress = progressLoopIdle
532535
where
533536
progressLoopIdle = do
534537
atomically $ do
@@ -560,7 +563,7 @@ shakeOpen lspEnv defaultConfig logger debouncer
560563
bracket_
561564
(start u)
562565
(stop u)
563-
(loop u Nothing)
566+
(loop u 0)
564567
where
565568
start id = LSP.sendNotification LSP.SProgress $
566569
LSP.ProgressParams
@@ -585,16 +588,27 @@ shakeOpen lspEnv defaultConfig logger debouncer
585588
current <- liftIO $ readVar inProgress
586589
let done = length $ filter (== 0) $ HMap.elems current
587590
let todo = HMap.size current
588-
let next = Just $ T.pack $ show done <> "/" <> show todo
591+
let next = 100 * fromIntegral done / fromIntegral todo
589592
when (next /= prev) $
590593
LSP.sendNotification LSP.SProgress $
591594
LSP.ProgressParams
592595
{ _token = id
593-
, _value = LSP.Report $ LSP.WorkDoneProgressReportParams
594-
{ _cancellable = Nothing
595-
, _message = next
596-
, _percentage = Nothing
597-
}
596+
, _value = LSP.Report $ case style of
597+
Explicit -> LSP.WorkDoneProgressReportParams
598+
{ _cancellable = Nothing
599+
, _message = Just $ T.pack $ show done <> "/" <> show todo
600+
, _percentage = Nothing
601+
}
602+
Percentage -> LSP.WorkDoneProgressReportParams
603+
{ _cancellable = Nothing
604+
, _message = Nothing
605+
, _percentage = Just next
606+
}
607+
NoProgress -> LSP.WorkDoneProgressReportParams
608+
{ _cancellable = Nothing
609+
, _message = Nothing
610+
, _percentage = Nothing
611+
}
598612
}
599613
loop id next
600614

‎ghcide/src/Development/IDE/Types/Options.hs

+9
Original file line numberDiff line numberDiff line change
@@ -16,6 +16,7 @@ module Development.IDE.Types.Options
1616
, IdeResult
1717
, IdeGhcSession(..)
1818
, OptHaddockParse(..)
19+
, ProgressReportingStyle(..)
1920
,optShakeFiles) where
2021

2122
import qualified Data.Text as T
@@ -78,6 +79,7 @@ data IdeOptions = IdeOptions
7879
, optShakeOptions :: ShakeOptions
7980
, optSkipProgress :: forall a. Typeable a => a -> Bool
8081
-- ^ Predicate to select which rule keys to exclude from progress reporting.
82+
, optProgressStyle :: ProgressReportingStyle
8183
}
8284

8385
optShakeFiles :: IdeOptions -> Maybe FilePath
@@ -104,6 +106,12 @@ newtype IdeDefer = IdeDefer Bool
104106
newtype IdeTesting = IdeTesting Bool
105107
newtype IdeOTMemoryProfiling = IdeOTMemoryProfiling Bool
106108

109+
data ProgressReportingStyle
110+
= Percentage -- ^ Report using the LSP @_percentage@ field
111+
| Explicit -- ^ Report using explicit 123/456 text
112+
| NoProgress -- ^ Do not report any percentage
113+
114+
107115
clientSupportsProgress :: LSP.ClientCapabilities -> IdeReportProgress
108116
clientSupportsProgress caps = IdeReportProgress $ Just True ==
109117
(LSP._workDoneProgress =<< LSP._window (caps :: LSP.ClientCapabilities))
@@ -131,6 +139,7 @@ defaultIdeOptions session = IdeOptions
131139
,optHaddockParse = HaddockParse
132140
,optCustomDynFlags = id
133141
,optSkipProgress = defaultSkipProgress
142+
,optProgressStyle = Explicit
134143
}
135144

136145
defaultSkipProgress :: Typeable a => a -> Bool

0 commit comments

Comments
 (0)