Skip to content

Commit 159724f

Browse files
pepeiborrapepeiborra
committed
optProgressStyle
1 parent 7f30444 commit 159724f

File tree

3 files changed

+56
-18
lines changed

3 files changed

+56
-18
lines changed

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

Lines changed: 23 additions & 8 deletions
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

Lines changed: 24 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -503,7 +503,7 @@ shakeOpen lspEnv defaultConfig logger debouncer
503503
let hiedbWriter = HieDbWriter{..}
504504
progressAsync <- async $
505505
when reportProgress $
506-
progressThread mostRecentProgressEvent inProgress
506+
progressThread optProgressStyle mostRecentProgressEvent inProgress
507507
exportsMap <- newVar mempty
508508

509509
actionQueue <- newQueue
@@ -521,7 +521,10 @@ shakeOpen lspEnv defaultConfig logger debouncer
521521
shakeDatabaseProfile <- shakeDatabaseProfileIO shakeProfileDir
522522
let ideState = IdeState{..}
523523

524-
IdeOptions{ optOTMemoryProfiling = IdeOTMemoryProfiling otProfilingEnabled } <- getIdeOptionsIO shakeExtras
524+
IdeOptions
525+
{ optOTMemoryProfiling = IdeOTMemoryProfiling otProfilingEnabled
526+
, optProgressStyle
527+
} <- getIdeOptionsIO shakeExtras
525528
startTelemetry otProfilingEnabled logger $ state shakeExtras
526529

527530
return ideState
@@ -532,7 +535,7 @@ shakeOpen lspEnv defaultConfig logger debouncer
532535
-- And two transitions, modelled by 'ProgressEvent':
533536
-- 1. KickCompleted - transitions from Reporting into Idle
534537
-- 2. KickStarted - transitions from Idle into Reporting
535-
progressThread mostRecentProgressEvent inProgress = progressLoopIdle
538+
progressThread style mostRecentProgressEvent inProgress = progressLoopIdle
536539
where
537540
progressLoopIdle = do
538541
atomically $ do
@@ -564,7 +567,7 @@ shakeOpen lspEnv defaultConfig logger debouncer
564567
bracket_
565568
(start u)
566569
(stop u)
567-
(loop u Nothing)
570+
(loop u 0)
568571
where
569572
start id = LSP.sendNotification LSP.SProgress $
570573
LSP.ProgressParams
@@ -589,16 +592,27 @@ shakeOpen lspEnv defaultConfig logger debouncer
589592
current <- liftIO $ readVar inProgress
590593
let done = length $ filter (== 0) $ HMap.elems current
591594
let todo = HMap.size current
592-
let next = Just $ T.pack $ show done <> "/" <> show todo
595+
let next = 100 * fromIntegral done / fromIntegral todo
593596
when (next /= prev) $
594597
LSP.sendNotification LSP.SProgress $
595598
LSP.ProgressParams
596599
{ _token = id
597-
, _value = LSP.Report $ LSP.WorkDoneProgressReportParams
598-
{ _cancellable = Nothing
599-
, _message = next
600-
, _percentage = Nothing
601-
}
600+
, _value = LSP.Report $ case style of
601+
Explicit -> LSP.WorkDoneProgressReportParams
602+
{ _cancellable = Nothing
603+
, _message = Just $ T.pack $ show done <> "/" <> show todo
604+
, _percentage = Nothing
605+
}
606+
Percentage -> LSP.WorkDoneProgressReportParams
607+
{ _cancellable = Nothing
608+
, _message = Nothing
609+
, _percentage = Just next
610+
}
611+
NoProgress -> LSP.WorkDoneProgressReportParams
612+
{ _cancellable = Nothing
613+
, _message = Nothing
614+
, _percentage = Nothing
615+
}
602616
}
603617
loop id next
604618

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

Lines changed: 9 additions & 0 deletions
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)