-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0
module Development.IDE.GHC.Error
  (
    -- * Producing Diagnostic values
    diagFromErrMsgs
  , diagFromErrMsg
  , diagFromString
  , diagFromStrings
  , diagFromGhcException
  , catchSrcErrors

  -- * utilities working with spans
  , srcSpanToLocation
  , srcSpanToRange
  , realSrcSpanToRange
  , realSrcLocToPosition
  , realSrcSpanToLocation
  , srcSpanToFilename
  , rangeToSrcSpan
  , rangeToRealSrcSpan
  , positionToRealSrcLoc
  , zeroSpan
  , realSpan
  , isInsideSrcSpan
  , noSpan

  -- * utilities working with severities
  , toDSeverity
  ) where

import                     Development.IDE.Types.Diagnostics as D
import qualified           Data.Text as T
import Data.Maybe
import Development.IDE.Types.Location
import Development.IDE.GHC.Orphans()
import qualified FastString as FS
import           GHC
import           Bag
import HscTypes
import Panic
import           ErrUtils
import           SrcLoc
import qualified Outputable                 as Out
import Data.String (fromString)



diagFromText :: T.Text -> D.DiagnosticSeverity -> SrcSpan -> T.Text -> FileDiagnostic
diagFromText :: Text -> DiagnosticSeverity -> SrcSpan -> Text -> FileDiagnostic
diagFromText Text
diagSource DiagnosticSeverity
sev SrcSpan
loc Text
msg = (FilePath -> NormalizedFilePath
toNormalizedFilePath' (FilePath -> NormalizedFilePath) -> FilePath -> NormalizedFilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
noFilePath (Maybe FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Maybe FilePath
srcSpanToFilename SrcSpan
loc,ShowDiagnostic
ShowDiag,)
    Diagnostic :: Range
-> Maybe DiagnosticSeverity
-> Maybe (Int |? Text)
-> Maybe Text
-> Text
-> Maybe (List DiagnosticTag)
-> Maybe (List DiagnosticRelatedInformation)
-> Diagnostic
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 -- not shown in the IDE, but useful for ghcide developers
    , $sel:_message:Diagnostic :: Text
_message  = Text
msg
    , $sel:_code:Diagnostic :: Maybe (Int |? Text)
_code     = Maybe (Int |? Text)
forall a. Maybe a
Nothing
    , $sel:_relatedInformation:Diagnostic :: Maybe (List DiagnosticRelatedInformation)
_relatedInformation = Maybe (List DiagnosticRelatedInformation)
forall a. Maybe a
Nothing
    , $sel:_tags:Diagnostic :: Maybe (List DiagnosticTag)
_tags     = Maybe (List DiagnosticTag)
forall a. Maybe a
Nothing
    }

-- | Produce a GHC-style error from a source span and a message.
diagFromErrMsg :: T.Text -> DynFlags -> ErrMsg -> [FileDiagnostic]
diagFromErrMsg :: Text -> DynFlags -> ErrMsg -> [FileDiagnostic]
diagFromErrMsg Text
diagSource DynFlags
dflags ErrMsg
e =
    [ Text -> DiagnosticSeverity -> SrcSpan -> Text -> FileDiagnostic
diagFromText Text
diagSource DiagnosticSeverity
sev (ErrMsg -> SrcSpan
errMsgSpan ErrMsg
e)
      (Text -> FileDiagnostic) -> Text -> FileDiagnostic
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ DynFlags -> ErrMsg -> FilePath
formatErrorWithQual DynFlags
dflags ErrMsg
e
    | Just DiagnosticSeverity
sev <- [Severity -> Maybe DiagnosticSeverity
toDSeverity (Severity -> Maybe DiagnosticSeverity)
-> Severity -> Maybe DiagnosticSeverity
forall a b. (a -> b) -> a -> b
$ ErrMsg -> Severity
errMsgSeverity ErrMsg
e]]

formatErrorWithQual :: DynFlags -> ErrMsg -> String
formatErrorWithQual :: DynFlags -> ErrMsg -> FilePath
formatErrorWithQual DynFlags
dflags ErrMsg
e =
    DynFlags -> SDoc -> FilePath
Out.showSDoc DynFlags
dflags
    (SDoc -> FilePath) -> SDoc -> FilePath
