Skip to content
This repository was archived by the owner on Oct 7, 2020. It is now read-only.

Commit cb51e9e

Browse files
fendorfendor
committed
Revert "Add passPublishDiagnostics to publish diagnostics via the server"
This reverts commit 50c82af.
1 parent 5e4a8c6 commit cb51e9e

File tree

4 files changed

+39
-59
lines changed

4 files changed

+39
-59
lines changed

‎hie-plugin-api/Haskell/Ide/Engine/ModuleCache.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -71,7 +71,7 @@ modifyCache f = modifyModuleCache f
7171

7272
-- ---------------------------------------------------------------------
7373

74-
type PublishDiagnostics = J.NormalizedUri -> J.TextDocumentVersion -> J.DiagnosticsBySource -> IO ()
74+
type PublishDiagnostics = Int -> J.NormalizedUri -> J.TextDocumentVersion -> J.DiagnosticsBySource -> IO ()
7575

7676
-- | Run the given action in context and initialise a session with hie-bios.
7777
-- If a context is given, the context is used to initialise a session for GHC.
@@ -186,7 +186,7 @@ loadCradle publishDiagnostics iniDynFlags (NewCradle fp) def action = do
186186
source = Just "bios"
187187
diag = Diagnostic range sev Nothing source (Text.unlines msgTxt) Nothing
188188

189-
liftIO $ publishDiagnostics normalizedUri Nothing
189+
liftIO $ publishDiagnostics maxBound normalizedUri Nothing
190190
(Map.singleton source (SL.singleton diag))
191191

192192
return $ IdeResultFail $ IdeError

‎src/Haskell/Ide/Engine/Server.hs

