{-# LANGUAGE CPP #-}
module Development.IDE.GHC.Error
(
diagFromErrMsgs
, diagFromErrMsg
, diagFromString
, diagFromStrings
, diagFromGhcException
, catchSrcErrors
, srcSpanToLocation
, srcSpanToRange
, realSrcSpanToRange
, realSrcLocToPosition
, realSrcSpanToLocation
, realSrcSpanToCodePointRange
, realSrcLocToCodePointPosition
, srcSpanToFilename
, rangeToSrcSpan
, rangeToRealSrcSpan
, positionToRealSrcLoc
, zeroSpan
, realSpan
, isInsideSrcSpan
, spanContainsRange
, noSpan
, toDSeverity
) where
import Data.Maybe
import Data.String (fromString)
import qualified Data.Text as T
import Development.IDE.GHC.Compat (DecoratedSDoc, MsgEnvelope,
errMsgSeverity, errMsgSpan,
formatErrorWithQual,
srcErrorMessages)
import qualified Development.IDE.GHC.Compat as Compat
import qualified Development.IDE.GHC.Compat.Util as Compat
import Development.IDE.GHC.Orphans ()
import Development.IDE.Types.Diagnostics as D
import Development.IDE.Types.Location
import GHC
import Language.LSP.Protocol.Types (isSubrangeOf)
import Language.LSP.VFS (CodePointPosition (CodePointPosition),
CodePointRange (CodePointRange))
diagFromText :: T.Text -> D.DiagnosticSeverity -> SrcSpan -> T.Text -> FileDiagnostic
diagFromText :: Text -> DiagnosticSeverity -> SrcSpan -> Text -> FileDiagnostic
diagFromText Text
diagSource DiagnosticSeverity
sev SrcSpan
loc Text
msg = (String -> NormalizedFilePath
toNormalizedFilePath' (String -> NormalizedFilePath) -> String -> NormalizedFilePath
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
noFilePath (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Maybe String
srcSpanToFilename SrcSpan
loc,ShowDiagnostic
ShowDiag,)
Diagnostic
{ $sel:_range:Diagnostic :: Range
_range = Range -> Maybe Range -> Range
forall a. a -> Maybe a -> a
fromMaybe Range
noRange (Maybe Range -> Range) -> Maybe Range -> Range
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Maybe Range
srcSpanToRange SrcSpan
loc
, $sel:_severity:Diagnostic :: Maybe DiagnosticSeverity
_severity = DiagnosticSeverity -> Maybe DiagnosticSeverity
forall a. a -> Maybe a
Just DiagnosticSeverity
sev
, $sel:_source:Diagnostic :: Maybe Text
_source = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
diagSource
, $sel:_message:Diagnostic :: Text
_message = Text
msg
, $sel:_code:Diagnostic :: Maybe (Int32 |? Text)
_code = Maybe (Int32 |? Text)
forall a. Maybe a
Nothing
, $sel:_relatedInformation:Diagnostic :: Maybe [DiagnosticRelatedInformation]
_relatedInformation = Maybe [DiagnosticRelatedInformation]
forall a. Maybe a
Nothing
, $sel:_tags:Diagnostic :: Maybe [DiagnosticTag]
_tags = Maybe [DiagnosticTag]
forall a. Maybe a
Nothing
, $sel:_codeDescription:Diagnostic :: Maybe CodeDescription
_codeDescription = Maybe CodeDescription
forall a. Maybe a
Nothing
, $sel:_data_:Diagnostic :: Maybe Value
_data_ = Maybe Value
forall a. Maybe a
Nothing
}
diagFromErrMsg :: T.Text -> DynFlags -> MsgEnvelope DecoratedSDoc -> [FileDiagnostic]
diagFromErrMsg :: Text -> DynFlags -> MsgEnvelope DecoratedSDoc -> [FileDiagnostic]
diagFromErrMsg Text
diagSource DynFlags
dflags MsgEnvelope DecoratedSDoc
e =
[ Text -> DiagnosticSeverity -> SrcSpan -> Text -> FileDiagnostic
diagFromText Text
diagSource DiagnosticSeverity
sev (MsgEnvelope DecoratedSDoc -> SrcSpan
forall e. MsgEnvelope e -> SrcSpan
errMsgSpan MsgEnvelope DecoratedSDoc
e)
(Text -> FileDiagnostic) -> Text -> FileDiagnostic
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ DynFlags -> MsgEnvelope DecoratedSDoc -> String
formatErrorWithQual DynFlags
dflags MsgEnvelope DecoratedSDoc
e
| Just DiagnosticSeverity
sev <- [Severity -> Maybe DiagnosticSeverity
toDSeverity (Severity -> Maybe DiagnosticSeverity)
-> Severity -> Maybe DiagnosticSeverity
forall a b. (a -> b) -> a -> b
$ MsgEnvelope DecoratedSDoc -> Severity
forall e. MsgEnvelope e -> Severity
errMsgSeverity MsgEnvelope DecoratedSDoc
e]]
diagFromErrMsgs :: T.Text -> DynFlags -> Compat.Bag (MsgEnvelope DecoratedSDoc) -> [FileDiagnostic]
diagFromErrMsgs :: Text
-> DynFlags -> Bag (MsgEnvelope DecoratedSDoc) -> [FileDiagnostic]
diagFromErrMsgs Text
diagSource DynFlags
dflags = (MsgEnvelope DecoratedSDoc -> [FileDiagnostic])
-> [MsgEnvelope DecoratedSDoc] -> [FileDiagnostic]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text -> DynFlags -> MsgEnvelope DecoratedSDoc -> [FileDiagnostic]
diagFromErrMsg Text
diagSource DynFlags
dflags) ([MsgEnvelope DecoratedSDoc] -> [FileDiagnostic])
-> (Bag (MsgEnvelope DecoratedSDoc) -> [MsgEnvelope DecoratedSDoc])
-> Bag (MsgEnvelope DecoratedSDoc)
-> [FileDiagnostic]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bag (MsgEnvelope DecoratedSDoc) -> [MsgEnvelope DecoratedSDoc]
forall a. Bag a -> [a]
Compat.bagToList
srcSpanToRange :: SrcSpan -> Maybe Range
srcSpanToRange :: SrcSpan -> Maybe Range
srcSpanToRange (UnhelpfulSpan UnhelpfulSpanReason
_) = Maybe Range
forall a. Maybe a
Nothing
srcSpanToRange (Compat.RealSrcSpan RealSrcSpan
real Maybe BufSpan
_) = Range -> Maybe Range
forall a. a -> Maybe a
Just (Range -> Maybe Range) -> Range -> Maybe Range
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
real
realSrcSpanToRange :: RealSrcSpan -> Range
realSrcSpanToRange :: RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
real =
Position -> Position -> Range
Range (RealSrcLoc -> Position
realSrcLocToPosition (RealSrcLoc -> Position) -> RealSrcLoc -> Position
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> RealSrcLoc
Compat.realSrcSpanStart RealSrcSpan
real)
(RealSrcLoc -> Position
realSrcLocToPosition (RealSrcLoc -> Position) -> RealSrcLoc -> Position
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> RealSrcLoc
Compat.realSrcSpanEnd RealSrcSpan
real)
realSrcLocToPosition :: RealSrcLoc -> Position
realSrcLocToPosition :: RealSrcLoc -> Position
realSrcLocToPosition RealSrcLoc
real =
UInt -> UInt -> Position
Position (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt) -> Int -> UInt
forall a b. (a -> b) -> a -> b
$ RealSrcLoc -> Int
srcLocLine RealSrcLoc
real Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt) -> Int -> UInt
forall a b. (a -> b) -> a -> b
$ RealSrcLoc -> Int
srcLocCol RealSrcLoc
real Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
realSrcSpanToCodePointRange :: RealSrcSpan -> CodePointRange
realSrcSpanToCodePointRange :: RealSrcSpan -> CodePointRange
realSrcSpanToCodePointRange RealSrcSpan
real =
CodePointPosition -> CodePointPosition -> CodePointRange
CodePointRange
(RealSrcLoc -> CodePointPosition
realSrcLocToCodePointPosition (RealSrcLoc -> CodePointPosition)
-> RealSrcLoc -> CodePointPosition
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> RealSrcLoc
Compat.realSrcSpanStart RealSrcSpan
real)
(RealSrcLoc -> CodePointPosition
realSrcLocToCodePointPosition (RealSrcLoc -> CodePointPosition)
-> RealSrcLoc -> CodePointPosition
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> RealSrcLoc
Compat.realSrcSpanEnd RealSrcSpan
real)
realSrcLocToCodePointPosition :: RealSrcLoc -> CodePointPosition
realSrcLocToCodePointPosition :: RealSrcLoc -> CodePointPosition
realSrcLocToCodePointPosition RealSrcLoc
real =
UInt -> UInt -> CodePointPosition
CodePointPosition (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt) -> Int -> UInt
forall a b. (a -> b) -> a -> b
$ RealSrcLoc -> Int
srcLocLine RealSrcLoc
real Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt) -> Int -> UInt
forall a b. (a -> b) -> a -> b
$ RealSrcLoc -> Int
srcLocCol RealSrcLoc
real Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
srcSpanToFilename :: SrcSpan -> Maybe FilePath
srcSpanToFilename :: SrcSpan -> Maybe String
srcSpanToFilename (UnhelpfulSpan UnhelpfulSpanReason
_) = Maybe String
forall a. Maybe a
Nothing
srcSpanToFilename (Compat.RealSrcSpan RealSrcSpan
real Maybe BufSpan
_) = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ FastString -> String
Compat.unpackFS (FastString -> String) -> FastString -> String
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
real
realSrcSpanToLocation :: RealSrcSpan -> Location
realSrcSpanToLocation :: RealSrcSpan -> Location
realSrcSpanToLocation RealSrcSpan
real = Uri -> Range -> Location
Location Uri
file (RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
real)
where file :: Uri
file = NormalizedUri -> Uri
fromNormalizedUri (NormalizedUri -> Uri) -> NormalizedUri -> Uri
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> NormalizedUri
filePathToUri' (NormalizedFilePath -> NormalizedUri)
-> NormalizedFilePath -> NormalizedUri
forall a b. (a -> b) -> a -> b
$ String -> NormalizedFilePath
toNormalizedFilePath' (String -> NormalizedFilePath) -> String -> NormalizedFilePath
forall a b. (a -> b) -> a -> b
$ FastString -> String
Compat.unpackFS (FastString -> String) -> FastString -> String
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
real
srcSpanToLocation :: SrcSpan -> Maybe Location
srcSpanToLocation :: SrcSpan -> Maybe Location
srcSpanToLocation SrcSpan
src = do
String
fs <- SrcSpan -> Maybe String
srcSpanToFilename SrcSpan
src
Range
rng <- SrcSpan -> Maybe Range
srcSpanToRange SrcSpan
src
Location -> Maybe Location
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Location -> Maybe Location) -> Location -> Maybe Location
forall a b. (a -> b) -> a -> b
$ Uri -> Range -> Location
Location (NormalizedUri -> Uri
fromNormalizedUri (NormalizedUri -> Uri) -> NormalizedUri -> Uri
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> NormalizedUri
filePathToUri' (NormalizedFilePath -> NormalizedUri)
-> NormalizedFilePath -> NormalizedUri
forall a b. (a -> b) -> a -> b
$ String -> NormalizedFilePath
toNormalizedFilePath' String
fs) Range
rng
rangeToSrcSpan :: NormalizedFilePath -> Range -> SrcSpan
rangeToSrcSpan :: NormalizedFilePath -> Range -> SrcSpan
rangeToSrcSpan = (RealSrcSpan -> SrcSpan)
-> (Range -> RealSrcSpan) -> Range -> SrcSpan
forall a b. (a -> b) -> (Range -> a) -> Range -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\RealSrcSpan
x -> RealSrcSpan -> Maybe BufSpan -> SrcSpan
Compat.RealSrcSpan RealSrcSpan
x Maybe BufSpan
forall a. Maybe a
Nothing) ((Range -> RealSrcSpan) -> Range -> SrcSpan)
-> (NormalizedFilePath -> Range -> RealSrcSpan)
-> NormalizedFilePath
-> Range
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizedFilePath -> Range -> RealSrcSpan
rangeToRealSrcSpan
rangeToRealSrcSpan
:: NormalizedFilePath -> Range -> RealSrcSpan
rangeToRealSrcSpan :: NormalizedFilePath -> Range -> RealSrcSpan
rangeToRealSrcSpan NormalizedFilePath
nfp =
RealSrcLoc -> RealSrcLoc -> RealSrcSpan
Compat.mkRealSrcSpan
(RealSrcLoc -> RealSrcLoc -> RealSrcSpan)
-> (Range -> RealSrcLoc) -> Range -> RealSrcLoc -> RealSrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NormalizedFilePath -> Position -> RealSrcLoc
positionToRealSrcLoc NormalizedFilePath
nfp (Position -> RealSrcLoc)
-> (Range -> Position) -> Range -> RealSrcLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range -> Position
_start
(Range -> RealSrcLoc -> RealSrcSpan)
-> (Range -> RealSrcLoc) -> Range -> RealSrcSpan
forall a b. (Range -> a -> b) -> (Range -> a) -> Range -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NormalizedFilePath -> Position -> RealSrcLoc
positionToRealSrcLoc NormalizedFilePath
nfp (Position -> RealSrcLoc)
-> (Range -> Position) -> Range -> RealSrcLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range -> Position
_end
positionToRealSrcLoc :: NormalizedFilePath -> Position -> RealSrcLoc
positionToRealSrcLoc :: NormalizedFilePath -> Position -> RealSrcLoc
positionToRealSrcLoc NormalizedFilePath
nfp (Position UInt
l UInt
c)=
FastString -> Int -> Int -> RealSrcLoc
Compat.mkRealSrcLoc (String -> FastString
forall a. IsString a => String -> a
fromString (String -> FastString) -> String -> FastString
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
nfp) (UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UInt -> Int) -> UInt -> Int
forall a b. (a -> b) -> a -> b
$ UInt
l UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
+ UInt
1) (UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UInt -> Int) -> UInt -> Int
forall a b. (a -> b) -> a -> b
$ UInt
c UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
+ UInt
1)
isInsideSrcSpan :: Position -> SrcSpan -> Bool
Position
p isInsideSrcSpan :: Position -> SrcSpan -> Bool
`isInsideSrcSpan` SrcSpan
r = case SrcSpan -> Maybe Range
srcSpanToRange SrcSpan
r of
Just (Range Position
sp Position
ep) -> Position
sp Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
<= Position
p Bool -> Bool -> Bool
&& Position
p Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
<= Position
ep
Maybe Range
_ -> Bool
False
spanContainsRange :: SrcSpan -> Range -> Maybe Bool
spanContainsRange :: SrcSpan -> Range -> Maybe Bool
spanContainsRange SrcSpan
srcSpan Range
range = (Range
range `isSubrangeOf`) (Range -> Bool) -> Maybe Range -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SrcSpan -> Maybe Range
srcSpanToRange SrcSpan
srcSpan
toDSeverity :: GHC.Severity -> Maybe D.DiagnosticSeverity
#if !MIN_VERSION_ghc(9,3,0)
toDSeverity SevOutput = Nothing
toDSeverity SevInteractive = Nothing
toDSeverity SevDump = Nothing
toDSeverity SevInfo = Just DiagnosticSeverity_Information
toDSeverity SevFatal = Just DiagnosticSeverity_Error
#else
toDSeverity :: Severity -> Maybe DiagnosticSeverity
toDSeverity Severity
SevIgnore = Maybe DiagnosticSeverity
forall a. Maybe a
Nothing
#endif
toDSeverity Severity
SevWarning = DiagnosticSeverity -> Maybe DiagnosticSeverity
forall a. a -> Maybe a
Just DiagnosticSeverity
DiagnosticSeverity_Warning
toDSeverity Severity
SevError = DiagnosticSeverity -> Maybe DiagnosticSeverity
forall a. a -> Maybe a
Just DiagnosticSeverity
DiagnosticSeverity_Error
diagFromStrings :: T.Text -> D.DiagnosticSeverity -> [(SrcSpan, String)] -> [FileDiagnostic]
diagFromStrings :: Text
-> DiagnosticSeverity -> [(SrcSpan, String)] -> [FileDiagnostic]
diagFromStrings Text
diagSource DiagnosticSeverity
sev = ((SrcSpan, String) -> [FileDiagnostic])
-> [(SrcSpan, String)] -> [FileDiagnostic]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((SrcSpan -> String -> [FileDiagnostic])
-> (SrcSpan, String) -> [FileDiagnostic]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Text -> DiagnosticSeverity -> SrcSpan -> String -> [FileDiagnostic]
diagFromString Text
diagSource DiagnosticSeverity
sev))
diagFromString :: T.Text -> D.DiagnosticSeverity -> SrcSpan -> String -> [FileDiagnostic]
diagFromString :: Text -> DiagnosticSeverity -> SrcSpan -> String -> [FileDiagnostic]
diagFromString Text
diagSource DiagnosticSeverity
sev SrcSpan
sp String
x = [Text -> DiagnosticSeverity -> SrcSpan -> Text -> FileDiagnostic
diagFromText Text
diagSource DiagnosticSeverity
sev SrcSpan
sp (Text -> FileDiagnostic) -> Text -> FileDiagnostic
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
x]
noSpan :: String -> SrcSpan
noSpan :: String -> SrcSpan
noSpan = FastString -> SrcSpan
Compat.mkGeneralSrcSpan (FastString -> SrcSpan)
-> (String -> FastString) -> String -> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FastString
Compat.fsLit
zeroSpan :: Compat.FastString
-> RealSrcSpan
zeroSpan :: FastString -> RealSrcSpan
zeroSpan FastString
file = RealSrcLoc -> RealSrcSpan
Compat.realSrcLocSpan (FastString -> Int -> Int -> RealSrcLoc
Compat.mkRealSrcLoc FastString
file Int
1 Int
1)
realSpan :: SrcSpan
-> Maybe RealSrcSpan
realSpan :: SrcSpan -> Maybe RealSrcSpan
realSpan = \case
Compat.RealSrcSpan RealSrcSpan
r Maybe BufSpan
_ -> RealSrcSpan -> Maybe RealSrcSpan
forall a. a -> Maybe a
Just RealSrcSpan
r
UnhelpfulSpan UnhelpfulSpanReason
_ -> Maybe RealSrcSpan
forall a. Maybe a
Nothing
catchSrcErrors :: DynFlags -> T.Text -> IO a -> IO (Either [FileDiagnostic] a)
catchSrcErrors :: forall a.
DynFlags -> Text -> IO a -> IO (Either [FileDiagnostic] a)
catchSrcErrors DynFlags
dflags Text
fromWhere IO a
ghcM = do
(GhcException -> IO (Either [FileDiagnostic] a))
-> IO (Either [FileDiagnostic] a) -> IO (Either [FileDiagnostic] a)
forall (m :: * -> *) a.
ExceptionMonad m =>
(GhcException -> m a) -> m a -> m a
Compat.handleGhcException GhcException -> IO (Either [FileDiagnostic] a)
forall {b}. GhcException -> IO (Either [FileDiagnostic] b)
ghcExceptionToDiagnostics (IO (Either [FileDiagnostic] a) -> IO (Either [FileDiagnostic] a))
-> IO (Either [FileDiagnostic] a) -> IO (Either [FileDiagnostic] a)
forall a b. (a -> b) -> a -> b
$
(SourceError -> IO (Either [FileDiagnostic] a))
-> IO (Either [FileDiagnostic] a) -> IO (Either [FileDiagnostic] a)
forall (m :: * -> *) a.
MonadCatch m =>
(SourceError -> m a) -> m a -> m a
handleSourceError SourceError -> IO (Either [FileDiagnostic] a)
forall {b}. SourceError -> IO (Either [FileDiagnostic] b)
sourceErrorToDiagnostics (IO (Either [FileDiagnostic] a) -> IO (Either [FileDiagnostic] a))
-> IO (Either [FileDiagnostic] a) -> IO (Either [FileDiagnostic] a)
forall a b. (a -> b) -> a -> b
$
a -> Either [FileDiagnostic] a
forall a b. b -> Either a b
Right (a -> Either [FileDiagnostic] a)
-> IO a -> IO (Either [FileDiagnostic] a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a
ghcM
where
ghcExceptionToDiagnostics :: GhcException -> IO (Either [FileDiagnostic] b)
ghcExceptionToDiagnostics = Either [FileDiagnostic] b -> IO (Either [FileDiagnostic] b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [FileDiagnostic] b -> IO (Either [FileDiagnostic] b))
-> (GhcException -> Either [FileDiagnostic] b)
-> GhcException
-> IO (Either [FileDiagnostic] b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FileDiagnostic] -> Either [FileDiagnostic] b
forall a b. a -> Either a b
Left ([FileDiagnostic] -> Either [FileDiagnostic] b)
-> (GhcException -> [FileDiagnostic])
-> GhcException
-> Either [FileDiagnostic] b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> DynFlags -> GhcException -> [FileDiagnostic]
diagFromGhcException Text
fromWhere DynFlags
dflags
sourceErrorToDiagnostics :: SourceError -> IO (Either [FileDiagnostic] b)
sourceErrorToDiagnostics = Either [FileDiagnostic] b -> IO (Either [FileDiagnostic] b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [FileDiagnostic] b -> IO (Either [FileDiagnostic] b))
-> (SourceError -> Either [FileDiagnostic] b)
-> SourceError
-> IO (Either [FileDiagnostic] b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FileDiagnostic] -> Either [FileDiagnostic] b
forall a b. a -> Either a b
Left ([FileDiagnostic] -> Either [FileDiagnostic] b)
-> (SourceError -> [FileDiagnostic])
-> SourceError
-> Either [FileDiagnostic] b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> DynFlags -> Bag (MsgEnvelope DecoratedSDoc) -> [FileDiagnostic]
diagFromErrMsgs Text
fromWhere DynFlags
dflags
#if MIN_VERSION_ghc(9,3,0)
(Bag (MsgEnvelope DecoratedSDoc) -> [FileDiagnostic])
-> (SourceError -> Bag (MsgEnvelope DecoratedSDoc))
-> SourceError
-> [FileDiagnostic]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MsgEnvelope GhcMessage -> MsgEnvelope DecoratedSDoc)
-> Bag (MsgEnvelope GhcMessage) -> Bag (MsgEnvelope DecoratedSDoc)
forall a b. (a -> b) -> Bag a -> Bag b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((GhcMessage -> DecoratedSDoc)
-> MsgEnvelope GhcMessage -> MsgEnvelope DecoratedSDoc
forall a b. (a -> b) -> MsgEnvelope a -> MsgEnvelope b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GhcMessage -> DecoratedSDoc
forall a. Diagnostic a => a -> DecoratedSDoc
Compat.renderDiagnosticMessageWithHints) (Bag (MsgEnvelope GhcMessage) -> Bag (MsgEnvelope DecoratedSDoc))
-> (SourceError -> Bag (MsgEnvelope GhcMessage))
-> SourceError
-> Bag (MsgEnvelope DecoratedSDoc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Messages GhcMessage -> Bag (MsgEnvelope GhcMessage)
forall e. Messages e -> Bag (MsgEnvelope e)
Compat.getMessages
#endif
(Messages GhcMessage -> Bag (MsgEnvelope GhcMessage))
-> (SourceError -> Messages GhcMessage)
-> SourceError
-> Bag (MsgEnvelope GhcMessage)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceError -> Messages GhcMessage
srcErrorMessages
diagFromGhcException :: T.Text -> DynFlags -> GhcException -> [FileDiagnostic]
diagFromGhcException :: Text -> DynFlags -> GhcException -> [FileDiagnostic]
diagFromGhcException Text
diagSource DynFlags
dflags GhcException
exc = Text -> DiagnosticSeverity -> SrcSpan -> String -> [FileDiagnostic]
diagFromString Text
diagSource DiagnosticSeverity
DiagnosticSeverity_Error (String -> SrcSpan
noSpan String
"<Internal>") (DynFlags -> GhcException -> String
showGHCE DynFlags
dflags GhcException
exc)
showGHCE :: DynFlags -> GhcException -> String
showGHCE :: DynFlags -> GhcException -> String
showGHCE DynFlags
dflags GhcException
exc = case GhcException
exc of
Signal Int
n
-> String
"Signal: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n
Panic String
s
-> [String] -> String
unwords [String
"Compilation Issue:", String
s, String
"\n", String
requestReport]
PprPanic String
s SDoc
sdoc
-> [String] -> String
unlines [String
"Compilation Issue", String
s,String
""
, DynFlags -> SDoc -> String
Compat.showSDoc DynFlags
dflags SDoc
sdoc
, String
requestReport ]
Sorry String
s
-> String
"Unsupported feature: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
s
PprSorry String
s SDoc
sdoc
-> [String] -> String
unlines [String
"Unsupported feature: ", String
s,String
""
, DynFlags -> SDoc -> String
Compat.showSDoc DynFlags
dflags SDoc
sdoc]
InstallationError String
str
-> String
"Installation error: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
str
UsageError String
str
-> [String] -> String
unlines [String
"Unexpected usage error", String
str]
CmdLineError String
str
-> [String] -> String
unlines [String
"Unexpected usage error", String
str]
ProgramError String
str
-> String
"Program error: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
str
PprProgramError String
str SDoc
sdoc ->
[String] -> String
unlines [String
"Program error:", String
str,String
""
, DynFlags -> SDoc -> String
Compat.showSDoc DynFlags
dflags SDoc
sdoc]
where
requestReport :: String
requestReport = String
"Please report this bug to the compiler authors."