-- | Source errors
module GHC.Types.SourceError
   ( SourceError (..)
   , mkSrcErr
   , srcErrorMessages
   , throwErrors
   , throwOneError
   , handleSourceError
   , SourceErrorContext (..)
   , getSourceErrorContext
   , initSourceErrorContext
   )
where
import GHC.Prelude
import GHC.Types.Error
import GHC.Utils.Monad
import GHC.Utils.Panic
import GHC.Utils.Exception
import GHC.Utils.Error (pprMsgEnvelopeBagWithLocDefault, DiagOpts, diag_ppr_ctx)
import GHC.Utils.Outputable

import GHC.Driver.Config.Diagnostic (initDiagOpts, initPrintConfig)
import GHC.Driver.DynFlags (DynFlags, HasDynFlags (getDynFlags))
import GHC.Driver.Errors.Ppr () -- instance Diagnostic GhcMessage
import GHC.Driver.Errors.Types

import Control.Monad.Catch as MC (MonadCatch, catch)

mkSrcErr :: SourceErrorContext -> Messages GhcMessage -> SourceError
mkSrcErr :: SourceErrorContext -> Messages GhcMessage -> SourceError
mkSrcErr = SourceErrorContext -> Messages GhcMessage -> SourceError
SourceError

srcErrorMessages :: SourceError -> Messages GhcMessage
srcErrorMessages :: SourceError -> Messages GhcMessage
srcErrorMessages (SourceError SourceErrorContext
_ Messages GhcMessage
msgs) = Messages GhcMessage
msgs

throwErrors :: MonadIO io => SourceErrorContext -> Messages GhcMessage -> io a
throwErrors :: forall (io :: * -> *) a.
MonadIO io =>
SourceErrorContext -> Messages GhcMessage -> io a
throwErrors SourceErrorContext
sec = IO a -> io a
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> io a)
-> (Messages GhcMessage -> IO a) -> Messages GhcMessage -> io a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceError -> IO a
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (SourceError -> IO a)
-> (Messages GhcMessage -> SourceError)
-> Messages GhcMessage
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceErrorContext -> Messages GhcMessage -> SourceError
mkSrcErr SourceErrorContext
sec

throwOneError :: MonadIO io => SourceErrorContext -> MsgEnvelope GhcMessage -> io a
throwOneError :: forall (io :: * -> *) a.
MonadIO io =>
SourceErrorContext -> MsgEnvelope GhcMessage -> io a
throwOneError SourceErrorContext
sec = SourceErrorContext -> Messages GhcMessage -> io a
forall (io :: * -> *) a.
MonadIO io =>
SourceErrorContext -> Messages GhcMessage -> io a
throwErrors SourceErrorContext
sec (Messages GhcMessage -> io a)
-> (MsgEnvelope GhcMessage -> Messages GhcMessage)
-> MsgEnvelope GhcMessage
-> io a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MsgEnvelope GhcMessage -> Messages GhcMessage
forall e. MsgEnvelope e -> Messages e
singleMessage

-- | A source error is an error that is caused by one or more errors in the
-- source code.  A 'SourceError' is thrown by many functions in the
-- compilation pipeline.  Inside GHC these errors are merely printed via
-- 'log_action', but API clients may treat them differently, for example,
-- insert them into a list box.  If you want the default behaviour, use the
-- idiom:
--
-- > handleSourceError printExceptionAndWarnings $ do
-- >   ... api calls that may fail ...
--
-- The 'SourceError's error messages can be accessed via 'srcErrorMessages'.
-- This list may be empty if the compiler failed due to @-Werror@
-- ('Opt_WarnIsError').
--
-- See 'printExceptionAndWarnings' for more information on what to take care
-- of when writing a custom error handler.
data SourceError = SourceError SourceErrorContext (Messages GhcMessage)

data SourceErrorContext
  = SEC
      !DiagOpts
      !(DiagnosticOpts GhcMessage)

getSourceErrorContext :: (Monad m, HasDynFlags m) => m SourceErrorContext
getSourceErrorContext :: forall (m :: * -> *).
(Monad m, HasDynFlags m) =>
m SourceErrorContext
getSourceErrorContext = do
  dflags <- m DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
  return $ initSourceErrorContext dflags

initSourceErrorContext :: DynFlags -> SourceErrorContext
initSourceErrorContext :: DynFlags -> SourceErrorContext
initSourceErrorContext DynFlags
dflags =
  let !diag_opts :: DiagOpts
diag_opts = DynFlags -> DiagOpts
initDiagOpts DynFlags
dflags
      !print_config :: DiagnosticOpts GhcMessage
print_config = DynFlags -> DiagnosticOpts GhcMessage
initPrintConfig DynFlags
dflags
  in DiagOpts -> DiagnosticOpts GhcMessage -> SourceErrorContext
SEC DiagOpts
diag_opts DiagnosticOpts GhcMessage
print_config

instance Show SourceError where
  -- We implement 'Show' because it's required by the 'Exception' instance, but diagnostics
  -- shouldn't be shown via the 'Show' typeclass, but rather rendered using the ppr functions.
  -- This also explains why there is no 'Show' instance for a 'MsgEnvelope'.
  show :: SourceError -> String
show (SourceError (SEC DiagOpts
diag_opts DiagnosticOpts GhcMessage
_) Messages GhcMessage
msgs) =
      SDocContext -> SDoc -> String
renderWithContext (DiagOpts -> SDocContext
diag_ppr_ctx DiagOpts
diag_opts)
    (SDoc -> String)
-> (Messages GhcMessage -> SDoc) -> Messages GhcMessage -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
    ([SDoc] -> SDoc)
-> (Messages GhcMessage -> [SDoc]) -> Messages GhcMessage -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bag (MsgEnvelope GhcMessage) -> [SDoc]
forall e. Diagnostic e => Bag (MsgEnvelope e) -> [SDoc]
pprMsgEnvelopeBagWithLocDefault
    (Bag (MsgEnvelope GhcMessage) -> [SDoc])
-> (Messages GhcMessage -> Bag (MsgEnvelope GhcMessage))
-> Messages GhcMessage
-> [SDoc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Messages GhcMessage -> Bag (MsgEnvelope GhcMessage)
forall e. Messages e -> Bag (MsgEnvelope e)
getMessages
    (Messages GhcMessage -> String) -> Messages GhcMessage -> String
forall a b. (a -> b) -> a -> b
$ Messages GhcMessage
msgs

instance Exception SourceError

-- | Perform the given action and call the exception handler if the action
-- throws a 'SourceError'.  See 'SourceError' for more information.
handleSourceError :: (MonadCatch m) =>
                     (SourceError -> m a) -- ^ exception handler
                  -> m a -- ^ action to perform
                  -> m a
handleSourceError :: forall (m :: * -> *) a.
MonadCatch m =>
(SourceError -> m a) -> m a -> m a
handleSourceError SourceError -> m a
handler m a
act =
  m a -> (SourceError -> m a) -> m a
forall e a. (HasCallStack, Exception e) => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
MC.catch m a
act (\(SourceError
e :: SourceError) -> SourceError -> m a
handler SourceError
e)