git.iko.soy/ghcide
on 8fca00d help sign in
ghcide/src/Development/IDE/GHC/Error.hs
152 lines 5.5 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
12 -- * utilities working with spans
13 , srcSpanToLocation
14 , srcSpanToFilename
15 , zeroSpan
16 , realSpan
17 ) where
19import Development.IDE.Types.Diagnostics as D
20import qualified Data.Text as T
21import Development.IDE.Types.Location
22import Development.IDE.GHC.Orphans()
23import qualified FastString as FS
24import GHC
25import Bag
26import ErrUtils
27import SrcLoc
28import qualified Outputable as Out
32diagFromText :: T.Text -> D.DiagnosticSeverity -> SrcSpan -> T.Text -> FileDiagnostic
33diagFromText diagSource sev loc msg = (toNormalizedFilePath $ srcSpanToFilename loc,)
34 Diagnostic
35 { _range = srcSpanToRange loc
36 , _severity = Just sev
37 , _source = Just diagSource -- not shown in the IDE, but useful for ghcide developers
38 , _message = msg
39 , _code = Nothing
40 , _relatedInformation = Nothing
41 }
43-- | Produce a GHC-style error from a source span and a message.
44diagFromErrMsg :: T.Text -> DynFlags -> ErrMsg -> [FileDiagnostic]
45diagFromErrMsg diagSource dflags e =
46 [ diagFromText diagSource sev (errMsgSpan e) $ T.pack $ Out.showSDoc dflags $ ErrUtils.pprLocErrMsg e
47 | Just sev <- [toDSeverity $ errMsgSeverity e]]
50diagFromErrMsgs :: T.Text -> DynFlags -> Bag ErrMsg -> [FileDiagnostic]
51diagFromErrMsgs diagSource dflags = concatMap (diagFromErrMsg diagSource dflags) . bagToList
54-- | Convert a GHC SrcSpan to a DAML compiler Range
55srcSpanToRange :: SrcSpan -> Range
56srcSpanToRange (UnhelpfulSpan _) = noRange
57srcSpanToRange (RealSrcSpan real) = realSrcSpanToRange real
59realSrcSpanToRange :: RealSrcSpan -> Range
60realSrcSpanToRange real =
61 Range (Position (srcSpanStartLine real - 1) (srcSpanStartCol real - 1))
62 (Position (srcSpanEndLine real - 1) (srcSpanEndCol real - 1))
64-- | Extract a file name from a GHC SrcSpan (use message for unhelpful ones)
65-- FIXME This may not be an _absolute_ file name, needs fixing.
66srcSpanToFilename :: SrcSpan -> FilePath
67srcSpanToFilename (UnhelpfulSpan fs) = FS.unpackFS fs
68srcSpanToFilename (RealSrcSpan real) = FS.unpackFS $ srcSpanFile real
70srcSpanToLocation :: SrcSpan -> Location
71srcSpanToLocation src =
72 -- important that the URI's we produce have been properly normalized, otherwise they point at weird places in VS Code
73 Location (fromNormalizedUri $ filePathToUri' $ toNormalizedFilePath $ srcSpanToFilename src) (srcSpanToRange src)
75-- | Convert a GHC severity to a DAML compiler Severity. Severities below
76-- "Warning" level are dropped (returning Nothing).
77toDSeverity :: GHC.Severity -> Maybe D.DiagnosticSeverity
78toDSeverity SevOutput = Nothing
79toDSeverity SevInteractive = Nothing
80toDSeverity SevDump = Nothing
81toDSeverity SevInfo = Just DsInfo
82toDSeverity SevWarning = Just DsWarning
83toDSeverity SevError = Just DsError
84toDSeverity SevFatal = Just DsError
87-- | Produce a bag of GHC-style errors (@ErrorMessages@) from the given
88-- (optional) locations and message strings.
89diagFromStrings :: T.Text -> [(SrcSpan, String)] -> [FileDiagnostic]
90diagFromStrings diagSource = concatMap (uncurry (diagFromString diagSource))
92-- | Produce a GHC-style error from a source span and a message.
93diagFromString :: T.Text -> SrcSpan -> String -> [FileDiagnostic]
94diagFromString diagSource sp x = [diagFromText diagSource DsError sp $ T.pack x]
97-- | Produces an "unhelpful" source span with the given string.
98noSpan :: String -> SrcSpan
99noSpan = UnhelpfulSpan . FS.fsLit
102-- | creates a span with zero length in the filename of the argument passed
103zeroSpan :: FS.FastString -- ^ file path of span
104 -> RealSrcSpan
105zeroSpan file = realSrcLocSpan (mkRealSrcLoc file 1 1)
107realSpan :: SrcSpan
108 -> Maybe RealSrcSpan
109realSpan = \case
110 RealSrcSpan r -> Just r
111 UnhelpfulSpan _ -> Nothing
114diagFromGhcException :: T.Text -> DynFlags -> GhcException -> [FileDiagnostic]
115diagFromGhcException diagSource dflags exc = diagFromString diagSource (noSpan "<Internal>") (showGHCE dflags exc)
117showGHCE :: DynFlags -> GhcException -> String
118showGHCE dflags exc = case exc of
119 Signal n
120 -> "Signal: " <> show n
122 Panic s
123 -> unwords ["Compilation Issue:", s, "\n", requestReport]
124 PprPanic s sdoc
125 -> unlines ["Compilation Issue", s,""
126 , Out.showSDoc dflags sdoc
127 , requestReport ]
129 Sorry s
130 -> "Unsupported feature: " <> s
131 PprSorry s sdoc
132 -> unlines ["Unsupported feature: ", s,""
133 , Out.showSDoc dflags sdoc]
136 ---------- errors below should not happen at all --------
137 InstallationError str
138 -> "Installation error: " <> str
140 UsageError str -- should never happen
141 -> unlines ["Unexpected usage error", str]
143 CmdLineError str
144 -> unlines ["Unexpected usage error", str]
146 ProgramError str
147 -> "Program error: " <> str
148 PprProgramError str sdoc ->
149 unlines ["Program error:", str,""
150 , Out.showSDoc dflags sdoc]
151 where
152 requestReport = "Please report this bug to the compiler authors."