forall a b. (a -> b) -> a -> b
$ PprStyle -> SDoc -> SDoc
Out.withPprStyle (DynFlags -> PrintUnqualified -> PprStyle
Out.mkErrStyle DynFlags
dflags (PrintUnqualified -> PprStyle) -> PrintUnqualified -> PprStyle
forall a b. (a -> b) -> a -> b
$ ErrMsg -> PrintUnqualified
errMsgContext ErrMsg
e)
    (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ DynFlags -> ErrDoc -> SDoc
ErrUtils.formatErrDoc DynFlags
dflags
    (ErrDoc -> SDoc) -> ErrDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ ErrMsg -> ErrDoc
ErrUtils.errMsgDoc ErrMsg
e

diagFromErrMsgs :: T.Text -> DynFlags -> Bag ErrMsg -> [FileDiagnostic]
diagFromErrMsgs :: Text -> DynFlags -> Bag ErrMsg -> [FileDiagnostic]
diagFromErrMsgs Text
diagSource DynFlags
dflags = (ErrMsg -> [FileDiagnostic]) -> [ErrMsg] -> [FileDiagnostic]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text -> DynFlags -> ErrMsg -> [FileDiagnostic]
diagFromErrMsg Text
diagSource DynFlags
dflags) ([ErrMsg] -> [FileDiagnostic])
-> (Bag ErrMsg -> [ErrMsg]) -> Bag ErrMsg -> [FileDiagnostic]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bag ErrMsg -> [ErrMsg]
forall a. Bag a -> [a]
bagToList

-- | Convert a GHC SrcSpan to a DAML compiler Range
srcSpanToRange :: SrcSpan -> Maybe Range
srcSpanToRange :: SrcSpan -> Maybe Range
srcSpanToRange (UnhelpfulSpan FastString
_)  = Maybe Range
forall a. Maybe a
Nothing
srcSpanToRange (RealSrcSpan RealSrcSpan
real) = 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
realSrcSpanStart RealSrcSpan
real)
        (RealSrcLoc -> Position
realSrcLocToPosition (RealSrcLoc -> Position) -> RealSrcLoc -> Position
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> RealSrcLoc
realSrcSpanEnd   RealSrcSpan
real)

realSrcLocToPosition :: RealSrcLoc -> Position
realSrcLocToPosition :: RealSrcLoc -> Position
realSrcLocToPosition RealSrcLoc
real =
  Int -> Int -> Position
