mirror of
https://github.com/haskell/haskell-ide-engine.git
synced 2024-09-11 11:05:30 +03:00
Update the diagnostic publishing function
This commit is contained in:
parent
cb51e9ef83
commit
f3cfe9d198
@ -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
|
||||
|
@ -359,16 +359,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
|
||||
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
@ -943,18 +944,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
|
||||
|
@ -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)
|
||||
|
@ -51,6 +51,7 @@ newPluginSpec = do
|
||||
(\_ _ _ -> return ())
|
||||
(\f x -> f x)
|
||||
dummyLspFuncs
|
||||
(\_ _ _ -> return ())
|
||||
(Just crdl)
|
||||
|
||||
updateDocument scheduler (filePathToUri "test") 3
|
||||
|
Loading…
Reference in New Issue
Block a user