Skip to content

Commit ac78312

Browse files
dylan-thinnesdylan-thinnes
committed
Supply structured error wherever we easily can - TODOs for hard parts
We're leaving the TODOs for either later in this PR or in another PR
1 parent 3c9ae07 commit ac78312

File tree

15 files changed

+183
-88
lines changed

15 files changed

+183
-88
lines changed

‎ghcide/session-loader/Development/IDE/Session.hs

Lines changed: 27 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -600,10 +600,11 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do
600600
this_flags = (this_error_env, this_dep_info)
601601
this_error_env = ([this_error], Nothing)
602602
this_error = ideErrorWithSource (Just "cradle") (Just DiagnosticSeverity_Error) _cfp
603-
$ T.unlines
604-
[ "No cradle target found. Is this file listed in the targets of your cradle?"
605-
, "If you are using a .cabal file, please ensure that this module is listed in either the exposed-modules or other-modules section"
606-
]
603+
(T.unlines
604+
[ "No cradle target found. Is this file listed in the targets of your cradle?"
605+
, "If you are using a .cabal file, please ensure that this module is listed in either the exposed-modules or other-modules section"
606+
])
607+
Nothing
607608

608609
void $ modifyVar' fileToFlags $ Map.insert hieYaml this_flags_map
609610
void $ modifyVar' filesMap $ flip HM.union (HM.fromList (map ((,hieYaml) . fst) $ concatMap toFlagsMap all_targets))
@@ -840,10 +841,10 @@ setNameCache nc hsc = hsc { hsc_NC = nc }
840841
-- GHC had an implementation of this function, but it was horribly inefficient
841842
-- We should move back to the GHC implementation on compilers where
842843
-- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/12162 is included
843-
checkHomeUnitsClosed' :: UnitEnv -> OS.Set UnitId -> [DriverMessages]
844+
checkHomeUnitsClosed' :: UnitEnv -> OS.Set UnitId -> Maybe (Compat.MsgEnvelope DriverMessage)
844845
checkHomeUnitsClosed' ue home_id_set
845-
| OS.null bad_unit_ids = []
846-
| otherwise = [singleMessage $ GHC.mkPlainErrorMsgEnvelope rootLoc $ DriverHomePackagesNotClosed (OS.toList bad_unit_ids)]
846+
| OS.null bad_unit_ids = Nothing
847+
| otherwise = Just (GHC.mkPlainErrorMsgEnvelope rootLoc $ DriverHomePackagesNotClosed (OS.toList bad_unit_ids))
847848
where
848849
bad_unit_ids = upwards_closure OS.\\ home_id_set
849850
rootLoc = mkGeneralSrcSpan (Compat.fsLit "<command line>")
@@ -921,11 +922,25 @@ newComponentCache recorder exts cradlePath _cfp hsc_env old_cis new_cis dir = do
921922
hscEnv' <- -- Set up a multi component session with the other units on GHC 9.4
922923
Compat.initUnits dfs hsc_env
923924