Lines changed: 35 additions & 55 deletions
Original file line numberDiff line numberDiff line change
@@ -198,7 +198,7 @@ run scheduler _origDir plugins captureFp = flip E.catches handlers $ do
198198
-- recognized properly by ghc-mod
199199
flip labelThread "scheduler" =<<
200200
forkIO
201-
( Scheduler.runScheduler scheduler errorHandler callbackHandler lf (passPublishDiagnostics rin) mcradle
201+
( Scheduler.runScheduler scheduler errorHandler callbackHandler lf (publishDiagnostics' lf) mcradle
202202
`E.catch`
203203
\(e :: E.SomeException) ->
204204
errorm $ "Scheduler thread exited unexpectedly: " ++ show e
@@ -256,13 +256,9 @@ run scheduler _origDir plugins captureFp = flip E.catches handlers $ do
256256

257257
-- ---------------------------------------------------------------------
258258

259-
data ReactorInput
260-
= CM FromClientMessage
261-
-- ^ injected into the reactor input by each of the individual
262-
-- callback handlers
263-
| PD J.NormalizedUri J.TextDocumentVersion DiagnosticsBySource
264-
-- ^ injected into the reactor input by any scheduler needing to
265-
-- publish additional diagnostics
259+
type ReactorInput
260+
= FromClientMessage
261+
-- ^ injected into the reactor input by each of the individual callback handlers
266262

267263
-- ---------------------------------------------------------------------
268264

@@ -363,10 +359,8 @@ updatePositionMap uri changes = pluginGetFile "updatePositionMap: " uri $ \file
363359
-- ---------------------------------------------------------------------
364360

365361
publishDiagnostics :: (MonadIO m, MonadReader REnv m)
366-
=> J.NormalizedUri -> J.TextDocumentVersion -> DiagnosticsBySource -> m ()
367-
publishDiagnostics uri' mv diags = do
368-
clientConfig <- getClientConfig
369-
let maxToSend = maxNumberOfProblems clientConfig
362+
=> Int -> J.NormalizedUri -> J.TextDocumentVersion -> DiagnosticsBySource -> m ()
363+
publishDiagnostics maxToSend uri' mv diags = do
370364
lf <- asks lspFuncs
371365
publishDiagnostics' lf maxToSend uri' mv diags
372366

@@ -421,15 +415,15 @@ reactor inp diagIn = do
421415
liftIO $ U.logs $ "****** reactor: got message number:" ++ show tn
422416

423417
case inval of
424-
CM (RspFromClient resp@(J.ResponseMessage _ _ _ merr)) -> do
418+
RspFromClient resp@(J.ResponseMessage _ _ _ merr) -> do
425419
liftIO $ U.logs $ "reactor:got RspFromClient:" ++ show resp
426420
case merr of
427421
Nothing -> return ()
428422
Just _ -> sendErrorLog $ "Got error response:" <> decodeUtf8 (BL.toStrict $ A.encode resp)
429423

430424
-- -------------------------------
431425

432-
CM (NotInitialized _notification) -> do
426+
NotInitialized _notification -> do
433427
liftIO $ U.logm "****** reactor: processing Initialized Notification"
434428
-- Server is ready, register any specific capabilities we need
435429

@@ -483,7 +477,7 @@ reactor inp diagIn = do
483477

484478
-- -------------------------------
485479

486-
CM (NotDidOpenTextDocument notification) -> do
480+
NotDidOpenTextDocument notification -> do
487481
liftIO $ U.logm "****** reactor: processing NotDidOpenTextDocument"
488482
let
489483
td = notification ^. J.params . J.textDocument
@@ -495,17 +489,17 @@ reactor inp diagIn = do
495489

496490
-- -------------------------------
497491

498-
CM (NotDidChangeWatchedFiles _notification) -> do
492+
NotDidChangeWatchedFiles _notification -> do
499493
liftIO $ U.logm "****** reactor: not processing NotDidChangeWatchedFiles"
500494

501495
-- -------------------------------
502496

503-
CM (NotWillSaveTextDocument _notification) -> do
497+
NotWillSaveTextDocument _notification -> do
504498
liftIO $ U.logm "****** reactor: not processing NotWillSaveTextDocument"
505499

506500
-- -------------------------------
507501

508-
CM (NotDidSaveTextDocument notification) -> do
502+
NotDidSaveTextDocument notification -> do
509503
-- This notification is redundant, as we get the NotDidChangeTextDocument
510504
liftIO $ U.logm "****** reactor: processing NotDidSaveTextDocument"
511505
let
@@ -517,7 +511,7 @@ reactor inp diagIn = do
517511

518512
-- -------------------------------
519513

520-
CM (NotDidChangeTextDocument notification) -> do
514+
NotDidChangeTextDocument notification -> do
521515
liftIO $ U.logm "****** reactor: processing NotDidChangeTextDocument"
522516
let
523517
params = notification ^. J.params
@@ -537,7 +531,7 @@ reactor inp diagIn = do
537531

538532
-- -------------------------------
539533

540-
CM (NotDidCloseTextDocument notification) -> do
534+
NotDidCloseTextDocument notification -> do
541535
liftIO $ U.logm "****** reactor: processing NotDidCloseTextDocument"
542536
let
543537
uri = notification ^. J.params . J.textDocument . J.uri
@@ -549,7 +543,7 @@ reactor inp diagIn = do
549543

550544
-- -------------------------------
551545

552-
CM (ReqRename req) -> do
546+
ReqRename req -> do
553547
liftIO $ U.logs $ "reactor:got RenameRequest:" ++ show req
554548
-- TODO: re-enable HaRe
555549
-- let (params, doc, pos) = reqParams req
@@ -562,7 +556,7 @@ reactor inp diagIn = do
562556

563557
-- -------------------------------
564558

565-
CM (ReqHover req) -> do
559+
ReqHover req -> do
566560
liftIO $ U.logs $ "reactor:got HoverRequest:" ++ show req
567561
let params = req ^. J.params
568562
pos = params ^. J.position
@@ -592,13 +586,13 @@ reactor inp diagIn = do
592586

593587
-- -------------------------------
594588

595-
CM (ReqCodeAction req) -> do
589+
ReqCodeAction req -> do
596590
liftIO $ U.logs $ "reactor:got CodeActionRequest:" ++ show req
597591
handleCodeActionReq tn req
598592

599593
-- -------------------------------
600594

601-
CM (ReqExecuteCommand req) -> do
595+
ReqExecuteCommand req -> do
602596
liftIO $ U.logs $ "reactor:got ExecuteCommandRequest:" ++ show req
603597
lf <- asks lspFuncs
604598

@@ -671,7 +665,7 @@ reactor inp diagIn = do
671665

672666
-- -------------------------------
673667

674-
CM (ReqCompletion req) -> do
668+
ReqCompletion req -> do
675669
liftIO $ U.logs $ "reactor:got CompletionRequest:" ++ show req
676670
let (_, doc, pos) = reqParams req
677671

@@ -689,7 +683,7 @@ reactor inp diagIn = do
689683
$ lift $ Completions.getCompletions doc prefix snippets
690684
makeRequest hreq
691685

692-
CM (ReqCompletionItemResolve req) -> do
686+
ReqCompletionItemResolve req -> do
693687
liftIO $ U.logs $ "reactor:got CompletionItemResolveRequest:" ++ show req
694688
snippets <- Completions.WithSnippets <$> configVal completionSnippetsOn
695689
let origCompl = req ^. J.params
@@ -702,7 +696,7 @@ reactor inp diagIn = do
702696

703697
-- -------------------------------
704698

705-
CM (ReqDocumentHighlights req) -> do
699+
ReqDocumentHighlights req -> do
706700
liftIO $ U.logs $ "reactor:got DocumentHighlightsRequest:" ++ show req
707701
let (_, doc, pos) = reqParams req
708702
callback = reactorSend . RspDocumentHighlights . Core.makeResponseMessage req . J.List
@@ -712,7 +706,7 @@ reactor inp diagIn = do
712706

713707
-- -------------------------------
714708

715-
CM (ReqDefinition req) -> do
709+
ReqDefinition req -> do
716710
liftIO $ U.logs $ "reactor:got DefinitionRequest:" ++ show req
717711
let params = req ^. J.params
718712
doc = params ^. J.textDocument . J.uri
@@ -722,7 +716,7 @@ reactor inp diagIn = do
722716
$ fmap J.MultiLoc <$> Hie.findDef doc pos
723717
makeRequest hreq
724718

725-
CM (ReqTypeDefinition req) -> do
719+
ReqTypeDefinition req -> do
726720
liftIO $ U.logs $ "reactor:got DefinitionTypeRequest:" ++ show req
727721
let params = req ^. J.params
728722
doc = params ^. J.textDocument . J.uri
@@ -732,7 +726,7 @@ reactor inp diagIn = do
732726
$ fmap J.MultiLoc <$> Hie.findTypeDef doc pos
733727
makeRequest hreq
734728

735-
CM (ReqFindReferences req) -> do
729+
ReqFindReferences req -> do
736730
liftIO $ U.logs $ "reactor:got FindReferences:" ++ show req
737731
-- TODO: implement project-wide references
738732
let (_, doc, pos) = reqParams req
@@ -744,7 +738,7 @@ reactor inp diagIn = do
744738

745739
-- -------------------------------
746740

747-
CM (ReqDocumentFormatting req) -> do
741+
ReqDocumentFormatting req -> do
748742
liftIO $ U.logs $ "reactor:got FormatRequest:" ++ show req
749743
provider <- getFormattingProvider
750744
let params = req ^. J.params
@@ -756,7 +750,7 @@ reactor inp diagIn = do
756750

757751
-- -------------------------------
758752

759-
CM (ReqDocumentRangeFormatting req) -> do
753+
ReqDocumentRangeFormatting req -> do
760754
liftIO $ U.logs $ "reactor:got FormatRequest:" ++ show req
761755
provider <- getFormattingProvider
762756
let params = req ^. J.params
@@ -769,7 +763,7 @@ reactor inp diagIn = do
769763

770764
-- -------------------------------
771765

772-
CM (ReqDocumentSymbols req) -> do
766+
ReqDocumentSymbols req -> do
773767
liftIO $ U.logs $ "reactor:got Document symbol request:" ++ show req
774768
sps <- asks symbolProviders
775769
C.ClientCapabilities _ tdc _ _ <- asksLspFuncs Core.clientCapabilities
@@ -794,14 +788,14 @@ reactor inp diagIn = do
794788

795789
-- -------------------------------
796790

797-
CM (NotCancelRequestFromClient notif) -> do
791+
NotCancelRequestFromClient notif -> do
798792
liftIO $ U.logs $ "reactor:got CancelRequest:" ++ show notif
799793
let lid = notif ^. J.params . J.id
800794
cancelRequest lid
801795

802796
-- -------------------------------
803797

804-
CM (NotDidChangeConfiguration notif) -> do
798+
NotDidChangeConfiguration notif -> do
805799
liftIO $ U.logs $ "reactor:didChangeConfiguration notification:" ++ show notif
806800
-- if hlint has been turned off, flush the diagnostics
807801
diagsOn <- configVal hlintOn
@@ -814,15 +808,8 @@ reactor inp diagIn = do
814808
else flushDiagnosticsBySource maxDiagnosticsToSend (Just "hlint")
815809

816810
-- -------------------------------
817-
818-
CM om -> do
811+
om -> do
819812
liftIO $ U.logs $ "reactor:got HandlerRequest:" ++ show om
820-
821-
-- -------------------------------
822-
823-
PD uri version diagnostics -> do
824-
publishDiagnostics uri version diagnostics
825-
826813
loop (tn + 1)
827814

828815
-- Actually run the thing
@@ -956,17 +943,18 @@ requestDiagnosticsNormal tn file mVer = do
956943
sendOneGhc :: J.DiagnosticSource -> (J.NormalizedUri, [Diagnostic]) -> R ()
957944
sendOneGhc pid (fileUri,ds) = do
958945
if any (hasSeverity J.DsError) ds
959-
then publishDiagnostics fileUri Nothing
946+
then publishDiagnostics maxToSend fileUri Nothing
960947
(Map.fromList [(Just "hlint",SL.toSortedList []),(Just pid,SL.toSortedList ds)])
961948
else sendOne pid (fileUri,ds)
962949

963950
sendOne pid (fileUri,ds) = do
964-
publishDiagnostics fileUri Nothing (Map.fromList [(Just pid,SL.toSortedList ds)])
951+
publishDiagnostics maxToSend fileUri Nothing (Map.fromList [(Just pid,SL.toSortedList ds)])
965952

966953
hasSeverity :: J.DiagnosticSeverity -> J.Diagnostic -> Bool
967954
hasSeverity sev (J.Diagnostic _ (Just s) _ _ _ _) = s == sev
968955
hasSeverity _ _ = False
969-
sendEmpty = publishDiagnostics (J.toNormalizedUri file) Nothing (Map.fromList [(Just "bios",SL.toSortedList [])])
956+
sendEmpty = publishDiagnostics maxToSend (J.toNormalizedUri file) Nothing (Map.fromList [(Just "bios",SL.toSortedList [])])
957+
maxToSend = maxNumberOfProblems clientConfig
970958

971959
let sendHlint = hlintOn clientConfig
972960
when sendHlint $ do
@@ -1065,14 +1053,6 @@ hieHandlers rin
10651053

10661054
passHandler :: TChan ReactorInput -> (a -> FromClientMessage) -> Core.Handler a
10671055
passHandler rin c notification = do
1068-
atomically $ writeTChan rin (CM (c notification))
1069-
1070-
-- ---------------------------------------------------------------------
1071-
1072-
-- | Generate a 'PublishDiagnostics' function that will simply insert
1073-
-- the request into the main server loop
1074-
passPublishDiagnostics :: TChan ReactorInput -> PublishDiagnostics
1075-
passPublishDiagnostics rin uri version diagnostics = do
1076-
atomically $ writeTChan rin (PD uri version diagnostics)
1056+
atomically $ writeTChan rin (c notification)
10771057

10781058
-- ---------------------------------------------------------------------

‎test/dispatcher/Main.hs

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -81,7 +81,6 @@ startServer = do
8181
(\lid errCode e -> logToChan logChan ("received an error", Left (lid, errCode, e)))
8282
(\g x -> g x)
8383
dummyLspFuncs
84-
(\_ _ _ -> return ())
8584
(Just crdl)
8685

8786
return (scheduler, logChan, dispatcher)

‎test/plugin-dispatcher/Main.hs

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -51,7 +51,6 @@ newPluginSpec = do
5151
(\_ _ _ -> return ())
5252
(\f x -> f x)
5353
dummyLspFuncs
54-
(\_ _ _ -> return ())
5554
(Just crdl)
5655

5756
updateDocument scheduler (filePathToUri "test") 3
@@ -66,3 +65,5 @@ newPluginSpec = do
6665
killThread pid
6766
resp1 `shouldBe` "text1"
6867
resp2 `shouldBe` "text4"
68+
69+

0 commit comments

Comments
 (0)