Position (RealSrcLoc -> Int
srcLocLine RealSrcLoc
real Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (RealSrcLoc -> Int
srcLocCol RealSrcLoc
real Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

-- | Extract a file name from a GHC SrcSpan (use message for unhelpful ones)
-- FIXME This may not be an _absolute_ file name, needs fixing.
srcSpanToFilename :: SrcSpan -> Maybe FilePath
srcSpanToFilename :: SrcSpan -> Maybe FilePath
srcSpanToFilename (UnhelpfulSpan FastString
_) = Maybe FilePath
forall a. Maybe a
Nothing
srcSpanToFilename (RealSrcSpan RealSrcSpan
real) = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ FastString -> FilePath
FS.unpackFS (FastString -> FilePath) -> FastString -> FilePath
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
$ FilePath -> NormalizedFilePath
toNormalizedFilePath' (FilePath -> NormalizedFilePath) -> FilePath -> NormalizedFilePath
forall a b. (a -> b) -> a -> b
$ FastString -> FilePath
FS.unpackFS (FastString -> FilePath) -> FastString -> FilePath
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
real

srcSpanToLocation :: SrcSpan -> Maybe Location
srcSpanToLocation :: SrcSpan -> Maybe Location
srcSpanToLocation SrcSpan
src = do
  FilePath
fs <- SrcSpan -> Maybe FilePath
srcSpanToFilename SrcSpan
src
  Range
rng <- SrcSpan -> Maybe Range
srcSpanToRange SrcSpan
src
  -- important that the URI's we produce have been properly normalized, otherwise they point at weird places in VS Code
  Location -> Maybe Location
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
$ FilePath -> NormalizedFilePath
toNormalizedFilePath' FilePath
fs) Range
rng

rangeToSrcSpan :: NormalizedFilePath -> Range -> SrcSpan
rangeToSrcSpan :: NormalizedFilePath -> Range -> SrcSpan
rangeToSrcSpan = (RealSrcSpan -> SrcSpan)
-> (Range -> RealSrcSpan) -> Range -> SrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RealSrcSpan -> SrcSpan
RealSrcSpan ((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
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 (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 Int
l Int
c)=
    FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc (FilePath -> FastString
forall a. IsString a => FilePath -> a
fromString (FilePath -> FastString) -> FilePath -> FastString
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> FilePath
fromNormalizedFilePath NormalizedFilePath
nfp) (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
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

-- | Convert a GHC severity to a DAML compiler Severity. Severities below
-- "Warning" level are dropped (returning Nothing).
toDSeverity :: GHC.Severity -> Maybe D.DiagnosticSeverity
toDSeverity :: Severity -> Maybe DiagnosticSeverity
toDSeverity Severity
SevOutput      = Maybe DiagnosticSeverity
forall a. Maybe a
Nothing
toDSeverity Severity
SevInteractive = Maybe DiagnosticSeverity
forall a. Maybe a
Nothing
toDSeverity Severity
SevDump        = Maybe DiagnosticSeverity
forall a. Maybe a
Nothing
toDSeverity Severity
SevInfo        = DiagnosticSeverity -> Maybe DiagnosticSeverity
forall a. a -> Maybe a
Just DiagnosticSeverity
DsInfo
toDSeverity Severity
SevWarning     = DiagnosticSeverity -> Maybe DiagnosticSeverity
forall a. a -> Maybe a
Just DiagnosticSeverity
DsWarning
toDSeverity Severity
SevError       = DiagnosticSeverity -> Maybe DiagnosticSeverity
forall a. a -> Maybe a
Just DiagnosticSeverity
DsError
toDSeverity Severity
SevFatal       = DiagnosticSeverity -> Maybe DiagnosticSeverity
forall a. a -> Maybe a
Just DiagnosticSeverity
DsError


-- | Produce a bag of GHC-style errors (@ErrorMessages@) from the given
--   (optional) locations and message strings.
diagFromStrings :: T.Text -> D.DiagnosticSeverity -> [(SrcSpan, String)] -> [FileDiagnostic]
diagFromStrings :: Text
-> DiagnosticSeverity -> [(SrcSpan, FilePath)] -> [FileDiagnostic]
diagFromStrings Text
diagSource DiagnosticSeverity
sev = ((SrcSpan, FilePath) -> [FileDiagnostic])
-> [(SrcSpan, FilePath)] -> [FileDiagnostic]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((SrcSpan -> FilePath -> [FileDiagnostic])
-> (SrcSpan, FilePath) -> [FileDiagnostic]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Text
-> DiagnosticSeverity -> SrcSpan -> FilePath -> [FileDiagnostic]
diagFromString Text
diagSource DiagnosticSeverity
sev))

-- | Produce a GHC-style error from a source span and a message.
diagFromString :: T.Text -> D.DiagnosticSeverity -> SrcSpan -> String -> [FileDiagnostic]
diagFromString :: Text
-> DiagnosticSeverity -> SrcSpan -> FilePath -> [FileDiagnostic]
diagFromString Text
diagSource DiagnosticSeverity
sev SrcSpan
sp FilePath
x = [Text -> DiagnosticSeverity -> SrcSpan -> Text -> FileDiagnostic
diagFromText Text
diagSource DiagnosticSeverity
sev SrcSpan
sp (Text -> FileDiagnostic) -> Text -> FileDiagnostic
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
x]


-- | Produces an "unhelpful" source span with the given string.
noSpan :: String -> SrcSpan
noSpan :: FilePath -> SrcSpan
noSpan = FastString -> SrcSpan
UnhelpfulSpan (FastString -> SrcSpan)
-> (FilePath -> FastString) -> FilePath -> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FastString
FS.fsLit


-- | creates a span with zero length in the filename of the argument passed
zeroSpan :: FS.FastString -- ^ file path of span
         -> RealSrcSpan
zeroSpan :: FastString -> RealSrcSpan
zeroSpan FastString
file = RealSrcLoc -> RealSrcSpan
realSrcLocSpan (FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc FastString
file Int
1 Int
1)

realSpan :: SrcSpan
         -> Maybe RealSrcSpan
realSpan :: SrcSpan -> Maybe RealSrcSpan
realSpan = \case
  RealSrcSpan RealSrcSpan
r -> RealSrcSpan -> Maybe RealSrcSpan
forall a. a -> Maybe a
Just RealSrcSpan
r
  UnhelpfulSpan FastString
_ -> Maybe RealSrcSpan
forall a. Maybe a
Nothing


-- | Catch the errors thrown by GHC (SourceErrors and
-- compiler-internal exceptions like Panic or InstallationError), and turn them into
-- diagnostics
catchSrcErrors :: DynFlags -> T.Text -> IO a -> IO (Either [FileDiagnostic] a)
catchSrcErrors :: 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
handleGhcException (DynFlags -> GhcException -> IO (Either [FileDiagnostic] a)
forall (m :: * -> *) b.
Monad m =>
DynFlags -> GhcException -> m (Either [FileDiagnostic] b)
ghcExceptionToDiagnostics DynFlags
dflags) (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.
ExceptionMonad m =>
(SourceError -> m a) -> m a -> m a
handleSourceError (DynFlags -> SourceError -> IO (Either [FileDiagnostic] a)
forall (m :: * -> *) b.
Monad m =>
DynFlags -> SourceError -> m (Either [FileDiagnostic] b)
sourceErrorToDiagnostics DynFlags
dflags) (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 :: DynFlags -> GhcException -> m (Either [FileDiagnostic] b)
ghcExceptionToDiagnostics DynFlags
dflags = Either [FileDiagnostic] b -> m (Either [FileDiagnostic] b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [FileDiagnostic] b -> m (Either [FileDiagnostic] b))
-> (GhcException -> Either [FileDiagnostic] b)
-> GhcException
-> m (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 :: DynFlags -> SourceError -> m (Either [FileDiagnostic] b)
sourceErrorToDiagnostics DynFlags
dflags = Either [FileDiagnostic] b -> m (Either [FileDiagnostic] b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [FileDiagnostic] b -> m (Either [FileDiagnostic] b))
-> (SourceError -> Either [FileDiagnostic] b)
-> SourceError
-> m (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 ErrMsg -> [FileDiagnostic]
diagFromErrMsgs Text
fromWhere DynFlags
dflags (Bag ErrMsg -> [FileDiagnostic])
-> (SourceError -> Bag ErrMsg) -> SourceError -> [FileDiagnostic]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceError -> Bag ErrMsg
srcErrorMessages


diagFromGhcException :: T.Text -> DynFlags -> GhcException -> [FileDiagnostic]
diagFromGhcException :: Text -> DynFlags -> GhcException -> [FileDiagnostic]
diagFromGhcException Text
diagSource DynFlags
dflags GhcException
exc = Text
-> DiagnosticSeverity -> SrcSpan -> FilePath -> [FileDiagnostic]
diagFromString Text
diagSource DiagnosticSeverity
DsError (FilePath -> SrcSpan
noSpan FilePath
"<Internal>") (DynFlags -> GhcException -> FilePath
showGHCE DynFlags
dflags GhcException
exc)

showGHCE :: DynFlags -> GhcException -> String
showGHCE :: DynFlags -> GhcException -> FilePath
showGHCE DynFlags
dflags GhcException
exc = case GhcException
exc of
        Signal Int
n
          -> FilePath
"Signal: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n

        Panic FilePath
s
          -> [FilePath] -> FilePath
unwords [FilePath
"Compilation Issue:", FilePath
s, FilePath
"\n", FilePath
requestReport]
        PprPanic  FilePath
s SDoc
sdoc
          -> [FilePath] -> FilePath
unlines [FilePath
"Compilation Issue", FilePath
s,FilePath
""
                     , DynFlags -> SDoc -> FilePath
Out.showSDoc DynFlags
dflags SDoc
sdoc
                     , FilePath
requestReport ]

        Sorry FilePath
s
          -> FilePath
"Unsupported feature: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
s
        PprSorry FilePath
s SDoc
sdoc
          -> [FilePath] -> FilePath
unlines [FilePath
"Unsupported feature: ", FilePath
s,FilePath
""
                     , DynFlags -> SDoc -> FilePath
Out.showSDoc DynFlags
dflags SDoc
sdoc]


        ---------- errors below should not happen at all --------
        InstallationError FilePath
str
          -> FilePath
"Installation error: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
str

        UsageError FilePath
str -- should never happen
          -> [FilePath] -> FilePath
unlines [FilePath
"Unexpected usage error", FilePath
str]

        CmdLineError FilePath
str
          -> [FilePath] -> FilePath
unlines [FilePath
"Unexpected usage error", FilePath
str]

        ProgramError FilePath
str
            -> FilePath
"Program error: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
str
        PprProgramError FilePath
str  SDoc
sdoc  ->
            [FilePath] -> FilePath
unlines [FilePath
"Program error:", FilePath
str,FilePath
""
                    , DynFlags -> SDoc -> FilePath
Out.showSDoc DynFlags
dflags SDoc
sdoc]
  where
    requestReport :: FilePath
requestReport = FilePath
"Please report this bug to the compiler authors."