git.iko.soy/ghcide
on 0336e41 help sign in
ghcide/src/Development/IDE/GHC/Error.hs
153 lines 5.2 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 , noSpan
19 ) where
21import Development.IDE.Types.Diagnostics as D
22import qualified Data.Text as T
23import Development.IDE.Types.Location
24import Development.IDE.GHC.Orphans()
25import qualified FastString as FS
26import GHC
27import Bag
28import ErrUtils
29import SrcLoc
30import qualified Outputable as Out
34diagFromText :: D.DiagnosticSeverity -> SrcSpan -> T.Text -> FileDiagnostic
35diagFromText sev loc msg = (toNormalizedFilePath $ srcSpanToFilename loc,)
36 Diagnostic
37 { _range = srcSpanToRange loc
38 , _severity = Just sev
39 , _source = Just "compiler" -- should really be 'daml' or 'haskell', but not shown in the IDE so who cares
40 , _message = msg
41 , _code = Nothing
42 , _relatedInformation = Nothing
43 }
45-- | Produce a GHC-style error from a source span and a message.
46diagFromErrMsg :: DynFlags -> ErrMsg -> [FileDiagnostic]
47diagFromErrMsg dflags e =
48 [ diagFromText sev (errMsgSpan e) $ T.pack $ Out.showSDoc dflags $ ErrUtils.pprLocErrMsg e
49 | Just sev <- [toDSeverity $ errMsgSeverity e]]
52diagFromErrMsgs :: DynFlags -> Bag ErrMsg -> [FileDiagnostic]
53diagFromErrMsgs dflags = concatMap (diagFromErrMsg dflags) . bagToList
56-- | Convert a GHC SrcSpan to a DAML compiler Range
57srcSpanToRange :: SrcSpan -> Range
58srcSpanToRange (UnhelpfulSpan _) = noRange
59srcSpanToRange (RealSrcSpan real) = realSrcSpanToRange real
61realSrcSpanToRange :: RealSrcSpan -> Range
62realSrcSpanToRange real =
63 Range (Position (srcSpanStartLine real - 1) (srcSpanStartCol real - 1))
64 (Position (srcSpanEndLine real - 1) (srcSpanEndCol real - 1))
66-- | Extract a file name from a GHC SrcSpan (use message for unhelpful ones)
67-- FIXME This may not be an _absolute_ file name, needs fixing.
68srcSpanToFilename :: SrcSpan -> FilePath
69srcSpanToFilename (UnhelpfulSpan fs) = FS.unpackFS fs
70srcSpanToFilename (RealSrcSpan real) = FS.unpackFS $ srcSpanFile real
72srcSpanToLocation :: SrcSpan -> Location
73srcSpanToLocation src =
74 Location (filePathToUri $ 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."