Update the diagnostic publishing function

Author: fendor

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

@@ -71,7 +71,7 @@ modifyCache f = modifyModuleCache f
 
 -- ---------------------------------------------------------------------
 
-type PublishDiagnostics = Int -> J.NormalizedUri -> J.TextDocumentVersion -> J.DiagnosticsBySource -> IO ()
+type PublishDiagnostics = J.NormalizedUri -> J.TextDocumentVersion -> J.DiagnosticsBySource -> IO ()
 
 -- | Run the given action in context and initialise a session with hie-bios.
 -- 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
             source = Just "bios"
             diag = Diagnostic range sev Nothing source (Text.unlines msgTxt) Nothing
 
-        liftIO $ publishDiagnostics maxBound normalizedUri Nothing
+        liftIO $ publishDiagnostics normalizedUri Nothing
             (Map.singleton source (SL.singleton diag))
 
         return $ IdeResultFail $ IdeError

src/Haskell/Ide/Engine/Server.hs

@@ -363,16 +363,17 @@ updatePositionMap uri changes = pluginGetFile "updatePositionMap: " uri $ \file
 -- ---------------------------------------------------------------------
 
 publishDiagnostics :: (MonadIO m, MonadReader REnv m)
-  => Int -> J.NormalizedUri -> J.TextDocumentVersion -> DiagnosticsBySource -> m ()
-publishDiagnostics maxToSend uri' mv diags = do
+  => J.NormalizedUri -> J.TextDocumentVersion -> DiagnosticsBySource -> m ()
+publishDiagnostics uri' mv diags = do
   lf <- asks lspFuncs
-  publishDiagnostics' lf maxToSend uri' mv diags
+  publishDiagnostics' lf uri' mv diags
 
 
 publishDiagnostics' :: MonadIO m
-  => Core.LspFuncs c  -> Int -> J.NormalizedUri -> J.TextDocumentVersion -> DiagnosticsBySource -> m ()
-publishDiagnostics' lf maxToSend uri' mv diags =
-  liftIO $ Core.publishDiagnosticsFunc lf maxToSend uri' mv diags
+  => Core.LspFuncs Config -> J.NormalizedUri -> J.TextDocumentVersion -> DiagnosticsBySource -> m ()
+publishDiagnostics' lf uri' mv diags = do
+  config <- liftIO $ fromMaybe Data.Default.def <$> Core.config lf
+  liftIO $ Core.publishDiagnosticsFunc lf (maxNumberOfProblems config) uri' mv diags
 
 
 -- ---------------------------------------------------------------------
@@ -947,18 +948,17 @@ requestDiagnosticsNormal tn file mVer = do
     sendOneGhc :: J.DiagnosticSource -> (J.NormalizedUri, [Diagnostic]) -> R ()
     sendOneGhc pid (fileUri,ds) = do
       if any (hasSeverity J.DsError) ds
-        then publishDiagnostics maxToSend fileUri Nothing
+        then publishDiagnostics fileUri Nothing
                (Map.fromList [(Just "hlint",SL.toSortedList []),(Just pid,SL.toSortedList ds)])
         else sendOne pid (fileUri,ds)
 
     sendOne pid (fileUri,ds) = do
-      publishDiagnostics maxToSend fileUri Nothing (Map.fromList [(Just pid,SL.toSortedList ds)])
+      publishDiagnostics fileUri Nothing (Map.fromList [(Just pid,SL.toSortedList ds)])
 
     hasSeverity :: J.DiagnosticSeverity -> J.Diagnostic -> Bool
     hasSeverity sev (J.Diagnostic _ (Just s) _ _ _ _) = s == sev
     hasSeverity _ _ = False
-    sendEmpty = publishDiagnostics maxToSend (J.toNormalizedUri file) Nothing (Map.fromList [(Just "bios",SL.toSortedList [])])
-    maxToSend = maxNumberOfProblems clientConfig
+    sendEmpty = publishDiagnostics (J.toNormalizedUri file) Nothing (Map.fromList [(Just "bios",SL.toSortedList [])])
 
   let sendHlint = hlintOn clientConfig
   when sendHlint $ do

test/dispatcher/Main.hs

@@ -81,6 +81,7 @@ startServer = do
       (\lid errCode e -> logToChan logChan ("received an error", Left (lid, errCode, e)))
       (\g x -> g x)
       dummyLspFuncs
+      (\_ _ _ -> return ())
       (Just crdl)
 
   return (scheduler, logChan, dispatcher)

test/plugin-dispatcher/Main.hs

@@ -51,6 +51,7 @@ newPluginSpec = do
                               (\_ _ _ -> return ())
                               (\f x -> f x)
                               dummyLspFuncs
+                              (\_ _ _ -> return ())
                               (Just crdl)
 
       updateDocument scheduler (filePathToUri "test") 3