924-
#if MIN_VERSION_ghc(9,3,0)
925-
let closure_errs = checkHomeUnitsClosed' (hsc_unit_env hscEnv') (hsc_all_home_unit_ids hscEnv')
926-
multi_errs = map (ideErrorWithSource (Just "cradle") (Just DiagnosticSeverity_Warning) _cfp . T.pack . Compat.printWithoutUniques) closure_errs
925+
#if MIN_VERSION_ghc(9,6,1)
926+
let closure_errs = maybeToList $ checkHomeUnitsClosed' (hsc_unit_env hscEnv') (hsc_all_home_unit_ids hscEnv')
927+
-- TODO: Is this the right thing to do here, to produce an error for each DriverMessage generated?
928+
closure_err_to_multi_err err =
929+
ideErrorWithSource
930+
(Just "cradle") (Just DiagnosticSeverity_Warning) _cfp
931+
(T.pack (Compat.printWithoutUniques (singleMessage err)))
932+
(Just (fmap GhcDriverMessage err))
933+
multi_errs = map closure_err_to_multi_err closure_errs
934+
bad_units = OS.fromList $ concat $ do
935+
x <- map errMsgDiagnostic closure_errs
936+
DriverHomePackagesNotClosed us <- pure x
937+
pure us
938+
isBad ci = (homeUnitId_ (componentDynFlags ci)) `OS.member` bad_units
939+
#elif MIN_VERSION_ghc(9,3,0)
940+
let closure_errs = maybeToList $ checkHomeUnitsClosed' (hsc_unit_env hscEnv') (hsc_all_home_unit_ids hscEnv')
941+
multi_errs = map (\diag -> ideErrorWithSource (Just "cradle") (Just DiagnosticSeverity_Warning) _cfp (T.pack (Compat.printWithoutUniques (singleMessage diag))) Nothing) closure_errs
927942
bad_units = OS.fromList $ concat $ do
928-
x <- bagToList $ mapBag errMsgDiagnostic $ unionManyBags $ map Compat.getMessages closure_errs
943+
x <- map errMsgDiagnostic closure_errs
929944
DriverHomePackagesNotClosed us <- pure x
930945
pure us
931946
isBad ci = (homeUnitId_ (componentDynFlags ci)) `OS.member` bad_units
@@ -1311,4 +1326,4 @@ showPackageSetupException PackageSetupException{..} = unwords
13111326

13121327
renderPackageSetupException :: FilePath -> PackageSetupException -> FileDiagnostic
13131328
renderPackageSetupException fp e =
1314-
ideErrorWithSource (Just "cradle") (Just DiagnosticSeverity_Error) (toNormalizedFilePath' fp) (T.pack $ showPackageSetupException e)
1329+
ideErrorWithSource (Just "cradle") (Just DiagnosticSeverity_Error) (toNormalizedFilePath' fp) (T.pack $ showPackageSetupException e) Nothing

‎ghcide/session-loader/Development/IDE/Session/Diagnostics.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -29,7 +29,7 @@ data CradleErrorDetails =
2929
renderCradleError :: CradleError -> Cradle a -> NormalizedFilePath -> FileDiagnostic
3030
renderCradleError (CradleError deps _ec ms) cradle nfp =
3131
let noDetails =
32-
ideErrorWithSource (Just "cradle") (Just DiagnosticSeverity_Error) nfp $ T.unlines $ map T.pack userFriendlyMessage
32+
ideErrorWithSource (Just "cradle") (Just DiagnosticSeverity_Error) nfp (T.unlines $ map T.pack userFriendlyMessage) Nothing
3333
in
3434
if HieBios.isCabalCradle cradle
3535
then flip modifyFdLspDiagnostic noDetails $ \diag -> diag{_data_ = Just $ Aeson.toJSON CradleErrorDetails{cabalProjectFiles=absDeps}}

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

Lines changed: 44 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -160,8 +160,13 @@ computePackageDeps
160160
-> IO (Either [FileDiagnostic] [UnitId])
161161
computePackageDeps env pkg = do
162162
case lookupUnit env pkg of
163-
Nothing -> return $ Left [ideErrorText (toNormalizedFilePath' noFilePath) $
164-
T.pack $ "unknown package: " ++ show pkg]
163+
Nothing ->
164+
return $ Left
165+
[ ideErrorText
166+
Nothing
167+
(toNormalizedFilePath' noFilePath)
168+
(T.pack $ "unknown package: " ++ show pkg)
169+
]
165170
Just pkgInfo -> return $ Right $ unitDepends pkgInfo
166171

167172
newtype TypecheckHelpers
@@ -599,8 +604,14 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do
599604
source = "compile"
600605
catchErrs x = x `catches`
601606
[ Handler $ return . (,Nothing) . diagFromGhcException source dflags
602-
, Handler $ return . (,Nothing) . diagFromString source DiagnosticSeverity_Error (noSpan "<internal>")
603-
. (("Error during " ++ T.unpack source) ++) . show @SomeException
607+
, Handler $ \diag ->
608+
return
609+
( diagFromString
610+
source DiagnosticSeverity_Error (noSpan "<internal>")
611+
("Error during " ++ T.unpack source ++ show @SomeException diag)
612+
Nothing
613+
, Nothing
614+
)
604615
]
605616

606617
-- | Whether we should run the -O0 simplifier when generating core.
@@ -1028,16 +1039,25 @@ handleGenerationErrors :: DynFlags -> T.Text -> IO () -> IO [FileDiagnostic]
10281039
handleGenerationErrors dflags source action =
10291040
action >> return [] `catches`
10301041
[ Handler $ return . diagFromGhcException source dflags
1031-
, Handler $ return . diagFromString source DiagnosticSeverity_Error (noSpan "<internal>")
1032-
. (("Error during " ++ T.unpack source) ++) . show @SomeException
1042+
, Handler $ \(exception :: SomeException) -> return $
1043+
diagFromString
1044+
source DiagnosticSeverity_Error (noSpan "<internal>")
1045+
("Error during " ++ T.unpack source ++ show exception)
1046+
Nothing
10331047
]
10341048

10351049
handleGenerationErrors' :: DynFlags -> T.Text -> IO (Maybe a) -> IO ([FileDiagnostic], Maybe a)
10361050
handleGenerationErrors' dflags source action =
10371051
fmap ([],) action `catches`
10381052
[ Handler $ return . (,Nothing) . diagFromGhcException source dflags
1039-
, Handler $ return . (,Nothing) . diagFromString source DiagnosticSeverity_Error (noSpan "<internal>")
1040-
. (("Error during " ++ T.unpack source) ++) . show @SomeException
1053+
, Handler $ \(exception :: SomeException) ->
1054+
return
1055+
( diagFromString
1056+
source DiagnosticSeverity_Error (noSpan "<internal>")
1057+
("Error during " ++ T.unpack source ++ show exception)
1058+
Nothing
1059+
, Nothing
1060+
)
10411061
]
10421062

10431063

@@ -1290,12 +1310,21 @@ parseFileContents env customPreprocessor filename ms = do
12901310
psMessages = getPsMessages pst
12911311
in
12921312
do
1293-
let IdePreprocessedSource preproc_warns errs parsed = customPreprocessor rdr_module
1294-
1295-
unless (null errs) $
1296-
throwE $ diagFromStrings sourceParser DiagnosticSeverity_Error errs
1297-
1298-
let preproc_warnings = diagFromStrings sourceParser DiagnosticSeverity_Warning preproc_warns
1313+
let IdePreprocessedSource preproc_warns preproc_errs parsed = customPreprocessor rdr_module
1314+
let attachNoStructuredError (span, msg) = (span, msg, Nothing)
1315+
1316+
unless (null preproc_errs) $
1317+
throwE $
1318+
diagFromStrings
1319+
sourceParser
1320+
DiagnosticSeverity_Error
1321+
(fmap attachNoStructuredError preproc_errs)
1322+
1323+
let preproc_warning_file_diagnostics =
1324+
diagFromStrings
1325+
sourceParser
1326+
DiagnosticSeverity_Warning
1327+
(fmap attachNoStructuredError preproc_warns)
12991328
(parsed', msgs) <- liftIO $ applyPluginsParsedResultAction env ms hpm_annotations parsed psMessages
13001329
let (warns, errors) = renderMessages msgs
13011330

@@ -1345,7 +1374,7 @@ parseFileContents env customPreprocessor filename ms = do
13451374

13461375
let pm = ParsedModule ms parsed' srcs2 hpm_annotations
13471376
warnings = diagFromErrMsgs sourceParser dflags warns
1348-
pure (warnings ++ preproc_warnings, pm)
1377+
pure (warnings ++ preproc_warning_file_diagnostics, pm)
13491378

13501379
loadHieFile :: Compat.NameCacheUpdater -> FilePath -> IO GHC.HieFile
13511380
loadHieFile ncu f = do

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -134,7 +134,7 @@ getModificationTimeImpl missingFileDiags file = do
134134
`catch` \(e :: IOException) -> do
135135
let err | isDoesNotExistError e = "File does not exist: " ++ file'
136136
| otherwise = "IO error while reading " ++ file' ++ ", " ++ displayException e
137-
diag = ideErrorText file (T.pack err)
137+
diag = ideErrorText Nothing file (T.pack err)
138138
if isDoesNotExistError e && not missingFileDiags
139139
then return (Nothing, ([], Nothing))
140140
else return (Nothing, ([diag], Nothing))

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -112,7 +112,7 @@ data CPPDiag
112112

113113
diagsFromCPPLogs :: FilePath -> [CPPLog] -> [FileDiagnostic]
114114
diagsFromCPPLogs filename logs =
115-
map (\d -> FileDiagnostic (toNormalizedFilePath' filename) ShowDiag (cppDiagToDiagnostic d)) $
115+
map (\d -> FileDiagnostic (toNormalizedFilePath' filename) ShowDiag (cppDiagToDiagnostic d) NoStructuredMessage) $
116116
go [] logs
117117
where
118118
-- On errors, CPP calls logAction with a real span for the initial log and

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

Lines changed: 3 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -501,17 +501,9 @@ reportImportCyclesRule recorder =
501501
where cycleErrorInFile f (PartOfCycle imp fs)
502502
| f `elem` fs = Just (imp, fs)
503503
cycleErrorInFile _ _ = Nothing
504-
toDiag imp mods = FileDiagnostic fp ShowDiag $ Diagnostic
505-
{ _range = rng
506-
, _severity = Just DiagnosticSeverity_Error
507-
, _source = Just "Import cycle detection"
508-
, _message = "Cyclic module dependency between " <> showCycle mods
509-
, _code = Nothing
510-
, _relatedInformation = Nothing
511-
, _tags = Nothing
512-
, _codeDescription = Nothing
513-
, _data_ = Nothing
514-
}
504+
toDiag imp mods =
505+
modifyFdLspDiagnostic (\lspDiag -> lspDiag { _range = rng })
506+
$ ideErrorWithSource (Just "Import cycle detection") (Just DiagnosticSeverity_Error) fp ("Cyclic module dependency between " <> showCycle mods) Nothing
515507
where rng = fromMaybe noRange $ srcSpanToRange (getLoc imp)
516508
fp = toNormalizedFilePath' $ fromMaybe noFilePath $ srcSpanToFilename (getLoc imp)
517509
getModuleName file = do

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

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1265,7 +1265,7 @@ defineEarlyCutoff' doDiagnostics cmp key file mbOld mode action = do
12651265
(mbBs, (diags, mbRes)) <- actionCatch
12661266
(do v <- action staleV; liftIO $ evaluate $ force v) $
12671267
\(e :: SomeException) -> do
1268-
pure (Nothing, ([ideErrorText file $ T.pack $ show e | not $ isBadDependency e],Nothing))
1268+
pure (Nothing, ([ideErrorText Nothing file $ T.pack $ show e | not $ isBadDependency e],Nothing))
12691269

12701270
ver <- estimateFileVersionUnsafely key mbRes file
12711271
(bs, res) <- case mbRes of
@@ -1374,7 +1374,7 @@ updateFileDiagnostics recorder fp ver k ShakeExtras{diagnostics, hiddenDiagnosti
13741374
lastPublish <- atomicallyNamed "diagnostics - publish" $ STM.focus (Focus.lookupWithDefault [] <* Focus.insert newDiags) uri' publishedDiagnostics
13751375
let action = when (lastPublish /= newDiags) $ case lspEnv of
13761376
Nothing -> -- Print an LSP event.
1377-
logWith recorder Info $ LogDiagsDiffButNoLspEnv (map (FileDiagnostic fp ShowDiag) newDiags)
1377+
logWith recorder Info $ LogDiagsDiffButNoLspEnv (map (\lspDiag -> FileDiagnostic fp ShowDiag lspDiag NoStructuredMessage) newDiags) -- TODO: Should try to get structured diagnostics plumbed here if possible
13781378
Just env -> LSP.runLspT env $ do
13791379
liftIO $ tag "count" (show $ Prelude.length newDiags)
13801380
liftIO $ tag "key" (show k)
@@ -1442,7 +1442,7 @@ getAllDiagnostics ::
14421442
STMDiagnosticStore ->
14431443
STM [FileDiagnostic]
14441444
getAllDiagnostics =
1445-
fmap (concatMap (\(k,v) -> map (FileDiagnostic (fromUri k) ShowDiag) $ getDiagnosticsFromStore v)) . ListT.toList . STM.listT
1445+
fmap (concatMap (\(k,v) -> map (\diag -> FileDiagnostic (fromUri k) ShowDiag diag NoStructuredMessage) $ getDiagnosticsFromStore v)) . ListT.toList . STM.listT -- TODO: Do we need the structured message here?
14461446

14471447
updatePositionMapping :: IdeState -> VersionedTextDocumentIdentifier -> [TextDocumentContentChangeEvent] -> STM ()
14481448
updatePositionMapping IdeState{shakeExtras = ShakeExtras{positionMapping}} VersionedTextDocumentIdentifier{..} changes =

‎ghcide/src/Development/IDE/GHC/Compat.hs

Lines changed: 11 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -362,16 +362,25 @@ corePrepExpr _ = GHC.corePrepExpr
362362

363363
renderMessages :: PsMessages -> (Bag WarnMsg, Bag ErrMsg)
364364
renderMessages msgs =
365-
#if MIN_VERSION_ghc(9,3,0)
365+
#if MIN_VERSION_ghc(9,6,1)
366+
let renderMsgs extractor = (fmap . fmap) GhcPsMessage . getMessages $ extractor msgs
367+
in (renderMsgs psWarnings, renderMsgs psErrors)
368+
#elif MIN_VERSION_ghc(9,3,0)
366369
let renderMsgs extractor = (fmap . fmap) renderDiagnosticMessageWithHints . getMessages $ extractor msgs
367370
in (renderMsgs psWarnings, renderMsgs psErrors)
368371
#else
369372
msgs
370373
#endif
371374

375+
#if MIN_VERSION_ghc(9,6,1)
376+
pattern PFailedWithErrorMessages :: forall a b. (b -> Bag (MsgEnvelope GhcMessage)) -> ParseResult a
377+
#elif MIN_VERSION_ghc(9,3,0)
372378
pattern PFailedWithErrorMessages :: forall a b. (b -> Bag (MsgEnvelope DecoratedSDoc)) -> ParseResult a
379+
#endif
373380
pattern PFailedWithErrorMessages msgs
374-
#if MIN_VERSION_ghc(9,3,0)
381+
#if MIN_VERSION_ghc(9,6,1)
382+
<- PFailed (const . fmap (fmap GhcPsMessage) . getMessages . getPsErrorMessages -> msgs)
383+
#elif MIN_VERSION_ghc(9,3,0)
375384
<- PFailed (const . fmap (fmap renderDiagnosticMessageWithHints) . getMessages . getPsErrorMessages -> msgs)
376385
#else
377386
<- PFailed (const . fmap pprError . getErrorMessages -> msgs)

‎ghcide/src/Development/IDE/GHC/Compat/Outputable.hs

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -147,8 +147,11 @@ pprNoLocMsgEnvelope (MsgEnvelope { errMsgDiagnostic = e
147147

148148

149149

150+
#if MIN_VERSION_ghc(9,6,1)
151+
type ErrMsg = MsgEnvelope GhcMessage
152+
type WarnMsg = MsgEnvelope GhcMessage
153+
#elif MIN_VERSION_ghc(9,3,0)
150154
type ErrMsg = MsgEnvelope DecoratedSDoc
151-
#if MIN_VERSION_ghc(9,3,0)
152155
type WarnMsg = MsgEnvelope DecoratedSDoc
153156
#endif
154157

0 commit comments

Comments
 (0)