git.iko.soy/ghcide
on a58751e help sign in
ghcide/src/Development/IDE/GHC/Error.hs
169 lines 6.2 kB history raw
1-- Copyright (c) 2019 The DAML Authors. All rights reserved.
2-- SPDX-License-Identifier: Apache-2.0
3module Development.IDE.GHC.Error
4 (
5 -- * Producing Diagnostic values
6 diagFromErrMsgs
7 , diagFromErrMsg
8 , diagFromString
9 , diagFromStrings
10 , diagFromGhcException
11 , catchSrcErrors
13 -- * utilities working with spans
14 , srcSpanToLocation
15 , srcSpanToFilename
16 , zeroSpan
17 , realSpan
18 ) where
20import Development.IDE.Types.Diagnostics as D
21import qualified Data.Text as T
22import Development.IDE.Types.Location
23import Development.IDE.GHC.Orphans()
24import qualified FastString as FS
25import GHC
26import Bag
27import DynFlags
28import HscTypes
29import Panic
30import ErrUtils
31import SrcLoc
32import qualified Outputable as Out
36diagFromText :: T.Text -> D.DiagnosticSeverity -> SrcSpan -> T.Text -> FileDiagnostic
37diagFromText diagSource sev loc msg = (toNormalizedFilePath $ srcSpanToFilename loc,)
38 Diagnostic
39 { _range = srcSpanToRange loc
40 , _severity = Just sev
41 , _source = Just diagSource -- not shown in the IDE, but useful for ghcide developers
42 , _message = msg
43 , _code = Nothing
44 , _relatedInformation = Nothing
45 }
47-- | Produce a GHC-style error from a source span and a message.
48diagFromErrMsg :: T.Text -> DynFlags -> ErrMsg -> [FileDiagnostic]
49diagFromErrMsg diagSource dflags e =
50 [ diagFromText diagSource sev (errMsgSpan e) $ T.pack $ Out.showSDoc dflags $ ErrUtils.pprLocErrMsg e
51 | Just sev <- [toDSeverity $ errMsgSeverity e]]
54diagFromErrMsgs :: T.Text -> DynFlags -> Bag ErrMsg -> [FileDiagnostic]
55diagFromErrMsgs diagSource dflags = concatMap (diagFromErrMsg diagSource dflags) . bagToList
58-- | Convert a GHC SrcSpan to a DAML compiler Range
59srcSpanToRange :: SrcSpan -> Range
60srcSpanToRange (UnhelpfulSpan _) = noRange
61srcSpanToRange (RealSrcSpan real) = realSrcSpanToRange real
63realSrcSpanToRange :: RealSrcSpan -> Range
64realSrcSpanToRange real =
65 Range (Position (srcSpanStartLine real - 1) (srcSpanStartCol real - 1))
66 (Position (srcSpanEndLine real - 1) (srcSpanEndCol real - 1))
68-- | Extract a file name from a GHC SrcSpan (use message for unhelpful ones)
69-- FIXME This may not be an _absolute_ file name, needs fixing.
70srcSpanToFilename :: SrcSpan -> FilePath
71srcSpanToFilename (UnhelpfulSpan fs) = FS.unpackFS fs
72srcSpanToFilename (RealSrcSpan real) = FS.unpackFS $ srcSpanFile real
74srcSpanToLocation :: SrcSpan -> Location
75srcSpanToLocation src =
76 -- important that the URI's we produce have been properly normalized, otherwise they point at weird places in VS Code
77 Location (fromNormalizedUri $ filePathToUri' $ toNormalizedFilePath $ srcSpanToFilename src) (srcSpanToRange src)
79-- | Convert a GHC severity to a DAML compiler Severity. Severities below
80-- "Warning" level are dropped (returning Nothing).
81toDSeverity :: GHC.Severity -> Maybe D.DiagnosticSeverity
82toDSeverity SevOutput = Nothing
83toDSeverity SevInteractive = Nothing
84toDSeverity SevDump = Nothing
85toDSeverity SevInfo = Just DsInfo
86toDSeverity SevWarning = Just DsWarning
87toDSeverity SevError = Just DsError
88toDSeverity SevFatal = Just DsError
91-- | Produce a bag of GHC-style errors (@ErrorMessages@) from the given
92-- (optional) locations and message strings.
93diagFromStrings :: T.Text -> [(SrcSpan, String)] -> [FileDiagnostic]
94diagFromStrings diagSource = concatMap (uncurry (diagFromString diagSource))
96-- | Produce a GHC-style error from a source span and a message.
97diagFromString :: T.Text -> SrcSpan -> String -> [FileDiagnostic]
98diagFromString diagSource sp x = [diagFromText diagSource DsError sp $ T.pack x]
101-- | Produces an "unhelpful" source span with the given string.
102noSpan :: String -> SrcSpan
103noSpan = UnhelpfulSpan . FS.fsLit
106-- | creates a span with zero length in the filename of the argument passed
107zeroSpan :: FS.FastString -- ^ file path of span
108 -> RealSrcSpan
109zeroSpan file = realSrcLocSpan (mkRealSrcLoc file 1 1)
111realSpan :: SrcSpan
112 -> Maybe RealSrcSpan
113realSpan = \case
114 RealSrcSpan r -> Just r
115 UnhelpfulSpan _ -> Nothing
118-- | Run something in a Ghc monad and catch the errors (SourceErrors and
119-- compiler-internal exceptions like Panic or InstallationError).
120catchSrcErrors :: GhcMonad m => T.Text -> m a -> m (Either [FileDiagnostic] a)
121catchSrcErrors fromWhere ghcM = do
122 dflags <- getDynFlags
123 handleGhcException (ghcExceptionToDiagnostics dflags) $
124 handleSourceError (sourceErrorToDiagnostics dflags) $
125 Right <$> ghcM
126 where
127 ghcExceptionToDiagnostics dflags = return . Left . diagFromGhcException fromWhere dflags
128 sourceErrorToDiagnostics dflags = return . Left . diagFromErrMsgs fromWhere dflags . srcErrorMessages
131diagFromGhcException :: T.Text -> DynFlags -> GhcException -> [FileDiagnostic]
132diagFromGhcException diagSource dflags exc = diagFromString diagSource (noSpan "<Internal>") (showGHCE dflags exc)
134showGHCE :: DynFlags -> GhcException -> String
135showGHCE dflags exc = case exc of
136 Signal n
137 -> "Signal: " <> show n
139 Panic s
140 -> unwords ["Compilation Issue:", s, "\n", requestReport]
141 PprPanic s sdoc
142 -> unlines ["Compilation Issue", s,""
143 , Out.showSDoc dflags sdoc
144 , requestReport ]
146 Sorry s
147 -> "Unsupported feature: " <> s
148 PprSorry s sdoc
149 -> unlines ["Unsupported feature: ", s,""
150 , Out.showSDoc dflags sdoc]
153 ---------- errors below should not happen at all --------
154 InstallationError str
155 -> "Installation error: " <> str
157 UsageError str -- should never happen
158 -> unlines ["Unexpected usage error", str]
160 CmdLineError str
161 -> unlines ["Unexpected usage error", str]
163 ProgramError str
164 -> "Program error: " <> str
165 PprProgramError str sdoc ->
166 unlines ["Program error:", str,""
167 , Out.showSDoc dflags sdoc]
168 where
169 requestReport = "Please report this bug to the compiler authors."