git.iko.soy/ghcide
on eddf78a help sign in
ghcide/src/Development/IDE/GHC/Error.hs
153 lines 5.4 kB history raw
1-- Copyright (c) 2019 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
2-- SPDX-License-Identifier: Apache-2.0
3{-# LANGUAGE OverloadedStrings #-}
4module Development.IDE.GHC.Error
5 (
6 -- * Producing Diagnostic values
7 diagFromErrMsgs
8 , diagFromErrMsg
9 , diagFromString
10 , diagFromStrings
11 , diagFromGhcException
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 ErrUtils
28import SrcLoc
29import qualified Outputable as Out
33diagFromText :: D.DiagnosticSeverity -> SrcSpan -> T.Text -> FileDiagnostic
34diagFromText sev loc msg = (toNormalizedFilePath $ srcSpanToFilename loc,)
35 Diagnostic
36 { _range = srcSpanToRange loc
37 , _severity = Just sev
38 , _source = Just "compiler" -- should really be 'daml' or 'haskell', but not shown in the IDE so who cares
39 , _message = msg
40 , _code = Nothing
41 , _relatedInformation = Nothing
42 }
44-- | Produce a GHC-style error from a source span and a message.
45diagFromErrMsg :: DynFlags -> ErrMsg -> [FileDiagnostic]
46diagFromErrMsg dflags e =
47 [ diagFromText sev (errMsgSpan e) $ T.pack $ Out.showSDoc dflags $ ErrUtils.pprLocErrMsg e
48 | Just sev <- [toDSeverity $ errMsgSeverity e]]
51diagFromErrMsgs :: DynFlags -> Bag ErrMsg -> [FileDiagnostic]
52diagFromErrMsgs dflags = concatMap (diagFromErrMsg dflags) . bagToList
55-- | Convert a GHC SrcSpan to a DAML compiler Range
56srcSpanToRange :: SrcSpan -> Range
57srcSpanToRange (UnhelpfulSpan _) = noRange
58srcSpanToRange (RealSrcSpan real) = realSrcSpanToRange real
60realSrcSpanToRange :: RealSrcSpan -> Range
61realSrcSpanToRange real =
62 Range (Position (srcSpanStartLine real - 1) (srcSpanStartCol real - 1))
63 (Position (srcSpanEndLine real - 1) (srcSpanEndCol real - 1))
65-- | Extract a file name from a GHC SrcSpan (use message for unhelpful ones)
66-- FIXME This may not be an _absolute_ file name, needs fixing.
67srcSpanToFilename :: SrcSpan -> FilePath
68srcSpanToFilename (UnhelpfulSpan fs) = FS.unpackFS fs
69srcSpanToFilename (RealSrcSpan real) = FS.unpackFS $ srcSpanFile real
71srcSpanToLocation :: SrcSpan -> Location
72srcSpanToLocation src =
73 -- important that the URI's we produce have been properly normalized, otherwise they point at weird places in VS Code
74 Location (fromNormalizedUri $ filePathToUri' $ toNormalizedFilePath $ srcSpanToFilename src) (srcSpanToRange src)
76-- | Convert a GHC severity to a DAML compiler Severity. Severities below
77-- "Warning" level are dropped (returning Nothing).
78toDSeverity :: GHC.Severity -> Maybe D.DiagnosticSeverity
79toDSeverity SevOutput = Nothing
80toDSeverity SevInteractive = Nothing
81toDSeverity SevDump = Nothing
82toDSeverity SevInfo = Just DsInfo
83toDSeverity SevWarning = Just DsWarning
84toDSeverity SevError = Just DsError
85toDSeverity SevFatal = Just DsError
88-- | Produce a bag of GHC-style errors (@ErrorMessages@) from the given
89-- (optional) locations and message strings.
90diagFromStrings :: [(SrcSpan, String)] -> [FileDiagnostic]
91diagFromStrings = concatMap (uncurry diagFromString)
93-- | Produce a GHC-style error from a source span and a message.
94diagFromString :: SrcSpan -> String -> [FileDiagnostic]
95diagFromString sp x = [diagFromText DsError sp $ T.pack x]
98-- | Produces an "unhelpful" source span with the given string.
99noSpan :: String -> SrcSpan
100noSpan = UnhelpfulSpan . FS.fsLit
103-- | creates a span with zero length in the filename of the argument passed
104zeroSpan :: FS.FastString -- ^ file path of span
105 -> RealSrcSpan
106zeroSpan file = realSrcLocSpan (mkRealSrcLoc file 1 1)
108realSpan :: SrcSpan
109 -> Maybe RealSrcSpan
110realSpan = \case
111 RealSrcSpan r -> Just r
112 UnhelpfulSpan _ -> Nothing
115diagFromGhcException :: DynFlags -> GhcException -> [FileDiagnostic]
116diagFromGhcException dflags exc = diagFromString (noSpan "<Internal>") (showGHCE dflags exc)
118showGHCE :: DynFlags -> GhcException -> String
119showGHCE dflags exc = case exc of
120 Signal n
121 -> "Signal: " <> show n
123 Panic s
124 -> unwords ["Compilation Issue:", s, "\n", requestReport]
125 PprPanic s sdoc
126 -> unlines ["Compilation Issue", s,""
127 , Out.showSDoc dflags sdoc
128 , requestReport ]
130 Sorry s
131 -> "Unsupported feature: " <> s
132 PprSorry s sdoc
133 -> unlines ["Unsupported feature: ", s,""
134 , Out.showSDoc dflags sdoc]
137 ---------- errors below should not happen at all --------
138 InstallationError str
139 -> "Installation error: " <> str
141 UsageError str -- should never happen
142 -> unlines ["Unexpected usage error", str]
144 CmdLineError str
145 -> unlines ["Unexpected usage error", str]
147 ProgramError str
148 -> "Program error: " <> str
149 PprProgramError str sdoc ->
150 unlines ["Program error:", str,""
151 , Out.showSDoc dflags sdoc]
152 where
153 requestReport = "Please report this bug to the compiler authors."